SUBROUTINE CALCDS(H)

Calculates d star squared, and its derivatives wrt reciprocal
cell quadratic products.

Arguments:

On entry H is a 1x3 vector holding h,k,l

Prerequisite calls:

In /CELPAR/ CPARS(1:6,2) should hold the 6 reciprocal quadratic products

A* = a* squared
D* = b* c* cos alpha* etc
KCPARS(1:6) should hold fix/vary information for each of the 6 reciprocal cell quadratic products.

Description:

Sets GCALC in /OBSCAL/ to be d star squared, the d spacing squared, and DERIVV in /DERVAR/ to be the derivative, where relevant

Common blocks used:

/CELPAR/ to use CPARS KCPARS

/DERVAR/ to use DERIVV

/OBSCAL/ to use GCALC

*** CALCDS by JCM 31 Jan 85 ***

SUBROUTINE CALCFR(H,SFCALC,MGCALC)

LSQ for flipping ratios or polarised neutron asymmetries

Arguments:

On entry H is the 1x3 array holding h,k,l

SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is usually LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Calculates either the flipping ratio (IREF=5) or the polarised neutron
Sets GCALC, the calculated function corresponding to an OBS just read
Applies an extinction correction if there was an E card .
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.

Calls:

CRSCLP EXTINC GMZER ISPABS LATABS MAGABS TESTOV VCTMOD

Called by:

CHILSQ MAGLSQ MMPLSQ MPCLSQ SNPLSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/EXTN/ to use KDOMR KMOSC EXTCOR DEXDFQ DEXDRQ DEXDGQ

/FCAL/ to use FCMOD COSAL SINAL FCDERS

/MCAL/ to use FMCMOD FMCSQR QDOTP DQDOTP

/OBSCAL/ to use GCALC YCALC

/PHASE/ to use JPHASE

/POLDA/ to use POLUP POLDW POLND

/PRBLEM/ to use LVFST1 NVARF

/QCALD/ to use all members

/REFINE/ to use IREF

/SCLDAT/ to use ISCALE SCALE KSCALE

/SYMMAG/ to use PARA

*** CALCFR updated to include asymmetry by PJB (+C4.2) Sept 2007 ***

SUBROUTINE CALCFW(S)

Calculates the Forsyth & Wells exponential function which
approximates to observed scattering factor curves.

Arguments:

On entry S is sin theta.

Prerequisite calls:

The relevant number of coeffivients (usually 5, 7 or 9) are held in /FWVALS/ as COEFFS(1:NVALS)

Description:

Used in FWLSQ as a very simple LSQ application, with no constraints.
Sets GCALC = Forsyth &$1;Wells sum of exponential terms, and DERIVV in /DERVAR/ as NVALS derivatives.

Notes:

PJB says it doesn't work; this must be investigated.

Common blocks used:

/DERVAR/ to use DERIVV

/FWVALS/ to use all members

/OBSCAL/ to use GCALC

*** CALCFW by JCM 19 Nov 84 ***

SUBROUTINE CALCGM(H,SFCALC,MGCALC)

Calculates GCALC (IREF=6) as the ratio of antiferromagnetic to
nuclear scattering Probably obsolete replaced by SNPLSQ types

Arguments:

On entry H is the 1x3 array holding h,k,l

SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is usually LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Sets GCALC, the calculated function corresponding to an OBS just read
Applies an extinction correction if there was an E card .
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The function GCALC is made up of three functions multiplied together.
We write G=P1*P2*P3 where P2 is a simple function of FCALC, P1 is independent of FCALC (being Scale * overall itf), and P3 is the extinction correction.(They are written in this way for ease of differentiation.)
If IREF=2, we are in fact comparing OBS squared with GCALC squared. This is dealt with right at the end, after proceeding as though we were not.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
Form P1 and its derivatives.
Form P2: get FCALC and derivatives of mod FCALC wrt family 2 variables,

using both nuclear and magnetic structure factors

The scattering factors are calculated using PFORMF with multipoles.
Convert derivatives to be of P2, not just mod FCALC
Form P3: convert derivatives
Form GCALC and make all derivatives so that they are of GCALC
Adjust for GCALC squared if necessary

On exit in /OBSCAL/ GCALC = calculated function to compare with observed
On exit in /DERVAR/ DERIVV is an array holding all derivatives of GCALC wrt all variables

Notes:

L REFI=6 the GOBS and CCALC are gammas (Fmag/Fnuc) expects imag Fmag

Calls:

GMZER ORTHO SCALPR TESTOV VCTMOD VECPRD

Called by:

MAGLSQ MMPLSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/FCAL/ to use FCMOD COSAL SINAL FCDERS

/IOUNIT/ to use LPT

/MAGDAT/ to use SPIND

/MCAL/ to use FMCMOD FMCSQR FMCDER

/OBSCAL/ to use GCALC YCALC

/PHASE/ to use JPHASE

/PRBLEM/ to use LVFST1 NVARF

*** CALCGM temporary PJB Oct 2009 ***

SUBROUTINE CALCGR(H,FAC)

Gives the calculated function for grouped single crystal Least
Squares.

Arguments:

On entry H is a 1x3 real array holding h,k,l

FAC is the factor by which to multiply GCALC before summing

Prerequisite calls:

SETFC (or its constituent parts SYMOP, RECIP etc) must have set up the

structure factor calculation.

