SUBROUTINE ABSCOR(IS)

Applies absorption corrections to groups of equivalent
reflections.

Arguments:

On entry IS =0 for the initial seting up, or 1 for the calculation

Prerequisite calls:

SYMOP, RECIP, SETABS should be obeyed first to set up calls of ABSOR
A group of reflections should be present in /REFS/

Output:

If IOUT is > 9 on entry IS=0, creates output unit LP2 (Note that this is a non-standard use of IOUT &$1;better change)
For entries IS=1, writes to that unit

Notes:

A PJB speciality called from ABSMSF

Calls:

ABSOR ANGDIR DEGREE EQVEC GMEQ GMSCA INDFIX NOPFIL TESTP UPONE WTMEAN

Called by:

ABSMSF INCMSF

Common blocks used:

/BRAGG/ to use DIFANG

/CONSTA/ to use RAD

/DGEOM/ to use IGEOM

/HEDABS/ to use all members

/HEDAB2/ to use all members

/IOUNIT/ to use IOUT

/REFS/ to use LL INC II ITEMS

/SCRACH/ to use MESSAG

*** ABSCOR updated by PJB 24-Apr-1995 ***

FUNCTION ABSOR(H)

Forms a transmission (=1/absorption) factor or related integrals.

Arguments:

On entry H is a 3-size real array holding h,k,l

Prerequisite calls:

On entry, SETABS (or a MAIN program) has placed in COMMON /ABSDAT

AMU = mu, the coefficient of absorption
MODEA = which integral is required -
MODEA = 1 usual exp(-mu(in+out)) transmission factor to ABSC(1)
MODEA = 2 path in exp(-mu(in)) depolarisation to ABSC(2)
MODEA = 3 derivative (in+out)*exp(-mu(in+out)) extinction to ABSC(3)

SETABS has set up (via SETGAU) the Gaussian 3D integration in COMMON /GAUSS
SETABS has set up the equations of the plane faces in COMMON /CPLANE.

Description:

Uses 3D Gaussian integration over the crystal as defined by its plane faces

Notes:

There also exists SUBROUTINE ABMULT, which is capable of calcuating more than one type of integral at one entry. If, e.g., absorption and depolarisation were both required, one call of ABMULT would be more efficient than 2 calls of ABSOR

Calls:

ERRIN2 GETDC TESTOV

Called by:

ABSCOR

Common blocks used:

/ABSDAT/ to use all members

/CPLANE/ to use all members

/GAUSS/ to use XX YY ZZ WW NQ

*** ABSOR by JCM 24 Sep 85 ***

SUBROUTINE ADDANG(NAME,N1,N2,N3,NA,IE)

Finds an angle in the tables for geometric constraints, or adds it
if absent.

Arguments:

On entry:

NAME is the angle name, A4, which may be empty
N1 is the number of the bond opposite the angle in the tables
N2 is the number of one bond at the angle
N3 is the number of the other bond at the angle

On exit, NA is the number of this angle in the angle names in ANGNAM

IE is an error indicator, =0 if OK

Description:

If an angle already exists in the tables opposite N1, ignores
NAME and sends out NA=its position.
If there is no such angle, counts up in NUMANG in /SLKGEO, and adds the new angle. If in this case NAME is empty, invents a name.

Notes:

The bonds N2 and N3 are held in INANG so that INANG( ,2) < INANG( ,3)

Calls:

ERRCH2 ERRCHK IATOM MAKNAM NCFIND

Called by:

ANGLST GEOMIN GEOMLS

Common blocks used:

/IOUNIT/ to use LPT ITO

/SLKGEC/ to use ATTNAM BONNAM ANGNAM

/SLKGEO/ to use INANG NUMBON NTARNM NUMANG

*** ADDANG updated by JCM 25 Jul 91 ***

SUBROUTINE ADDATM(NAME,IA,XA,ISA,ILA,CELA,N)

Finds an atom in the tables for geometric constraints, or adds it
if absent.

Arguments:

On entry:

NAME=the atom name, or is empty if a name is to be invented
IA=the number of the base atom from which it is derived
XA(1:3) hold its actual fractional coordinates
ISA is the symmetry operator making it from base (-ve if needed)
ILA is the lattice translation making it from base
CELA(1:3) hold the cell translations making it from base

On exit N=which entry in the atom tables it is

Description:

Searches for NAME in the existing table; if found, checks that all the other components are the same, and exits with N=where found.
If NAME is empty , still does the check on all other components.
If not found, counts in NTARNM in /SLKGEO, and adds NAME and all other components to tables, exitting with N=NTARNM

Calls:

ERRCH2 ERRCHK IATOM MAKNAM NCFIND

