147 lines
5.5 KiB
Fortran
147 lines
5.5 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C
|
|
C Find Reflections with Chi Values .GT. CHIMIN which are suitable for
|
|
C Psi Rotation, particularly on Kappa geometry machines
|
|
C
|
|
C The routine does the following :--
|
|
C 1. Finds the exact indices for the Euler angles
|
|
C theta = THTMAX, omega = 0, chi = 90, phi = 0.
|
|
C 2. Finds the exact, i.e fractional, min/max values of h,k,l for
|
|
C theta = THTMAX, omega = 0, chi = 80, phi = 0 to 350 in steps
|
|
C of 10 degrees.
|
|
C 3. Searches from theta = 0 to THTMAX in steps of 0.01 in sin(theta),
|
|
C for reflections with chi greater than CHIMIN, using h,k,l limits
|
|
C which are proportional to those found at THTMAX in step 2.
|
|
C
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE BIGCHI
|
|
INCLUDE 'COMDIF'
|
|
DIMENSION RHKL(3),RMNMXH(2,3),MNMXH(2,3),X(3),RM1(3,3)
|
|
EQUIVALENCE (RHKL(1),RH),(RHKL(2),RK),(RHKL(3),RL),
|
|
$ (MNMXH(1,1),MINH),(MNMXH(2,1),MAXH),
|
|
$ (MNMXH(1,2),MINK),(MNMXH(2,2),MAXK),
|
|
$ (MNMXH(1,3),MINL),(MNMXH(2,3),MAXL),
|
|
$ (X(1),X1),(X(2),X2),(X(3),X3)
|
|
C-----------------------------------------------------------------------
|
|
C Get CHIMIN and THTMAX
|
|
C-----------------------------------------------------------------------
|
|
WRITE (COUT,10000)
|
|
CALL FREEFM (ITR)
|
|
CHIMIN = RFREE(1)
|
|
IF (CHIMIN .EQ. 0.0) CHIMIN = 80.0
|
|
WRITE (COUT,11000) THEMAX
|
|
CALL FREEFM (ITR)
|
|
THTMAX = RFREE(1)
|
|
IF (THTMAX .EQ. 0.0) THTMAX = THEMAX
|
|
C-----------------------------------------------------------------------
|
|
C Calculate h,k,l for THTMAX,0,90,0
|
|
C-----------------------------------------------------------------------
|
|
CALL MATRIX (R,RM1,RM1,RM1,'INVERT')
|
|
THETA = 0.5*THTMAX/DEG
|
|
OMEGA = 0.0
|
|
CHI = 90.0/DEG
|
|
PHI = 0.0
|
|
CALL ANGTOH (RH,RK,RL,RM1)
|
|
WRITE (COUT,12000) THTMAX,RH,RK,RL,CHIMIN
|
|
CALL GWRITE (ITP,' ')
|
|
WRITE (LPT,12000) THTMAX,RH,RK,RL,CHIMIN
|
|
C-----------------------------------------------------------------------
|
|
C Find the min and max h,k and l at theta = 90 and chi = 80 for
|
|
C phi from 0 to 350 in steps of 10deg
|
|
C-----------------------------------------------------------------------
|
|
DO 100 I = 1,3
|
|
RMNMXH(1,I) = 10000
|
|
RMNMXH(2,I) = -10000
|
|
100 CONTINUE
|
|
THETA = 90.0/DEG
|
|
OMEGA = 0.0
|
|
CHI = CHIMIN/DEG
|
|
DO 110 IPHI = 0,350,10
|
|
PHI = IPHI/DEG
|
|
CALL ANGTOH (RH,RK,RL,RM1)
|
|
DO 105 I = 1,3
|
|
IF (RHKL(I) .LT. RMNMXH(1,I)) RMNMXH(1,I) = RHKL(I)
|
|
IF (RHKL(I) .GT. RMNMXH(2,I)) RMNMXH(2,I) = RHKL(I)
|
|
105 CONTINUE
|
|
110 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Loop over the min/max indices for shells of 0.01 sin(theta) from
|
|
C theta 0.0 to THTMAX/2.0
|
|
C-----------------------------------------------------------------------
|
|
IHSAVE = IH
|
|
IKSAVE = IK
|
|
ILSAVE = IL
|
|
STMIN2 = 0.0
|
|
STMAX = SIN(0.5*THTMAX/DEG)
|
|
NTHETA = 1.0 + STMAX/0.01
|
|
DO 150 N = 1,NTHETA
|
|
SMAX = N*0.01
|
|
IF (SMAX .GT. STMAX) SMAX = STMAX
|
|
DO 115 J = 1,3
|
|
DO 115 I = 1,2
|
|
TEMP = SMAX*RMNMXH(I,J)
|
|
ROUND = 0.5
|
|
IF (TEMP .LT. 0.0) ROUND = -0.5
|
|
MNMXH(I,J) = TEMP + ROUND
|
|
115 CONTINUE
|
|
STMAX2 = 4.0*SMAX*SMAX
|
|
OMEGA = 0.0
|
|
DO 140 JH = MINH,MAXH
|
|
DO 130 JK = MINK,MAXK
|
|
DO 120 JL = MINL,MAXL
|
|
IF (JH .NE. 0 .OR. JK .NE. 0 .OR. JL .NE. 0) THEN
|
|
X1 = JH*R(1,1) + JK*R(1,2) + JL*R(1,3)
|
|
X2 = JH*R(2,1) + JK*R(2,2) + JL*R(2,3)
|
|
X3 = JH*R(3,1) + JK*R(3,2) + JL*R(3,3)
|
|
SUM = X1*X1 + X2*X2 + X3*X3
|
|
STHT2 = SUM
|
|
IF (STHT2 .GE. STMIN2 .AND. STHT2 .LT. STMAX2) THEN
|
|
IPRVAL = 0
|
|
IH = JH
|
|
IK = JK
|
|
IL = JL
|
|
CALL DEQHKL (NHKL,0)
|
|
IF (IVALID .EQ. 0) THEN
|
|
CALL CALANG (X)
|
|
IF (CHI .GT. CHIMIN) THEN
|
|
WRITE (LPT,13000) JH,JK,JL,THETA,OMEGA,CHI,PHI
|
|
WRITE (COUT,13000) JH,JK,JL,THETA,OMEGA,CHI,PHI
|
|
CALL GWRITE (ITP,' ')
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
120 CONTINUE
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
STMIN2 = STMAX2
|
|
150 CONTINUE
|
|
IH = IHSAVE
|
|
IK = IKSAVE
|
|
IL = ILSAVE
|
|
KI = ' '
|
|
RETURN
|
|
10000 FORMAT (/10X,'Search for Reflections with High Chi Values'//
|
|
$ ' Type the minimum acceptable chi value (80) ',$)
|
|
11000 FORMAT (' Type 2theta(max) (',F5.1,') ',$)
|
|
12000 FORMAT (' h,k,l for 2theta',F8.3,', Chi 90 ',3F8.3/
|
|
$ ' Reflections with chi greater than',F8.3/
|
|
$ ' h k l 2theta omega chi phi')
|
|
13000 FORMAT (3I4,4F9.3)
|
|
END
|
|
C-----------------------------------------------------------------------
|
|
C Subroutine to compute h,k,l from Euler angles with omega = 0
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE ANGTOH (RH,RK,RL,RM1)
|
|
INCLUDE 'COMDIF'
|
|
DIMENSION RM1(3,3)
|
|
TEMP = 2.0*SIN(THETA)
|
|
X1 = TEMP*COS(CHI)*COS(PHI)
|
|
X2 = TEMP*COS(CHI)*SIN(PHI)
|
|
X3 = TEMP*SIN(CHI)
|
|
RH = RM1(1,1)*X1 + RM1(1,2)*X2 + RM1(1,3)*X3
|
|
RK = RM1(2,1)*X1 + RM1(2,2)*X2 + RM1(2,3)*X3
|
|
RL = RM1(3,1)*X1 + RM1(3,2)*X2 + RM1(3,3)*X3
|
|
RETURN
|
|
END
|