Initial revision

difrac/inchkl.f

@@ -0,0 +1,81 @@
+C-----------------------------------------------------------------------
+C  Subroutine to increment the indices with the DH segment scheme.
+C  Incrementing is done up one row of h2 and down the next row of h2,
+C  on each level of h1.
+C  IUPDWN = 1 at the start of each level of h1
+C  ISEG = 0 if the next refln is OK, = 1 if the end of segment.
+C-----------------------------------------------------------------------
+      SUBROUTINE INCHKL
+      INCLUDE 'COMDIF'
+      INTEGER IHSAVE,IKSAVE,ILSAVE
+      ISEG = 0
+      IH = IH + NDH(1,3)*IUPDWN
+      IK = IK + NDH(2,3)*IUPDWN
+      IL = IL + NDH(3,3)*IUPDWN
+      IX = IABS(IH)
+      IY = IABS(IK)
+      IZ = IABS(IL)
+C-----------------------------------------------------------------------
+C  IUPDWN = 1  Increment h3 up towards IHMAX,IKMAX,ILMAX
+C-----------------------------------------------------------------------
+      IF (IUPDWN .GT. 0) THEN
+        IF (IX.LT.IHMAX .AND. IY.LT.IKMAX .AND. IZ.LT.ILMAX) RETURN
+C-----------------------------------------------------------------------
+C  H3 going up has run out. Prepare for going down
+C-----------------------------------------------------------------------
+        IHSAVE = IH + NDH(1,2)
+        IKSAVE = IK + NDH(2,2)
+        ILSAVE = IL + NDH(3,2)
+      ELSE
+C-----------------------------------------------------------------------
+C  IUPDWN = -1  Increment h3 down towards FSTHKL(I,2)
+C-----------------------------------------------------------------------
+        IF (ISTOP .NE. 1) THEN
+          ISTOP = 0
+          IF (IH .NE. IFSHKL(1,2) .OR. IK .NE. IFSHKL(2,2) .OR. 
+     $        IL .NE. IFSHKL(3,2)) RETURN
+          ISTOP = 1
+          RETURN
+        ENDIF
+        ISTOP = 0
+C-----------------------------------------------------------------------
+C  H3 going down has run out. Prepare for going up.
+C-----------------------------------------------------------------------
+        IHSAVE = IFSHKL(1,2) + NDH(1,2)
+        IKSAVE = IFSHKL(2,2) + NDH(2,2)
+        ILSAVE = IFSHKL(3,2) + NDH(3,2)
+      ENDIF
+      IUPDWN = -IUPDWN
+      DO 100 I = 1,3
+        IFSHKL(I,2) = IFSHKL(I,2) + NDH(I,2)
+        IFSHKL(I,3) = IFSHKL(I,2)
+  100 CONTINUE
+      IX = IABS(IFSHKL(1,3))
+      IY = IABS(IFSHKL(2,3))
+      IZ = IABS(IFSHKL(3,3))
+C-----------------------------------------------------------------------
+C  Start of new level of h1. Set IUPDWN = 1
+C-----------------------------------------------------------------------
+      IF (IX .GE. IHMAX .OR. IY .GE. IKMAX .OR. IZ .GE. ILMAX) THEN
+        IUPDWN = 1
+        DO 120 I = 1,3
+          IFSHKL(I,1) = IFSHKL(I,1) + NDH(I,1)
+          IFSHKL(I,2) = IFSHKL(I,1)
+          IFSHKL(I,3) = IFSHKL(I,2)
+  120   CONTINUE
+        IHSAVE = IFSHKL(1,3)
+        IKSAVE = IFSHKL(2,3)
+        ILSAVE = IFSHKL(3,3)
+        IX = IABS(IHSAVE)
+        IY = IABS(IKSAVE)
+        IZ = IABS(ILSAVE)
+        IF (IX .GE. IHMAX .OR. IY .GE. IKMAX .OR. IZ .GE. ILMAX) THEN
+          ISEG = 1
+          RETURN
+        ENDIF
+      ENDIF
+      IH = IHSAVE
+      IK = IKSAVE
+      IL = ILSAVE
+      RETURN
+      END