124 lines
4.6 KiB
Fortran
124 lines
4.6 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C subroutine to calculate the s.d.'s of the cell parameters from the
|
|
C s.d.'s of the orientation matrix
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE CELLSD
|
|
INCLUDE 'COMDIF'
|
|
DIMENSION RT(3,3),ANGS(3),ANG(3),RS(3,3),SRT(3,3)
|
|
DIMENSION SAS(3),SANS(3),SAN(3),SA(3)
|
|
DO 100 I = 1,3
|
|
DO 100 J = 1,3
|
|
R(I,J) = R(I,J)/WAVE
|
|
100 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Real and reciprocal angles passed from LSORMT in CANG and CANGS
|
|
C-----------------------------------------------------------------------
|
|
DO 110 J = 1,3
|
|
ANG(J) = CANG(J)
|
|
ANGS(J) = CANGS(J)
|
|
SANG(J) = SIN(CANG(J)/DEG)
|
|
CANG(J) = COS(CANG(J)/DEG)
|
|
SANGS(J) = SIN(CANGS(J)/DEG)
|
|
CANGS(J) = COS(CANGS(J)/DEG)
|
|
110 CONTINUE
|
|
DO 120 I = 1,3
|
|
DO 120 J = 1,3
|
|
RS(I,J) = R(I,J)*R(I,J)
|
|
SR(I,J) = SR(I,J)*SR(I,J)
|
|
120 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Use the RT array for the S matrix
|
|
C-----------------------------------------------------------------------
|
|
DO 130 I = 1,3
|
|
DO 130 J = 1,3
|
|
SRT(I,J) = SR(J,I)
|
|
130 CONTINUE
|
|
CALL MATRIX (SRT,RS,RT,RT,'MATMUL')
|
|
SSG(1,1) = 4.0*RT(1,1)
|
|
SSG(2,2) = 4.0*RT(2,2)
|
|
SSG(3,3) = 4.0*RT(3,3)
|
|
SSG(1,2) = RT(1,2) + RT(2,1)
|
|
SSG(1,3) = RT(1,3) + RT(3,1)
|
|
SSG(2,3) = RT(2,3) + RT(3,2)
|
|
DO 140 J = 1,3
|
|
SANG(J) = SANG(J)*SANG(J)
|
|
SANGS(J) = SANGS(J)*SANGS(J)
|
|
CANG(J) = CANG(J)*CANG(J)
|
|
CANGS(J) = CANGS(J)*CANGS(J)
|
|
AP(J) = AP(J)*AP(J)
|
|
APS(J) = APS(J)*APS(J)
|
|
SAS(J) = SSG(J,J)/(4.0*GI(J,J))
|
|
140 CONTINUE
|
|
XA = SAS(2)*GI(2,3)*GI(2,3)/APS(2)
|
|
YA = SAS(3)*GI(2,3)*GI(2,3)/APS(3)
|
|
ZA = APS(2)*APS(3)*SANGS(1)
|
|
SANS(1) = (SSG(2,3) + XA + YA)/ZA
|
|
XA = SAS(1)*GI(1,3)*GI(1,3)/APS(1)
|
|
YA = SAS(3)*GI(1,3)*GI(1,3)/APS(3)
|
|
ZA = APS(1)*APS(3)*SANGS(2)
|
|
SANS(2) = (SSG(1,3) + XA + YA)/ZA
|
|
XA = SAS(1)*GI(1,2)*GI(1,2)/APS(1)
|
|
YA = SAS(2)*GI(1,2)*GI(1,2)/APS(2)
|
|
ZA = APS(1)*APS(2)*SANGS(3)
|
|
SANS(3) = (SSG(1,2) + XA + YA)/ZA
|
|
XA = SANS(1) + SANS(2)*CANG(3) + SANS(3)*CANG(2)
|
|
YA = SANG(2)*SANGS(3)
|
|
SAN(1) = XA/YA
|
|
XA = SANS(1)*CANG(3) + SANS(2) + SANS(3)*CANG(1)
|
|
YA = SANG(3)*SANGS(1)
|
|
SAN(2) = XA/YA
|
|
XA = SANS(1)*CANG(2) + SANS(2)*CANG(1) + SANS(3)
|
|
YA = SANG(1)*SANGS(2)
|
|
SAN(3) = XA/YA
|
|
XA = SAS(1)/APS(1)
|
|
YA = SANS(2)*CANGS(2)/SANGS(2)
|
|
ZA = SAN(3)*CANG(3)/SANG(3)
|
|
SA(1) = AP(1)*(XA + YA + ZA)
|
|
XA = SAS(2)/APS(2)
|
|
YA = SANS(3)*CANGS(3)/SANGS(3)
|
|
ZA = SAN(1)*CANG(1)/SANG(1)
|
|
SA(2) = AP(2)*(XA + YA + ZA)
|
|
XA = SAS(3)/APS(3)
|
|
YA = SANS(1)*CANGS(1)/SANGS(1)
|
|
ZA = SAN(2)*CANG(2)/SANG(2)
|
|
SA(3) = AP(3)*(XA + YA + ZA)
|
|
C-----------------------------------------------------------------------
|
|
C Form the s.d.'s from the variances
|
|
C-----------------------------------------------------------------------
|
|
DO 150 J = 1,3
|
|
SA(J) = SQRT(SA(J))
|
|
SAS(J) = SQRT(SAS(J))
|
|
SAN(J) = DEG*SQRT(SAN(J))
|
|
SANS(J) = DEG*SQRT(SANS(J))
|
|
150 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Store the R-matrix times the wavelength
|
|
C-----------------------------------------------------------------------
|
|
DO 160 I = 1,3
|
|
DO 160 J = 1,3
|
|
R(I,J) = R(I,J)*WAVE
|
|
160 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Put the correct values of the cell parameters in COMMON
|
|
C-----------------------------------------------------------------------
|
|
DO 170 J = 1,3
|
|
SANG(J) = SIN(ANG(J)/DEG)
|
|
CANG(J) = COS(ANG(J)/DEG)
|
|
SANGS(J) = SIN(ANGS(J)/DEG)
|
|
CANGS(J) = COS(ANGS(J)/DEG)
|
|
APS(J) = SQRT(APS(J))
|
|
AP(J) = SQRT(AP(J))
|
|
170 CONTINUE
|
|
WRITE (LPT,10000) AP(1),AP(2),AP(3),ANG(1),ANG(2),ANG(3),
|
|
$ SA(1), SA(2), SA(3), SAN(1), SAN(2), SAN(3)
|
|
WRITE (LPT,11000) APS(1),APS(2),APS(3),ANGS(1),ANGS(2),ANGS(3),
|
|
$ SAS(1),SAS(2),SAS(3),SANS(1),SANS(2),SANS(3)
|
|
RETURN
|
|
10000 FORMAT (/,' Real Cell'/
|
|
$ 3X,'a', 11X,'b', 11X,'c', 9X,'alpha', 6X, 'beta', 5X,'gamma'/
|
|
$ 3(F9.5,3X),3(F7.3,3X)/3(F9.5,3X),3(F7.3,3X))
|
|
11000 FORMAT (/,' Reciprocal Cell'/
|
|
$ 3X,'a*',10X,'b*',10X,'c*',8X,'alpha*',5X, 'beta*',4X,'gamma*'/
|
|
$ ,3(1X,F8.6,3X),3(F7.3,3X)/3(1X,F8.6,3X),3(F7.3,3X))
|
|
END
|