SUBROUTINE EA06D(V,IV,M)

Harwell routine called by EA06C

Called by:

EA06C

SUBROUTINE EA08C(A,B,VALUE,VEC,M,IV,W)

Harwell routine to find the eigenvalues and eigenvector of a
symmetric tridiagonal matrix.

Description:

Uses qr iteration to find the eigenvalues and eigenvectors of the symmetric tridiagonal matrix whose diagonal elements are
A(I),I=1,M and off-diagonal elements are B(I),I=2,M. The array
W is used for workspace and must have dimension at least 2*M.

Calls:

EA09C

Called by:

EA06C

SUBROUTINE EA09C(A,B,VALUE,M,OFF)

Harwell routine used in solution od eigenvalue problem

Notes:

Called by EC08C

Called by:

EA08C

FUNCTION ELEMAT(ALSQ,MATSZ,I,J)

Gets a matrix element from the triangular LSQ matrix.

Arguments:

ALSQ holds the symmetrical triangular LSQ matrix
MATSZ is its dimension
I,J ask for the particular element, as though ALSQ were square
ELEMAT is set on exit to the element I,J

Notes:

ALSQ and MATSZ are passed through the whole of the LSQ system as arguments, enabling MATSZ to be set and ALSQ to be dimensioned in MAIN programs.

Called by:

MATCEL MATCOR

Common blocks used:

*** ELEMAT by JCM 16 Jul 87 ***

SUBROUTINE EQOP(R,T,N,L)

Checks whether a rotation matrix and a translation vector of a
symmetry operator are already in a list, and adds them if not. Also finds lattice translations.

Arguments:

On entry R holds a 3x3 rotation matrix (part of a space group symmetry

operator)
T holds a 1x3 translation vector for the same operator.
N is the number of entries in the list in /SCRAT so far
L is the number of non-primitive lattice vectors so far.

On exit N and or L may have been increased by 1. N may also indicate which element of TSYM matched R.

Description:

Checks whether R is already in table TSYM in /SCRAT. If not, R and T are added to TSYM and TTRANS in /SCRAT, and N is incremented.
If R occurs in TSYM table, examines T in case it gives a new lattice translation. If it does, adds that to the permanent array ALAT in /SYMDA and increments L. Returns pointer to matching TSYM in N.
Checks are made that N<=48 and L<=4.

Calls:

EQPOS ERRCHK GMEQ

Called by:

SYMOP

Common blocks used:

/SCRAT/ to use all members

/SYMDA/ to use ALAT

*** EQOP by JCM 28 Jun 83 ***

SUBROUTINE EQPOS(VEC1,VEC2,N1,N2,M)

Checks whether the given atom position already occurs in a given
list, and adds the new one if not.

Arguments:

On entry VEC2 holds a 1x3 vector giving a real space postion.

VEC1 is a table of 1x3 vectors, of size (3,M)
N1 is the number of entries in VEC1 so far

Description:

Determines whether VEC2 occurs in VEC1, disregarding multiples of unit cells.
If VEC2 gives a new position it is added to the list VEC1 and N2 is set to
N1+1. A check is made that the total number of positions does not exceed
M, the maximum allowed.
All elements of VEC1 are put into the range 0 =< X <1.
If VEC2 does occur in the list VEC1, N2 is set to its position there.

Notes:

M must be at least 1.

Calls:

FRAC3 GMEQ

Called by:

ATOGEN ATOMS EQOP SYMOP MAG3D MG3DGL MVENTR

Common blocks used:

/IOUNIT/ to use LPT ITO

*** EQPOS updated by JCM 13 Apr 86 ***

SUBROUTINE EQPPOS(VEC1,VEC2,N1,N2,M)

Checks whether the given position vector is related by lattice
translation to one already in the given list.

Arguments:

On entry VEC2 holds a 1x3 vector giving a real space postion.

VEC1 is a table of 1x3 vectors, of size (3,M)
N1 is the number of entries in VEC1 so far

Description:

Determines whether VEC2 occurs in VEC1, disregarding multiples of lattice vectors.
If VEC2 gives a new position it is added to the list VEC1 and N2 is set to
N1+1. A check is made that the total number of positions does not exceed
M, the maximum allowed.
All elements of VEC1 are put into the range 0 =< X <1.
If VEC2 does occur in the list VEC1, N2 is set to its position there.

Notes:

M must be at least 1.

Calls:

FRAC3 GMEQ GMSUB LATVEC