Called by:

BNDLST GEOMIN RDBOND

Common blocks used:

/SLKGEC/ to use ATTNAM

/SLKGEO/ to use ISYM ILAT CELLTR XSLAK IABASE NTARNM

*** ADDATM updated by JCM 9 Jun 91 ***

SUBROUTINE ADDBON(NAME,NA1,NA2,NA)

Finds a bond in the tables for geometric constraints, or adds it
if absent.

Arguments:

On entry:

NAME is either the bond name, A4, or it is empty, meaning

that the name is irrelevant

NA1 is the number of the atom at one end in the tables
NA2 is the number of the atom at the other end

On exit, NA is the number of this bond in the bond tables

Description:

If a bond already exists in the tables from NA1 to NA2, ignores
NAME and sends out NA=its position.
If there is no such bond, counts up in NUMBON in /SLKGEO, and adds the new bond. If in this case NAME is empty, invents a name.

Notes:

The ends of a bond are in IATM(,1:2) with (,1) less than (,2)

Calls:

ERRCH2 ERRCHK IATOM MAKNAM NCFIND

Called by:

ADDTOR BNDLST BONTRI GEOMIN

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

/SLKGEC/ to use ATTNAM BONNAM

/SLKGEO/ to use IATM NUMBON NTARNM

*** ADDBON updated by JCM 21 Jul 91 ***

SUBROUTINE ADDCON(NPAR,KK1,AM,NSTAT)

Adds a constraint to the list held in LSQ programs.

Arguments:

On entry:

NPAR=number of parameters involved in constraint
KK1 is an array holding the NPAR parameter specs
AM is a corresponding array of amounts
NSTAT is the status to be given to the constraint:

NSTAT=4 : user supplied (may be later removed)
NSTAT=5 : program supplied (may not be later removed)

Description:

Puts the constraint into a standard form, with the KK increasing, and the amount corresponding to the smallest KK as 1. Thus can tell if it has had this constraint before, and if so merely gives it the new status.

Notes:

There is also an entry SUBCON to take one out. If the first element of
KK1 for SUBCON is incomplete, this will scan all constraints looking for any whose KKs are ALL encompassed by KK1(1), and delete them. It is used to clear out family 4 each cycle for CAILS type refinement

Entries:

RELCON called by: SPHELI

SUBCON

Calls:

ERRCHK JGMEQ KSAME KWHOLE MINIM

Called by:

F2RELA FIXREL RDRELA SPHELI

Common blocks used:

/LENINT/ to use all members

/LINKAG/ to use NUMCON KKCON AMCON KPTCON KSTCON KTPCON

*** ADDCON corrected by PJB 30-May-1995 ***

SUBROUTINE ADDELM(ITAB,IEL,IJTAB,NUM)

Adds the element IEL to the subgroup defined by ITAB

Arguments:

On Entry ITAB is a teble in which ITAB(I) is non-zero if element I is

in the subgroup. TAB(I) is negative if only the centric partner is in the subgroup.

IEL is the operator nomber of the element to add

SUBROUTINE ADDPLN(NIN,N)

A dummy routine at the moment, called when setting slack
constraints

Called by:

GEOMIN

SUBROUTINE ADDSPC(WORD,LWORD)

To pad a word with spaces to length lword

Calls:

LENGT

Called by:

D3OP99

*** ADDSPC modified by PJB 15-Apr-1997 ***

SUBROUTINE ADDTOR(NAME,N1,N2,N3,N4,N5,N6,NT,
IE)

Finds a torsion angle in the tables for geometric constraints, or
adds it if absent.

Arguments:

On entry:

NAME is the torsion angle name, A4, which may be empty
N1 is the number of the first bond of the pair of non-

intersecting bonds between which the angle is required

N2 is the number of the "axis" bond which joins one atom of N1

to one atom of N3

N3 is the number of the other bond of the pair defining the angle
N4 is the number of the "free" bond joining the two other ends

of N1 and N3

N5 is the third side of the triangle formed by N1 and N2
N6 is the third side of the triangle formed by N3 and N2

On exit, NT is the number of this angle in the angle names in ANGTOR

IE is an error indicator, =0 if OK

Description:

If the angle already exists in the tables, ignores NAME and sends out
NT=its position.
If there is no such angle, counts up in NUMTOR in /SLKGEO, and adds the new angle. If in this case NAME is empty, invents a name.

Notes:

The bonds N1 and N3 are held in INTOR; which is which depends on the axis
N2, because it must join atoms (say A2 to A3) so that A2 < A3. A2 is defined to be on N1, and A3 on N3

Calls:

