SUBROUTINE GAUSPT(NN,GPT,GWT)

Sets up Gauss points and weights for use in 3D integration.

Arguments:

On entry NN=number of Gauss points &$1;weights required.
On exit the array GPT contains the necessary Gauss points and the array GWT contains the corresponding weights.

Description:

The array GTABLE contains n-1 numbers for each n allowed. If n is even, these are X1, W1, X2, W2, . . Xm (where 2m=n), and if n is odd they are
X1, W1, X2, W2, . . Xm, Wm (where 2m=n-1).
This subroutine generates the two full arrays GPT(1:n) from the Xi and
GWT(1:n) from the Wi. For all except the 'centre' points the algorithm is simple: i<m Xi, Wi as stored; i>m+1: Xi=1-Xj and Wi=Wj, where i+j=n+1
For the 'centre' points:
For n odd: i=m Xi, Wi as stored;

i=m+1 Xi=0.5, Wi=1-sum of previous weights*2

n even: i=m Xi as stored, Wi=0.5-sum of previous weights.

*** GAUSPT by JCM 26 Sep 85 ***

SUBROUTINE GENELM(NSUB,ISGEN)

Finds the generators of a subgroup of a space group.

Arguments:

On entry NSUB is an integer array holding the orders of the elements of the

subgroup, with zeros for those elements not in the subgroup.

ISGEN(1) is the multiplicity of the subgroup

generators.

Called by:

ATOPOS PROPAG SUBSYM

Common blocks used:

/NSYM/ to use NOP NOPC NGEN

/SYMTAB/ to use MULTAB

*** GENELM corrected by JCM 18 Sep 89 ***

SUBROUTINE GENGRP(ITAB,JTAB,IJTAB,MODE,
PRODCT)

Generates the product of two subgroups of the space group in
SYMTAB

Arguments:

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

in the first subgroup. a negative value for ITAB(I) indicates that it is the centro

JTAB gives the same information for the second subgroup
PRODCT is the name of a subroutine which will execute a product

operation if MODE=1

If MODE=0, no product operation is executed and PRODCT should

be set to DUMMY.

On Exit IJTABis a teble in which IJTAB(I) is non-zero if element I is

in the product group.

Notes:

a negative value for ITAB(I), JTAB(I) or IJTAB(I) indicates that it is the centro-symmetric partner to element I which is in the group.

Called by:

MAGSYM

Common blocks used:

/NSYM/ to use NOPC

/SYMTAB/ to use MULTAB

*** GENGRP new by PJB C137 April 2005

SUBROUTINE GENMAG(H,NOMORE,MUL,SMAX,NFLAG)

Generates the next set of magnetic h,k,l, scanning the asymmetric
unit.

Arguments:

On entry NFLAG=-9999 if this is the very first entry

if IPROP is non-zero this entry makes a magnetic asymmetric unit and sets things up for subsequent calls. otherwise NFLAG is left severely alone and just presented again on each subsequent entry.

On exit H is a real 1x3 array holding the next h,k,l (unless none)

NOMORE is a LOGICAL saying whether or not no more generated
MUL is the multiplicity of H

Prerequisite calls:

PROPER must have been called to fill in /SATELL/

Calls:

ASUNIT GETGEN GMADD GMEQ GMSUB GMZER MULBOX SETGEN SUBSYM SYMUNI VCTMOD

Called by:

GETMSF MAGPOW

Common blocks used:

/SATELL/ to use PROP KSTAB NKSTAR IPROP

/TEMGEN/ to use all members

*** GENMAG updated by JCM 6 May 92 ***

SUBROUTINE GENMUL(H,NOMORE,M)

Gives next useful set of h,k,l and multiplicity, scanning the
asymmetric unit of reciprocal space.

Arguments:

On exit H is a 1x3 real vector holding next generated values of h,k,l

NOMORE is TRUE if there are no more to be found
M is the multiplicity of the found reflection.

Prerequisite calls:

SYMOP should have read the space group symmetry.
SYMUNI should have found the asymmetric unit of reciprocal space.
SETGEN should have set up stepping over asymmetric unit in /HKLGEN

Description:

Uses "previous" h,k,l in PT in /HKLGEN to move to a new one.
Rejects lattice absences (but not space group absences - do those outside

using ISPABS if required), h,k,l outside asymmetric unit, h,k,l for which sin theta/lambda is greater than STHLMX, and h,k,l for which sin theta is around zero (to reject 0,0,0)

Allows for non-primitive stepping vectors in array STEP, by use of inter- mediate primitive steps as calculated by PRMTIV on leaving SETGEN.
Leaves value of sin theta/lambda in STHL in /BRAGG

Notes:

Exactly like GETGEN, but sends out M and STHL also

Calls:

GMADD GMEQ LATABS MULBOX SCALPR VCTMOD

Called by:

GETMSF MAGPOW POWDER

Common blocks used:

/BRAGG/ to use STHL

/HKLGEN/ to use STEP PT VECEND PRPT NPRIM NP LFAC MCOUNT

*** GENMUL by JCM 18 Jun 85 ***

CHARACTER *4 FUNCTION GENNAM(NAME)

Finds all the starting letters of an atom name.

Arguments:

On entry NAME is an A4 CHARACTER variable
On exit GENNAM is an A4 CHARACTER variable being all the leftmost letters

of NAME

Calls:

LETTER

Called by:

BNDLST BONDS

*** GENNAM by JCM 26 Mar 91 ***

SUBROUTINE GEOMCO(N)

Multiple entry routine for geometric slack constraints.

Arguments:

N on entry specifies action required:

N=1 initialise: copy out constraint information for access later

and read print instructions from I PRSK (this is used by Pawley slacks as well).

N=2 entered from APSHSF: recalculate actual coordinates at bond ends

after shift application to position coordinates

N=3 entered from NWINSF: put out new L ATOM card

Prerequisite calls:

Slack constraints must have been set up in /SLKGEO/ via GEOMIN
Parameters and variables must be set up via PARSSF

Calls:

CELMAT DEPRIN GMUNI JFIX MESS NCFIND ONCARD RDWORD XTRANS

Called by:

APSHSF NWINSF SFLSQ SFTLSQ

Common blocks used:

/ATNAM/ to use ATNAME

/CELPAR/ to use CELL

/IOUNIT/ to use LPT

/NEWOLD/ to use NEWIN

/REFINE/ to use IPRNT

/SLAKDA/ to use NSLAK

/SLKGEC/ to use ATTNAM

/SLKGEO/ to use ISYM ILAT CELLTR XSLAK COSIN IABASE TOSTAR NTARNM

*** GEOMCO updated by JCM 24 Jan 90 ***

SUBROUTINE GEOMIN(N)

Reads
L cards for bond slack constraints.

Arguments:

On entry N=0 if this is an initial, very early entry to read the L SLAK

card and decide whether there are any slack constraints.

N=1 for all other cards

Description:

For N=0 reads and interprets first a possible L SLAK card , setting in particular SLONLY if there are ONLY slack constraints, and NO observations.
For N=1 reads possibly several cards starting:

L ATOM define named atom not on A card for use in constraints,
L BOND define named bond between 2 given atoms;

also used for type 1, bond=given length with sigma,

L ANGL define named angle between 2 given bonds, and implying the

use of a third bond; also used for type 2, angle = given size in degrees, with sigma

L EQUB type 3, 2 bonds are of equal length, with sigma
L LINE type 4, 2 bonds are in a straight line (angle=180 degrees), with

sigma,

L TORS define named torsion angle between 2 non-intersecting bonds,

needing to be given a bond joining the two, and implying the use of the 3 further bonds joining the 4 atoms; also used for type 5, torsion angle between 2 non-intersecting bonds = given size in degrees, with sigma

L EQUA type 6, 2 angles (each between 2 bonds) are equal, with sigma
L PLAN type 7; an experimental type which for the moment requests that