Common blocks used:

/IOUNIT/ to use LPT ITO

*** EQPPOS corrected by PJB 31-May-1994 ***

SUBROUTINE EQRLV(VEC1,VEC2,N1,N2,M)

Checks whether vectors differ by a reciprocal lattice vector.

Arguments:

On entry VEC1 holds a list of 1x3 vectors

VEC2 holds a single 1x3 vector
N1 is the number of vectors in the list VEC1
M is positive if it is required to add VEC2 to list if unique.

On exit N2 points to the position of VEC2 in the list VEC1

Description:

Checks whether VEC2 is identical to, or differs by a reciprocal lattice vector from any of the N1 vectors stored in VEC1. If on entry
M>0 and if VEC2 is unique it is added to the list VEC1 and N2 is set to N1+1; otherwise N2=which vector it matched.
A check is made that the total number of vectors in VEC1 is <= M , the maximum allowed.
If on entry M=0, N2 is set as above, but the new vector is not added to the list.

Calls:

GMEQ GMSUB LATABS

Called by:

PROPER

Common blocks used:

/IOUNIT/ to use LPT ITO

*** EQRLV by PJB Jun 88 ***

SUBROUTINE EQVEC(VEC1,VEC2,N1,N2,M)

Finds a given vector in given table of vectors, or adds it as a
new one.

Arguments:

On entry VEC1 holds a list of 1x3 vectors

VEC2 holds a single 1x3 vector
N1 is the number of vectors in the list VEC1
M is positive if it is required to add VEC2 to list if unique.

On exit N2 points to the position of VEC2 in the list VEC1

Description:

Checks whether VEC2 is identical to any of the N1 vectors stored in VEC1.
If on entry M>0 and if VEC2 is unique it is added to the list VEC1 and N2 is set to N1+1; otherwise N2=which vector it matched.
A check is made that the total number of vectors in VEC1 is <= M , the maximum allowed.
If on entry M=0, N2 is set as above, but the new vector is not added to the list.

Calls:

GMEQ GMSAME

Called by:

ABSCOR ERRMAP INVENT POLUNI SYMEQU SYMREF TRYUNI

Common blocks used:

/IOUNIT/ to use LPT ITO

*** EQVEC updated by JCM 22 Oct 86 ***

FUNCTION ERFNC(X)

Calculates the error function accurate to 3E-7, for + and - X.

Arguments:

On entry X is the argument at which the function is required.
On exit ERFNC holds the function.

Description:

See Abramovitz and Stegun p.299

Called by:

RGAUSS

*** ERFNC by WIFD 22 Aug 85 ***

SUBROUTINE ERRATM(NAME,NACT,MESS)

Writes an error message to say that the given name is not an atom
name; there is a choice of subsequent action.

Arguments:

On entry, NAME is the A4 non-atom name
On entry NACT says which action is required:

NACT +ve means increase IERR in /CARDRC/ by 1, complain and exit
NACT -ve means complain and exit
NACT =0 means complain and stop
IABS(NACT)=1 just gives atom name
IABS(NACT)=2 also writes out ICARD from /SCRACH

On entry MESS is the message specific to this error state

Output:

Writes message on units LPT and ITO.

Calls:

LENGT MESS

Called by:

DOCHI1 DOMAG DOMAG1 GEOMIN INPUTT RDATOM RDBOND SETANI BONDS

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

*** ERRATM by JCM 25 Sep 89 ***

SUBROUTINE ERRCH2(WORD,NACT,MESS1,MESS2)

Write an error message which involves a given WORD between 2
messages; there is a choice of subsequent action.

Arguments:

On entry, WORD is the A4 word to print
On entry NACT says which action is required:

NACT +ve means increase IERR in /CARDRC/ by 1, complain and exit
NACT -ve means complain and exit
NACT =0 means complain and stop

Absolute values for NACT on entry are:

1 means simply write MESS1, WORD, MESS2 2 means follow these on the next line by ICARD

On entry MESS1 is the message before WORD
On entry MESS2 is the message after WORD

Prerequisite calls:

If ABS(NACT)=2, ICARD in /SCRACH/ must contain the A80 card read

Output:

Writes message on units LPT and ITO.

Calls:

LENGT

Called by:

ADDANG ADDATM ADDBON ADDTOR CDFIN DOCHI1 DOMAG DOMAG1 GEOMIN INPUTA INPUTC INPUTD INPUTF INPUTG INPUTJ INPUTM INPUTQ INPUTT MAGCON RADFUN RDANGL RECIP SETFOR SPACE MVENTX

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

