source: trunk/fsource/spsubs/sgmtml.for

Last change on this file was 211, checked in by vondreele, 12 years ago

unfix includes

File size: 1.6 KB
Line 
1      SUBROUTINE SGMTML(X,I,J,K)
2
3!Purpose:      Form product of operators to generate the full group
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, USA
13
14      REAL*4        X(5,4,25)           
15      INTEGER*4     I                   !Input matrix number
16      INTEGER*4     J                   !Input matrix number
17      INTEGER*4     K                   !Output matrix number
18
19      DO L=1,4
20        DO M=1,4
21          X(L,M,K) = 0.0
22          DO N=1,4
23            X(L,M,K) = X(L,M,K)+X(L,N,J)*X(N,M,I)
24          END DO
25        END DO
26      END DO
27
28      X(1,4,K) = MOD(NINT((7.0+X(1,4,K))*12)/12.0,1.0)            !Force the translations to be in the cell
29      X(2,4,K) = MOD(NINT((7.0+X(2,4,K))*12)/12.0,1.0)            !Also reset them to the value nearest to n/12
30      X(3,4,K) = MOD(NINT((7.0+X(3,4,K))*12)/12.0,1.0)
31
32      X(5,1,K) = 81*(2*X(1,1,K)+3*X(1,2,K)+4*X(1,3,K))            !Calculate a matrix flag
33     1  +9*(2*X(2,1,K)+3*X(2,2,K)+4*X(2,3,K))
34     1  +2*X(3,1,K)+3*X(3,2,K)+4*X(3,3,K)
35      X(5,2,K) = 1728*X(1,4,K)+144*X(2,4,K)+12*X(3,4,K)            !Calculate the translation flag
36      X(5,2,K) = NINT(X(5,2,K))                              !These should be whole numbers
37      X(5,3,K) = IEOR(NINT(X(5,3,J)),NINT(X(5,3,I)))                  !Note the generator matrix number
38      X(5,4,K) = 0.0
39
40      RETURN
41      END
Note: See TracBrowser for help on using the repository browser.