Files
sics/difrac/latmod.f
2000-02-18 15:54:23 +00:00

38 lines
1.2 KiB
Fortran

C-----------------------------------------------------------------------
C Get the lattice mode of the conventional cell
C-----------------------------------------------------------------------
SUBROUTINE LATMOD (LAT,MODE)
REAL LAT
DIMENSION LAT(3,3),M(3)
CHARACTER*1 CMODE
CALL MATRIX(LAT(1,1),LAT(1,2),LAT(1,3),DET,'DETERM')
IDET = ABS(DET) + .1
CMODE = ' '
IF (IDET .EQ. 1) CMODE = 'P'
IF (IDET .EQ. 3) CMODE = 'R'
IF (IDET .EQ. 4) CMODE = 'F'
IF (IDET .NE. 2) GO TO 130
DO 120 I = 1,2
M(1) = MOD(I,2)
DO 120 J = 1,2
M(2) = MOD(J,2)
DO 120 K = 1,2
M(3) = MOD(K,2)
IF (M(1) + M(2) + M(3) .LT. 2) GO TO 120
DO 110 L = 1,3
ISUM = 0
DO 100 N = 1,3
100 ISUM = ISUM + M(N)*ABS(LAT(L,N)) + 0.1
IF (MOD(ISUM,2) .NE. 0) GO TO 120
110 CONTINUE
CMODE = 'I'
IF (M(1) .EQ. 0) CMODE = 'A'
IF (M(2) .EQ. 0) CMODE = 'B'
IF (M(3) .EQ. 0) CMODE = 'C'
GO TO 130
120 CONTINUE
130 READ (CMODE,10000) MODE
RETURN
10000 FORMAT (A1)
END