EXTINC must have set up the extinction corrections
LSETUP, PARSSF and VARMAK must have set up the Least Squares
STLSSF must have read the L cards .

Description:

Forms GCALC and sums it in YCALC, multiplied by FAC. Also derivatives of
GCALC with respect to any parameters, and summs them likewise into DERIVV.
GCALC is the product of 3 functions, P1, P2, P3
P1 is the scale * overall itf * FAC (at present in GRLSQ FAC=multiplicity

times d to the power 4)

P2 is the square of the structure factor.
P3 is an extinction correction, possibly absent.

Notes:

Only IREF=1 makes sense here.

Calls:

EXTINC GMZER LFCALC VCTMOD

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/EXTN/ to use KDOMR KMOSC EXTCOR DEXDFQ DEXDRQ DEXDGQ

/FCAL/ to use FCMOD FCDERS

/OBSCAL/ to use GCALC YCALC

/PRBLEM/ to use LVFST1 NVARF

/SCLDAT/ to use ISCALE SCALE KSCALE

*** CALCGR by JCM 18 Feb 85 ***

SUBROUTINE CALCMG(H,SFCALC,MGCALC)

Calculates GCALC and its derivatives for structures which may have
mixed magnetic and nuclear reflections.

Arguments:

On entry H is the 1x3 array holding h,k,l

SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is usually LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Sets GCALC, the calculated function corresponding to an OBS just read
Applies an extinction correction if there was an E card .
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The function GCALC is made up of three functions multiplied together.
We write G=P1*P2*P3 where P2 is a simple function of FCALC, P1 is independent of FCALC (being Scale * overall itf), and P3 is the extinction correction.(They are written in this way for ease of differentiation.)
If IREF=2, we are in fact comparing OBS squared with GCALC squared. This is dealt with right at the end, after proceeding as though we were not.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
Form P1 and its derivatives.
Form P2: get FCALC and derivatives of mod FCALC wrt family 2 variables,

using both nuclear and magnetic structure factors

The scattering factors are calculated using PFORMF with multipoles.
Convert derivatives to be of P2, not just mod FCALC
Form P3: convert derivatives
Form GCALC and make all derivatives so that they are of GCALC
Adjust for GCALC squared if necessary

On exit in /OBSCAL/ GCALC = calculated function to compare with observed
On exit in /DERVAR/ DERIVV is an array holding all derivatives of GCALC wrt all variables

Notes:

If L REFI=5 the GOBS and GCALC are polarised neutron flipping ratios

and the scales multiply the up and down polarisations

if L REFI=6 the GOBS and CCALC are gammas (Fmag/Fnuc) expects imag Fmag

Calls:

EXTINC GMZER SINCOS TESTOV VCTMOD

Called by:

CHILSQ MAGLSQ MMPLSQ MPCLSQ

Common blocks used:

/BRAGG/ to use STHL SINTH COSTH SSQRD

/DERVAR/ to use all members

/EXTN/ to use KDOMR KMOSC EXTCOR DEXDFQ DEXDRQ DEXDGQ

/FCAL/ to use FCMOD FCDERS

/MCAL/ to use FMCSQR FMCDER

/OBSCAL/ to use GCALC YCALC

/PHASE/ to use JPHASE

/PRBLEM/ to use LVFST1 NVARF

/REFINE/ to use IREF

/SCLDAT/ to use ISCALE SCALE KSCALE

*** CALCMG modified by PJB C108 May-2001 ***

SUBROUTINE CALCMP(H)

Makes the calculated function and derivatives for single crystal
LSQ with multipoles.

Arguments:

On input H is a 3-sized array containing h,k,l

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI

Description:

Sets GCALC, the calculated function corresponding to an OBS just read
Applies an extinction correction if there was an E card .
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The function GCALC is made up of three functions multiplied together.
We write G=P1*P2*P3 where P2 is a simple function of FCALC, P1 is independent of FCALC (being Scale * overall itf), and P3 is the extinction correction.(They are written in this way for ease of differentiation.)
If IREF=2, we are in fact comparing OBS squared with GCALC squared. This is dealt with right at the end, after proceeding as though we were not.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
Form P1 and its derivatives.
Form P2: get FCALC and derivatives of mod FCALC wrt family 2 variables

This includes the multipoles.

Convert derivatives to be of P2, not just mod FCALC.
Form P3: convert derivatives.
Form GCALC and make all derivatives so that they are of GCALC.
Adjust for GCALC squared if necessary.

Calls:

EXTINC LMPCAL TESTOV VCTMOD

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/EXTN/ to use KDOMR KMOSC EXTCOR DEXDFQ DEXDRQ DEXDGQ

/FCAL/ to use FCMOD FCDERS

/OBSCAL/ to use GCALC

/PRBLEM/ to use LVFST1 NVARF

/REFINE/ to use IREF

/SCLDAT/ to use ISCALE SCALE KSCALE

*** CALCMP by PJB Oct 88 ***

SUBROUTINE CALCPA(H,IPDIR,SFCALC,MGCALC)

Calculates scattered polarisations and their derivatives for
structures which may have mixed magnetic and nuclear reflections.

Arguments:

On entry H is the 1x3 array holding h,k,l

SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is now LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Sets GCALC to the component of the scattered polarisation indicated by Pin
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
If NEW calculate the nuclear and magnetic structure factors and their derivatives.
If ICOMP=1 (ie 1st component for this input polarisation) calculate the output polarisation, summing over all domains and its differential wrt all parameters.
Otherwise just set GCALC to previously calculated component of polarisation and scale the appropriate component of the differentials.

