ROTATION PREDICTION FUNCTIONS (RPF)

INTRODUCTION

The rotation image prediction functions are a set of program independent Fortran subroutines to enable the prediction of monochromatic X-ray crystallographic rotation images. Routines included for generating a set of unique reflections for a given cell and space group. The coding of the main rotation prediction function is closely based on code from OSCGEN & MADNES by Peter Brick, Andrew Leslie, Jean Claude Thierry, Alan J. Wonacott and J. W. Pflugrath from Reeke prediction coded by R.M. Sweet.

The following sets of routines are available:

Rotation Prediction Functions
Set Up and Utility Routines
Unique Data Analysis

ROTATION PREDICTION FUNCTIONS

Introduction

These routines include the main prediction function and some additional functions to assist the user with preparing a program/detector specific output routine.

The following routines are available:

Rotation prediction function - RPF_PREDICT
Get spot fractions - RPF_FRACS
Get flat detector coordinates - RPF_RTOD

Rotation prediction function - RPF_PREDICT

The routine rpf_predict is used to reflections for monochromatic rotation method. It is closely Based on code from OSCGEN & MADNES by Peter Brick, Andrew Leslie, Jean Claude Thierry, Alan J. Wonacott and J. W. Pflugrathoth from Reeke prediction coded by R.M. Sweet. In this packaging, the program dependent aspsects have been removed. In particular this affects the way in which the predicted reflection data are stored once they have been predicted and how they relate to spot positions on the detector. The user needs to supply a routine to perform this function but some additional routines are supplied to assist this process. The prediction routine handles systematic absences as determined by the lattice type but the user supplied output routine should handle any additional absences.
 
Fortran call:
 
      SUBROUTINE RPF_PREDICT (ROTS, ROTE, APRS, APRE, APRSX, APREX,
     *                 IAX, S0, SCAX, DST2MX, DSTPL2, NWMAX, LATT, 
     *                 ISYN, DIVH, DIVV, ETA, DELAMB, DELCOR,
     *                 IAX_H, IAX_V, QUICK, SAVSPOT, IERR)
 
Parameters:
 
 ROTS       (R)  Rotation start angle in degrees.
 ROTE       (R)  Rotation end angle in degrees.
 APRS(3,3)  (R)  Orientation matrix at start of rotation range.
 APRE(3,3)  (R)  Orientation matrix at end of rotation range.
 APRSX(3,3) (R)  Orientation matrix at start of range extended (in negative 
                 direction) by maximum possible reflection width.
 APREX(3,3) (R)  Orientation matrix at end of range extended (in positive
                 direction) by maximum possible reflection width.
 IAX(3)     (R)  Order of varying indices for Reeke algorithm.
                 IAX(1) r.l. axis most nearly parallel/antiparallel
                        to X-ray beam.
                 IAX(3) r.l. axis most nearly parallel/antiparallel to 
                        rotation axis away from spindle
                 IAX(2) remaining r.l. axis
 S0(3)      (R)  Beam direction vector wrt laboratory axes.
 SCAX(3)    (R)  Scan axis direction vector  wrt laboratory axes.
 DST2MX     (R)  Maximum value of (dstar)**2
 DSTPL2     (R)  Maximum value of (dstar)**2 allowing for a bit extra for
                 determining overlaps at edge of image
 NWMAX      (R)  Maximum no. of images over which a spot may be spread.
 LATT       (R)  Lattice type flag 1-7 for P, A, B, C, I, F, R for lattice
                 based systematic absences. User must handle other space
                 group specific absences in user supplied SAVSPOT routine.
 ISYN       (R)  Source type flag =0 lab source, =1 synchrotron.
 DIVH       (R)  Horizontal beam divergence (half-width, radians)
 DIVV       (R)  Verticaal beam divergence (half-width, radians)
 ETA        (R)  Mosaicity (half_width, radians).
 DELAMB     (R)  Dispersion (Delta(lambda)/lambda)
 DELCOR     (R)  Correlated dispersion term (Only used for synchrotron)
                 (half-width, radians)
 IAX_H      (R)  No. of horizontal axis in laborarory system (1=X, 2=Y, 3=Z)
 IAX_V      (R)  No. of vertical axis in laborarory system (1=X, 2=Y, 3=Z)
 QUICK      (R)  Logical flag; If .true. do a quick analysis which does
                 not distinguish between fulls & partials and which does
                 not calculate relection widths. If .false. do the full
                 detailed prediction.
 SAVSPOT    (S)  Routine to convert spot coordinates to detector coordinates
                 & save  spot details as desired. This user supplied routine
                 may call RPF_RTOD if appropriate. Also, if a detailed
                 prediction has been done (QUICK = .false.) RPF_FRACS 
                 may be called to obtain additional items of information 
                 about the predicted reflection not passed via the 
                 subroutine parameters. The routine should also check
                 for any systematic absences in addition to those due to
                 the basic lattice type. The parameters in the call depend
                 on the value of the flag QUICK and are as follows:

                 if QUICK = .FALSE. (detailed analysis requested)

                 CALL SAVSPOT (IHKL, IR_FLAG, INR_FLAG, NIMG, IFIRST, 
                +              XRLPE, PHI, PHIW, RLORF, DST2MX, IERR)

                 INTEGER IHKL(3)    (R)  Reflection indices
                 INTEGER IR_FLAG    (R)  Recorded flag      
                                             0 = not recorded
                                             1 = full
                                             2 = good partial 
                                                 (<= nwmax images)
                                             3 = too-wide partial
                                             4 = within cusp but part 
                                                 visible
                 INTEGER INR_FLAG   (R)  Not recorded flag   
                                             0 = recorded
                                             1 = on rotation axis
                                             2 = within cusp
                                             3 = > extended resol limit
                                             4 = not-recorded but still 
                                                 in list
                 INTEGER NIMG       (R)  No. of images over which spot 
                                         spread (1=full spot)
                                         0 if too wide (>NWMAX images)
                 INTEGER IFIRST     (R)  First image for spot (offset from 
                                         current image)
                 REAL XRLPE(3)      (R)  Reciprocal lattice coordinates for
                                         reflection on Ewald sphere wrt the 
                                         laboratory axes.
                 REAL PHI           (R)  Phi value when rlp is on the Ewald
                                         sphere
                 REAL PHIW          (R)  Reflection width
                 REAL RLORF         (R)  Lorentz factor
                 DST2MX             (R)  Maximum value of (dstar)**2 as
                                         used in RPF_PREDICT call
                 IERR               (W)  Error flag (returned via
                                         RPF_PREDICT parameter IERR)
                                         Must be set to 0 if OK and
                                         a non-zero value for an error.

                 if QUICK = .TRUE. (quick analysis requested)

                 CALL SAVSPOT (IHKL, IR_FLAG, INR_FLAG, PHI, DST2MX,
                +              IERR)

                 INTEGER IHKL(3)    (R)  Reflection indices
                 INTEGER IR_FLAG    (R)  Recorded flag      
                                             0 = not recorded
                                             1 = recorded (full/partial)
                 INTEGER INR_FLAG   (R)  Not recorded flag   
                                             0 = recorded
                                             1 = on rotation axis
                                             2 = within cusp
                 REAL PHI           (R)  Phi value when rlp is on the Ewald
                                         sphere
                 DST2MX             (R)  Maximum value of (dstar)**2 as
                                         used in RPF_PREDICT call
                 IERR               (W)  Error flag (returned via
                                         RPF_PREDICT parameter IERR)
                                         Must be set to 0 if OK and
                                         a non-zero value for an error.

 IERR       (W)  Error flag from SAVSPOT routine

