C INTERACTIVE PROGRAM TETRA FOR XDS SIGMA-5 C 7/72 R. SNYDER C FILE 10 IS THE INPUT FILE CONTAINING THE FOLLOWING C RECORD 1: ANY TITLE INFORMATION C RECORD 2: A, B, C, COS(ALPHA), COS(BETA), COS(GAMMA) IN 6F7.4 C RECORD 3 AND ON : COORDINATE CARDS IN ORFLS FORMAT C C FILE 20 IS AN OUTPUT FILE FOR THE GENERATED ATOMIC COORDINATES C PROGRAM TO CALCULATE ATOMIC POSITIONS FOR TETRAHEDRAL COORDINATION C YOU MUST SPECIFY I1,I2,I3 AND D AND AN OPTIONAL ANGLE C WHERE ATOMS I3--I1--I2 ARE IN A PLANE WITH I1 AT THE APEX C D IS THE DISTANCE TO THE GENERATED ATOMS G1 AND G2 C ANG1 IS THE ANGLE I3--I1--G2 C ANG2 IS THE ANGLE G1--I1--G2 C THUS IF ANG2 IS SET TO ZERO THE TWO SOLUTIONS COINCIDE AND THE C PROGRAM COMPLETES A TRIGONAL COORDINATION ARRANGEMENT C C DIMENSION Q(3,3),QI(3,3),X(4,4),XT(3,3),D(3) DIMENSION XYZ(99,3),AA(99,2) DIMENSION ITITLE(20) DATA NO/'N'/ 4 FORMAT(20A4) 998 FORMAT('ATOM',14X,'COORDINATES') 552 FORMAT(1XI2,2X,A4,A2,3F9.6) 101 FORMAT(6F7.4) 250 FORMAT(3I2) 2 FORMAT(//5X,'A',9X,'B',9X,'C',9X,'COSA',6X,'COSB',6X,'COSC') 1 FORMAT(6F10.4) 300 FORMAT(/5X,'A*',8X,'B*',8X,'C*',8X,'COSA*',5X,'COSB*',5X,'COSC*') 201 FORMAT(A4,A2,21X,3F9.6) 280 FORMAT(A4,A2,21X,3F9.6/) 202 FORMAT(I1,2F9.3,3I2) 9 FORMAT(3(1XA4,A2),6F8.5) 701 FORMAT(/1X,'ATOM 1',1X,'ATOM 2',1X,'ATOM 3',3X,'X(1)', 14X,'Y(1)',4X,'Z(1)',4X,'X(2)',4X,'Y(2)',4X,'Z(2)') ITAP = 10 IN = 105 IOUT = 108 WRITE(IOUT,110) 110 FORMAT(/' PROGRAM TO CALCULATE ATOMIC POSITIONS FOR'/ 1' TETRAHEDRAL OR TRIGONAL COORDINATION'/ 5' ENTER ALL NUMBERS WITH DECIMAL''S SEPERATED BY COMMAS'/) 100 READ(ITAP,4)ITITLE READ(ITAP,101)A,B,C,COSA,COSB,COSC SINA=SQRT(1.-COSA*COSA) SINB=SQRT(1.-COSB*COSB) SINC=SQRT(1.-COSC*COSC) COSAS=(COSB*COSC-COSA)/(SINB*SINC) COSBS=(COSA*COSC-COSB)/(SINA*SINC) COSCS=(COSA*COSB-COSC)/(SINA*SINB) SINAS=SQRT(1.-COSAS*COSAS) SINBS=SQRT(1.-COSBS*COSBS) SINCS=SQRT(1.-COSCS*COSCS) AS=1./(A*SINB*SINCS) BS=1./(B*SINA*SINCS) CS=1./(C*SINA*SINBS) 61 Q(1,1)=A Q(1,2)=B*COSC Q(1,3)=C*COSB Q(2,1)=0. Q(2,2)=B*SINAS*SINC Q(2,3)=0. Q(3,1)=0. Q(3,2)=-B*COSAS*SINC Q(3,3)=C*SINB QI(1,1)=1./A QI(1,2)=AS*COSCS QI(1,3)=-COSB/(A*SINB) QI(2,1)=0. QI(2,2)=BS QI(2,3)=0. QI(3,1)=0. QI(3,2)=CS*COSAS QI(3,3)=1./(C*SINB) WRITE(IOUT,111) 111 FORMAT(/' DO YOU WISH DATA FROM F:10 TYPED?') NL = 1 READ(IN,112)NO1 112 FORMAT(A1) IF(NO1.EQ.NO) NL = 0 WRITE(IOUT,113) 113 FORMAT(/' ARE THERMAL PARAMETERS INTERSPERSED WITH'/ 1' COORDINATES ON FILE 10 ?') READ(IN,112)NO1 M = 2 IF(NO1.EQ.NO) M = 1 IF(NL) 5,6,5 5 WRITE(IOUT,4)ITITLE 60 WRITE(IOUT,2) WRITE(IOUT,1)A,B,C,COSA,COSB,COSC WRITE(IOUT,300) WRITE(IOUT,1)AS,BS,CS,COSAS,COSBS,COSCS 6 IF(M-1)260,260,261 260 DO900I=1,99 READ(ITAP,201,END=262)AA(I,1),AA(I,2),XYZ(I,1),XYZ(I,2),XYZ(I,3) IF(XYZ(I,1).EQ.999.) GO TO 262 900 CONTINUE 262 NC = I - 1 IF(1-NL)549,549,551 549 WRITE(IOUT,998) DO550I=1,NC 550 WRITE(IOUT,552)I,AA(I,1),AA(I,2),XYZ(I,1),XYZ(I,2),XYZ(I,3) 551 GO TO 204 261 DO901I=1,99 901 READ(ITAP,280,END=263)AA(I,1),AA(I,2),XYZ(I,1),XYZ(I,2),XYZ(I,3) 263 NC = I - 1 IF(1-NL)649,649,651 649 WRITE(IOUT,998) DO650I=1,NC 650 WRITE(IOUT,552)I,AA(I,1),AA(I,2),XYZ(I,1),XYZ(I,2),XYZ(I,3) 651 CONTINUE 204 IN = 105 WRITE(IOUT,119) 119 FORMAT(/' DO YOU WANT THE INSTRUCTIONS LISTED?') READ(IN,112)NO1 IF(NO1.EQ.NO)GO TO 213 WRITE(IOUT,115) 115 FORMAT(//' DEFINITIONS: A1 A2 AND A3 ARE THE SEQUENTIAL'/ 1' ATOM NUMBERS( FROM FILE 10) OF THREE ATOMS'/ X' A1 IS ALWAYS THE APEX ATOM'/ 2' G1 AND G2 ARE THE GENERATED ATOMS'/ 3' ANG1 IS THE ANGLE A3-A1-G2'/ 4' ANG2 IS THE ANGLE G2-A1-G1'/ 5' THUS ANG2 = 109.5 GIVES TETRAHEDRAL COORDINATION'/ 6' ANG2 = 0.0 GIVES TRIGONAL COORDINATION'/ 7/' FOR EACH ATOM TO BE CALCULATED ENTER THE FOLLOWING'/ 8' COL 1 = 1 - ANG1 IS TO BE READ'/ 9' = 2 - ANG2 IS TO BE READ'/ Z' = 4 - CALL EXIT'/ A' COL 2-10 = DISTANCE TO GENERATED ATOM IN ANGSTROMS'/ B' COL 11-19 = ANG1 OR ANG2'/ C' COL 20-21 A1 IN FIXED POINT FORMAT'/ D' COL 22-23 A2 " " " "'/ E' COL 24-25 A3 " " " "'//) 213 KK = 4 212 READ(IN,202)IW,T,WW,I1,I2,I3 KK = KK + 1 IF(IW.EQ.4) GO TO 220 DO203J=1,3 X(1,J)=XYZ(I1,J) X(2,J)=XYZ(I2,J) 203 X(3,J)=XYZ(I3,J) W=0.87266463E-02*WW 63 DO64I=1,3 DO64J=1,3 XT(I,J)=0.0 DO64K=1,3 64 XT(I,J)=XT(I,J)+Q(J,K)*X(I,K) 68 DO14I=2,3 D(I)=0. DO13J=1,3 XT(I,J)=XT(I,J)-XT(1,J) 13 D(I)=D(I)+XT(I,J)*XT(I,J) 14 D(I)=SQRT(D(I)) COM=(XT(2,1)*XT(3,1)+XT(2,2)*XT(3,2)+XT(2,3)*XT(3,3))/(D(2)*D(3)) DO15I=2,3 DO15J=1,3 15 XT(I,J)=XT(I,J)/D(I) DO16J=1,3 X(1,J)=(XT(2,J)+XT(3,J))/SQRT(2.*(1.+COM)) 16 X(2,J)=(XT(3,J)-XT(2,J))/SQRT(2.*(1.-COM)) X(3,1)=X(1,2)*X(2,3)-X(2,2)*X(1,3) X(3,2)=X(1,3)*X(2,1)-X(2,3)*X(1,1) X(3,3)=X(1,1)*X(2,2)-X(2,1)*X(1,2) DO17J=1,3 X(4,J)=XT(1,J) 17 X(J,4)=0. X(4,4)=1. COM=SQRT(0.5*(COM+1.)) IF(IW-1)20,21,20 21 SALPH=-COS(2.*W)/COM GO TO 24 20 IF(IW-2)22,23,22 23 SALPH=COS(W) GO TO 24 22 SALPH=0.25*(-COM+SQRT(COM*COM+8.)) 24 CALPH=SQRT(1.-SALPH*SALPH) K=1 D(1)=-T*SALPH D(2)=0. D(3)=T*CALPH 50 DO30I=1,3 XT(1,I)=X(4,I) DO30J=1,3 30 XT(1,I)=XT(1,I)+X(J,I)*D(J) DO40I=1,3 XT(2,I)=0. DO40J=1,3 40 XT(2,I)=XT(2,I)+QI(I,J)*XT(1,J) IF(K-2)41,42,42 41 SX=XT(2,1) SY=XT(2,2) SZ=XT(2,3) D(3)=-D(3) K=2 GO TO 50 42 RX=XT(2,1) RY=XT(2,2) RZ=XT(2,3) IF(KK.LT.5) GO TO 217 KK = 1 WRITE(IOUT,701) 217 WRITE(IOUT,9)AA(I1,1),AA(I1,2),AA(I2,1),AA(I2,2), 1 AA(I3,1),AA(I3,2),SX,SY,SZ,RX,RY,RZ WRITE(20,3)SX,SY,SZ,RX,RY,RZ GO TO 212 3 FORMAT(27X3F9.6/27X3F9.6) 220 CONTINUE CALL EXIT END