ADDBON BONTRI ERRCH2 ERRCHK IATOM NCFIND

Called by:

GEOMIN GEOMLS

Common blocks used:

/IOUNIT/ to use LPT ITO

/SLKGEC/ to use all members

/SLKGEO/ to use IATM INTOR NUMBON NTARNM NUMANG NUMTOR

*** ADDTOR corrected by PJB 2-Jan-1996 ***

SUBROUTINE ADJUST(PAR)

Applies a (possibly fudged) shift to a given LSQ parameter.

Arguments:

On entry PAR is the parameter to be updated

Prerequisite calls:

In /NEWOLD/ SHIFT on entry is the shift from the LSQ matrix inversion

IFAM,IGEN,ISPC specify the parameter, also packed in KPACK

In /FUDG/ is a list of all required fudge factors and their types

Description:

Sets XOLD = the existing value of PAR
Makes a tentative Xby applying SHIFT to XOLD
Scans IFDGPT to see if parameter has a fudge; if so, branches on its type in IFDTYP, and adjusts XNEW accordingly.
Finally sets XNEW into the parameter PAR.

Calls:

KPAK

Called by:

APSHDS APSHFW APSHT2 CELSHF DOMAG DOMAG2 DOMPL2 DOTWN2 EXTINC F2SHFT LLSCAL LLTFAC PRMBLK PROPAG

Common blocks used:

/FUDG/ to use NFUDGE FUDGE1 FUDGE2

/NEWOLD/ to use SHIFT XOLD XNEW IGEN ISPC KPACK

*** ADJUST updated by JCM 11 Jan 88 ***

SUBROUTINE AINOUT(K,FBUF,N,N1,MODE)

Multiple function routine called by ARRNGE type programs to
process sort items.

Arguments:

The function is chosen by MODE:

MODE = 0 Initialise: vector K of length N holds the limits for the

sorting keys. Sets N1 items to be associated with the sorted quantity.

MODE = 1 Enter the items in FBUF creating the sort key from K
MODE = 2 Sort all items read
MODE = 3 Return the next item from the sorted list in FBUF together with

the unpacked key in K and the number of identically labelled items in N. N1 is set to indicate the most significant K that changes after the Nth item.

MODE = 4 Simply return the next item in the sorted list in FBUF and

the number remaining from the same group in N

Calls:

ERRCHK ERRMES GMEQ JGMEQ MESS NPACK SORTN

Called by:

ARRINC ARRNGE

Common blocks used:

/ARSORT/ to use all members

/IOUNIT/ to use ITO

/SCRAT/ to use all members

*** AINOUT by PJB June 92 ***

FUNCTION ALNINT(A,B,X,N)

Performs linear interpolation, suitable for profile backgrounds
etc.

Arguments:

On entry:

A is a real array of dimension N which holds the arguments
B is a real array of dimension N which holds the function values
X is a real which holds the argument for which the function value

is required

N is the integer dimension of A and B

ALINT on exit will hold the function value for argument X

*** ALNINT by JCM 21 May 85 ***

SUBROUTINE ALRPOL(H,ALR,POL,MODE)

Calculates the reciprocals of Lorentz and polarisation factors.

Arguments:

H is a 3-size real array holding h,k,l on entry
ALR on exit will hold the Lorentz factor
POL on exit will hold the polarisation factor
MODE on entry =1 if wavelength is already in WLGTH (or ALAMBD)

=2 if wavelength is not set, but SINTH holds sin theta,

and the wavelength will not be required.

Prerequisite calls:

SETDC must have been obeyed to read necessary D cards to COMMON /DGEOM
SETLP calls SETDC; it also checks that if a monochromator angle is needed it has been supplied, and ANGLIN(2) holds cos sqrd 2 theta monochromator. POL will be modified appropriately.
SETDC has set the geometry type into IGEOM; possible types are:

IGEOM = 1 Normal beam
IGEOM = 2 Normal beam equatorial
IGEOM = 3 Equi-inclination Weissenberg
IGEOM = 6 4 circle bisecting
IGEOM = 7 4 circle angles given
IGEOM = 8 D3
IGEOM = 9 Powder data, no polarisation
IGEOM = 10 Powder data, X ray
IGEOM = 11 4 circle high chi
IGEOM = 12 SXD geometry

Calls:

ERRIN2 GMEQ ORTHO SCALPR SINCOS UNIVEC

Common blocks used:

/DGEOM/ to use IGEOM UM ANGLIN

/IOUNIT/ to use LPT ITO

*** ALRPOL by JCM 24 Sep 85 ***

SUBROUTINE ANGDIR(H,ANG)

Calculates D3 or 4-circle angles from direction cosines.