On exit in /OBSCAL/ GCALC = calculated function to compare with observed

in /DERVAR/ DERIVV is an array holding all derivatives of GCALC

wrt all variables.

Calls:

C1MSCA CGMADD CGMEQ CGMPRD CGMREV CGMSCA CGMZER CMCONJ CMIMAG CMREAL CMRSCA CRSCLP GMADD GMEQ GMPRD GMREV GMSCA GMSUB GMZER ORTHO RCMPRD RSCALP SCALPR UNIVEC VECPRD

Called by:

SNPLSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/DSOURC/ to use JSRC DPOP KDPOP IPDOM

/FCAL/ to use FC

/IOUNIT/ to use LPT IOUT

/QCALD/ to use all members

/OBSCAL/ to use GCALC ICODE

/PHASE/ to use JPHASE

/POLDA/ to use POLND

/POLDAT/ to use DXSDN DXSDQ DPOLDN DPOLDQ POLIT POLO QSQR POLD QSQRM

/PRBLEM/ to use LVFST1 NVARF

/SATELL/ to use IPROP KCENT

/SYMMAG/ to use NDOM

/TWIN/ to use TWMAT NTWIN MTWIN

*** CALCPA Updated C4.7 by PJB March 2008 ***

SUBROUTINE CALCSF(H,SFCALC)

Makes the calculated function and derivatives for single crystal
LSQ.

Arguments:

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

SFCALC is a subroutine name used for the actual structure factor calculation, like LFCALC

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Sets GCALC, the calculated function corresponding to an OBS just read
Applies an extinction correction if there was an E card .
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The function GCALC is made up of three functions multiplied together.
We write G=P1*P2*P3 where P2 is a simple function of FCALC, P1 is independent of FCALC (being Scale * overall itf), and P3 is the extinction correction.(They are written in this way for ease of differentiation.)
If IREF=2, we are in fact comparing OBS squared with GCALC squared. This is dealt with right at the end, after proceeding as though we were not.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
Form P1 and its derivatives.
Form P2: get FCALC and derivatives of mod FCALC wrt family 2 variables
Convert derivatives to be of P2, not just mod FCALC
Form P3: convert derivatives
Form GCALC and make all derivatives so that they are of GCALC
Adjust for GCALC squared if necessary

Calls:

EXTINC GMZER TESTOV VCTMOD

Called by:

MPLSQ SFLSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/EXTN/ to use KDOMR KMOSC EXTCOR DEXDFQ DEXDRQ DEXDGQ

/FCAL/ to use FCMOD FCDERS

/OBSCAL/ to use GCALC

/PHASE/ to use JPHASE

/PRBLEM/ to use LVFST1 NVARF

/REFINE/ to use IREF

/SCLDAT/ to use ISCALE SCALE KSCALE

*** CALCSF updated by PJB 31-May-1994 ***

SUBROUTINE CALDSM(H,ISAT)

Calculates d star squared, and its derivatives wrt reciprocal
cell quadratic products and components of propagation vector.

Arguments:

On entry H is a 1x3 vector holding h,k,l

Prerequisite calls:

In /CELPAR/ CPARS(1:6,2) should hold the 6 reciprocal quadratic products

A* = a* squared
D* = b* c* cos alpha* etc
KCPARS(1:6) should hold fix/vary information for each of the 6 reciprocal cell quadratic products.

If magnetic /SATELL/ should have been set up with a call to PROPER

and the corresponding symmetry constraints with PROPSM

Description:

Sets GCALC in /OBSCAL/ to be d star squared, the d spacing squared, and DERIVV in /DERVAR/ to be the derivative, where relevant

Calls:

PROPDR

Common blocks used:

/CELPAR/ to use CPARS KCPARS

/DERVAR/ to use DERIVV

/OBSCAL/ to use GCALC

/REFINE/ to use MAG

/SATELL/ to use KPROP

*** CALDSM to include PROPAGATION VECTOR by PJB 21-Sept-93 ***

SUBROUTINE CALMMG(HH,SFCALC,MGCALC)

Calculates GCALC and its derivatives for structures with magnetic
twinning

Arguments:

On entry H is the 1x3 array holding h,k,l

SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is usually LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Sets GCALC, the calculated function corresponding to an OBS just read
Applies an extinction correction if there was an E card .
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The function GCALC is made up of three functions multiplied together.
We write G=P1*P2*P3 where P2 is a simple function of FCALC, P1 is independent of FCALC (being Scale * overall itf), and P3 is the extinction correction.(They are written in this way for ease of differentiation.)
If IREF=2, we are in fact comparing OBS squared with GCALC squared. This is dealt with right at the end, after proceeding as though we were not.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
Form P1 and its derivatives.
Form P2: get FCALC and derivatives of mod FCALC wrt family 2 variables,

using both nuclear and magnetic structure factors

The scattering factors are calculated using PFORMF with multipoles.
Convert derivatives to be of P2, not just mod FCALC
Form P3: convert derivatives
Form GCALC and make all derivatives so that they are of GCALC
Adjust for GCALC squared if necessary

On exit in /OBSCAL/ GCALC = calculated function to compare with observed
On exit in /DERVAR/ DERIVV is an array holding all derivatives of GCALC wrt all variables

