Files
sics/difrac/sinmat.f
2000-02-07 10:38:55 +00:00

88 lines
3.4 KiB
Fortran

C-----------------------------------------------------------------------
C Make a symmetry constrained matrix for calculating Sin(Theta)
C
C Constrain the DUM array for the appropriate Crystal System
C If ISYS = 1 triclinic, no constraints;
C 2 is a dummy;
C 3 orthorhombic;
C 4 tetragonal;
C 5 hexagonal;
C 6 rhombohedral;
C 7 cubic;
C 8,9,10 monoclinic, a,b,c axes unique.
C-----------------------------------------------------------------------
SUBROUTINE SINMAT
INCLUDE 'COMDIF'
DIMENSION DUM(6)
IF (ISYS .LT. 1 .OR. ISYS .GT. 10) ISYS = 1
DO 100 I = 1,3
DUM(I) = APS(I)
DUM(I+3) = CANGS(I)
100 CONTINUE
TEMP = WAVE*WAVE
C-----------------------------------------------------------------------
C Orthorhombic, tetragonal, hexagonal, cubic alpha, beta, gamma.
C-----------------------------------------------------------------------
IF ((ISYS .GE. 3 .AND. ISYS .LE. 5) .OR. ISYS .EQ. 7) THEN
DO 110 I = 4,6
DUM(I) = 0
110 CONTINUE
ENDIF
C-----------------------------------------------------------------------
C Tetragonal, hexagonal a, a, c
C-----------------------------------------------------------------------
IF (ISYS .EQ. 4 .OR. ISYS .EQ. 5) THEN
DUM(1) = (DUM(1)+DUM(2))/2
DUM(2) = DUM(1)
ENDIF
C-----------------------------------------------------------------------
C Hexagonal gamma
C-----------------------------------------------------------------------
IF (ISYS .EQ. 5) DUM(6) = 0.5
C-----------------------------------------------------------------------
C Rhombohedral, cubic a, a, a
C-----------------------------------------------------------------------
IF (ISYS .EQ. 6 .OR. ISYS .EQ. 7) THEN
DUM(1) = (DUM(1)+DUM(2)+DUM(3))/3
DUM(2) = DUM(1)
DUM(3) = DUM(1)
ENDIF
C-----------------------------------------------------------------------
C Rhombohedral alpha, alpha, alpha
C-----------------------------------------------------------------------
IF (ISYS .EQ. 6) THEN
DUM(4) = (DUM(4)+DUM(5)+DUM(6))/3
DUM(5) = DUM(4)
DUM(6) = DUM(4)
ENDIF
C-----------------------------------------------------------------------
C Monoclinic (a unique) beta, gamma
C-----------------------------------------------------------------------
IF (ISYS .EQ. 8) THEN
DUM(5) = 0
DUM(6) = 0
C-----------------------------------------------------------------------
C Monoclinic (b unique) alpha, gamma
C-----------------------------------------------------------------------
ELSE IF (ISYS .EQ. 9) THEN
DUM(4) = 0
DUM(6) = 0
C-----------------------------------------------------------------------
C Monoclinic (c unique) alpha, beta
C-----------------------------------------------------------------------
ELSE IF (ISYS .EQ. 10) THEN
DUM(4) = 0
DUM(5) = 0
ENDIF
C-----------------------------------------------------------------------
C Calculate the symmetry constrained matrix SINABS
C-----------------------------------------------------------------------
SINABS(1) = TEMP*DUM(1)*DUM(1)
SINABS(2) = TEMP*DUM(2)*DUM(2)
SINABS(3) = TEMP*DUM(3)*DUM(3)
SINABS(4) = TEMP*2*DUM(1)*DUM(2)*DUM(6)
SINABS(5) = TEMP*2*DUM(1)*DUM(3)*DUM(5)
SINABS(6) = TEMP*2*DUM(2)*DUM(3)*DUM(4)
RETURN
END