*** ERRCH2 by JCM 25 Sep 89 ***

SUBROUTINE ERRCHK(NTYP,NVALUE,NBOUND,NACT,
MESS)

(Possibly increases and) checks a value, giving if appropriate an
error message; there is a choice of subsequent action.

Arguments:

On entry NTYP=type of check required:

NTYP=1 simply check NVALUE for being NOT GREATER THAN NBOUND
NTYP=2 increment NVALUE by 1, then as type 1

On entry NVALUE is the integer to be checked

NBOUND is its upper bound

On entry NACT says which action is required if the test fails:

NACT +ve means increase IERR in /CARDRC/ by 1, complain and exit
NACT -ve means complain and exit
NACT =0 means complain and stop

On entry MESS is the message specific to this error state

Description:

The error message starts " ERROR ** ", and finishes with MESS.
If NTYP=1, NVALUE is printed.

Output:

Outputs the required message on units LPT and ITO

Calls:

LENGT MESS

Called by:

ADDANG ADDATM ADDBON ADDCON ADDTOR AINOUT ATMPLO ATOPOS BNDLST DOCHI1 DOMAG DOMAG1 DOTWN1 EQOP EXPAND FILPRO FIXVAR FUDGIN GEOMIN INOBGR INPUTG LATVCS LLSCAL LSETSF LSETUP MPFORM ORTFUN PFSET RADFUN READRT SETANI SETFOU SETGAU SYMCEN VARMAK VOCAB MAG3D MAG3DX MVENTR MVENTX

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

*** ERRCHK by JCM 4 Oct 88 ***

SUBROUTINE ERRIN2(INT,NACT,MESS1,MESS2)

Writes an error message which involves a given integer INT between
2 messages; there is a choice of subsequent action.

Arguments:

On entry, INT is the integer to print
On entry NACT says which action is required:

NACT +ve means increase IERR in /CARDRC/ by 1, complain and exit
NACT -ve means complain and exit
NACT =0 means complain and stop
IABS(NACT)=1 means just give message
IABS(NACT)=2 means also print contents of /SCRACH/

On entry MESS1 is the message before INT
On entry MESS2 is the message after INT

Output:

Writes message on units LPT and ITO.

Calls:

LENGT

Called by:

ABMULT ABSOR ALRPOL ANGDIR BJ CARDIN DOMAG DOMAG1 DOTWN1 F2NEW FACT FILNOM GAMEX GAUSPT GEOMIN GETDC INPLSF INPUTD INPUTE INPUTM INPUTU INTDIG MAGCON MAGSYM MB11A NEWCRY NPACK OPNFIL PARNAM PARRD PSICON RDNUMS RDRELA RDWRDS RECELL RFACS RREFSF SETDC SETFOR SETFOU SPCSET STPLOT TRYUNI WGHTLS CHILSQ POPDOM MAGLSQ MMPLSQ MPLSQ SFLSQ SFTLSQ

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

*** ERRIN2 by JCM 25 Sep 89 ***

SUBROUTINE ERRMAP

Calculates the standard deviation of the density in a Fourier map.

Prerequisite calls:

The results are meaningless if DELTA, the resolution length, is zero.
Should be set up in the same way as FOUR1Z

Description:

Uses the same kind of data as FOUR1Z, the normal Fourier routine, but the calculation is much slower. One should therefore use a coarser sampling grid. Experience shows that the results vary very little throughout the unit cell.
Assumes errors in non-equivalent reflections are independent and those in related reflections the same.

Input:

Reads data from unit LUNI in FORMAT given by MODED in /MAPDA/

Notes:

Old.

Calls:

EQVEC JFIX RDDATA RESOL ROTSYM TRIG VCTMOD

Called by:

FORFIG FOURPL

Common blocks used:

/CONSTA/ to use TWOPI

/IOUNIT/ to use LUNI

/MAPDA/ to use OUTLIM NX NY NXY NH NK NDIM DENS NOBSIN NUSED SCALF1 SCALF2 DELTA MODED SMAX

/NSYM/ to use NOP NOPC

/SCRAT/ to use all members

/SYMDA/ to use TRANS

*** ERRMAP updated by JCM 14 Apr 89 ***

SUBROUTINE ERRMES(NTYP,NACT,MESS)

Writes an error message, with choice of action on exit.

Arguments:

On entry, NTYP=type of message:

NTYP=0 If IERR not 0 write "Errors in input" followed by MESS and stop
NTYP=1 write "ERROR **" followed by MESS
NTYP=-1 write "PROGRAM ERROR **" followed by MESS
ABS(NTYP)=2 write "ERROR ** need" followed by MESS
ABS(NTYP)=3 write "ERROR ** need card" followed by MESS
NTYP=4 write "WARNING **" followed by MESS

On entry NACT says which action is then required

NACT +ve means increase IERR in /CARDRC/ by 1, complain and exit
NACT -ve means complain and exit
NACT =0 means complain and stop

On entry MESS is the message specific to this error state

Output:

Writes message on units LPT and ITO.

Calls:

LENGT MESS

Called by:

AINOUT APSHSF ATOPOS DOCHI1 DOMAG DOMAG1 DOTWN1 FOUINP FUDGIN GETDC GMINV IICD3 INPUTD INPUTE INPUTG INPUTI INPUTM INPUTU INPUTW INVENT LCOLPG LOGMAG LSETSF LSETUP LSYMPG MAGSYM MOLORB MPFORM NOPFIL ORTFUN OTPUTI PFORMF PFSET PIGLET PLOTCT PRBLOK PROPAG RADFUN RDATOM RDDATA RDFV READRT RECELL RECIP RECISD RGAUSS SETABS SETDC SETFC SETFCM SETFOR SETFOU SETGAU SETGEN SETLP SETPOL SPACE STLSFW STLSSF SYMOP SYMUNI TQLI TRYUNI USYM VARSDS VARSSF VECOUP ABSMSF ARRINC ICDINC ARRNGE AVEXAR BONDS CALMSF CALQSF CHILSQ FORFAC FOURPL GETMSF GETSFZ GRAFIC INCMSF ICDINC MAG3D MAG3DX MAGLSQ MAGPOW MG3DGL MMPLSQ MPLSQ MVENTR MVENTX PALSQ POWDER SFLSQ SFTLSQ

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

*** ERRMES updated by PJB C118 Sept 2002 *** ***

SUBROUTINE ERRRE2(X,NACT,MESS1,MESS2)

Writes an error message which involves a given real X between 2
messages; there is a choice of subsequent action.

Arguments:

On entry, X is the real number to print
On entry NACT says which action is required:

NACT +ve means increase IERR in /CARDRC/ by 1, complain and exit
NACT -ve means complain and exit
NACT =0 means complain and stop
IABS(NACT)=1 means just give message
IABS(NACT)=2 means also print contents of /SCRACH/

On entry MESS1 is the message before X
On entry MESS2 is the message after X

Output:

Writes message on units LPT and ITO.

Calls:

LENGT

Called by:

GETMAP RADFUN SPHELI

Common blocks used:

/CARDRC/ to use IERR

/IOUNIT/ to use LPT ITO

*** ERRRE2 by JCM 25 Sep 89 ***

SUBROUTINE ESDFMT(X,DX,BUFF,IW)

Writes X and its esd DX in the form X(DX)

Arguments:

X is the value and DX its standard deviation
BUFF is a character buffer to receive the result
IW is the maximum number of characters in BUFF to be used

Description:

A value X and its its ESD DX are written into the buffer BUFF in the form
X(DX) as often used in published tables.

*** ESDFMT modified by PJB 14-Mar-96 ***

SUBROUTINE EULSYM(ANG,SYM,ROT)

Finds the Euler angles correponding to a symmetry rotation.

Arguments:

On entry SYM holds a 3x3 symmetry matrix

ROT 3x3x2 contains the matrix relating the axes for the Euler rotations

to the axes of the symmetry matrices and its inverse.

On exit ANG holds the corresponding Euler angles alpha,beta and gamma

in radians.

Calls:

GMPRD

Called by:

MPCON

Common blocks used:

/CONSTA/ to use PI

*** EULSYM by PJB ***

LOGICAL FUNCTION EXCLD(A,B,M)

Determines whether a number occurs within any of a set of given
ranges.

Arguments:

On entry A is a single element.

B is an array of M/2 pairs of numbers, B1 and B2 say.

Each B1 must be < or = its own B2, but the B's need not all be in ascending order.

On exit EXCLD is.TRUE. if A occurs within any of the ranges B1 to B2,

both inclusive.

Notes:

If M should be 0 it should be given as 1

*** EXCLD by JCM 17 Jan 85 ***

SUBROUTINE EXPAND(IBUF,OBUF)