Notes:

If L REFI=5 the GOBS and GCALC are polarised neutron flipping ratios

and the scales multiply the up and down polarisations

if L REFI=6 the GOBS and CCALC are gammas (Fmag/Fnuc) expects imag Fmag

Calls:

ERRIN2 EXTINC GMPRD GMZER RSCALP TESTOV VCTMOD

Called by:

SNPLSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/DSOURC/ to use JSRC DPOP KDPOP IPDOM

/EXTN/ to use KDOMR KMOSC EXTCOR DEXDFQ DEXDRQ DEXDGQ

/FCAL/ to use FCMOD FCDERS

/OBSCAL/ to use GCALC YCALC

/PHASE/ to use JPHASE

/PRBLEM/ to use LVFST1 NVARF

/QCALD/ to use all members

/REFINE/ to use IREF

/SCLDAT/ to use ISCALE SCALE KSCALE

/SYMMAG/ to use NDOM

/TWIN/ to use TWMAT NTWIN

*** CALMMG updated C4.7 by PJB March 2008 ***

SUBROUTINE CALPOL(H,NEW,ICOMP,SFCALC,MGCALC)

Calculates scattered polarisations and their derivatives for
structures which may have mixed magnetic and nuclear reflections.

Arguments:

On entry H is the 1x3 array holding h,k,l

NEW is TRUE if this hkl differs from the previous one

FALSE if it is the same

ICOMP is the component of polarisation required
SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is now LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Sets GCALC to the ICOMPth component of the scattered polarisation.
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.
The sequence of operations is:

Get STHL= sin theta/lambda, SSQRD= STHL squared.
Clear derivatives to zero.
If NEW calculate the nuclear and magnetic structure factors and their derivatives.
If ICOMP=1 (ie 1st component for this input polarisation) calculate the output polarisation, summing over all domains and its differential wrt all parameters.
Otherwise just set GCALC to previously calculated component of polarisation and scale the appropriate component of the differentials.

On exit in /OBSCAL/ GCALC = calculated function to compare with observed

in /DERVAR/ DERIVV is an array holding all derivatives of GCALC

wrt all variables.

Calls:

C1MSCA CGMADD CGMEQ CGMPRD CGMSCA CGMZER CMCONJ CMIMAG CMREAL CMRSCA CRSCLP GMADD GMEQ GMSCA GMSUB GMZER RSCALP SCALPR VCTMOD VECPRD

Called by:

PALSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/FCAL/ to use FC

/IOUNIT/ to use LPT IOUT

/QCALD/ to use all members

/OBSCAL/ to use GCALC

/PHASE/ to use JPHASE

/POLDAT/ to use DXSDN DXSDQ DPOLDN DPOLDQ NDOMN ND180 POLM POLO QSQR POLD QSQRM

/PRBLEM/ to use LVFST1 NVARF

/SCLDAT/ to use SCALE KSCALE

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

SUBROUTINE CALPOW(H,MODE,SFCALC,MGCALC)

LSQ for magnetised powders and polarised neutrons

Arguments:

On entry H is the 1x3 array holding h,k,l

MODE is 0 for the first entry for each H, calculates the structure

factors and differentials and returns I+ as GCALC

is >0 for the second entry which returns I-.

SFCALC is the name of the routine to get nuclear structure factors

and their derivatives. This is usually LFCALC.

MGCALC is the name of the routine to get magnetic structure factors

and their derivatives. This is usually LMCALC.

Prerequisite calls:

Structure factor data must have been set up in various COMMON blocks by SYMOP RECIP ATOPOS, SETFOR, SETANI
LSETUP, PARSSF, VARMAK must have set up the Least Squares.
STLSSF must have read the L cards :

Description:

Calculates the up and down intensities and their derivatives with respect to all parameters.
Sets GCALC, the calculated function corresponding to an OBS just read
Also produces the vector DERIVV (LVARV long) of derivatives of this function wrt each variable in turn.

Calls:

GMZER VCTMOD

Called by:

CHILSQ MPCLSQ

Common blocks used:

/BRAGG/ to use STHL SSQRD

/DERVAR/ to use all members

/FCAL/ to use FCMOD COSAL SINAL FCDERS

/MCAL/ to use FMCMOD FMCSQR

/OBSCAL/ to use GCALC YCALC

/PHASE/ to use JPHASE

/POLDA/ to use POLUP POLDW

/PRBLEM/ to use LVFST1 NVARF

/SCLDAT/ to use ISCALE SCALE KSCALE

*** CALPOW by PJB July 2009 C4.17 ***

SUBROUTINE CARDIN(IDEN)

Finds the record number IDEN in the DIRECT ACCESS file on unit
IO10, which is a copy of the Crystal Data File.

Arguments:

On entry IDEN holds the number of the required record.

Description:

Reads card in format A80 to ICARD, leaving this to be interpreted elsewhere.
Ignores Y and Z cards , which were not counted when PREFIN read the data.
Counts those it ignores in NYZ, and so that calling routines know if last card is Y or Z, sets NYZ=-1 in those cases.
Complains if record IDEN is not present.

Calls:

ERRIN2

Called by:

CDSCAN DOTWN1 FINDCD INPLSF INPUTA INPUTC INPUTD INPUTE INPUTF INPUTG INPUTI INPUTJ INPUTM INPUTN INPUTQ INPUTS INPUTT INPUTU INPUTW MAJUST ONCARD SETPOL