Arguments:

On entry H (of dimension 3) holds h,k,l for the required reflection
On exit, ANG (of dimension 4) must hold some useful useful afgles.

Prerequisite calls:

SETDC must have set IGEOM, UM matrix, NLR for left/right

Notes:

Only written for geometry types 6,7,8,11

Calls:

ARCCOS ERRIN2 GETDC GMPRD GMREV SCALPR UNIVEC VECPRD

Called by:

ABSCOR

Common blocks used:

/DGEOM/ to use IGEOM UM NLR

*** ANGDIR by PJB Sep 87 ***

SUBROUTINE ANGERS(I1,NB1,NB2,COSANG,ANGER)

To calculate esd's in bond angles

Arguments:

On Entry I1 is the number of the central atom

NB1 and NB2 are the numbers of the two bonds in the bond list held

in BONDLA

COSANG is the cosine of the angle between them
IATS and IOP hold information about the previous call to ANGERS

(to avoid unnecessary duplication of calculations)

On exit ANGER is the ESD in the angle in degrees

Prerequisite calls:

This subroutine is expected to be called just after an angle calculation it uses data in common BONDLA which is set up by BNDLST

Calls:

ATSPEC DEGREE GMEQ GMPRD GMSUB GMZER RELMT3 RELMTX RELPOS SINCOS

Called by:

ANGLST

Common blocks used:

/BANERR/ to use IPFIX APFIX RELMT IATS IOP

/BONDLA/ to use NB BSAVE DXSAVE N2SAVE

/CELFIX/ to use RCLMAT

/CELPAR/ to use CPARS CELESD SDCELL

/POSNS/ to use SDX ATESDS

*** ANGERS corrected by PJB C98 Oct-2000 ***

SUBROUTINE ANGLST(I1)

Lists all angles at one source atom made by a given list of bonds.

Arguments:

I1 is the number of the source atom (which will belong to the original list)

Prerequisite calls:

A list of bonds starting from atom I1 must be in COMMON /BONDLA.
There will be NB bonds stored in BSAVE, with the specifications of the destination atoms in N2SAVE (held negatively if the atom is not in the original list, but a symmetry relation), and the coordinate differences in DXSAVE.

Description:

If there are at least 2 bonds, scans all pairs of bonds &$1;prints out the angle at atom I1 between the pair. Destination atoms may be in any of the 27 cells around the central asymmetric unit.

Output:

Writes to unit LPT the list of angles, with specifications of destination

atoms if not original

Machine readable list of angles and their specs written to LBOND if it is non-zero

Calls:

ADDANG ANGERS ATSPEC BONTRI DEGREE JGMZER MESS SCLPRD SINCOS

Called by:

BONDS

Common blocks used:

/ATNAM/ to use ATNAME

/BANERR/ to use IATS IOP ANGESD

/BONDLA/ to use NB BSAVE DXSAVE NBSAVE N2SAVE ANG1 ANG2 SD1 SD2 LSK SLK LBOND

/IOUNIT/ to use LPT

/SLKGEC/ to use BONNAM ANGNAM

/SLKGEO/ to use NUMANG

*** ANGLST updated by PJB 22nd Apr 2003 C123 ***

FUNCTION ANGRAD(A,B,IR)

Calculates the angle in radians between two vectors, in either
space.

Arguments:

A is a real 3-sized array which on entry holds the first vector
B is a real 3-sized array which on entry holds the second vector
IR on entry =1 for real space, 2 for reciprocal

Prerequisite calls:

RECIP must have set up the cell parameters.

Description:

ANGRAD on exit is set to be the angle in radians between vectors A and B.
Uses -A.B/moduli if real space, because expects A and B to be plane normals, and the required angle to be between planes.

Calls:

ARCCOS SCLPRD VCTMOD

Called by:

TRYUNI

*** ANGRAD by JCM 26 Sep 84 ***

FUNCTION ANITF(H,N)

Forms the contribution to the anisotropic temperature factor on an
atom N from indices H.

Arguments:

H is a 3-size real array holding h,k,l on entry
N on entry = which atomic position

Prerequisite calls:

SETANI must have been obeyed to set up in the COMMON /ANISO:

IAPT(N) =I for 'Nth atom has Ith temperature factor in array ATF', or

=0 for 'Nth atom has no anisotropic temperature factor.

Description:

SETANI has converted the user's coefficients to standard betas in the array
ATF, in the expression \$exp-(\beta_{11}h^{2} + 2\beta_{23}kl + \cdots)\$ so that
ANITF need use only this single expression.

Notes:

Note the 2's in the expression.

Called by:

FCALC FCHALC FMCALC FMMPCA FMPCAL LFCALC LMCALC LMMPCA LMPCAL LCHALC

Common blocks used:

/ANISO/ to use ATF IAPT

*** ANITF by JCM 19 Jul 83 ***

SUBROUTINE APSHDS

Applies shifts for during d-spacing refinement.

Prerequisite calls:

Only of use from MAIN program DSLSQ,DSMLSQ, or similar; only expects one family of parameters, containing the 6 reciprocal cell quadratic products and the three components of the propagation vector.
Expects shifts (one for each basic variable) in array BLSQ, with corresponding ESDs in array DERIVB.

Description:

Applies shifts, possibly fudged, dealing with constraints if necessary. Recalculates all cell quantities and if the propagation vector has changed, calls REINDX to reindex the reflection indices in /REFLNS/

Output:

Writes to LPT the old and new values, the shift and its esd.

Calls:

ADJUST FETSHF GMZER NSIGFG PARNAM PUNPAK RECELL REINDX SHFESD

Common blocks used:

/CELPAR/ to use CPARS

/DERBAS/ to use DERIVB

/DERVAR/ to use LVARV

/IOUNIT/ to use LPT

/MATDAT/ to use BLSQ

/NEWOLD/ to use SHIFT XOLD XNEW ESD IGEN ISPC KPACK SHESD

/POINTS/ to use LVRBS LVRPR

/REFINE/ to use ICYC

/SATELL/ to use PROP

*** APSHDS updated PJB 4-Apr-2001 ***

SUBROUTINE APSHFW

Applies shifts for Forsyth & Wells scattering factor coefficient
refinement.

Prerequisite calls:

Only useful if called from FWLSQ or similar.

Description:

Scans variables, applies shifts with possible fudges.

Output:

Prints new value, shift, esd and old value.

Calls:

ADJUST PARNAM

Common blocks used:

/DERBAS/ to use DERIVB

/DERVAR/ to use LVARV

/FWVALS/ to use COEFFS

/IOUNIT/ to use LPT

/MATDAT/ to use BLSQ

/NEWOLD/ to use SHIFT XOLD XNEW ESD KPACK

/POINTS/ to use LVRBS LVRPR

/REFINE/ to use ICYC

*** APSHFW updated by JCM 10 Feb 87 ***

SUBROUTINE APSHSF(MAGSHF)

Applies shifts to all variables in single crystal structure factor
based LSQ, and prints the results.

Arguments:

On entry MAGSHF is the name of a routine which applies shifts to magnetic parameters. It is LDUMMY for non-magnetic applications.

Prerequisite calls:

Shifts are in array BLSQ, and ESDs in DERIVB (to save space)

Description:

Identifies each variable as a type of parameter, and call individual routines to apply shift (possibly fudged).
For redundant variables, calculates shift from constituent parts of relevant constraint.

Output:

Prints old and new values, shift and esd, with parameter name
If family 2 (structure parameter), does printing in blocks

Calls:

CELSHF ERRMES F2SHFT FETSHF GEOMCO LLSCAL LLTFAC MESS NSIGFG PARNAM PRBLOK PUNPAK RECELL SHFESD EXTIN3

Called by:

CHILSQ MAGLSQ MMPLSQ MPLSQ PALSQ SFLSQ SFTLSQ

Common blocks used:

/ATBLOC/ to use all members

/ATBLOK/ to use all members

/DERBAS/ to use DERIVB

/DERVAR/ to use LVARV

/IOUNIT/ to use LPT

/MATDAT/ to use BLSQ

/NEWOLD/ to use SHIFT XOLD XNEW ESD IGEN ISPC KPACK SHESD

/POINTS/ to use LVRBS LVRPR

/REFINE/ to use ICYC SIMUL

*** APSHSF updated by PJB C139 July-4-2005 ***

SUBROUTINE APSHT2

Applies shifts for reciprocal cell quadratic products and zero
during 2theta refinement.

Prerequisite calls:

Only of use from MAIN program T2LSQ, or similar; only expects one family of parameters, being the 6 reciprocal cell quadratic products and a zero point.
Expects shifts (one for each basic variable) in array BLSQ, with corresponding ESDs in array DERIVB.

Description:

Applies shifts as given to the parameters, dealing with constraints if necessary. Recalculates all cell quantities.

Output:

Writes to unit LPT the old and new values, the shift and its esd.

Calls:

ADJUST NSIGFG PARNAM PUNPAK RECELL SHFESD

Common blocks used:

/CELPAR/ to use CPARS

/DERBAS/ to use DERIVB

/DERVAR/ to use LVARV

/IOUNIT/ to use LPT

