linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
cvs
2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
difrac/wxw2t.f Normal file
View File

@@ -0,0 +1,71 @@
C-----------------------------------------------------------------------
C Routine to align a reflection as follows :--
C 1. For Euler 4-circle machines.
C Centre omega, omega/2theta, chi, omega, 2omega/-theta.
C 2. For Kappa machines.
C Centre omega/2theta, theta(-45slit), theta(+45slit)
C-----------------------------------------------------------------------
SUBROUTINE WXW2T (DT,DO,DC,ISLIT)
INCLUDE 'COMDIF'
DIMENSION ANG(4)
CALL SHUTTR (99)
C-----------------------------------------------------------------------
C For the CAD-4 centering is as follows :--
C 1. an omega/2theta scan with the 4mm variable slit,
C 2. a) a 2theta scan with the negative 45deg slit,
C b) a 2theta scan with the positive 45deg slit.
C c) the best 2theta and chi values are then calculated.
C-----------------------------------------------------------------------
IF (DFMODL .EQ. 'CAD4') THEN
KI = 'WT'
CALL CENTRE (DT,ANG,ISLIT)
IF (KI .EQ. 'FF') GO TO 100
KI = 'ST'
CALL CENTRE (DT,ANG,0)
IF (KI .EQ. 'FF') GO TO 100
ELSE
C-----------------------------------------------------------------------
C Align Omega
C-----------------------------------------------------------------------
KI = 'SO'
CALL CENTRE (DO,ANG,0)
IF (KI .EQ. 'FF') GO TO 100
C-----------------------------------------------------------------------
C Align 2Theta the first time (Insert 7-May-81)
C-----------------------------------------------------------------------
KI = 'ST'
CALL CENTRE (DT,ANG,0)
IF (KI .EQ. 'FF') GO TO 100
C-----------------------------------------------------------------------
C Align Chi
C-----------------------------------------------------------------------
KI = 'SC'
CALL CENTRE (DC,ANG,0)
IF (KI .EQ. 'FF') GO TO 100
C-----------------------------------------------------------------------
C Omega again
C-----------------------------------------------------------------------
KI = 'SO'
CALL CENTRE (DO,ANG,0)
IF (KI .EQ. 'FF') GO TO 100
C-----------------------------------------------------------------------
C Align 2Theta
C----------------------------------------------------------------------
KI = 'ST'
CALL CENTRE (DT,ANG,0)
IF (KI .EQ. 'FF') GO TO 100
ENDIF
C-----------------------------------------------------------------------
C The answers are passed in BPSI in COMMON
C-----------------------------------------------------------------------
RTHETA = ANG(1)
ROMEGA = ANG(2)
RCHI = ANG(3)
RPHI = ANG(4)
THETA = RTHETA
OMEGA = ROMEGA
CHI = RCHI
PHI = RPHI
100 CALL SHUTTR (-99)
RETURN
END