Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/cntref.f
+++ b/difrac/cntref.f
@@ -0,0 +1,88 @@
+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