/MATDAT/ to use BLSQ

/NEWOLD/ to use SHIFT XOLD XNEW ESD IGEN ISPC KPACK SHESD

/POINTS/ to use LVRBS LVRPR

/REFINE/ to use ICYC

/ZEROPT/ to use ZERO

*** APSHT2 updated PJB 4-Apr-2001 ***

FUNCTION ARCCOS(X)

Calculates an arc cosine.

Arguments:

On entry X= a cosine
On exit ARCCOS is the arc cosine of X in radians in range 0 to Pi.

Notes:

Written because IBM did not have it at the time.

Calls:

SINCOS

Called by:

ANGDIR ANGRAD BONCOS CELNEW GEOMLS

Common blocks used:

/CONSTA/ to use PI PIBY2

*** ARCCOS FOR IBM by JCM 26 Sep 83 ***

SUBROUTINE ARPRIN(H,FBUF,MODE)

A multi-mode routine to produce the output in ARRNGE type main
programs.

Arguments:

On entry H contains a set of floating indices

FBUF is as set up in the main program. FBUF(1) is the record

number and normally FBUF(2:3) the observation and its standard deviation.

MODE selects what is printed out
MODE = 0 Sets up the variable formats in accordance with IFOR
MODE = 1 Reject output
MODE = 2 Initial heading
MODE = 3 1st entry for a reflection (rec no indices and values)
MODE = 4 Add values to output file buffer
MODE = 5 Entry for repeated reflections (recno and values)
MODE = 6 End of sub-group
MODE = 7 End of group
MODE = 8 Average of configuration domains

Calls:

INDFIX NEWLIN TESTP

Called by:

ARRINC ARRNGE

Common blocks used:

/ARRFMT/ to use all members

/ARRDAT/ to use INC LINO NREF INLBUF NBUF IBUF INFBUF INDLEN NUMVAL IPOS ISTORE ICHNGE NEW LPRINT ICD IS

/HEDIN/ to use all members

/IOUNIT/ to use LPT LUNI

/WHEN/ to use DATIM

*** ARPRIN updated by PJB 14 Jun-2004 C130 ***

SUBROUTINE ARREAD(H,FBUF,IEND)

Multiple entry routine to deal with reading items for ARRNGE type
programs.

Description:

Expects IICD3 to have been obeyed to read the data type DTYP. The following formats are defined:

DTYP = 0 user supplied subroutine QARRIN to read the data
DTYP = 1 D3 polarised neutron ratios as given by D3OP99

Data read: NUMOR,K,(ANG(I),I=1,3),R,DR
FORMAT (4I5,3F8.2,2F10.6)4I5,24X,2F1.6

DTYP = 2 COLL5 1 card output
DTYP = 3 COLL5 2 card output

Data read for 2 and 3:NUMOR,K,Fsqr,Dfsqr,(ANG(I),I=1,4)
FORMAT (I6,3I4,2F10.2,4F8.2)

DTYP = 4 RACER floating format output

Data read: NUMOR,H,INT,dINT,(ANG(I),I=1,4)
FORMAT (I6,3F6.2,I8,I4,4F8.2)

DTYP = 5 SXD format output including wave-length and path length

Data read: NUMOR,H,Fsqr,DFsqr,Lambda,path
FORMAT (I8,3F8.2,4F10.4)

DTYP = 6 LLB format (floating indices)

Data read: NUMOR,H,Fsqr,Dfsqr,(ANG(I),I=1,4)
FORMAT (I4,3F6.2,2F10.4,4F8.3)

DTYP = 7 D3 Integrated intensities (ext .ROC)

Data read: NUMOR,H,Fsqr,Dfsqr,(ANG(I),I=1,4)
FORMAT (I6,3F6.2,2F10.2,4F8.2)

DTYP = 8 COLL5 floating format (1 card ext .COL)

Data read: NUMOR,H,Fsqr,Dfsqr,(ANG(I),I=1,4)
FORMAT (I6,3F7.3,2F10.4,4F8.2)

DTYP = 9 D3 Flipping ratios floating indices (ext .FLI)

Data read: LINENO,H,(ANG(i).i=1,3),R,DR:
FORMAT (I8,3F8.3,3F8.2,2F10.4)

Calls:

FILNOM GMEQ INDFLO LENGT MESS NOPFIL QARRIN RDINTG

Called by:

ARRINC ARRNGE

Common blocks used:

/ARRDAT/ to use NREF1 NREFL NUMOR

/IOUNIT/ to use LPT ITO LUNI

/SCRACH/ to use all members

*** ARREAD updated by PJB April 2005 C136 ***

SUBROUTINE ARROW(P,S,N)

