| 1 | SUBROUTINE SGTRCF(M,RT,N,M2,LCENT,LAUENO,IER) |
|---|
| 2 | |
|---|
| 3 | !Purpose: Search for translation conflicts |
|---|
| 4 | |
|---|
| 5 | INCLUDE '../INCLDS/COPYRIGT.FOR' |
|---|
| 6 | |
|---|
| 7 | C This program was developed for |
|---|
| 8 | C The Division of Chemistry |
|---|
| 9 | C of |
|---|
| 10 | C The National Research Council of Canada |
|---|
| 11 | C by |
|---|
| 12 | C Allen C. Larson, 14 Cerrado Loop, Santa Fe, NM 87505-8832, USA |
|---|
| 13 | |
|---|
| 14 | INTEGER*4 M ! |
|---|
| 15 | REAL*4 RT(5,4,25) !Matrices being generated |
|---|
| 16 | INTEGER*4 N !Sequence no. of matrix 1 |
|---|
| 17 | INTEGER*4 M2 !Sequence no. of matrix 2 |
|---|
| 18 | INTEGER*4 LCENT !Number of Lattice centering vectors |
|---|
| 19 | INTEGER*4 LAUENO !Laue group flag |
|---|
| 20 | INTEGER*4 IER !Error flag |
|---|
| 21 | |
|---|
| 22 | DIMENSION ICENV(3,5),NCVT(7),JCVT(7) |
|---|
| 23 | DATA ICENV/0,0,0, 0,6,6, 6,0,6, 6,6,0, 6,6,6/ |
|---|
| 24 | DATA NCVT/1,2,3,4,5,4,1/ |
|---|
| 25 | DATA JCVT/1,1,2,3,4,1,1/ |
|---|
| 26 | |
|---|
| 27 | IER = 0 |
|---|
| 28 | IRX = 12.0*MOD((RT(1,4,N)-RT(1,4,M2)),1.0) |
|---|
| 29 | IRY = 12.0*MOD((RT(2,4,N)-RT(2,4,M2)),1.0) |
|---|
| 30 | IRZ = 12.0*MOD((RT(3,4,N)-RT(3,4,M2)),1.0) |
|---|
| 31 | NCV = NCVT(LCENT) |
|---|
| 32 | JCV = JCVT(LCENT) |
|---|
| 33 | |
|---|
| 34 | ICV = 1-JCV |
|---|
| 35 | TOTTR = 1 |
|---|
| 36 | DO WHILE ( TOTTR.NE.0 .AND. ICV.LT.NCV ) !Loop over the lattice centering vectors |
|---|
| 37 | ICV = ICV+JCV |
|---|
| 38 | IRX1 = MOD(IRX+ICENV(1,ICV),12) |
|---|
| 39 | IRY1 = MOD(IRY+ICENV(2,ICV),12) |
|---|
| 40 | IRZ1 = MOD(IRZ+ICENV(3,ICV),12) |
|---|
| 41 | |
|---|
| 42 | IF ( RT(5,1,N)+RT(5,1,M2).EQ.0 ) THEN !Does this pair generate 1bar? |
|---|
| 43 | M2Z = 1 ! No |
|---|
| 44 | ELSE |
|---|
| 45 | M2Z = M2 !Yes, they do generate 1Bar |
|---|
| 46 | END IF |
|---|
| 47 | IF ( RT(3,3,N)+RT(3,3,M2Z).LE.0 ) THEN !Is Z constrained in the unit cell |
|---|
| 48 | IRZ1 = 0 ! Yes |
|---|
| 49 | END IF |
|---|
| 50 | IF ( LAUENO.LE.3 .OR. M.NE.4 ) THEN ! Does this operator operate along the face diagonal? |
|---|
| 51 | IF ( RT(1,1,N)+RT(1,1,M2Z).LE.0 ) IRX1=0 ! No |
|---|
| 52 | IF ( RT(2,2,N)+RT(2,2,M2Z).LE.0 ) IRY1=0 |
|---|
| 53 | ELSE |
|---|
| 54 | IRX1 = MOD(IRX1+IRY1,12) ! Yes |
|---|
| 55 | IRY1 = 0 |
|---|
| 56 | END IF |
|---|
| 57 | TOTTR = 144*IRX1+12*IRY1+IRZ1 |
|---|
| 58 | END DO |
|---|
| 59 | IF ( TOTTR.NE.0 ) THEN |
|---|
| 60 | IER = 18 |
|---|
| 61 | ! IF ( LPT.GT.0 ) THEN |
|---|
| 62 | ! WRITE (LPT,2991) M,N,M2 |
|---|
| 63 | !2991 FORMAT (' Operator ',I2,' generates Matrix',I3, |
|---|
| 64 | ! 1 ' which has a translation conflict with', |
|---|
| 65 | ! 1 ' matrix ',I2) |
|---|
| 66 | ! WRITE (LPT,'(A,I3,A,3(I4,2I3),3F5.2,F8.1)') ' Matrix',N, |
|---|
| 67 | ! 1 ' is',((NINT(RT(I,J,N)),J=1,3),I=1,3),(RT(I,4,N),I=1,3) |
|---|
| 68 | ! 1 ,RT(5,2,N) |
|---|
| 69 | ! WRITE (LPT,'(A,I3,A,3(I4,2I3),3F5.2,F8.1)') ' Matrix',M2, |
|---|
| 70 | ! 1 ' is',((NINT(RT(I,J,M2)),J=1,3),I=1,3),(RT(I,4,M2),I=1,3) |
|---|
| 71 | ! 1 ,RT(5,2,M2) |
|---|
| 72 | ! END IF |
|---|
| 73 | END IF |
|---|
| 74 | RETURN |
|---|
| 75 | END |
|---|