Common blocks used:

/CARDRC/ to use NTOTAL NYZ IO10

/PHASE/ to use JPHASE

*** CARDIN by JCM 2 Feb 88 ***

SUBROUTINE CDFIN(NUMCDF,ID,ENDIP)

Reads in one Crystal Data File and copies it to direct access unit
number IO10, starting at record number ID.

Arguments:

On entry NUMCDF = which crystal data file is required; 1 in MK3

ID is the previously used record of DIRECT ACCESS file IO10 in COMMON /CARDRC/ ICRYDA=unit from which to read

On exit ID has been advanced and gives total records on IO10

ENDIP is TRUE if the end of the file hs been reached.

Description:

Writes to /CARDRC/ the following:

NTOTAL(NUMCDF)=number of records for phase NUMCDF
INREA(26,NUMCDF)=absolute starting addresses for letters
ICDN(26,NUMCDF)=numbers of cards starting with letters

Also detects presence of I OUTP item, and unless a non-zero value is already in IOUT in /IOUNIT/, interprets the integer after the I OUTP.
Also detects if it is reading phase 1 of a multiphase job, because it must form the union of this with "phase 0"

Input:

Reads crystal data sets from unit ICRYDA.

Output:

Writes Y cards straight to unit LPT.
Lists on LPT numbers of each type of card read.

Notes:

Modified to ignore empty cdfs (e.g. if the file inadvertently starts with a non-letter)

Calls:

ERRCH2 FILNOM JFIX LENGT LETTER MAJUST MESS ONCARD RDWORD

Called by:

PREFIN

Common blocks used:

/CARDRC/ to use ICRYDA NTOTAL INREA ICDN IO10

/CHARS/ to use LETUP

/GLOBAL/ to use MULFAS

/IOUNIT/ to use LPT IOUT

/PHAS0/ to use NCDF0

/PHASE/ to use NPHASE

*** CDFIN updated by JCM 21 Jan 92 ***

SUBROUTINE CDSCAN(CH,WORDS,LEN,K,LCD,NW)

Finds the next card which starts with the letter given in CH, and
has then a word which is one of the collection given in WORDS.

Arguments:

On entry CH is the A1 character to start the card

WORDS is an A4 array of length LEN with possible next words
K is 0 if to search from start, otherwise where to start - i.e. we search from the K+1th card of the crystal data

On exit LCD = which card, if found

= -1 if none found starting CH = 0 if some start CH, but none of WORDS come next

NW = which word of WORDS was found

Description:

sets a copy of the found card into ICARD

Calls:

CARDIN LETTER RDWORD

Called by:

RDFV

Common blocks used:

/CARDRC/ to use NTOTAL NYZ

/PHASE/ to use JPHASE

*** CDSCAN updated by JCM 2 Feb 88 ***

SUBROUTINE CELDER(H,DERS)

From h,k,l calculates d* squared and its derivatives, and sets
SSQRD.

Arguments:

On entry H is a real 1x3 vector holding h,k,l
On exit DERS is a real 1x6 array holding the derivatives of d* squared

wrt A*, B*, C*, D*, E*, F*

Prerequisite calls:

CPARS in /CELPAR/ must contain A*, B*, C*, D*, E*, F*

Description:

Also sets SSQRD in /BRAGG/ to be s squared (=d* squared/4)
STHL in /BRAGG/ to be sin theta/lambda, s, or d*/2 and DSTAR2 in /BRAGG/ to be d* squared

Common blocks used:

/BRAGG/ to use STHL SSQRD DSTAR2

/CELPAR/ to use CPARS

*** CELDER updated by JCM 7 Sep 88 ***

SUBROUTINE CELLMA(BGTOSM)

Makes the matrix to transform the variance/covariance matrix for
the quadratic products to that for a,b,c etc

Arguments:

On exit BGTOSM(6,6) is the required matrix

Calls:

GMZER RADIAN

Called by:

RECISD

Common blocks used:

/CELPAR/ to use CELL CPARS

*** from MATCEL by PJB Aug 98 26-Aug-1998 ***

SUBROUTINE CELMAT(TOSTAR)

Sets up the matrix to convert derivatives wrt A,B,C . . (cell
quadratic products in real space) to derivatives wrt A*, B*, C*, . . in reciprocal space.

Arguments:

On exit TOSTAR is the required 6x6 matrix

Prerequisite calls:

On entry CPARS(1:6,1) contain the real space cell quadratic products,
A=a sqrd, B=b sqrd, C=c sqrd D=b c cos alpha, etc

Called by:

GEOMCO MATCEL

Common blocks used:

/CELPAR/ to use CPARS

*** CELMAT by JCM 17 Aug 89 ***

SUBROUTINE CELNEW

Writes out a new
C card after cell parameter refinement.

Prerequisite calls:

CELL in /CELPAR/ should contain a,b,c, cos alpha, beta, gamma
CELESD in /CELPAR/ should contain the variance/covariance matrix for the quadratic products (see MATCEL)

Output:

Writes to unit NEWIN a new C card

Notes:

Does not preserve any blanks originally left for symmetry.

Calls:

ARCCOS DEGREE

Called by:

NWINDS NWINT2

Common blocks used:

/CELPAR/ to use CELL CELESD CELLSD PRODSD

/DERBAS/ to use LVARB

/NEWOLD/ to use NEWIN

