C  INTERACTIVE PROGRAM FOR XDS SIGMA-5
C  7/72  R. SNYDER
C
C FILE 10 CONTAINS 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
C
C     DISTANCE, ANGLE, AND CONFORMATION ANGLE - ** DAC **
C          FOR KEYBOARD INPUT OF ATOM NUMBERS IN INPUT LIST
C          FOUR NUMBERS FOR CONFORMATION ANGLE
C          THREE NUMBERS FOR ANGLE
C          TWO NUMBERS FOR DISTANCE
C
	DIMENSION A(4,3), Q(3,3), D(3), T(3), V(3), COMPD(20), ATOM(2,100)
	1    ,X(3,100), L(4)
	DATA NO/'N'/
011	FORMAT ( 20A4)
012	FORMAT ( 6F7.4  )
013	FORMAT ( / ' CELL CONST. ' / 6F6.2/)
015	FORMAT ( 2A4, 19X, 3F9.7)
016	FORMAT ( I4, 2X, 3F7.4, 3X, 2A4 )
17	FORMAT('0CONFORMATION ANGLE FOR ATOMS ',1X,4(2A4,2X)/,
	1'  IS ',F8.2/)
019	FORMAT ( 4G  )
20	FORMAT(/' DISTANCE BETWEEN ',2A4,' AND ',2A4,' IS ',F9.4)
21	FORMAT(/4X,2A4,'---------',2A4,'---------',2A4/
	1' DISTANCE = ',F9.4,8XF9.4/
	2' ANGLE = ',F8.2/)
	ITAP = 10
	IN = 105
	IOUT = 108
	WRITE(IOUT,50)
