657 lines
28 KiB
Fortran
657 lines
28 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Space group lattice and operator interpretation
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE SGLATC (K,L,D,LCENT,NCENT,LAUENO,NAXIS,LPT,IER,I209,ID)
|
|
DIMENSION D(3,3),L(4,4)
|
|
JUNK = LCENT
|
|
JUNK = LPT
|
|
C-----------------------------------------------------------------------
|
|
C Now let us determine the Laue group and unique axis if monoclinic
|
|
C-----------------------------------------------------------------------
|
|
IF ( K-3 ) 100,180,190
|
|
100 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Only 2 fields were read
|
|
C-----------------------------------------------------------------------
|
|
IF ( L(1,2) .EQ. 17 ) GO TO 120
|
|
IF ( L(1,2) .EQ. 14 ) GO TO 130
|
|
IF ( L(1,2) .EQ. 15 ) GO TO 140
|
|
IF ( L(1,2) .EQ. 12 ) GO TO 170
|
|
C-----------------------------------------------------------------------
|
|
C 2/m, b-axis unique
|
|
C-----------------------------------------------------------------------
|
|
IM = 2
|
|
GO TO 350
|
|
110 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C We have something like P 6n 1 *
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .NE. 12) GO TO 460
|
|
120 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 6/m
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 11
|
|
GO TO 620
|
|
130 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 3bar
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 8
|
|
GO TO 620
|
|
140 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 4/m
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 4
|
|
C-----------------------------------------------------------------------
|
|
C Is it I-centered or F-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .GE. 5) GO TO 150
|
|
C-----------------------------------------------------------------------
|
|
C Is it C-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 4) GO TO 160
|
|
C-----------------------------------------------------------------------
|
|
C No. Is there an n-glide normal to c?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(3,2) .EQ. 10) GO TO 520
|
|
IF (L(4,2) .EQ. 10) D(2,3) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C No. OK, let's get on with this.
|
|
C-----------------------------------------------------------------------
|
|
GO TO 620
|
|
150 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Is there either an a-glide or a d-glide normal to c?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(4,2) .NE. 4 .AND. L(4,2) .NE. 11) GO TO 530
|
|
C-----------------------------------------------------------------------
|
|
C Yes.
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.75
|
|
IF (LCENT .EQ. 5) D(2,3) = 0.25
|
|
GO TO 620
|
|
160 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C C-centered 4/m tetragonal
|
|
C If there is no a-glide normal to c we are through
|
|
C-----------------------------------------------------------------------
|
|
IF (L(3,2) .NE. 4 .AND. L(4,2) .NE. 4) GO TO 620
|
|
D(1,3) = 0.25
|
|
D(2,3) = 0.25
|
|
IF (L(4,2) .EQ. 4) D(2,3) = 0.75
|
|
GO TO 620
|
|
170 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 1bar
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 1
|
|
GO TO 620
|
|
180 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 3 fields were read. Must be m3 cubic. (R3R has been taken care of)
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .NE. 14) IER = 20
|
|
IF (IER .GT. 0) GO TO 630
|
|
LAUENO = 13
|
|
C-----------------------------------------------------------------------
|
|
C Set the b-axis translation flag if a 21 along a
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .EQ. 12) D(2,1) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C Set the c-axis translation flag if an a-glide normal to c
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .EQ. 3 .OR. L(1,2) .EQ. 4) D(3,3) = 0.5
|
|
GO TO 610
|
|
C-----------------------------------------------------------------------
|
|
C Four fields were read
|
|
C-----------------------------------------------------------------------
|
|
190 IF (L(1,3) .EQ. 14) GO TO 390
|
|
C-----------------------------------------------------------------------
|
|
C It is not cubic
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .EQ. 17) GO TO 450
|
|
C-----------------------------------------------------------------------
|
|
C It is not hexagonal
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .EQ. 14) GO TO 470
|
|
C-----------------------------------------------------------------------
|
|
C It is not trigonal
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .EQ. 15) GO TO 480
|
|
C-----------------------------------------------------------------------
|
|
C It is not tetragonal
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .EQ. 12) GO TO 340
|
|
IF (L(1,3) .EQ. 12) GO TO 360
|
|
C-----------------------------------------------------------------------
|
|
C It may be orthorhombic
|
|
C-----------------------------------------------------------------------
|
|
200 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is orthorhombic
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 3
|
|
C-----------------------------------------------------------------------
|
|
C Set up counts of the various types of mirrors.
|
|
C-----------------------------------------------------------------------
|
|
IM = 0
|
|
IR = 0
|
|
IA = 0
|
|
IB = 0
|
|
IC = 0
|
|
ID = 0
|
|
I21 = 0
|
|
C-----------------------------------------------------------------------
|
|
C Do we have a 2-axis along a
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .NE. 13) GO TO 210
|
|
C-----------------------------------------------------------------------
|
|
C Yes, is it a 21?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .NE. 12) GO TO 220
|
|
D(1,2) = 0.5
|
|
D(1,3) = 0.5
|
|
I21 = 4
|
|
GO TO 220
|
|
210 CONTINUE
|
|
IR = 1
|
|
IF (L(1,2) .EQ. 9) IM = 4
|
|
IF (L(1,2) .EQ. 3) IB = 1
|
|
IF (L(1,2) .EQ. 2) IC = 1
|
|
IF (L(1,2) .EQ. 11) ID = 1
|
|
IF (L(1,3) .EQ. 4 .OR. L(1,3) .EQ. 10) D(1,1) = 0.5
|
|
IF (L(1,4) .EQ. 4 .OR. L(1,4) .EQ. 10) D(1,1) = D(1,1) + 0.5
|
|
220 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Do we have a 2-axis along b
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .NE. 13) GO TO 230
|
|
C-----------------------------------------------------------------------
|
|
C Yes, is it a 21?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,3) .NE. 12) GO TO 240
|
|
D(2,1) = 0.5
|
|
D(2,3) = 0.5
|
|
I21 = I21 + 2
|
|
GO TO 240
|
|
230 CONTINUE
|
|
IR = IR + 1
|
|
IF (L(1,3) .EQ. 9) IM = IM + 2
|
|
IF (L(1,3) .EQ. 4) IA = 1
|
|
IF (L(1,3) .EQ. 2) IC = IC + 1
|
|
IF (L(1,3) .EQ. 11) ID = ID + 1
|
|
IF (L(1,2) .EQ. 3 .OR. L(1,2) .EQ. 10) D(2,2) = 0.5
|
|
IF (L(1,4) .EQ. 3 .OR. L(1,4) .EQ. 10) D(2,2) = D(2,2) + 0.5
|
|
240 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Do we have a 2-axis along c
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .NE. 13) GO TO 250
|
|
C-----------------------------------------------------------------------
|
|
C Yes, is it a 21?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,4) .NE. 12) GO TO 260
|
|
D(3,1) = 0.5
|
|
D(3,2) = 0.5
|
|
I21 = I21 + 1
|
|
GO TO 260
|
|
250 CONTINUE
|
|
IR = IR + 1
|
|
IF (L(1,4) .EQ. 9) IM = IM + 1
|
|
IF (L(1,4) .EQ. 4) IA = IA + 1
|
|
IF (L(1,4) .EQ. 3) IB = IB + 1
|
|
IF (L(1,4) .EQ. 11) ID = ID + 1
|
|
IF (L(1,2) .EQ. 2 .OR. L(1,2) .EQ. 10) D(3,3) = 0.5
|
|
IF (L(1,3) .EQ. 2 .OR. L(1,3) .EQ. 10) D(3,3) = D(3,3) + 0.5
|
|
260 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C If there are 3 mirrors check for centering, Which may alter the
|
|
C origin location
|
|
C-----------------------------------------------------------------------
|
|
IF (IR .EQ. 3) GO TO 300
|
|
C-----------------------------------------------------------------------
|
|
C Less than 3 mirrors. Set up the 2-axes locations
|
|
C-----------------------------------------------------------------------
|
|
IF (I21 .EQ. 4 .OR. I21 .EQ. 5 .OR. I21 .EQ. 7) D(1,2) = 0.0
|
|
IF (I21 .EQ. 6 .OR. I21 .EQ. 7) D(1,3) = 0.0
|
|
IF (I21 .EQ. 3) D(2,1) = 0.0
|
|
IF (I21 .EQ. 2 .OR. I21 .EQ. 6 .OR. I21 .EQ. 7) D(2,3) = 0.0
|
|
IF (I21 .EQ. 1 .OR. I21 .EQ. 3 .OR. I21 .EQ. 7) D(3,1) = 0.0
|
|
IF (I21 .EQ. 5) D(3,2) = 0.0
|
|
IF (IM .LE. 0) GO TO 620
|
|
IF (IM .EQ. 1 .AND. (I21 .EQ. 4 .OR. I21 .EQ. 2)) GO TO 270
|
|
IF (IM .EQ. 2 .AND. (I21 .EQ. 4 .OR. I21 .EQ. 1)) GO TO 280
|
|
IF (IM .EQ. 4 .AND. (I21 .EQ. 2 .OR. I21 .EQ. 1)) GO TO 290
|
|
GO TO 620
|
|
270 CONTINUE
|
|
IF (D(3,3) .EQ. 0.0) GO TO 620
|
|
D(3,3) = 0.0
|
|
D(3,2) = D(3,2) + 0.5
|
|
GO TO 620
|
|
280 CONTINUE
|
|
IF (D(2,2) .EQ. 0.0) GO TO 620
|
|
D(2,2) = 0.0
|
|
D(2,1) = D(2,1) + 0.5
|
|
GO TO 620
|
|
290 CONTINUE
|
|
IF (D(1,1) .EQ. 0.0) GO TO 620
|
|
D(1,1) = 0.0
|
|
D(1,3) = D(1,3) + 0.5
|
|
GO TO 620
|
|
300 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 3 mirrors present. Is the lattice centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 1) GO TO 620
|
|
C-----------------------------------------------------------------------
|
|
C Yes. Is it A-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 2) GO TO 310
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it B-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 3) GO TO 320
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it C-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 4) GO TO 330
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it I-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .NE. 5) GO TO 620
|
|
C-----------------------------------------------------------------------
|
|
C Yes. If only 1 glide plane, shift the mirrors by I
|
|
C-----------------------------------------------------------------------
|
|
IF (IA + IB + IC .NE. 1) GO TO 620
|
|
D(1,1) = D(1,1) + 0.5
|
|
D(2,2) = D(2,2) + 0.5
|
|
D(3,3) = D(3,3) + 0.5
|
|
GO TO 620
|
|
310 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C An A-centered lattice.
|
|
C If only one b or c glide present relocate the mirrors by A
|
|
C-----------------------------------------------------------------------
|
|
IF (IB + IC .NE. 1) GO TO 620
|
|
IF (IA .EQ. 2) GO TO 620
|
|
D(2,2) = D(2,2) + 0.5
|
|
D(3,3) = D(3,3) + 0.5
|
|
GO TO 620
|
|
320 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C A B-centered lattice
|
|
C-----------------------------------------------------------------------
|
|
IF (IA + IC .NE. 1) GO TO 620
|
|
IF (IB .EQ. 2) GO TO 620
|
|
D(1,1) = D(1,1) + 0.5
|
|
D(3,3) = D(3,3) + 0.5
|
|
GO TO 620
|
|
330 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C A C-centered lattice
|
|
C-----------------------------------------------------------------------
|
|
IF (IA + IB .NE. 1) GO TO 620
|
|
IF (IC .EQ. 2) GO TO 620
|
|
D(1,1) = D(1,1) + 0.5
|
|
D(2,2) = D(2,2) + 0.5
|
|
GO TO 620
|
|
340 IF (L(1,3) .EQ. 12) GO TO 370
|
|
C-----------------------------------------------------------------------
|
|
C It is not c-axis unique monoclinic
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .NE. 12) GO TO 200
|
|
IM = 3
|
|
350 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is b-axis unique monoclinic. (full symbol used)
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 2
|
|
NAXIS = 2
|
|
IA = 4
|
|
IC = 2
|
|
NA = 1
|
|
NB = 2
|
|
NC = 3
|
|
GO TO 380
|
|
360 IF (L(1,4) .NE. 12) GO TO 200
|
|
C-----------------------------------------------------------------------
|
|
C It is a-axis unique monoclinic
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 2
|
|
NAXIS = 1
|
|
IA = 3
|
|
IC = 2
|
|
NA = 2
|
|
NB = 1
|
|
NC = 3
|
|
IM = 2
|
|
GO TO 380
|
|
370 IF (L(1,4) .EQ. 12) GO TO 170
|
|
C-----------------------------------------------------------------------
|
|
C It is c-axis unique monoclinic
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 2
|
|
NAXIS = 3
|
|
IA = 4
|
|
IC = 3
|
|
NA = 1
|
|
NB = 3
|
|
NC = 2
|
|
IM = 4
|
|
380 CONTINUE
|
|
IF (L(2,IM) .EQ. 12) D(NB,NAXIS) = 0.5
|
|
IF (L(3,IM) .EQ. IA .OR. L(3,IM) .EQ. 10) D(NA,NAXIS) = 0.5
|
|
IF (L(3,IM) .EQ. IC .OR. L(3,IM) .EQ. 10) D(NC,NAXIS) = 0.5
|
|
IF (L(4,IM) .EQ. IA .OR. L(4,IM) .EQ. 10) D(NA,NAXIS) = 0.5
|
|
IF (L(4,IM) .EQ. IC .OR. L(4,IM) .EQ. 10) D(NC,NAXIS) = 0.5
|
|
GO TO 620
|
|
390 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is m3m cubic
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 14
|
|
C-----------------------------------------------------------------------
|
|
C Set the c-axis translation flag if an a-glide normal to c
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .EQ. 3 .OR. L(1,2) .EQ. 4) D(3,3) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C Is a 4n-axis specified
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,2) .NE. 15) GO TO 610
|
|
C-----------------------------------------------------------------------
|
|
C Yes. Is it 4bar?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .EQ. 3) GO TO 400
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it a 4?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .LT. 12) GO TO 610
|
|
IF (L(2,2) .GT. 14) GO TO 610
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it a 41?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .EQ. 12) GO TO 410
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it a 42?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .EQ. 13) GO TO 420
|
|
C-----------------------------------------------------------------------
|
|
C No. It must be a 43 (P 43 3 2)
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 6) GO TO 430
|
|
D(1,3) = 0.75
|
|
D(2,3) = 0.25
|
|
GO TO 610
|
|
400 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 4b. Is it 4b 3 m
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 9) GO TO 610
|
|
C-----------------------------------------------------------------------
|
|
C No. Is it 4b 3 d?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 11) GO TO 440
|
|
C-----------------------------------------------------------------------
|
|
C No.
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.5
|
|
D(2,3) = 0.5
|
|
D(3,3) = 0.5
|
|
GO TO 610
|
|
410 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C 41-axis. Is it F 41 3 2?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 6) GO TO 430
|
|
C-----------------------------------------------------------------------
|
|
C No. It is either P 41 3 2 or I 41 3 2
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.25
|
|
D(2,3) = -0.25
|
|
GO TO 610
|
|
420 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C P 42 3 2
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.5
|
|
D(2,3) = 0.5
|
|
GO TO 610
|
|
430 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C F 41 3 2
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.25
|
|
D(2,3) = 0.25
|
|
GO TO 610
|
|
440 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C I 4b 3 d we hope
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .NE. 5) IER = 21
|
|
IF (IER .GT. 0) GO TO 630
|
|
D(1,3) = 0.75
|
|
D(2,3) = 0.25
|
|
D(3,3) = 0.75
|
|
GO TO 610
|
|
450 CONTINUE
|
|
IF (L(1,3) .EQ. 12) GO TO 110
|
|
460 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is hexagonal 6/mmm
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 12
|
|
GO TO 620
|
|
470 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is trigonal p3**
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .EQ. 12) GO TO 600
|
|
IF (L(1,4) .NE. 12) GO TO 460
|
|
C-----------------------------------------------------------------------
|
|
C It is trigonal 3m1
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 9
|
|
GO TO 620
|
|
480 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is tetragonal 4/mmm
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 5
|
|
C-----------------------------------------------------------------------
|
|
C If there is an n-glide normal to c put any mirror normal to a at 1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(3,2) .EQ. 10 .OR. L(4,2) .EQ. 10) D(1,1) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C If there is an a-glide normal to c, put any mirror normal to (110)
|
|
C at 1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(3,2) .EQ. 4 .OR. L(4,2) .EQ. 4) D(2,2) = 0.25
|
|
C-----------------------------------------------------------------------
|
|
C If there is a 21 along b, move it and place it at x=1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .EQ. 13 .AND. L(2,3) .EQ. 12) D(1,2) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C If there is a 21 along (110), move it and place it at x=1/4
|
|
C If there is either a b- or n-glide normal to the a-axis
|
|
C shift the mirror by 1/4 along the a-axis
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .EQ. 3 .OR. L(1,3) .EQ. 10) D(1,1) = D(1,1) + 0.5
|
|
C-----------------------------------------------------------------------
|
|
C If there is either a b- or n-glide normal to (110)
|
|
C shift the mirror by 1/4 along the a-axis
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 3 .OR. L(1,4) .EQ. 10) D(2,2) = D(2,2) + 0.25
|
|
C-----------------------------------------------------------------------
|
|
C Set the z location for 2-axes along (110)
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .GT. 11 .AND. L(2,2) .LT. 15 .AND. L(2,3) .NE. 12)
|
|
$ D(3,1) = -(L(2,2) - 11)/4.0
|
|
C-----------------------------------------------------------------------
|
|
C Set the z-translation for 21-axes along (110)
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 13 .AND. L(2,4) .NE. 12) GO TO 490
|
|
IF (L(2,2) .GT. 11 .AND. L(2,2) .LT. 15)
|
|
$ D(3,1) = (L(2,2) - 11)/4.0
|
|
490 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Set the z-translation for 21-axes along b
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .EQ. 13 .AND. L(2,3) .NE. 12) GO TO 500
|
|
IF (L(2,2) .GT. 11 .AND. L(2,2) .LT. 15)
|
|
$ D(3,2) = (L(2,2) - 11)/4.0
|
|
500 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Place the d in F 4* d * at y=7/8
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) + L(3,2) .EQ. 11 .AND. LCENT .EQ. 6) D(2,1) = 0.75
|
|
C-----------------------------------------------------------------------
|
|
C Set position of m in F 4** * * at x=1/8 if there is a c along (110)
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 2 .AND. LCENT .EQ. 6) D(1,1) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C Is this a 4bar?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .EQ. 3) GO TO 560
|
|
C-----------------------------------------------------------------------
|
|
C Is the lattice primitive?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .GT. 1) GO TO 530
|
|
C-----------------------------------------------------------------------
|
|
C Yes. Do we have a n-glide normal to c?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(3,2) .EQ. 10 .OR. L(4,2) .EQ. 10) GO TO 520
|
|
C-----------------------------------------------------------------------
|
|
C No. Do we have a 21 along b?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .EQ. 13 .AND. L(2,3) .EQ. 12) GO TO 510
|
|
C-----------------------------------------------------------------------
|
|
C No. Do we have a n-glide normal to a?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .NE. 10) GO TO 620
|
|
IF (L(2,2) .LE. 0) GO TO 620
|
|
IF (L(2,2) .GT. 15) GO TO 620
|
|
510 CONTINUE
|
|
D(1,3) = 0.5
|
|
D(2,3) = 0.5
|
|
GO TO 620
|
|
520 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C P 4n/n * *
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.5
|
|
GO TO 620
|
|
530 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Is the lattice I or F-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .LT. 5) GO TO 550
|
|
C-----------------------------------------------------------------------
|
|
C Yes. If there is a c along (110) place the d at y=1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 2) D(2,1) = D(2,1) + 0.5
|
|
C-----------------------------------------------------------------------
|
|
C Is this I 41/a * * or F 41/d * * ?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(4,2) .NE. 4 .AND. L(4,2) .NE. 11) GO TO 540
|
|
C-----------------------------------------------------------------------
|
|
C Yes.
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.25
|
|
IF (LCENT .EQ. 5) D(2,3) = 0.75
|
|
GO TO 620
|
|
540 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Is there a 41 present?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(2,2) .NE. 12) GO TO 620
|
|
C-----------------------------------------------------------------------
|
|
C Yes. If F-centered go to 580
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .EQ. 6) GO TO 580
|
|
D(2,3) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C Set the b-axis translation flags for I 41 2 2
|
|
C-----------------------------------------------------------------------
|
|
GO TO 570
|
|
550 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Is the lattice C-centered?
|
|
C-----------------------------------------------------------------------
|
|
IF (LCENT .NE. 4) IER = 23
|
|
IF (IER .GT. 0) GO TO 630
|
|
C-----------------------------------------------------------------------
|
|
C C-centered. An a normal to c
|
|
C-----------------------------------------------------------------------
|
|
IF (L(3,2) .EQ. 4 .OR. L(4,2) .EQ. 4) GO TO 590
|
|
IF (D(1,1) .EQ. 0.0) D(1,1) = 2.0*D(2,2)
|
|
C-----------------------------------------------------------------------
|
|
C Is there a 21 on the diagonal?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 13 .AND. L(2,4) .EQ. 12) GO TO 520
|
|
IF (L(2,2) .LE. 0) GO TO 620
|
|
C-----------------------------------------------------------------------
|
|
C Is there a n-glide normal to (110)?
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .NE. 10) GO TO 620
|
|
IF (L(2,2) .GT. 15) GO TO 620
|
|
D(1,1) = D(1,1) - 2.0*D(2,2)
|
|
GO TO 520
|
|
560 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Account for translations due to diagonal symmetry operation
|
|
C If F 4b d 2 we want the 2 at z=1/8
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,3) .EQ. 11 .AND. LCENT .EQ. 6) D(3,1) = 0.25
|
|
C-----------------------------------------------------------------------
|
|
C If * 4b * 21 we want the mirror at x=1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 13 .AND. L(2,4) .EQ. 12) D(1,1) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C If there is a c- or a n-glide along (110) set the 2-axis at z=1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 2 .OR. L(1,4) .EQ. 10) D(3,2) = 0.5
|
|
C-----------------------------------------------------------------------
|
|
C If there is a b- or a n-glide along (110) set the 2 at x=1/4
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 3 .OR. L(1,4) .EQ. 10) D(1,2) = 0.5
|
|
IF (L(1,4) .NE. 11) GO TO 620
|
|
570 CONTINUE
|
|
IF (LCENT .EQ. 5) D(1,2) = 0.5
|
|
D(3,2) = 0.75
|
|
GO TO 620
|
|
580 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C F 41 * *
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.25
|
|
D(2,3) = 0.75
|
|
GO TO 620
|
|
590 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C C 4*/a * *
|
|
C-----------------------------------------------------------------------
|
|
D(1,3) = 0.25
|
|
D(2,3) = 0.25
|
|
IF (L(1,4) .EQ. 3 .OR. L(1,4) .EQ. 10) D(1,1) = 0.5
|
|
GO TO 620
|
|
600 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C It is trigonal 31*
|
|
C-----------------------------------------------------------------------
|
|
IF (L(1,4) .EQ. 12) GO TO 130
|
|
C-----------------------------------------------------------------------
|
|
C It is trigonal 31m
|
|
C-----------------------------------------------------------------------
|
|
LAUENO = 10
|
|
GO TO 620
|
|
610 CONTINUE
|
|
I209 = 1
|
|
620 CONTINUE
|
|
RETURN
|
|
630 CONTINUE
|
|
IF (IER .EQ. 0) IER = 5
|
|
RETURN
|
|
END
|