the atoms which follow (4 or more of them) are to be planar, with sigma.

Calls:

ADDANG ADDATM ADDBON ADDPLN ADDTOR ERRATM ERRCH2 ERRCHK ERRIN2 FINDCD MESS NCFIND RDANGL RDATOM RDBOND RDINTG RDREAL RDWORD

Called by:

STLSSF SFLSQ SFTLSQ

Common blocks used:

/IOUNIT/ to use LPT

/SLAKDA/ to use NSLAK SLAKWT NSKTOT

/SLKGEC/ to use ATTNAM BONNAM ANGNAM

/SLKGEO/ to use NSTYP BOBS EOBS IATM XSLAK NST1 SLONLY ITYPSK INVBON NINVB INANG NUMBON NTARNM NUMANG NUMTOR

*** GEOMIN updated by JCM 8 Mar 91 ***

SUBROUTINE GEOMLS(ALSQ,MATSZ)

Calculates bond lengths and derivatives for geometrical slack
constraints.

Arguments:

ALSQ and MATSZ are handed all through LSQ programs in this fashion

- they are needed here for the call of MATTOT

Prerequisite calls:

On entry, COMMON /SLKGEO/ should contain:

XSLAK holding actual x,y,z coordinates for all atoms involved in

bonds

ISYM holding the number of the symmetry operator which takes original coords into actual, -ve if by -x,-y,-z also
ILAT holding the number of the lattice translation
CELLTR the cell translations

The symmetry must have been set up in SYMOP, and the original positions

read from the A cards by ATOPOS. The cell parameters must have been read by RECIP.

Description:

Called from MAIN programs to add to the LSQ matrix once per cycle.
First, for every involved bond, calculates the bond length and its 12 derivatives, remembering that the actual position coordinates involved may be related to those which are being refined.
Then scans all geometrical constraints, forming calculated function (which for types 1, 2, bonds, angles, are already there).
Proceeds exactly as though these are conventional observations and calculated functions; makes basic variable derivatives, gets weights, and adds totals in to LSQ matrix.

Output:

Prints obs and calc list if requested on I card .

Calls:

ADDANG ADDTOR ARCCOS BONCOS BONDER DEGREE GMZER MATTOT MESS PRNCYC RADIAN RELATE RFACS SINCOS TESTOV

Called by:

SFLSQ SFTLSQ

Common blocks used:

/CELPAR/ to use KCPARS

/DERVAR/ to use all members

/IOUNIT/ to use LPT

/OBSCAL/ to use OBS YCALC DIFF WT SQRTWT WDIFF

/POSNS/ to use KX

/SLAKDA/ to use NSLAK SLAKWT ISLKTP

/SLKGEC/ to use all members

/SLKGEO/ to use BOBS EOBS IATM IABASE NST1 SLONLY BCALC DERCEL DERPOS ITYPSK INVBON NINVB DERBON NVB NUMBON

*** GEOMLS updated by JCM 2 Oct 90 ***

SUBROUTINE GETDC(H,DIREC)

Calculates direction cosines of the incident and diffracted beams
used by absorption correction type integrals

Arguments:

On entry H is a 1x3 real vector holding h,k,l
On exit DIREC is a (3,2) real array holding the direction cosines

of the incident (in (,1)) and diffracted (in (,2)) beams

Prerequisite calls:

SETDC should have set up the calculation by interpreting "D" cards .

Description:

Calculates the direction cosines with respect to the CCSL orthogonal axes.

Calls:

ERRIN2 ERRMES GMEQ GMREV ORTHO SCALPR SINCOS TRIAN1 UNIVEC VECPRD

Called by:

ABMULT ABSOR ANGDIR

Common blocks used:

/BRAGG/ to use SINTH COSTH DIFANG

/DGEOM/ to use IGEOM UM NLR

/SCRACH/ to use MESSAG

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

SUBROUTINE GETGEN(H,NOMORE)

Gives the next useful set of h,k,l scanning the asymmetric unit of
reciprocal space.

Arguments:

