source: trunk/spsubs/sgtrcf.for @ 57

Last change on this file since 57 was 57, checked in by toby, 12 years ago

fixup unit test for GSASIIspg.py; provide files & Makefile for pyspg.for

File size: 2.9 KB
Line 
1      SUBROUTINE SGTRCF(M,RT,N,M2,LCENT,LAUENO,IER)
2
3!Purpose:      Search for translation conflicts
4
5      INCLUDE       '../INCLDS/COPYRIGT.FOR' 
6
7C       This program was developed for
8C                    The Division of Chemistry
9C                               of
10C               The National Research Council of Canada
11C                               by
12C       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
Note: See TracBrowser for help on using the repository browser.