Directory of image this file is from
This file as a plain text file

	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(9),KTP(9)
	DIMENSION UM(3),UMK(3),EU(3),EV(3),EW(3),EN(3)
C------DATA ASSIGNMENT
	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-4
	CMIN=.040
	DO 1 I=1,9
1	DY(I)=.045-(I-1)*.015
	NA=4
	NB=4
	NAB=NA+NB
	KTR(1)=8
	KTR(2)=7
	KTR(3)=5
	KTR(4)=2
	KTR(5)=1
	KTR(6)=3
	KTR(7)=6
	KTR(8)=9
	KTR(9)=4
C---------
	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(9)
	EL=TL-(RBL+Q+S)
	N=KTP(NAB+1)
	FI(N)=0.0
	GAM(N)=0.0
	XY(1,N)=EL
	XY(2,N)=0.0
	GAM(8)=3.*PI/2.
	PHAD=14.2447
	FIA=PHAD*DTR
	PHABD=13.3014
	FIAB=PHABD*DTR
C------COMPUTE X AND Y FOR PHI A SOLENOIDS
	K3=1
	I3=0
3	DO 4 II=1,NA
	I=KTP(II)
4	FI(I)=FIA
	PHAD=FIA*RTD
	TYPE 765,PHAD
765	FORMAT(/,'  FI A = ',F10.4)
	HEL=EL/2.
	PHI=FIA/2.
	CALL BEND(I0,PHI,FI0,FI0,PHI,PSI,HEL,P1,R1,R2)
	DO 33 JJ=1,NA
	J=KTP(JJ)
	DO 33 I=1,2
33	XY(I,J)=X(3,I+2)
C------COMPUTE X AND Y FOR PHI B SOLENOIDS
	K2=1
	I2=0
	FIB=FIA+FIAB
2	DO 8 II=1,NB
	I=KTP(NA+II)
8	FI(I)=FIB
	PHI=FIB/2.
	CALL BEND(I0,PHI,FI0,FI0,PHI,PSI,HEL,P1,R1,R2)
	DO 34 JJ=1,NB
	J=KTP(NA+JJ)
	DO 34 I=1,2
34	XY(I,J)=X(3,I+2)
C------ITERATE ON ALL CIRCUMFRENTIAL CLEARENCES
	N=NAB-1
	DO 5 I=1,N
	DGAM=180.*DTR/FLOAT(NAB)
	IA=KTR(I)
	IB=KTR(I+1)
	K1=1
	I1=0
6	GAM(IB)=GAM(IA)+DGAM
	IF(GAM(IB).LT.0.) GAM(IB)=PI2+GAM(IB)
	IF(GAM(IB).GT.PI2) GAM(IB)=GAM(IB)-PI2
	CALL CORD(IA,IB)
	IF(IGA.EQ.0) GO TO 11
	DGAM=DGAM+1.0
	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(8) = Y(9) ?
	N=KTR(NAB)
	Y2=RSB(2,N)
	X2=FIB
	N=KTR(1)
	Y2RF=RSB(2,N)
	PHBD=FIB*RTD
	TYPE 567,Y2,Y2RF,PHBD
567	FORMAT(' Y(9)= ',F8.4,'  Y(8)= ',F8.4,'  FI B = ',F10.3)
	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	CSML=100.
	N=KTR(NAB+1)
	DO 16 II=1,NAB
	I=KTR(II)
	CALL CORD(I,N)
16	IF(C(I,N).LT.CSML) CSML=C(I,N)
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
	FIAB=FIB-FIA
	FIA=X3+.5*DX3
	GO TO 3
C------PRINT THE RESULTS
22	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
	SA5=5.*SIN(FIA)
	SB5=5.*SIN(FIB)
	TYPE 23, CMIN,PHAD,PHBD,TL,RBL,Q,S,PL,EL
	2,SL,SD,WOD,TID,BT
	WRITE(3,23) CMIN,PHAD,PHBD,TL,RBL,Q,S,PL,EL
	2,SL,SD,WOD,TID,BT
23	FORMAT(T5,'CMIN',T15,'PHI A',T25,'PHI B',T35,'TOTAL L',
	2/,4F10.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
	N=NAB+1
	DO 19 IJ=1,N
	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,N
	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