On exit H is a 1x3 real vector holding next generated values of h,k,l

NOMORE is TRUE if there are no more to be found

Prerequisite calls:

SYMOP should have read the space group symmetry.
SYMUNI should have found the asymmetric unit of reciprocal space.
SETGEN should have set up stepping over asymmetric unit in /HKLGEN

Description:

Uses "previous" h,k,l in PT in /HKLGEN to move to a new one.
Rejects lattice absences (but not space group absences - do those outside

using ISPABS if required),

h,k,l outside asymmetric unit, h,k,l for which sin theta/lambda is greater than STHLMX, and h,k,l for which sin theta is around zero (to reject 0,0,0)

Allows for non-primitive stepping vectors in array STEP, by use of inter- mediate primitive steps as calculated by PRMTIV on leaving SETGEN.

Notes:

There also exists GENMUL which sends out M also

Calls:

GMADD GMEQ LATABS MULBOX SCALPR VCTMOD

Called by:

GENMAG GENREF GETSFZ

Common blocks used:

/BRAGG/ to use STHL

/HKLGEN/ to use STEP PT VECEND PRPT NPRIM NP LFAC MCOUNT

*** GETGEN by PJB 27 Jun 84 ***

SUBROUTINE GETMAP

Retrieves 1 Fourier map previously filed using SAVMAP.

Prerequisite calls:

Assumes unit IDUMPG is positioned so that reading from it will produce the "next" map dumped there.
The required Z value must be set in OUTLIM(1,3)

Description:

Continues reading down maps until it finds one for the given Z.
If no map is dumped for this value of Z, will eventually read the trailer record of file IDUMPG and complain.

Calls:

ERRRE2

Called by:

FORFIG FOURPL

Common blocks used:

/IOUNIT/ to use LPT ITO

/MAPDA/ to use OUTLIM NX NY DENS NOBSIN NUSED

/MAPGT/ to use IDUMPG

*** GETMAP updated C19 by JCM 22 Aug 86 ***

SUBROUTINE GETSCL(VMIN,VMAX,L)

Chooses a sensible scale for a graph.

Arguments:

On entry VMIN is minimum value to be plotted

VMAX is maximum value to be plotted
L=1 for x axis

2 for y axis

Prerequisite calls:

X(L,2) must be set up as below:

Description:

The vector X(I,J) in /PLTS defines how the graph will be drawn.

I=1 for X-axis, I=2 for Y-axis.
J=1 length of axis in user units
J=2 length of axis in cms.
J=3 division of axis in user units
J=4 minimum value in user units
J=5 position of plotted axis in user units

Sets X(L,J) for J=1,3,4,5.

Output:

If VMAX and VMIN are not sensible, complains and stops.

Calls:

JFIX

Called by:

PLOTIT

Common blocks used:

/IOUNIT/ to use ITO

/PLTS/ to use ISIG NDIVS

*** GETSCL updated by PJB Sep 87 ***

SUBROUTINE GETSQ(A,T,X,I,J,MM,NN)

Works out where a contour crosses the sides of a square of
function values.

Arguments:

On entry array A holds the rectangular array of function values.

MM,NN are the dimensions of A.
I,J specify the point under consideration.

On exit array T has been set up to indicate where in the square the contour will go.

Called by:

PLOTCT

*** GETSQ by JCM 24 Nov 83 ***

SUBROUTINE GMADD(A,B,C,NI,NJ)

Sets matrix C = matrix A plus matrix B.

Arguments:

On entry A and B are real matrices of dimension (NIxNJ)
On exit C is a real matrix which is their sum.

Notes:

NI and NJ must be at least 1

Called by:

ATMPLT ATOGEN ATOPOS BNDLST CALPOL GENMAG GENMUL GETGEN LATVCS MAGABS MAGCON MAGDIR MPCON MUCALC PRMTIV REINDX SATGEN SYMOP XROOT XTRANS ICDINC ICDINC MAG3D OVERLA MAGPOW MG3DGL MVENTR LABAX

*** GMADD by JCM ***