/OBSCAL/ to use SUMWD NOBS

*** CELNEW updated by PJB 26-Aug-1998 ***

SUBROUTINE CELREL(IFAM,IGEN,ISPC)

Transfers any relations which exist between cell parameters from
their own COMMON to the general "contraint/fixing" COMMON.

Arguments:

On entry IFAM, IGEN, ISPC designate the first parameter, A*

Description:

Moves the constraint and/or fixing information from /CELFIX/ to join the general initial fix/constrain info.
Also keep starting family, genus, species for later consultation in
NCELF,NCELG,NCELS

Notes:

Cell parameters are source-independent (KSOURC=1) but may be phase dependent
B*, C* etc are assumed to have ISPC going sequentially up in 1's from A*

Calls:

FIXREL KPAK

Called by:

PARSDS PARSSF

Common blocks used:

/CELFIX/ to use IPTCEL AMCELL NCELF NCELG NCELS

/PHASE/ to use JPHASE

*** CELREL updated by JCM 2 May 90 ***

SUBROUTINE CELSDP(ALSQ,MATSZ)

Prints the esds of real cell parameters after a cycle of
refinement.

Arguments:

ALSQ, MATSZ need to be handed around in routine calls

Prerequisite calls:

ALSQ must hold the inverse LSQ matrix
CPARS holds A,B,C,D,E,F, the real cell quadratic products, and
CELL the result of reading a C card .

Output:

If a variance is negative, writes 0.

Calls:

DEGREE MESS NEWLIN

Common blocks used:

/CELPAR/ to use CELL CELLSD

/DERBAS/ to use LVARB

/IOUNIT/ to use LPT

/OBSCAL/ to use SUMWD NOBS

*** CELSDP by JCM 17 Aug 89 ***

SUBROUTINE CELSHF(N)

Applies a shift to a cell quadratic product.

Arguments:

N= which parameter; 1=A*, 2=B*, 3=C* etc

Entries:

CELVAR called by: VARSDS VARSMG VARSSF VARST2

Calls:

ADJUST

Called by:

APSHSF

Common blocks used:

/CELPAR/ to use CPARS KCPARS

*** CELSHF updated by JCM 10 Feb 87 ***

SUBROUTINE CENTRE(LUNIT,N,TXT,NWIDE)

Writes on unit LUNIT the given message, centred & preceded by N
empty lines.

Arguments:

On entry TXT is a CHARACTER variable holding the message,

N is in integer requesting N empty lines before the message, and

may be 0, for no lines or > 98, for a page throw.

LUNIT is the unit on which to write.
NWIDE is the width of page in which the text is to be centred.

Output:

Writes to unit LUNIT N empty lines or a page throw, then the given text with a "space" carriage control, centred within NWIDE spaces.

Calls:

LENGT

Called by:

SPACE STLSFW ARISNP ARRINC ARRNGE ARRSNP BONDS CALMSF CALQSF CHILSQ GETMSF GETSFZ MAGLSQ MAGPOW MPCLSQ POWDER SFLSQ SFTLSQ SNPLSQ SORASY SORGAM

*** CENTRE by JCM 12 Sep 92 ***

SUBROUTINE CENTRO(CVEC,SVEC,RMAT,PSIFAC,
PSIFCC)

Executes the action of the centre of symmetry on a term in the
magnetic structure factor for helimagnetic structures.

Arguments:

On entry: CVEC(3) is a complex vector, the term for one operator,

RMAT(3,3) is the required rotation matrix,
PSIFAC is the phase factor associated with the operator,
PSIFCC is the phase factor for the centrosymmetic operator,

On exit: SVEC(3) is the result of applying the phase factors and the

centrosymmetric rotation.

For entry CENDIF the two terms VEC1 and VEC2 whose sum is SVEC are also returned to allow calculation of the differentials wrt the psi's.

Notes:

SVEC can be the same as CVEC if replacement is required
Called in magnetic stucture factors and magnetic least squares when treating the centre of symmetry.

Entries:

CENDIF called by: LMCALC LMMPCA LMTCAL

Calls:

CGMADD CGMEQ CGMSCA CMCONJ RCMPRD

Called by:

FMCALC FMMPCA LMCALC LMMPCA LMTCAL

*** CENTRO updated by PJB C141 March 2006 ***

SUBROUTINE CGAMMA(R,PUP,PDN,DEL,G,QQ,QLAM,
RMS)

Solves the quadratic equation for gamma in terms of the flipping
ratio.

Arguments:

scattering.
On entry R is the flipping ratio,

PUP is the up polarisation,
PDN is the down polarisation,
DEL(3) contains the esd's in R, PUP and PDN in that order
QQ is the sin of the angle between the magnetisation direction

and the scattering vector

QLAM is the cosine of the angle between the polarisation direction

and the scattering vector

RMS is the ratio of multiple (or lamba/2) to nuclear scattering.

On exit the positive root is in G(1) and the negative one is in G(2).

Description:

Used to determine the ratio, gamma, of mangetic to nuclear scattering from polarised neutron flipping ratios.
Can correct for spin-independent multiple or unpolarised lambda/2

Notes:

For polarised neutron data analysis.

Called by:

FGAMMA

*** CGAMMA modified by PJB 04-May-1999 ***

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

Sets COMPLEX matrix C = COMPLEX matrix A + COMPLEX matrix B.

Arguments:

On entry A and B are NI by NJ COMPLEX matrices
On exit C is set to the sum of A and B

Called by:

CALCPA CALPOL CENTRO FCHALC FMCALC FMMPCA LMCALC LMMPCA LMTCAL TCHALC TCHMPC

*** CGMADD by JCM 20 Nov 87 ***

SUBROUTINE CGMEQ(A,B,N,M)

Sets COMPLEX matrix B equal to COMPLEX matrix A.

Arguments:

On entry A is a COMPLEX matrix of DIMENSION N,M
On exit B, a COMPLEX matrix of the same total size, has been set equal to A

Notes:

Would not give error even if N or M were zero.

Called by:

CALCPA CALPOL CENTRO FMCALC FMMPCA LMCALC LMMPCA LMTCAL

*** CGMEQ by JCM ***

SUBROUTINE CGMPRD(A,B,C,I,J,K)

Multiplies together two COMPLEX matrices.

Arguments:

On entry A (of dimensions IxJ) and B (of dimensions JxK) are COMPLEX matrices
On exit C (of dimensions IxK) is the product of A and B

Notes:

C is unchanged if any of I,J or K is zero.

Called by:

CALCPA CALPOL REAORB

*** CGMPRD by JCM ***

SUBROUTINE CGMREV(A,B,NI,NJ)

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

Arguments:

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

Notes:

A and B may be the same matrix

Called by:

CALCPA ROTOSM

*** CGMREV by PJB 14-Mar-96 ***

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

Multiplies every element of a COMPLEX matrix by a COMPLEX scale.

Arguments:

On entry, A holds a COMPLEX NI by NJ matrix

SCALE holds a COMPLEX scalar scaling number

On exit, B holds a COMPLEX NI by NJ matrix being A times SCALE

Notes:

A may be the same as B
Note the existence of CMRSCA which works with a REAL scale

Called by:

CALCPA CALPOL CENTRO FCHALC FMCALC FMMPCA LMCALC LMMPCA LMTCAL TCHALC TCHMPC

*** CGMSCA by PJB Apr 87 ***

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

Sets COMPLEX matrix C = COMPLEX matrix A - COMPLEX matrix B.

Arguments:

On entry A nnd B are NI by NJ COMPLEX matrices
On exit C is set to the difference of A and B

Called by:

LMCALC LMMPCA LMTCAL

*** CGMSUB by PJB 20 Feb 91 ***

SUBROUTINE CGMUNI(A,NI)

Clears a COMPLEX square matrix to contain the unit matrix.

Arguments:

On exit A is an NIxNI unit matrix

Notes:

NI must be at least 1

*** CGMUNI modified by PJB c17 17 sept 93 ***

SUBROUTINE CGMZER(A,NI,NJ)

Clears to zero a complex matrix.

Arguments:

On entry A is an NI by NJ COMPLEX matrix
On exit A is cleared to COMPLEX zero

Called by:

CALCPA CALPOL FCHALC FMCALC FMMPCA LFCALC LMCALC LMMPCA LMPCAL LMTCAL PRJECT REAORB TCHALC GETMSF MAGPOW TCHMPC

*** CGMZER by JCM 23 Oct 87 ***

LOGICAL FUNCTION CHGPAR(A,B,N)

Indicates whether two real arrays are the same

Arguments:

On entry A and B are real arrays of length N
On exit CHGPAR is TRUE if they are different (i.e. CHanGed PARameters)

FALSE if same

*** CHGPAR BY PJB 14-Mar-1997 ***

SUBROUTINE CHITRN

Calculate transformed susceptibility for all operators In
orthogonal crystallographic coordinates

Output:

prints the coefficients if (OUTP &$1;512)

Calls:

BINDIG GMEQ GMPRD GMREV GMZER TRANSQ

Called by:

CHILSQ MPCLSQ

Common blocks used:

/CELPAR/ to use ORTH

/IOUNIT/ to use LPT IOUT

/MAGCHI/ to use CHISYM

/NSYM/ to use NOPC

/SYMDA/ to use SYM

/SYMTAB/ to use NORD

*** CHITRN rewritten for tensor structure factors C4.17 by PJB June 2009 ***

SUBROUTINE CHOOSF(F,SF,ALPHA1,ALPHA,MODEF)

Chooses modulus and phase for a particular Fourier.

Arguments:

On entry ALPHA1 is an original phase

F is a 1x2 array of read coefficients
MODEF is the type of Fourier:

MODEF=1 FCAL
MODEF=2 FOBS (Centrosymmetric)
MODEF=3 mod(FOBS)*phase(FCAL)
MODEF=4 FOBS-FCAL
MODEF=5 (mod(FOBS)-mod(FCAL))*phase(FCAL)
MODEF=6 FOBS*FOBS (Patterson)

On exit SF holds the modulus and ALPHA the required phase.

Called by:

FOUR1D FOUR1Z FOURGP

*** CHOOSF by PJB ***

SUBROUTINE CIRCLE(XX,YY,R,M)

Draws a circle of given radius and centre, with various options.

Arguments:

On entry XX,YY give the centre of the circle in the current space.

R is the required radius, in cms.
M lists the required options:

If M=0 the circle is open
If M=+/- 1 a plus or minus is inscribed
If M>1 the circle is hatched at intervals of M*.25 mm.

Calls:

GMEQ GMSCA KANGA1 PLCONV SPCSET

Called by:

MAG3D

Common blocks used:

/CONSTA/ to use TWOPI

/PLTRAN/ to use NSPCE

*** CIRCLE by PJB 25 May 90 ***

SUBROUTINE CLOFIL(LUN)

Closes the FORTRAN unit LUN and returns the CCSL unit to the pool.

Arguments:

On entry LUN is the number of an existing FORTRAN unit, now finished with.

Prerequisite calls:

NOPFIL (or OPNFIL) should have set up LUN when the file was opened.

Description:

Closes LUN; releases its table entries IOTAB in /LOONEY and FILNAM in /FINAME.
If LUN was not in such table entries, does nothing.

Called by:

DATASF LISPEC PSFILE ABSMSF AVERPA AVEXAR INCMSF MAG3D SORASY SORGAM

Common blocks used:

/FINAME/ to use all members

/LOONEY/ to use all members

*** CLOFIL by PJB Jan 86 ***

SUBROUTINE CMCONJ(A,B,I,J)

Gives the conjugate of a COMPLEX matrix.

Arguments:

On entry A is a complex I by J matrix
On exit the I by J complex matrix B contains conjugate complex of A

Called by:

CALCPA CALPOL CENTRO LMMPCA

*** CMCONJ by PJB Nov 89 ***

SUBROUTINE CMIMAG(A,B,I,J)

Gives the imaginary parts of a COMPLEX matrix.

Arguments:

On entry A is a complex I by J matrix
On exit the I by J real matrix B contains the imaginary parts of A

Called by:

CALCPA CALPOL

*** CMIMAG by PJB Nov 89 ***

SUBROUTINE CMREAL(A,B,I,J)

Gives the real parts of a COMPLEX matrix.

Arguments:

On entry A is a complex I by J matrix
On exit the I by J real matrix B contains the real parts of A

Called by:

CALCPA CALPOL

*** CMREAL by PJB Nov 89 ***

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

Multiplies every element of a COMPLEX matrix by a REAL scale.

Arguments:

On entry, A holds a COMPLEX NI by NJ matrix

SCALE holds a REAL scalar scaling number

On exit, B holds a COMPLEX NI by NJ matrix being A times SCALE

Notes:

A may be the same as B
Note also the existence of CGMSCA which works entirely in COMPLEX.

Called by:

CALCPA CALPOL FCHALC FMCALC FMMPCA LMCALC LMMPCA LMTCAL TCHALC TCHMPC

*** CMRSCA by JCM 23 Aug 88 ***

FUNCTION CONATF(N,IA)

Produces for a single coefficient of an anisotropic temperature
factor, its conversion factor from the internally used betas, in order to communicate with the user.

Arguments:

On entry IA says which ATF

N says which of the coefficients, in the program's ordering

11 22 33 23 13 12

On exit CONATF is the required muliplicative conversion factor.

Notes:

It is inefficient, but not often used.

Called by:

F2NEW F2SHFT

Common blocks used:

/ANISO/ to use IATYP

/CELPAR/ to use CELL CPARS

/CONSTA/ to use PI TWOPI

*** CONATF by JCM 16 Nov 84 ***

SUBROUTINE CONVMP(MODE)

Converts between user values and LSQ parameters for multipoles.

Arguments:

On entry MODE = the action required:
MODE=1 convert user values in POLAMP(,1) to LSQ parameters in POLAMP(,2)
MODE=2 convert LSQ obtained ESD's to user EDS's, and

convert LSQ shifts in POLAMP(,4) to user values in POLAMP(,3)

Prerequisite calls:

In /MPODA/ CONMAT must have been set up by ORTFUN

POLAMP must contain the user values, read by ORTFUN
KCLUMP must contain clump sizes set in ORTFUN
NCLUMP must be number of clumps set in ORTFUN

Calls:

GMPRD

Called by:

DOMPL2 PFSET

Common blocks used:

/MPODA/ to use NCLUMP KCLUMP POLAMP CONMAT

*** CONVMP updated by JCM 20 Apr 90 ***

SUBROUTINE COSET(JEL,ICOSET,N,IFTAB,NGP)

Returns the coset in the full group generated by a given element
of one of its sub-grouo

Arguments:

On entry IFTAB contains the sub-group factorisation table of a group of

order NGP be in the sub-group)

On exit ICOSET is a table containing the operator numbers of the N members of

the coset

Called by:

MAGSYM PSICON

*** New by PJB 13 March 2006 ***

SUBROUTINE CRMPRD(A,B,C,I,J,K)

Performs COMPLEX by REAL matrix multiplication.

Arguments:

On entry A (of dimensions IxJ) is a COMPLEX matrix

B (of dimensions JxK) is a REAL matrix

On exit C (of dimensions IxK and COMPLEX) is the product of A and B.

Notes:

C is unchanged if any of I,J or K is zero.
Note also the existence of SUBROUTINE RCMPRD which multiplies them the other way round.

Called by:

CALQSF

*** CRMPRD by PJB Nov 89 ***

COMPLEX FUNCTION CRSCLP(A,B)

Finds the COMPLEX scalar product of a COMPLEX with a REAL vector.

Arguments:

On entry A is a complex vector of dimension 3

B is a real vector of dimension 3 in a space orthogonal to

that of A

Description:

On exit the function value is the scalar product of A and B

Called by:

CALCFR CALCPA CALPOL

*** CRSCLP by PJB Nov 89 ***