Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/sgtrcf.f
+++ b/difrac/sgtrcf.f
@@ -0,0 +1,69 @@
+C-----------------------------------------------------------------------
+C  Space group routine check of operators
+C-----------------------------------------------------------------------
+      SUBROUTINE SGTRCF (M,RT,N,M2,LCENT,LAUENO,IER,LPT)
+      CHARACTER COUT*132
+      COMMON /IOUASC/ COUT(20)
+      DIMENSION RT(5,4,24)
+      DIMENSION ICENV(3,5),NCVT(7),JCVT(7)
+      DATA ICENV/0,0,0,0,6,6,6,0,6,6,6,0,6,6,6/
+      DATA NCVT/1,2,3,4,5,4,1/
+      DATA JCVT/1,1,2,3,4,1,1/
+      IER = 0
+      IRN = RT(5,2,N)
+      IRM = RT(5,2,M2)
+      IRX = MOD((IRN/144 + IRM/144),12)
+      IRY = MOD((IRN/12  + IRM/12),12)
+      IRZ = MOD(IRN + IRM,12)
+      NCV = NCVT(LCENT)
+      JCV = JCVT(LCENT)
+        DO 120 ICV = 1,NCV,JCV
+        IRX1 = MOD(IRX + ICENV(1,ICV),12)
+        IRY1 = MOD(IRY + ICENV(2,ICV),12)
+        IRZ1 = MOD(IRZ + ICENV(3,ICV),12)
+C-----------------------------------------------------------------------
+C  Does this pair make a 1bar?
+C-----------------------------------------------------------------------
+        M2Z = M2
+        IF (RT(5,1,N) + RT(5,1,M2) .EQ. 0) M2Z = 1
+C-----------------------------------------------------------------------
+C  No.
+C-----------------------------------------------------------------------
+        IF (RT(3,3,N) + RT(3,3,M2Z) .LE. 0) IRZ1 = 0
+C-----------------------------------------------------------------------
+C  Is this an operator operating along the face diagonal?
+C-----------------------------------------------------------------------
+        IF (LAUENO .LE. 3 .OR. M .NE. 4) GO TO 100
+C-----------------------------------------------------------------------
+C  Yes.
+C-----------------------------------------------------------------------
+        IRX1 = MOD(IRX1 + IRY1,12)
+        IRY1 = 0
+        GO TO 110
+  100   CONTINUE
+C-----------------------------------------------------------------------
+C  No.
+C-----------------------------------------------------------------------
+        IF (RT(1,1,N) + RT(1,1,M2Z) .LE. 0) IRX1 = 0
+        IF (RT(2,2,N) + RT(2,2,M2Z) .LE. 0) IRY1 = 0
+  110   CONTINUE
+        TOTTR = 144*IRX1 + 12*IRY1 + IRZ1
+        IF (TOTTR .EQ. 0) RETURN
+  120   CONTINUE
+      CONTINUE
+      IF (LPT .GE. 0) THEN
+        WRITE (COUT,10000) RT(5,2,N),RT(5,2,M2),
+     $                     TOTTR,IRX,IRY,IRZ,RT(5,1,N),RT(5,1,M2)
+        CALL GWRITE (LPT,' ')
+      ENDIF
+      IER = 18
+      IF (LPT .GE. 0) THEN
+        WRITE (COUT,11000) M,N,M2
+      CALL GWRITE (LPT,' ')
+      ENDIF
+      RETURN
+10000 FORMAT (3F10.1,3I5,2F10.1)
+11000 FORMAT (' Operator',I2,' generates matrix',I3,' which has a',
+     $        ' translation conflict',2I3)
+      END
+