Writes postscript output to plot an arrow in MAG3D

Arguments:

On entry L=0 requests outline arrow

L=1 requests solid arrow

Prerequisite calls:

General CCSL plotting must have been set up.

Calls:

KANGA1 PLCONV

Called by:

ATLABS POSORT MVENTR

Common blocks used:

/VFRMTS/ to use all members

/IOUNIT/ to use IPLO

/LAYOUT/ to use all members

/PICDEF/ to use CMPERA APERMB

*** ARROW by PJB Sep 87 ***

SUBROUTINE ASK(MESS)

Writes a message on unit ITO and reads an interactive answer to
/SCRACH/.

Arguments:

On entry MESS is the message.

Input:

On exit the answer typed to the terminal unit ITI is in ICARD, A80.

Output:

Writes the message on unit ITO, using a FORMAT finishing $ if this is allowed by the FORTRAN system being used.

Calls:

LENGT MESS

Called by:

BIGGAM NEXCON NOPFIL PLOTO AVEXAR CALMSF CALQSF D3OP99 INFILE EXTCAL GENREF GETMSF GETSFZ GRAFIC MADUBM MAG3D MAGPOW MEANWT MG3DGL MVENTR NVENTR POWDER SORGAM

Common blocks used:

/IOUNIT/ to use ITI ITO

*** ASK updated by PJB 17-Jun-1994 ***

FUNCTION ASPHFF(H,IAT)

Calculates an aspherical form factor for a cubic space group.

Arguments:

On entry H is a 3-sized array holding h,k,l

IAT=which atom

On exit ASPHFF holds the form factor.

Calls:

FORMFC VCTMOD

Common blocks used:

/CONSTA/ to use TWOPI

/VALUES/ to use all members

*** ASPHFF by PJB Jun 86 ***

SUBROUTINE ASUNIT(H,HIN,N,M)

Produces reflection indices in the asymmetric unit, related to
those given.

Arguments:

On entry H is a 3-sized vector containing h,k,l, which may be anywhere in reciprocal space.
On exit HIN is a 3-sized vector related by symmetry to H, and in (or on)

the asymmetric unit.

M is its multiplicity.
N is the number of the symmetry operator which takes H into

HIN. N is -ve if (-x,-y,-z) involved, or 0 if error.

Prerequisite calls:

SYMUNI must have set up the asymmetric unit.

Description:

Takes account of Friedel - for non-centrosymmetric groups, Friedel is *** ONLY *** assumed if the user has given an I FRIE card with a non-zero number. If HIN is related to H by an operator belonging to the Friedel- related set (which are not stored explicitly in COMMON SYMDA), then N is set negatively.
If there has been an error in the formation of the asymmetric unit, and
H does not therefore transform into the unit using any of the space group operators, N is set=0

Calls:

GMREV MULBOX ROTSYM

Called by:

GENMAG INOBGR ARRINC ARRNGE

Common blocks used:

/FRIED/ to use FRIEDL

/NSYM/ to use NOPC

*** ASUNIT by JCM 3 Jul 84 ***

SUBROUTINE ATMPLO(IFND,NFND,JP)

Plots atom positions on a map.

Arguments:

On exit NFND=number of positions plotted

IFND, an integer array, contains pointers to the atoms plotted
JP, an integer array, points to the symbols used for each atom

Calls:

ATOGEN ERRCHK GMEQ GMPRD KANGA3 SPCSET TBOUND TRINV3 VCTMOD

Called by:

FORFIG

Common blocks used:

/MAPDA/ to use OUTLIM NDIM MODET

/NSYM/ to use NLAT

/PLODAT/ to use CHUNIT

/PLOMAP/ to use CHSCAL

/POSNS/ to use NATOM

/SCRAT/ to use all members

/SYMDA/ to use ALAT

*** ATMPLO by PJB Aug 86 ***

SUBROUTINE ATMPLT(ZED)

Plots atom positions on a map.

Arguments:

On entry ZED gived the z-value of the section. Irelevant if 2D.

Calls:

ATOMS GMADD GMEQ GMINV GMPRD GMSCA GMSUB GMTRAN GMZER KANGA2 KANGA3 LENGT PIGLET PLCONV SCALPR SPCSET VECPRD

Called by:

FOURPL

Common blocks used:

/ATNAM/ to use ATNAME

/IOUNIT/ to use LPT

/MAPDA/ to use OUTLIM NX NY

/MAPLAB/ to use all members

/PLODAT/ to use CHUNIT

/PLOMAP/ to use WIDMAP HGTMAP

*** ATMPLT new by PJB June 2006 ***

SUBROUTINE ATOGEN(MOLD)