Get spot fractions - RPF_FRACS

This routine may be called by the user supplied output subroutine for the rpf_predict subroutine to access the spot fraction parameters calculated for the reflection for which the output routine has been called.
 
Fortran call:
 
      SUBROUTINE RPF_FRACS (DEL_EPS1, DEL_EPS2, D_RATIO)
 
Parameters:
 
DEL_EPS1  (W)  Fraction of spot remaining to pass through Ewald
               sphere at start of oscillation.
DEL_EPS2  (W)  Fraction of spot that has already passed through
               Ewald sphere at end of oscillation.
D_RATIO   (W)  Fraction recorded for rejection criterion >=1.0 for fully's, 
               the larger the safer.

Get flat detector coordinates - RPF_RTOD

This routine enables the conversion of reciprocal lattice coordinates to the spot positions on a flat detector. It may be used, for example, in the user supplied output routine to the rpf_predict subroutine. This subroutine was created using code written by Albrecht Messerschmidt. (from MADNES)
 
Fortran call:
 
      SUBROUTINE RPF_RTOD (XR, CTOD, S0, DN, DDINV, XD, YD)
 
Parameters:
 
XR(3)       (R)  Reciprocal lattice coordinates (laboratory axes)
CTOD        (R)  Crystal to detector distance (mm)
S0(3)       (R)  Beam direction vector wrt laboratory axes
DN(3)       (R)  Detector normal vector wrt laboratory axes
DDINV(3,3)  (R)  Inverse of detector orientation matrix
XD          (W)  Axis 1 (x) coordinate of spot on detector (mm from origin)
YD          (W)  Axis 2 (y) coordinate of spot on detector (mm from origin)
                 Note: See for example rpf_set_mosdet for setting values for 
                       DDINV, DN

SET UP AND UTILITY ROUTINES

Introduction

These are a number of routines which may be useful in setting up parameters in preparation for using the reflection prediction routines themselves.

The following routines are available:

Set up detector matrices - RPF_SET_MOSDET
Form a rotation matrix - RPF_RTM
Set up orthogonalisation matrix - RPF_SET_BMATRIX
Convert Between Real and Reciprocal Cells - RPF_RECCEL
Get axis order for Reeke prediction - RPF_SETAX

Set up detector matrices - RPF_SET_MOSDET

This routine enables the Setting up of the (flat plate) detector orientation matrix, its inverse and detector normal vector based on the MOSFLM convention of laboratory axes.
 