LOGICAL FUNCTION GMATCH(A,B,NA,NB)

To determine whether the two real matrices A and B are the same

Arguments:

A and B are real matices of dimension NAxNB

Description:

Return .TRUE. if all equivalent elements of the two matrices differ by less than 10E-5, returns .FALSE, otherwise

*** GMATCH corrected by PJB 4-Apr-2001 ***

SUBROUTINE GMEQ(A,B,NI,NJ)

Sets matrix B = matrix A.

Arguments:

On entry A is a real matrix of dimension NIxNJ
On exit B is a real matrix equal to A

Notes:

NI and NJ must be at least 1

Called by:

ABSCOR AINOUT ALRPOL ANGERS ARREAD ATMPLO ATMPLT ATOGEN ATOMS ATOPOS AXIS BONDER BONERR CALPOL CIRCLE DOCHI1 DPLOT EQOP EQPOS EQPPOS EQRLV EQVEC F2RELA FIXUNI FOUR1Z GENMAG GENMUL GETDC GETGEN GMINV INCELL INPUAR INPUTD INPUTE INVENT KSTARS LATVCS MAGCON MAGDIR MAGSYM MPCON MUCALC OPSYM ORTFUN PFORMF PLCONV PLN3AD PLTRIN PRMTIV PROPAG PROPER PSICON READRT RELMTX RELPOS ROTOSM SATFND SATGEN SETDC SETFOU SETGEN SPCSET STPLOT SUBSYM SYMBAK SYMCEN SYMTID SYMUNI TBOUND TRYUNI UNITID UNUSYM USYM XYZREL ARRINC ICDINC PATHS D3OP99 BPBPRC GETMSF GETSFZ INCMSF ICDINC MAG3D PERSPC POSORT MAGPOW MG3DGL MVENTR ARROW LABAX MAKROT PALSQ SORGAM

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

SUBROUTINE GMINV(A,B,N)

Inverts matrix A into matrix B.

Arguments:

On entry A is a square NxN real matrix
On exit B is its inverse

Description:

Based on SID

Calls:

ERRMES GMEQ

Called by:

ATMPLT MATCEL ORTFUN RECISD UNUSYM

*** GMINV by JCM from SID 11 Oct 88 ***

SUBROUTINE GMNORM(A,B,II,JJ)

Normalises the rows of a matrix.

Arguments:

On entry A is an IIxJJ real matrix
On exit A has been normalised using B, A(I,J) out = A(I,J) in / B(J)

B holds the normalising coefficients

Calls:

GMPRD GMSCA

Called by:

MPCON

*** GMNORM by PJB ***

SUBROUTINE GMPRD(A,B,C,NI,NJ,NK)

Sets matrix C = matrix A times matrix B.

Arguments:

On entry A is a real NIxNJ matrix

B is a real NJxNK matrix

On exit C is a real NIxNK matrix holding A times B

Called by:

ANGDIR ANGERS ATMPLO ATMPLT BONDER BONERR CONVMP DOCHI1 EULSYM FCHALC FOUR1Z GMNORM MAGSYM MATCEL MPCON MUCALC ORTFUN ORTHO PFORMF READRT RELMT3 ROTOSM ROTSYM SCALPR SETDC SYMOP TBOUND UNUSYM USYM LCHALC ANGLD3 MAG3D PERSPC MG3DGL MVENTR PALSQ CALCTW

*** GMPRD by JCM ***

SUBROUTINE GMREV(A,B,NI,NJ)

Reverses the signs of the elements of an NI X NJ matrix.

Arguments:

On entry A is a real matrix of dimension NIxNJ
On exit B is a real matrix holding -A

Notes:

A and B may be the same matrix

Called by:

ANGDIR ASUNIT ATOGEN BNDLST BONDER DOCHI1 F2RELA FMCALC FMMPCA GETDC INVENT ISPABS KSTARS LATVCS LMCALC LMMPCA MAGCON MAGDOM MAGSYM MPCON PLN3AD POLUNI PROPAG PROPER RELMT3 RELPOS ROTOSM SATGEN SUBSYM SYMREF TRYUNI UNITID XROOT XTRANS XYZREL ARRINC ARRNGE GETMSF GETSFZ MG3DGL MVENTR

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