Expands UNIX pathnames by substituting for environment variables

Arguments:

IBUF is a character variable containing the path name to be expanded on output the character variable OBUF contains the expanded pathname

Notes:

OBUF must be given a length by the calling program which is sufficient to hold the expanded path

Calls:

ERRCHK LENGT LETTER NDIGIT

Called by:

FILPRO LISPEC

*** EXPAND new by PJB Mar-28-1994 ***

FUNCTION EXPINT(A,P,N,L)

Calculates an exponential radial integral.

Arguments:

On entry A, P N and L are set up for the routine to calculate the integral between 0 and infinity of the Lth order spherical Bessel function of
A*X times X**N*exp(-P*X)

Description:

Uses hypergeometric series.

Notes:

Used to calculate form-factors from Slater type wave-functions

Calls:

FACT

Called by:

FORMFC

*** EXPINT by PJB Dec 84 ***

SUBROUTINE EXTINC(N,F)

Multi-entry routine to deal with all aspects of single crystal
extinction corrections.

Arguments:

On entry N indicates action required:

N=1 Read and interpret an E card

(This is also ENTRY EXTIN1)

N=2 Calculate an extinction correction, given F=mod(FC)
N=3 as 2, and also calculate divided derivatives
N=4 Apply shift to DOMR
N=5 Apply shift to MOSC

(These are also ENTRY EXTIN3(NP) where NP=1 for DOMR, 2 for MOSC)

N=6 Output new E card

(This is also ENTRY EXTIN4)

ENTRY EXTIN8(NP,NV) sets DOMR (NP=1) or MOSC (NP=2) to be variable NV
ENTRY EXTIN9 sets both DOMR and MOSC fixed.

Prerequisite calls:

Entries 2 through 6 require that the extinction is set up by an entry 1.
Entries 2 and 3 expect in the array CEXT in /EXTN/ the 4 coefficients as described in Becker &$1;Coppens (1974) Acta Cryst A30 p129.
Normally entry 3 would be from an LSQ job via CALCSF

entries 4 &$1;5 from an LSQ job via APSHSF entry 6 from an LSQ job via NWINSF

Description:

Entry 1 reads DOMR and MOSC and IEXTYP into /EXTN, setting LOGICALS

GAUSS and LOREN

Entry 2 calculates EXTCOR, which is SQRT(Y) in the theory above, using either

the Lorenztian (IEXTYP=1) or Gaussian (IEXTYP=2) model.

Entry 3 calculates in addition the derivatives:

DEX/DR (R is DOMR) DEX/DG (G is MOSC) and DEX/DF (F is mod(FC)) and all these are required divided by EX itself. They are therefore put into variables ending Q for "quotient"

Output:

Entry 6 writes a new E card to unit NEWIN

Notes:

If the path length is given in mm ,the wavelength and cell pars in
Angstroms and the scattering lengths in 10e-12cm then the domain radius is in nanometres and the mosaic spread in radians

Entries:

EXTIN1

EXTIN3 called by: APSHSF

EXTIN4

EXTIN8 called by: VARSMG VARSSF

EXTIN9 called by: VARSMG VARSSF

Calls:

ADJUST INPUTE TESTOV

Called by:

CALCFR CALCGR CALCMG CALCMP CALCSF GAMEX NWINSF AVEXAR CHILSQ EXTCAL MAGLSQ MMPLSQ MPLSQ SFLSQ SFTLSQ CALCTW SORGAM

Common blocks used:

/EXTN/ to use IEXTYP KDOMR AMOSC KMOSC EXTCOR CEXT XEXT DEXDFQ DEXDRQ DEXDGQ LOREN GAUSS

/NEWOLD/ to use NEWIN

*** EXTINC Modified C141 February 2006 ***

SUBROUTINE EXTPAR(H,WLGTH,TM)

Calculates the theta dependent extinction parameters for
reflection H

Arguments:

On entry WLGTH holds the wavelength and TM the mean pathlength

Prerequisite calls:

RECIP for VCTMOD

Notes:

If the path length is given in mm ,the wavelength and cell pars in
Angstroms and the scattering lengths in 10e-12cm then the domain radius is in nanometres and the mosaic spread in radians

Calls:

SINCOS VCTMOD

Called by:

PATHS EXTCAL SORGAM

Common blocks used:

/EXTN/ to use CEXT LOREN GAUSS

*** EXTPAR Modified C129 BY PJB Feb 2004 ***