source: trunk/fsource/spsubs/genhkl.for @ 3396

Last change on this file since 3396 was 3396, checked in by vondreele, 4 years ago

set refList=False for a couple of calls to GetHistogramPhaseData? where reflection list shouldn't be rebuilt
fix OnDrawDist? to report Sym Ops correctly
Move atom labels over 4 spaces to be clear of atom ball

File size: 3.7 KB
Line 
1      SUBROUTINE GENHKL(XH,NSYM,RT,ICEN,NCV,CEN,JHK,HKL,IABSNT,MULP)
2
3      INCLUDE       '../INCLDS/COPYRIGT.FOR' 
4!
5! The HKL index generation S.R. - Generate equivs. even for spgp absent refl.
6
7! Input data list
8
9      REAL*4        XH(4)               ! Input Miller indices
10      INTEGER*4     NSYM                ! Number of symmetry matrices
11      INTEGER*4     RT(3,5,24)          ! The symmetry matrices
12      INTEGER*4     ICEN                ! Flag indicating 1bar
13      INTEGER*4     NCV                 ! The number of lattice centering vectors
14      REAL*4        CEN(3,NCV)            ! The lattice centering vectors
15
16!Output data list
17
18      INTEGER*4     JHK                 ! Number of equivalent indices generated
19      REAL*4        HKL(4,24)           ! The generated Miller indices
20      INTEGER*4     IHKL(4,24)          ! The generated Miller indices
21      INTEGER*4     IABSNT              ! Space group absence flag
22      INTEGER*4     MULP                ! Multiplicity for powder line intensities
23
24!CODE
25
26      MULP = 0
27      JHK = 1                                              ! Set generated reflection count to 1
28      IABSNT = 0                                          ! Assume NOT Space Group Extinct
29
30      IF ( ABS(NINT(XH(1))-XH(1))+
31     1  ABS(NINT(XH(2))-XH(2))+
32     1  ABS(NINT(XH(3))-XH(3)).GT.0.05 ) THEN                  !Check for non-integral indices, leave a bit of slop
33        IABSNT = 1                                        !Non-integral indices are not allowed
34      ELSE
35        DO I=2,NCV                                          ! First check for lattice type extinctions
36          K = 0
37          DO J=1,3
38            K = K+NINT(XH(J)*CEN(J,I)*12.0)
39          END DO
40          IF ( MOD(K,12).NE.0 ) IABSNT=1
41        END DO
42      END IF
43
44      I = 1
45      DO WHILE ( I.LE.NSYM )                                    ! Generate the equivalent index set
46        DO J=1,4
47          IHKL(J,JHK) = 0.0
48          DO K=1,3
49            IHKL(J,JHK) = IHKL(J,JHK)+IFIX(XH(K))*RT(K,J,I)
50          END DO
51        END DO
52
53        NEW = 1
54        NEWX = 1
55        IF ( JHK.GT.1 ) THEN                                    ! Check for previous generation of this index
56          J = 1
57          DO WHILE ( J.LT.JHK .AND. NEW.EQ.1 )
58            IF ( IHKL(1,J).EQ.IHKL(1,JHK) ) THEN
59              IF ( IHKL(2,J).EQ.IHKL(2,JHK) ) THEN
60                IF ( IHKL(3,J).EQ.IHKL(3,JHK) ) THEN
61                  NEW = 0
62                  NEWX = 0
63                  IF ( MOD(IHKL(4,JHK)-IHKL(4,J)+960,12).NE.0 ) THEN
64                    IABSNT = 1
65                  END IF
66                END IF
67              END IF
68            END IF
69            IF ( NEW.EQ.1 ) THEN
70              IF ( IHKL(1,J).EQ.-IHKL(1,JHK) ) THEN                  ! Check -h,k,l)
71                IF ( IHKL(2,J).EQ.-IHKL(2,JHK) ) THEN
72                  IF ( IHKL(3,J).EQ.-IHKL(3,JHK) ) THEN
73                    NEWX = 0
74                    IF ( ICEN.GT.0 ) THEN
75                      NEW = 0
76                      IF ( MOD(IHKL(4,JHK)-IHKL(4,J)+960,12).NE.0 ) THEN
77                        IABSNT = 1
78                      END IF
79                    END IF
80                  END IF
81                END IF
82              END IF
83            END IF
84            J = J+1
85          END DO
86        END IF
87        MULP = MULP+NEWX
88        IF ( NEW.EQ.1 ) THEN
89!         IMAT(JHK) = I
90          JHK = JHK+NEW
91        END IF
92        I = I+1
93      END DO
94      JHK = JHK-1
95
96      DO I=1,JHK                                          ! All is OK. Convert to F.P.
97        HKL(1,I) = IHKL(1,I)
98        HKL(2,I) = IHKL(2,I)
99        HKL(3,I) = IHKL(3,I)
100        HKL(4,I) = MOD(FLOAT(IHKL(4,I))/12.0,1.0)
101      END DO
102      RETURN
103      END
Note: See TracBrowser for help on using the repository browser.