LOGICAL FUNCTION GMSAME(A,B,N,TOLER)

Tells whether one vector is the same as another, to a given
tolerance.

Arguments:

A on entry is an N-sized array, to be compared with:
B, also an N-sized array (A and B may of course be parts of larger arrays)
N on entry is the number of elements of A and B to compare
TOLER on entry is the number within which all the elements of A and B

must agree

GMSAME will be set .TRUE. if all elements of A and B agree within TOLER,

and .FALSE. otherwise

Called by:

EQVEC XROOT

*** GMSAME by JCM 22 Oct 86 ***

SUBROUTINE GMSCA(A,B,SCALE,NI,NJ)

Multiplies every element of the matrix A by the scalar SCALE.

Arguments:

On entry A is a real matrix of dimension NIxNJ

SCALE is the required multiplying scale

On exit B is a real matrix whose elements are those of A times SCALE.

Notes:

A and B may be the same matrix

Called by:

ABSCOR ATMPLT CALPOL CIRCLE GMNORM LATVCS MAGDIR MPCON PIGLET SYMCEN AISPRC MAG3D ARROW ATLAB ATOM LAXIS LINE OVERLA MG3DGL MVENTR ARROW ATOM LABAX LINES PALSQ SORGAM

*** GMSCA by JCM 22 Nov 84 ***

SUBROUTINE GMSUB(A,B,C,NI,NJ)

Sets matrix C = matrix A minus matrix B.

Arguments:

On entry A and B are real matrices of dimension NIxNJ
On exit C is a real matrix whose elements are those of A-B

Called by:

ANGERS ATMPLT ATOPOS BNDLST BONDER BONERR CALPOL EQPPOS EQRLV FCHALC GENMAG MAGABS MAGCON REINDX SETGEN ICDINC LCHALC ICDINC MAG3D OVERLA MAGPOW MG3DGL MVENTR

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

SUBROUTINE GMTRAN(A,B,JJ,II)

Transposes a JJxII matrix A into B.

Arguments:

On entry A is a real matrix of dimension (JJxII)
On exit B is a real matrix of dimension (IIxJJ) which is the transpose of A

Called by:

ATMPLT MATCEL MG3DGL

*** GMTRAN by PJB ***

SUBROUTINE GMUNI(A,NI)

Writes a unit matrix into the square matrix A.

Arguments:

On entry NI is the dimension of the required matrix
On exit A is a square real matrix of dimension NIxNI, set to a unit matrix

Called by:

F2RELA GEOMCO MAGSYM PIGLET PINITL READRT ROTOSM SETFOU SETGEN SPCSET SYMOP MAG3D PALSQ

*** GMUNI by JCM 7 Jul 83 ***

SUBROUTINE GMZER(A,NI,NJ)

Clears to zero the matrix A.

Arguments:

On entry NI and NJ specify A to be of dimension NIxNJ
On exit A is a real matrix of dimension NIxNJ all cleared to zero.

Called by:

ANGERS APSHDS ATMPLT ATOMS ATOPOS BONERR CALCFR CALCGR CALCMG CALCSF CALPOL CELLMA DOCHI1 DOMAG DOMAG1 GENMAG GEOMLS INPUTC INPUTE INPUTS INVENT LATVCS LFCALC LMCALC LMMPCA LMPCAL MAPCON MAPKEY MATCEL MATSET MPCON PFORMF PIGLET PINITL PLCONV PROPDR PSICON RDBOND RECISD RELCL6 RELMT3 RELMTX RFACS SETGEN SPCSET STATIS STPLOT SYMCEN SYMOP SYMUNI VARMAK WTMEAN ARRNGE LCHALC GRAFIC INCMSF POPDOM MAG3D CALCTW

*** GMZER by JCM 7 Jul 83 ***