COMMON/A/FI(9),PL,Q,SD,SL,XY(2,9),GAM(9),DY(9),RSB(3,9)
	2,R(3,9),C(9,9),IGA,WOD,TID,P(6,9),RSN(3,9),RBH(3,9),BT,E(3,9)
	COMMON/B/RE,RI,D,X(21,4),RL(21),RRR(21),FFI(21)
	DIMENSION KTR(7),KTP(9)
	DIMENSION UM(3),UMK(3),EU(3),EV(3),EW(3),EN(3)
C------DATA ASSIGNMENT
	GAM(4)=0.0
	PI=3.14159
	PI2=2.*PI
	DTR=PI/180.
	RTD=180./PI
	RE=.5E8
	D=.014
	RI=PI*(D**4)/64.
	TL=4.75
	RBL=.094
	S=.867
	PL=.5
	BT=.25
	Q=.5
	SL=1.170
	SD=.5
	WOD=.014
	TID=.0165
	I0=2
	FI0=0.
	PSI=PI/2.
	T1=.1E-5
	T2=.1E-5
	CMIN=.015
	DO 1 I=1,9
1	DY(I)=.045-(I-1)*.015
	KTR(1)=7
	KTR(2)=5
	KTR(3)=2
	KTR(4)=1
	KTR(5)=3
	KTR(6)=6
	KTR(7)=4
	KTP(1)=1
	KTP(2)=2
	KTP(3)=6
	KTP(4)=7
	KTP(5)=3
	KTP(6)=5
	KTP(7)=8
	KTP(8)=9
	KTP(9)=4
C--------SET LENGTH AND GAM(7)
	EL=TL-(RBL+Q+S)
	GAM(7)=3.*PI/2.
	FI(4)=0.0
C------INITIAL PHI A
	PHAD=15.5
	FIA=PHAD*DTR
	K3=1
	I3=0
3	FI(1)=FIA
	FI(2)=FI(1)
	FI(6)=FI(1)
	FI(7)=FI(1)
	HEL=EL/2.
	PHI=FIA/2.
	CALL BEND(I0,PHI,FI0,FI0,PHI,PSI,HEL,P1,R1,R2)
	DO 33 I=1,2
	XY(I,1)=X(3,I+2)
	XY(I,2)=XY(I,1)
	XY(I,6)=XY(I,1)
33	XY(I,7)=XY(I,1)
	XY(1,4)=EL
	XY(2,4)=0.0
C------PHI B INITIAL
	PHBD=PHAD+10.
	FIB=PHBD*DTR
	K2=1
	I2=0
2	FI(3)=FIB
	FI(5)=FIB
	PHI=FIB/2.
	CALL BEND(I0,PHI,FI0,FI0,PHI,PSI,HEL,P1,R1,R2)
	DO 34 I=1,2
	XY(I,3)=X(3,I+2)
34	XY(I,5)=XY(I,3)
C------ITERATE ON ALL CIRCUMFRENTIAL CLEARENCES
	DO 5 I=1,5
	DGAM=45.*DTR
	IA=KTR(I)
	IB=KTR(I+1)
	K1=1
	I1=0
6	GAM(IB)=GAM(IA)+DGAM
	IF(GAM(IB).GT.PI2) GAM(IB)=GAM(IB)-PI2
	CALL CORD(IA,IB)
	IF(IGA.EQ.0) GO TO 11
	DGAM=DGAM+.35
	K1=K1+1
	GO TO 6
11	X1=DGAM
	Y1=C(IA,IB)
	CALL ITER8(I,K1,X1,XM1,Y1,YM1,CMIN,DX1,I1,T1)
	IF(I1.EQ.1) GO TO 5
	DGAM=X1+DX1
	GO TO 6
5	CONTINUE
C------DOES Y(6) = Y(7) ?
	Y2=RSB(2,6)
	X2=FIB
	Y2RF=RSB(2,7)
	CALL ITER8(8,K2,X2,XM2,Y2,YM2,Y2RF,DX2,I2,T2)
	IF(I2.EQ.1) GO TO 7
	FIB=X2+DX2
	GO TO 2
C------CALCULATE RADIAL CLEARANCES
7	I4=4
	DO 16 II=1,7
	IF(II.EQ.4) GO TO 16
	CALL CORD(II,I4)
16	CONTINUE
	CSML=100.
	DO 21 I=1,6
	II=KTR(I)
21	IF(C(II,I4).LT.CSML) CSML=C(II,I4)
C------ITERATE ON PHI A
	X3=FIA
	Y3=CSML
	CALL ITER8(9,K3,X3,XM3,Y3,YM3,CMIN,DX3,I3,T2)
	IF(I3.EQ.1) GO TO 22
	FIA=X3+DX3
	GO TO 3
C------CHECK FOR INTERFERENCE
22	CALL CORD(1,6)
	CALL CORD(2,7)
C------PUT IN SOLENOIDS 8 & 9
	PHCD=PHBD+10.
	FIC=PHCD*DTR
	K4=1
	I4=0
50	FI(8)=FIC
	FI(9)=FIC
	PHI=FIC/2.
	CALL BEND(I0,PHI,FI0,FI0,PHI,PSI,HEL,P1,R1,R2)
	DO 53 I=1,2
	XY(I,8)=X(3,I+2)