Generates a set of equivalent positions.

Arguments:

MOLD on exit is the number generated

Prerequisite calls:

In /SCRAT/ on entry (usually from ATMPLO) TRXX(1:3,1) holds the original atomic position.

Description:

Generates all the related (different) positions in TRXX within 1 unit cell.

Notes:

A PJB special for use with ATMPLO.

Calls:

EQPOS GMADD GMEQ GMREV ROTSYM

Called by:

ATMPLO

Common blocks used:

/NSYM/ to use NCENT NOPC NLAT

/SCRAT/ to use all members

/SYMDA/ to use TRANS

*** ATOGEN by PJB Aug 86 ***

SUBROUTINE ATOMS(IR,N,ALIST,MAX)

Makes a real space unit cell full of related atomic positions.

Arguments:

On entry IR=an atom number

MAX is the maximum number of positions ALIST can hold

On exit N is the number of distinct positions related to the original,

still within the original unit cell.

ALIST(3,) holds N distinct atomic positions, the first being

the given position, translated into (0,1) if necessary

Calls:

EQPOS FRAC3 GMEQ GMZER XTRANS

Called by:

ATMPLT

Common blocks used:

/NSYM/ to use NCENT NOPC NLAT

*** ATOMS by JCM 3 Apr 88 ***

SUBROUTINE ATOPOS

Reads and interprets all given
A cards .

Prerequisite calls:

PREFIN must have first read the Crystal Data File
SYMOP must have already input the space group symmetry.

Description:

Reads a sequence of A cards .
Each card should start:

A <atom label> or A SD <atom label>

The <atom label> is a word of up to 4 characters, starting with a letter

In the first case the data following <atom label> are:

X,Y and Z coordinates (which may be given as fractions if appropriate, e.g. 1/4 or 2/3) an isotropic temperature factor a possible scattering factor label (if different from starting letters

of atom label)

a possible site occupation factor (set = 1 if read as 0, so that it can be omitted altogether if wished.

In the second case the data are the estimated standard deviations in the above parameters

The scattering factor label and site occupation factor are both optional, which means that if anything occurs after the isotropic temperature factor, it is a label if it starts with a letter, or a number if a digit.
Calculates the numbers of atoms of each type in the unit cell, and if the position is special records the generators of its subgroup.
Keeps lists of atom labels and scattering factor labels.

Calls:

ERRCHK ERRMES GENELM GMADD GMEQ GMSUB GMZER INPUTA JFIX LATVEC LMATCH MESS RELPOS ROTSYM SYMOP

Called by:

SETANI SETFC SETFCM SETFOR SETFOU BONDS FORFIG MMPLSQ MPLSQ

Common blocks used:

/ATNAM/ to use ATNAME

/CARDRC/ to use NYZ SDREAD

/FORMDA/ to use NFORMF NBAKF NUMFNM

/FONAM/ to use FONAME

/FORMD2/ to use all members

/IOUNIT/ to use LPT

/NSYM/ to use NOP NOPC NLAT CENTRC

/PHASE/ to use JPHASE

/POSNS/ to use NATOM AMULT TF SITE ISGEN SDX SDTF SDSITE ATESDS

/POSNS2/ to use all members

/SCRAT/ to use all members

/SYMDA/ to use TRANS

/SYMTAB/ to use NORD

*** ATOPOS modified by PJB 26-Aug-1998 ***

SUBROUTINE ATSPEC(N,K,CH)

Makes the 16-character specification of a symmetry related atom
from its packed specification.

Arguments:

N on entry is the packed integer giving atom specification
K is a 6-sized integer array which on exit is filled as follows:

K(1)=which atom number was the original
K(2)=which symmetry operator gave current position, -ve if also

needed (-x,-y,-z)

K(3)=which lattice translation
K(4)=which cell in x direction (-1, 0 or +1)
K(5)=which cell in y direction (-1, 0 or +1)
K(6)=which cell in z direction (-1, 0 or +1)

CH is a A16 string; on exit it holds a printable representation of K

Prerequisite calls:

Specification must have been packed by a call of NPACK

Calls:

INTCHR INTDIG NPACK

Called by:

ANGERS ANGLST BNDLST

Common blocks used:

/ATNMPK/ to use all members

*** ATSPEC updated by JCM 12 Nov 89 ***

SUBROUTINE AXIS(R,A)

Finds the axis of a given rotation matrix.

Arguments:

On entry R is a 3x3 rotation matrix
On exit A is a 1x3 vector holding its axis

Calls:

DETER3 FCTOR GMEQ

Called by:

SYMUNI

*** AXIS by PJB/JCM 28 Jun 83 ***