89 lines
3.0 KiB
Fortran
89 lines
3.0 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Subroutine to count the number of reflections in a segment
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE CNTREF
|
|
INCLUDE 'COMDIF'
|
|
DIMENSION INDX(3),FDH(3,3),FDHI(3,3),ISET(25)
|
|
WRITE (COUT,10000)
|
|
CALL GWRITE (ITP,' ')
|
|
IOUT = -1
|
|
CALL SPACEG (IOUT,1)
|
|
C-----------------------------------------------------------------------
|
|
C Ensure no rotation and set segment flag
|
|
C-----------------------------------------------------------------------
|
|
DPSI = 0.0
|
|
ISEG = 0
|
|
IPRVAL = 0
|
|
IUMPTY = 1
|
|
C-----------------------------------------------------------------------
|
|
C Get segment data and calculate segment parameters
|
|
C-----------------------------------------------------------------------
|
|
DO 180 JSEG = 1,NSEG
|
|
DO 110 I = 1,3
|
|
DO 110 J = 1,3
|
|
NDH(I,J) = IDH(JSEG,I,J)
|
|
110 CONTINUE
|
|
IND(1) = IHO(JSEG)
|
|
IND(2) = IKO(JSEG)
|
|
IND(3) = ILO(JSEG)
|
|
HO = IND(1)
|
|
KO = IND(2)
|
|
LO = IND(3)
|
|
DO 120 I = 1,3
|
|
DO 120 J = 1,3
|
|
FDH(I,J) = NDH(I,J)
|
|
120 CONTINUE
|
|
CALL MATRIX (FDH,FDHI,FDHI,FDHI,'INVERT')
|
|
DO 140 I = 1,3
|
|
INDX(I) = FDHI(I,1)*(IND(1)-HO) + FDHI(I,2)*(IND(2)-KO) +
|
|
$ FDHI(I,3)*(IND(3)-LO)
|
|
IF (INDX(I) .GE. 0) THEN
|
|
INDX(I) = INDX(I) + 0.5
|
|
ELSE
|
|
INDX(I) = INDX(I) - 0.5
|
|
ENDIF
|
|
140 CONTINUE
|
|
IFSHKL(1,1) = NDH(1,1)*INDX(1) + IND(1)
|
|
IFSHKL(2,1) = NDH(2,1)*INDX(1) + IND(2)
|
|
IFSHKL(3,1) = NDH(3,1)*INDX(1) + IND(3)
|
|
DO 150 I = 1,3
|
|
IFSHKL(I,2) = NDH(I,2)*INDX(2) + IFSHKL(I,1)
|
|
IFSHKL(I,3) = NDH(I,3)*INDX(3) + IFSHKL(I,2)
|
|
150 CONTINUE
|
|
IH = IFSHKL(1,3)
|
|
IK = IFSHKL(2,3)
|
|
IL = IFSHKL(3,3)
|
|
IUPDWN = 1
|
|
C-----------------------------------------------------------------------
|
|
C Set the standards flag for ANGCAL
|
|
C-----------------------------------------------------------------------
|
|
ISTAN = 0
|
|
NN = 0
|
|
NCOUNT = 0
|
|
C-----------------------------------------------------------------------
|
|
C Calculate the angle values and count the valid reflections
|
|
C-----------------------------------------------------------------------
|
|
160 IPRVAL = 0
|
|
CALL ANGCAL
|
|
IF (IVALID .EQ. 0) THEN
|
|
IF (ISCAN .EQ. 1) THEN
|
|
IBZ = 1
|
|
CALL COMPTN (IBZ)
|
|
IF (IBZ .EQ. 3) GO TO 170
|
|
ENDIF
|
|
NCOUNT = NCOUNT + 1
|
|
CALL HKLN (IH,IK,IL,NCOUNT)
|
|
ENDIF
|
|
170 CALL INCHKL
|
|
IF (ISEG .EQ. 0) GO TO 160
|
|
WRITE (COUT,11000) JSEG,NCOUNT
|
|
CALL GWRITE (ITP,' ')
|
|
WRITE (LPT,11000) JSEG,NCOUNT
|
|
180 CONTINUE
|
|
IUMPTY = 0
|
|
KI = ' '
|
|
RETURN
|
|
10000 FORMAT (' Count the number of reflections in each segment')
|
|
11000 FORMAT (' DH Segment',I2,' contains',I6,' reflections')
|
|
END
|