53	XY(I,9)=XY(I,8)
	GAM(8)=(3.*PI/2.)+ASIN(.015/X(3,4))
	GAM(9)=(PI/2.)-ASIN(.030/X(3,4))
	I=8
56	K5=1
	I5=0
58	CALL CORD(8,9)
	X5=GAM(I)
	Y5=RSB(2,I)
	YD=RSB(2,7)
	CALL ITER8(I,K5,X5,XM5,Y5,YM5,YD,DX5,I5,T1)
	IF(I5.EQ.1) GO TO 57
	GAM(I)=X5+DX5
	GO TO 58
57	IF(I-8) 59,60,59
60	I=9
	GO TO 56
59	CSML=100.
	DO 55 II=1,4
	I=KTP(II+2)
	DO 55 J=8,9
	CALL CORD(I,J)
55	IF(C(I,J).LT.CSML) CSML=C(I,J)
	X4=FIC
	Y4=CSML
	CALL ITER8(10,K4,X4,XM4,Y4,YM4,CMIN,DX4,I4,T1)
	IF(I4.EQ.1) GO TO 52
	FIC=FIC+DX4
	GO TO 50
C------PRINT THE RESULTS
52	CALL DATE(A1,A2)
	CALL TIME(A3,A4)
	WRITE(3,26) A1,A2,A3,A4
26	FORMAT(///,2X,2A5,3X,2A5,/)
	PHAD=FIA*RTD
	PHBD=FIB*RTD
	PHCD=FIC*RTD
	SA5=5.*SIN(FIA)
	SB5=5.*SIN(FIB)
	SC5=5.*SIN(FIC)
	TYPE 23, CMIN,PHAD,PHBD,PHCD,TL,RBL,Q,S,PL,EL
	2,SL,SD,WOD,TID,BT
	WRITE(3,23) CMIN,PHAD,PHBD,PHCD,TL,RBL,Q,S,PL,EL
	2,SL,SD,WOD,TID,BT
23	FORMAT(T5,'CMIN',T15,'PHI A',T25,'PHI B',T35,'PHI C',
	1T45,'TOTAL L',
	2/,5F10.4,//,T5,'RUBY L',T15,'Q',T25,'S',T35,'PROJ. L',
	3T45,'EFF. L',/,5F10.4,//,T5,'SOL. L',T15,'SOL. D',T25,
	4'WIRE OD',T35,'BUSH ID',T45,'BLKHD T',/,5F10.4,/)
	WRITE(3,127) SA5,SB5,SC5
127	FORMAT(//,' 5 X SIN(FI A) = ',F10.5,/
	2,' 5 X SIN(FI B) = ',F10.5,/,' 5 X SIN(FI C) = ',F10.5,/)
C-------PRINT FOR EACH SOLENIOD
	DO 19 IJ=1,9
	II=KTP(IJ)
	GMD=GAM(II)*RTD
	FID=FI(II)*RTD
	CS=COS(GAM(II))
	SN=SIN(GAM(II))
	SN5=SN*5.
	WRITE(3,20) II,GMD,FID,SN5
20	FORMAT(///,' SOLENIOD #',I2,4X,'GAMMA : ',F10.4,4X,'PHI : '
	2,F10.4,4X,'5 X SIN(GAM) = ',F10.4,/)
	WRITE(3,18) (RSN(I,II),I=1,3),(RSB(I,II),I=1,3),(R(I,II),I=1,3),
	2(P(I,II),I=1,3),(P(I,II),I=4,6),(RBH(I,II),I=1,3)
18	FORMATL(' RSN VECTOR : ',/,3(3X,F12.5),/,
	1' RSB VECTOR : ',/,3(3X,F12.5),/,
	2' R VECTOR : ',/,3(3X,F12.5),/,
	3' SHIFTED RHO : ',/,3(3X,F12.5),/,' WIRE RHO : ',/
	4,3(3X,F12.5),/,' BLKHD. VECTOR : ',/,3(3X,F12.5),//)
C---------MACHINIST COORDINATES
	UM(1)=.3183
	UM(2)=0.0
	UM(3)=0.0
	DO 402 I=1,3
402	UMK(I)=RBH(I,4)+UM(I)+.125*E(I,II)-RBH(I,II)
	EU(1)=0.0
	EU(2)=SN
	EU(3)=-CS
	DO 403 I=1,3
403	EW(I)=E(I,II)
	CALL CROSS(EW,EU,EN)
	SM=0.0
	DO 404 K=1,3
404	SM=SM+EN(K)**2
	DO 405 K=1,3
405	EV(K)=EN(K)/SQRT(SM)
	CALL DOT(UMK,EU,RU)
	CALL DOT(UMK,EV,RV)
	CALL DOT(UMK,EW,RW)
	RUP=RU*CS-RV*SN
	RVP=RU*SN+RV*CS
	RWP=RW
	WRITE(3,406) RU,RV,RW
406	FORMAT(' M.E IN THE U,V,W DIRECTIONS : ',/,3(3X,F12.5))
C-----------
	DO 51 JJ=1,9
	IF(C(II,JJ).EQ.0.) GO TO 51
	WRITE(3,17) II,JJ,C(II,JJ)
17	FORMAT(' C(',I1,',',I1,') = ',F12.5)
51	CONTINUE
19	CONTINUE
	END