C************DIST.FOR********************************************** C**Calculates bond distances and angles with sigmas. C**Dimensioned for 100 atoms and 20 symmetry equivalents. C**Input for this should be created by editing the output of XYZ.FOR. C**Input format is explained in that output-don't delete the C**explanatory text while editing! C*******************mvr/november '95******************************** C IMPLICIT REAL*8(A-H,O-Z) DIMENSION X(100),Y(100),Z(100),DX(100),DY(100),DZ(100) COMMON TX(20),TY(20),TZ(20),L1(20),L2(20),L3(20), 1M1(20),M2(20),M3(20),N1(20),N2(20),N3(20), 2A,B,C,CA,CB,CG,DA,DB,DC,DCA,DCB,DCG CHARACTER*30 TITLE CHARACTER*4 DUMC,NAM1,NAM2,NAM3,NAMIS,NAMIE,NAMJS,NAMJE,NAM(100) DATA PIB /0.0174532D0/ READ(1,10)TITLE 10 FORMAT(A30) WRITE(2,10)TITLE C**Cell dimensions and their sigmas READ(1,70)A,B,C,AL,BT,GA,DA,DB,DC,DAL,DBT,DGA WRITE(2,70)A,B,C,AL,BT,GA,DA,DB,DC,DAL,DBT,DGA 70 FORMAT(3F10.5,3F10.4/3F10.5,3F10.4) IF(AL.EQ.90.0000) THEN CA=0.D0 DCA=0.D0 ELSE AL=PIB*AL CA=DCOS(AL) SA=DSIN(AL) DCA=DABS(SA*DAL*PIB) ENDIF IF(BT.EQ.90.0000) THEN CB=0.D0 DCB=0.D0 ELSE BT=PIB*BT CB=DCOS(BT) SB=DSIN(BT) DCB=DABS(SB*DBT*PIB) ENDIF IF(GA.EQ.90.0000) THEN CG=0.D0 DCG=0.D0 ELSE GA=PIB*GA CG=DCOS(GA) SG=DSIN(GA) DCG=DABS(SG*DGA*PIB) ENDIF C**Number of atoms READ(1,*) N C**Label(A4), x,y,z,sigmax,y,z(6f10.5) for N atoms DO 5 I=1,N READ(1,20)NAM(I),X(I),Y(I),Z(I),DX(I),DY(I),DZ(I) 20 FORMAT(A4,6F10.5) 5 CONTINUE I=1 C**Symmetry transformations(I2,3(F9.5,3I3). Entries like for ORTEP READ(1,90) 90 FORMAT( ) 120 FORMAT(I2,3(F9.5,3I3)) 15 READ(1,120)NS,TX(I),L1(I),L2(I),L3(I), 1TY(I),M1(I),M2(I),M3(I),TZ(I),N1(I),N2(I),N3(I) I=I+1 IF(NS.NE.0)GOTO 15 C C**Specify bond NAM1 - NAM2 with symmetry transformation(IT1,IT2) C**for each (if necessary)- Label, serial no. of sym. trans. C**(A4,I2,A4,I2) C**IT1/IT2 can be left blank if no transformation is needed C**skip three lines(explanatory text) C READ(1,130) 130 FORMAT(//) DMX=-1.D0 16 READ(1,40,END=100)NAM1,IT1,NAM2,IT2 IF(NAM1.EQ.'****')GOTO 51 40 FORMAT(A4,I2,1X,A4,I2) I1=0 I2=0 DO 25 I=1,N IF(NAM1.EQ.NAM(I)) I1=I IF(NAM2.EQ.NAM(I)) I2=I 25 CONTINUE IF((I1.EQ.0).OR.(I2.EQ.0)) GOTO 16 X1=X(I1) Y1=Y(I1) Z1=Z(I1) DX1=DX(I1) DY1=DY(I1) DZ1=DZ(I1) IF(IT1.NE.0) CALL TRANS(X1,Y1,Z1,DX1,DY1,DZ1,IT1) X2=X(I2) Y2=Y(I2) Z2=Z(I2) DX2=DX(I2) DY2=DY(I2) DZ2=DZ(I2) IF(IT2.NE.0) CALL TRANS(X2,Y2,Z2,DX2,DY2,DZ2,IT2) CALL DISTAN(X1,DX1,Y1,DY1,Z1,DZ1,X2,DX2,Y2,DY2,Z2,DZ2,D,SD,DMX) WRITE(2,50)NAM1,IT1,NAM2,IT2,X1,Y1,Z1,X2,Y2,Z2,D WRITE(2,60)DX1,DY1,DZ1,DX2,DY2,DZ2,SD GOTO 16 50 FORMAT(/1X,A4,I2,'_',A4,I2,6(1X,F7.4),1X,F10.4) 60 FORMAT(14X,6(1X,F7.4),1X,F10.4) C C**Find distances < DMX for all pairs between the two sets, C**NAMIS-NAMIE and NAMJS-NAMJE with transformations, ITR C**(1st set) and JTR(2nd set)-A4,1X,A4,I2,1X,A4,1X,A4,I2,F10. C**eg: Ag1 C12 00 Ag1 C12 01 3.5 C 51 READ(1,130) 54 READ(1,80,END=100) NAMIS,NAMIE,ITR,NAMJS,NAMJE,JTR,DMX 80 FORMAT(A4,1X,A4,I2,1X,A4,1X,A4,I2,F10.4) IF(NAMIS.EQ.'****')GOTO 55 IS=0 IE=0 JS=0 JE=0 DO 61 I=1,N IF(NAM(I).EQ.NAMIS) IS=I IF(NAM(I).EQ.NAMIE) IE=I IF(NAM(I).EQ.NAMJS) JS=I IF(NAM(I).EQ.NAMJE) JE=I 61 CONTINUE IF((IS.EQ.0).OR.(IE.EQ.0).OR.(JS.EQ.0).OR.(JE.EQ.0))GOTO 54 DO 52 I=IS,IE DO 53 J=JS,JE NAM1=NAM(I) NAM2=NAM(J) X1=X(I) Y1=Y(I) Z1=Z(I) DX1=DX(I) DY1=DY(I) DZ1=DZ(I) IF(ITR.NE.0) CALL TRANS(X1,Y1,Z1,DX1,DY1,DZ1,ITR) X2=X(J) Y2=Y(J) Z2=Z(J) DX2=DX(J) DY2=DY(J) DZ2=DZ(J) IF(JTR.NE.0) CALL TRANS(X2,Y2,Z2,DX2,DY2,DZ2,JTR) CALL DISTAN(X1,DX1,Y1,DY1,Z1,DZ1,X2,DX2,Y2,DY2,Z2,DZ2,D,SD,DMX) IF(D.LT.0.D0)GOTO 53 WRITE(2,50)NAM1,ITR,NAM2,JTR,X1,Y1,Z1,X2,Y2,Z2,D WRITE(2,60)DX1,DY1,DZ1,DX2,DY2,DZ2,SD 53 CONTINUE 52 CONTINUE GOTO 54 C C**Calcuate NAM1-NAM2 and NAM3-NAM2 and angle at NAM2. The e.s.d of C**angle is set at zero when the |angle-180| < .001, C**else, e.s.d(angle, deg.) = e.s.d[cos(angle)]/[2sin(angle)*PIB] C**this seems to reproduce the e.s.d values obtained using SHELXL93 C 55 READ(1,130) DMX=-1.D0 59 READ(1,140)NAM1,IT1,NAM2,IT2,NAM3,IT3 IF(NAM1.EQ.'****') GOTO 100 I1=0 I2=0 I3=0 DO 56 I=1,N IF(NAM1.EQ.NAM(I)) I1=I IF(NAM2.EQ.NAM(I)) I2=I IF(NAM3.EQ.NAM(I)) I3=I 56 CONTINUE IF((I1.EQ.0).OR.(I2.EQ.0).OR.(I3.EQ.0)) GOTO 59 X1=X(I1) Y1=Y(I1) Z1=Z(I1) DX1=DX(I1) DY1=DY(I1) DZ1=DZ(I1) X2=X(I2) Y2=Y(I2) Z2=Z(I2) DX2=DX(I2) DY2=DY(I2) DZ2=DZ(I2) X3=X(I3) Y3=Y(I3) Z3=Z(I3) DX3=DX(I3) DY3=DY(I3) DZ3=DZ(I3) IF(IT1.NE.0) CALL TRANS(X1,Y1,Z1,DX1,DY1,DZ1,IT1) IF(IT2.NE.0) CALL TRANS(X2,Y2,Z2,DX2,DY2,DZ2,IT2) IF(IT3.NE.0) CALL TRANS(X3,Y3,Z3,DX3,DY3,DZ3,IT3) CALL DISTAN(X1,DX1,Y1,DY1,Z1,DZ1,X2,DX2,Y2,DY2,Z2,DZ2,D,SD,DMX) AD=D ADS=SD CALL DISTAN(X3,DX3,Y3,DY3,Z3,DZ3,X2,DX2,Y2,DY2,Z2,DZ2,D,SD,DMX) BD=D BDS=SD CALL DISTAN(X1,DX1,Y1,DY1,Z1,DZ1,X3,DX3,Y3,DY3,Z3,DZ3,D,SD,DMX) CD=D CDS=SD CTH=(AD*AD+BD*BD-CD*CD)/(2.D0*AD*BD) TH=(DACOS(CTH))/PIB IF(DABS(TH-180.D0).LT.0.001D0) GOTO 57 SGA=(1.D0/BD)-(AD*AD+BD*BD-CD*CD)/(2.D0*BD*AD*AD) SGB=(1.D0/AD)-(AD*AD+BD*BD-CD*CD)/(2.D0*AD*BD*BD) SGC=-CD/(AD*BD) SCTH=DSQRT(SGA*SGA*ADS*ADS+SGB*SGB*BDS*BDS+SGC*SGC*CDS*CDS) SINTH=DSQRT(1.D0-CTH*CTH) STH=SCTH/(2.D0*PIB*SINTH) GOTO 58 57 STH=0.D0 58 WRITE(2,150)NAM1,IT1,X1,DX1,Y1,DY1,Z1,DZ1,AD,ADS WRITE(2,160)NAM2,IT2,X2,DX2,Y2,DY2,Z2,DZ2,TH,STH WRITE(2,170)NAM3,IT3,X3,DX3,Y3,DY3,Z3,DZ3,BD,BDS GOTO 59 150 FORMAT(/1X,A4,I2,6(1X,F7.4),2(1X,F10.4)) 160 FORMAT(1X,A4,I2,6(1X,F7.4),2(1X,F8.2)) 170 FORMAT(1X,A4,I2,6(1X,F7.4),2(1X,F10.4)) 140 FORMAT(A4,I2,1X,A4,I2,1X,A4,I2) 110 CONTINUE 100 STOP END C** SUBROUTINE TRANS(X,Y,Z,DX,DY,DZ,I) IMPLICIT REAL*8(A-H,O-Z) COMMON TX(20),TY(20),TZ(20),L1(20),L2(20),L3(20), 1M1(20),M2(20),M3(20),N1(20),N2(20),N3(20), 2A,B,C,CA,CB,CG,DA,DB,DC,DCA,DCB,DCG C**Does symmetry transformation to x,y,z of an atom RL1=L1(I) RL2=L2(I) RL3=L3(I) RM1=M1(I) RM2=M2(I) RM3=M3(I) RN1=N1(I) RN2=N2(I) RN3=N3(I) QX=X*RL1+Y*RL2+Z*RL3+TX(I) QY=X*RM1+Y*RM2+Z*RM3+TY(I) QZ=X*RN1+Y*RN2+Z*RN3+TZ(I) X=QX Y=QY Z=QZ QDX=DSQRT((DX*RL1)**2+(DY*RL2)**2+(DZ*RL3)**2) QDY=DSQRT((DX*RM1)**2+(DY*RM2)**2+(DZ*RM3)**2) QDZ=DSQRT((DX*RN1)**2+(DY*RN2)**2+(DZ*RN3)**2) DX=QDX DY=QDY DZ=QDZ RETURN END C** SUBROUTINE DISTAN(X1,DX1,Y1,DY1,Z1,DZ1, 1X2,DX2,Y2,DY2,Z2,DZ2,D,SD,DMX) IMPLICIT REAL*8(A-H,O-Z) COMMON TX(20),TY(20),TZ(20),L1(20),L2(20),L3(20), 1M1(20),M2(20),M3(20),N1(20),N2(20),N3(20), 2A,B,C,CA,CB,CG,DA,DB,DC,DCA,DCB,DCG DX=X1-X2 DY=Y1-Y2 DZ=Z1-Z2 C**The formulae below for D and SD differ from those found in C**Stout&Jenson, which appear to be in error! D2=(DX*A)**2+(DY*B)**2+(DZ*C)**2 1 +2.*(A*B*DX*DY*CG+B*C*DY*DZ*CA+C*A*DZ*DX*CB) D=DSQRT(D2) IF(DMX.LT.0.D0) GOTO 2 IF(D.GT.DMX)THEN D=-D RETURN ENDIF C**contribution to sigma^2 from x1,y1,z1,x2,y2,z2 2 CONTINUE S1=(DX1*DX1+DX2*DX2)*((DX*A*A+DY*A*B*CG+DZ*C*A*CB)**2) S2=(DY1*DY1+DY2*DY2)*((DY*B*B+DZ*B*C*CA+DX*A*B*CG)**2) S3=(DZ1*DZ1+DZ2*DZ2)*((DZ*C*C+DX*C*A*CB+DY*B*C*CA)**2) C**contribution to sigma^2 from a,b,c S4=((A*DX*DX+B*DX*DY*CG+C*DX*DZ*CB)*DA)**2 S5=((B*DY*DY+C*DY*DZ*CA+A*DY*DX*CG)*DB)**2 S6=((C*DZ*DZ+A*DZ*DX*CB+B*DZ*DY*CA)*DC)**2 C**contribution to sigma^2 from cell angles S7=(A*B*DX*DY*DCG)**2+(B*C*DY*DZ*DCA)**2+(C*A*DZ*DX*DCB)**2 SD=DSQRT((S1+S2+S3+S4+S5+S6+S7)/D2) RETURN END