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