Fortran call:
 
      SUBROUTINE RPF_SET_MOSDET (CCX, CCY, CTOD, TAU1, TAU2, TAU3,
     +                           DGDA, DGDV, DD, DDINV, DN)
 
Parameters:
 
CCX         (R)   Camera constant ccx (mm)
CCY         (R)   Camera constant ccy (mm)
CTOD        (R)   Crystal to detector distance (mm) - always positive
TAU1        (R)   Detector rotation around 1'st detector axis (degrees)
TAU2        (R)   Detector rotation around 2'nd detector axis (degrees)
TAU3        (R)   Detector rotation around 3'nd detector axis (degrees)
DGDA(j,i)   (R)   Components 'j' of the detector rotation axes 'i'
DGDV(j,i)   (R)   Components 'j' of detector vectors 'i' = dx, dy
DD(3,3)     (W)   Detector orientation matrix
DDINV(3,3)  (W)   Inverse of 'DD' matrix
DN(3)       (W)   Vector defining rotation axis

Form a rotation matrix - RPF_RTM

This routine creates a rotation matrix with respect to an angle of rotation about a given axis. The direction of the input vector is taken as the axis down which the rotation represented by the matrix is seen to be clockwise, and the angle of rotation is taken to be in radians.
 
Fortran call:
 
      SUBROUTINE  RPF_RTM (ANGLE, AXIS, MATS)
 
Parameters:
 
ANGLE      (R)  Rotation angle in radians
AXIS(3)    (R)  Rotation axis (unit vector)
MATS(3,3)  (W)  Returns the required rotation matrix

Set up orthogonalisation matrix - RPF_SET_BMATRIX

This routine sets up the standard orthogonalisation or 'B' matrix given the unit cell parameters and a wavelength.
 
Fortran call:
 
      SUBROUTINE RPF_SET_BMATRIX (CELL, WAVE, BMAT)
 
Parameters:
 
CELL(6)    (R)   Real cell dimensions (Angstroms and degrees)
WAVE       (R)   Wavelength (Angstroms)
BMAT(3,3)  (W)   Returns the 'B' matrix

Convert Between Real and Reciprocal Cells - RPF_RECCEL

This routine converts between real and reciprocal cell parameters.
 
Fortran call:
 
      SUBROUTINE RPF_RECCEL(RX, CX ,WAVE)
 
Parameters:
 
RX(6)   r  (W) Converted cell parameters reciprocal or real
CX(6)   r  (R) Input cell parameters real or reciprocal
WAVE    r  (R) Standard wavelength

Get axis order for Reeke prediction - RPF_SETAX

This routine gets the axis nearest to the rotation axis and the axis nearest to the beam direction for use in the Reeke prediction algorithm as used for example in RPF_PREDICT.
 
Fortran call:
 
      SUBROUTINE RPF_SETAX(BBEG, BEND, IAX)
 
Parameters:
 
BBEG(3,3)  r  (R)  Orientation matrix at start of rotation with 
                   misseting angles and start rotation angle applied
BEND(3,3)  r  (R)  Orientation matrix at end of rotation with 
                   misseting angles and end rotation angle applied
IAX(3)     i  (W)  Axis most nearly along rotation axis IAX(3), beam
                   IAX(1) and remaining axis IAX(2) (Flags 1-3)

UNIQUE DATA ANALYSIS

Introduction

A routine is available for generating a lists of unique reflections for a given cell and symmetry. It requires the use of the keyword symmetry module (KSM) routines to handle the symmetry and the set of Fortran/C routines for handling unique reflection lists. The latter routines enable reflection counts of predicted or observed data to be accumulated for the purpose of gathering unique data coverage statistics.

The following routines are available:

Generate unique reflections list - RPF_UNQ_GEN

Generate unique reflections list - RPF_UNQ_GEN

This routine will generate a list of the unique relections for a given resolution range and cell based on the current KSM symmetry data which must have been be defined. The unique reflections list is stored internally and may be accessed via routine which are part of the set of routines for handling unique reflections lists.
 
Fortran call:
 
      SUBROUTINE RPF_UNQ_GEN (MINDX_UNQ, CELL, WAVE, RESMIN, RESMAX,  
     +                        NUNIQUE, IERR)
 
Parameters:
 
 MINDX_UNQ i (R/W)   Index for accessing unique data list; if -1 on input
                     then a new list is generated. Otherwise it must be
                     set equal to that returned from a previous call
                     to RPF_UNQ_GEN. Returns the index found (-1 if error)
 CELL(6)   r (R)     The real cell parameters in Angstroms and degrees
 WAVE      r (R)     The wavelength
 RESMIN    r (R)     Minimum resolution limit in Angstroms  
 RESMAX    r (R)     Maximum resolution limit in Angstroms 
 NUNIQUE   i (W)     No. of unique reflections generated
 IERR      i (W)     Error flag =0  OK, 
                                =1  No symmetry defined,
                                =2  too may reflections to store
                                =-1 Cannot allocate required memory
       
                     Resolution limits may be in either order; one may be
                     0.0 to indicate a low resolution limit of infinity



John W. Campbell
CCLRC Daresbury Laboratory
Last update 28 Aug 1996