50	FORMAT(/' PROGRAM TO CALCULATE INTERATOMIC DISTANCES'/
	1' ANGLES AND DIHEDRAL ANGLES'/
	2' ENTER ALL NUMBERS WITH DECIMAL SEPERATED BY COMMAS'/
	3//' DO YOU WANT INPUT FROM FILE 10 LISTED?')
	READ(IN,51)NO1
51	FORMAT(A1)
	WRITE(IOUT,52)
52	FORMAT(/' DO YOU HAVE TEMPERATURE PARAMETERS IN DATA ?')
	READ(IN,51)NO2
	READ ( ITAP, 011 ) COMPD
	IF(NO1.EQ.NO) GO TO 53
	WRITE( IOUT, 011 ) COMPD
53	READ  (ITAP, 012) AA, BB, CC, COSA, COSB, COSG
	SINA=SQRT(1.-COSA*COSA)
	SINB=SQRT(1.-COSB*COSB)
	SING=SQRT(1.-COSG*COSG)
	COSAS=(COSB*COSG-COSA)/(SINB*SING)
	COSBS=(COSA*COSG-COSB)/(SINA*SING)
	COSGS=(COSA*COSB-COSG)/(SINA*SINB)
	SINAS=SQRT(1.-COSAS*COSAS)
	SINBS=SQRT(1.-COSBS*COSBS)
	SINGS=SQRT(1.-COSGS*COSGS)
	AS=1./(AA*SINB*SINGS)
	BS=1./(BB*SINA*SINGS)
	CS=1./(CC*SINA*SINBS)
	IF(NO1.EQ.NO) GO TO 54
	WRITE(IOUT,2)
	WRITE(IOUT,1)AA,BB,CC,COSA,COSB,COSG
	WRITE(IOUT,3)
	WRITE(IOUT,1)AS,BS,CS,COSAS,COSBS,COSGS
2	FORMAT(//5X,'A',9X,'B',9X,'C',9X,'COSA',6X,'COSB',6X,'COSG')
1	FORMAT(6F10.4)
3	FORMAT(/5X,'A*',8X,'B*',8X,'C*',8X,'COSA*',5X,'COSB*',5X,'COSG*')
54	COSPS = (COSB - COSG*COSA) / SING
	COSRH = SQRT ( 1.0 - COSA*COSA - COSPS*COSPS)
	DO 105 I = 1, 100
	READ (ITAP,15,END=110) ATOM(1,I),ATOM(2,I), X(1,I), X(2,I), X(3,I)
	IF(X(1,I).EQ.999.) GO TO 110
	IF(NO2.NE.NO) READ(ITAP,51)
	IF(NO1.EQ.NO) GO TO 105
103	WRITE (IOUT, 016) I, X(1,I), X(2,I), X(3,I), ATOM(1,I),ATOM(2,I)
105	CONTINUE
110	WRITE(IOUT,55)
55	FORMAT(//' DO YOU WANT INSTRUCTIONS LISTED?')
	READ(IN,51)NO1
	IF(NO1.EQ.NO) GO TO 150
	WRITE(IOUT,56)
56	FORMAT(//' THE TYPE OF CALCULATION PERFORMED IS '/
	1' DETERMINED BY THE NUMBER OF DATA ENTERED'/
	2' ALL ATOMS ARE REFERRED TO BY THEIR SEQUENCE NUMBER'/
	3' IN THE COORDINATE LIST ON FILE 10(OR AS TYPED)'/
	4/' ENTER 2 NUMBERS: GET DISTANCE BETWEEN ATOMS'/
	5' ENTER 3 NUMBERS: GET 2 DISTANCES AND ANGLE'/
	6'                    ASSUMING #2 IS APEX ATOM'/
	7' ENTER 4 NUMBERS: GET CONFORMATION ANGLE'/
	8' ENTER 0 NUMBERS: CALL EXIT'/)
150	WRITE(IOUT,57)
57	FORMAT(/' ENTER ATOM SEQUENCE NUMBERS'/)
	READ(IN,19)L
	IF(L(4).NE.0) GO TO 200
	IF(L(3).NE.0) GO TO 300
	IF(L(2).NE.0) GO TO 500
	GO TO 999
	GO TO 150
C
C      CONFORMATION ANGLE SECTION
C
200	DO 210 K = 1, 4
	I = L(K)
	A(K,1) = X(1,I)*AA*SING + X(3,I)*CC*COSPS
	A(K,2) = X(1,I)*AA*COSG + X(2,I)*BB + X(3,I)*CC*COSA
210	A(K,3) = X(3,I)*CC*COSRH
	DO 220 I = 1, 3
	J = I + 1
220	D(I) = SQRT((A(I,1)-A(J,1))**2 + (A(I,2)-A(J,2))**2 +
	1            (A(I,3)-A(J,3))**2  )
	DO 230 I = 1, 3
	Q(1,I) = (A(1,I)-A(2,I)) / D(1)
	Q(2,I) = (A(2,I)-A(3,I)) / D(2)
230	Q(3,I) = (A(3,I)-A(4,I)) / D(3)
	U = SQRT(1.-(Q(1,1)*Q(2,1)+Q(1,2)*Q(2,2)+Q(1,3)*Q(2,3))**2  )
	W = SQRT(1.-(Q(2,1)*Q(3,1)+Q(2,2)*Q(3,2)+Q(2,3)*Q(3,3))**2  )
	T(1) = (Q(1,1)*Q(2,2) - Q(1,2)*Q(2,1)) / U
	T(2) = (Q(1,3)*Q(2,1) - Q(1,1)*Q(2,3)) / U
	T(3) = (Q(1,2)*Q(2,3) - Q(1,3)*Q(2,2)) / U
	V(1) = (Q(2,1)*Q(3,2) - Q(2,2)*Q(3,1)) / W
	V(2) = (Q(2,3)*Q(3,1) - Q(2,1)*Q(3,3)) / W
	V(3) = (Q(2,2)*Q(3,3) - Q(2,3)*Q(3,2)) / W
	SIN1 = T(1)*V(1) + T(2)*V(2) + T(3)*V(3)
	CALL ARSIN (SIN1, ANG)
	ANG = 450. - ANG * 57.29578 + 0.01
	IF (ANG - 360.) 250, 250, 240
240	ANG = ANG - 360.
250	L1 = L(1)
	L2 = L(2)
	L3 = L(3)
	L4 = L(4)
	WRITE(IOUT,17) ATOM(1,L1),ATOM(2,L1),ATOM(1,L2),ATOM(2,L2),
	1 ATOM(1,L3),ATOM(2,L3),ATOM(1,L4),ATOM(2,L4),ANG
	GO TO 150
C
C      DISTANCE AND ANGLE SECTION
C
300	DO 310 K = 1, 3
	I = L(K)
	A(K,1) = X(1,I)*AA*SING + X(3,I)*CC*COSPS
	A(K,2) = X(1,I)*AA*COSG + X(2,I)*BB + X(3,I)*CC*COSA
310	A(K,3) = X(3,I)*CC*COSRH
	DO 320 I = 1, 2
	J = I + 1
320	D(I) = SQRT((A(I,1)-A(J,1))**2 + (A(I,2)-A(J,2))**2 +
	1            (A(I,3)-A(J,3))**2  )
	Q(1,1) = (A(1,1) - A(2,1)) / D(1)
	Q(1,2) = (A(1,2) - A(2,2)) / D(1)
	Q(1,3) = (A(1,3) - A(2,3)) / D(1)
	Q(2,1) = (A(2,1) - A(3,1)) / D(2)
	Q(2,2) = (A(2,2) - A(3,2)) / D(2)
	Q(2,3) = (A(2,3) - A(3,3)) / D(2)
	SIN1 = Q(1,1)*Q(2,1) + Q(1,2)*Q(2,2) + Q(1,3)*Q(2,3)
	CALL ARSIN (SIN1 , ANG )
	ANG = 90.01 + ANG * 57.29578
	IF (ANG - 360. ) 350, 340, 340
340	ANG = ANG - 360.
350	L1 = L(1)
	L2 = L(2)
	L3 = L(3)
	WRITE(IOUT,21)ATOM(1,L1),ATOM(2,L1),ATOM(1,L2),ATOM(2,L2),
	1 ATOM(1,L3),ATOM(2,L3),D(1),D(2),ANG
	GO TO 150
C
C      DISTANCE ONLY  SECTION
C
500	DO 510 K = 1, 2
	I = L(K)
	A(K,1) = X(1,I)*AA*SING + X(3,I)*CC*COSPS
	A(K,2) = X(1,I)*AA*COSG + X(2,I)*BB + X(3,I)*CC*COSA
510	A(K,3) = X(3,I)*CC*COSRH
	I = 1
	J = 2
	D(1) = SQRT((A(I,1)-A(J,1))**2 + (A(I,2)-A(J,2))**2 +
	1            (A(I,3)-A(J,3))**2  )
	L1 = L(1)
	L2 = L(2)
	WRITE (IOUT, 020) ATOM(1,L1),ATOM(2,L1),ATOM(1,L2),ATOM(2,L2),D(1)
	GO TO 150
999	CALL EXIT
C
C
	END
	SUBROUTINE ARSIN (SIN1,ANG)
201	A = 1.570795207
	B = -0.214512362
	C = 0.087876311
	D = -0.044958884
	E = 0.019349939
	F = -0.004337769
	SIN2 = ABS (SIN1)
	PSI = A + B*SIN2 + C*SIN2**2 + D*SIN2**3 + E*SIN2**4 + F*SIN2**5
	ANG = 1.5707963-PSI*SQRT (1.-SIN2)
	IF(SIN1)202,203,203
202	ANG = 6.2831853 - ANG
203	RETURN
	END
