Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/latmod.f
+++ b/difrac/latmod.f
@@ -0,0 +1,38 @@
+C-----------------------------------------------------------------------
+C  Get the lattice mode of the conventional cell
+C-----------------------------------------------------------------------
+      SUBROUTINE LATMOD (LAT,MODE)
+      REAL LAT
+      DIMENSION LAT(3,3),M(3)
+      CHARACTER*1 CMODE
+      CALL MATRIX(LAT(1,1),LAT(1,2),LAT(1,3),DET,'DETERM')
+      IDET = ABS(DET) + .1
+      CMODE = ' '
+      IF (IDET .EQ. 1) CMODE = 'P'
+      IF (IDET .EQ. 3) CMODE = 'R'
+      IF (IDET .EQ. 4) CMODE = 'F'
+      IF (IDET .NE. 2) GO TO 130
+        DO 120 I = 1,2
+        M(1) = MOD(I,2)
+          DO 120 J = 1,2
+          M(2) = MOD(J,2)
+            DO 120 K = 1,2
+            M(3) = MOD(K,2)
+            IF (M(1) + M(2) + M(3) .LT. 2) GO TO 120
+              DO 110 L = 1,3
+              ISUM = 0
+                DO 100 N = 1,3
+  100           ISUM = ISUM + M(N)*ABS(LAT(L,N)) + 0.1
+              IF (MOD(ISUM,2) .NE. 0) GO TO 120
+  110         CONTINUE
+            CMODE = 'I'
+            IF (M(1) .EQ. 0) CMODE = 'A'
+            IF (M(2) .EQ. 0) CMODE = 'B'
+            IF (M(3) .EQ. 0) CMODE = 'C'
+            GO TO 130
+  120       CONTINUE
+  130 READ (CMODE,10000) MODE
+      RETURN
+10000 FORMAT (A1)
+      END
+