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