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
