SUBROUTINE BEND(NK,FI0,FIN,FIC,FIT,PSI,WL,P1,R1,R2) REAL LAM,M,KC,KIC DIMENSION ST(21),DK(21),CURV(21) COMMON/B/ E,RI,D,X(21,4),RL(21),R(21),FI(21) N=2 IF(NK.EQ.0) GO TO 8 N=IABS(NK) 18 IF(IABS(NK).LT.4) GO TO 8 WRITE(3,133) 133 FORMAT(//,' K',9X,'X',13X,'Y',13X,'RADIUS',10X,'L', 2 13X,'PHI') 8 LAM=PSI-FI0 M=SIN(PSI/2.) IDK=0 K=N+1 FI(K)=FIN THET1=1.5707963 GO TO 1 2 IDK=1 DO 3 K=1,N FI(K)=FIC+(N-K)*(FI0-FIC)/(N-1) 1 CONTINUE THETA=THET1 IF(FI(K).EQ.FI0) GO TO 4 ARG=(SIN((FI(K)+LAM)*.5))/M IF(ABS(ARG).GT.1.) ARG=SIGN(1.0,ARG) THETA=ASIN(ARG) 4 CALL CEL1(KC,M,IER) CALL ELI1(KIC,THETA,M) CALL CEL2(EC,M,IER) CALL ELI2(EIC,THETA,M) DK(K)=KC-KIC DE=EC-EIC X(K,1)=0. X(K,2)=0. RL(K)=0.0 IF(ABS(DK(N+1)).LT..1E-3.OR.ABS(DK(K)).LT..1E-3) GO TO 6 RL(K)=WL*DK(K)/DK(N+1) AK=(2.*DE/DK(K))-1. BK=(2.*M*(COS(THETA)-COS(THET1)))/DK(K) X(K,1)=RL(K)*(AK*COS(LAM)+BK*SIN(LAM)) X(K,2)=RL(K)*(BK*COS(LAM)-AK*SIN(LAM)) 6 CONTINUE C TYPE 123,K,DK(K),DE,RL(K),AK,BK,X(K,1),X(K,2),FI(K) 123 FORMAT(1X,I2,8(3X,F6.4)) CURV(K)=1.414213562*P1*SQRT(ABS(COS(FI(K)+LAM)-COS(FI0+LAM))) R(K)=.1E+10 IF(ABS(CURV(K)).LT..1E-5) GO TO 9 R(K)=1.0/CURV(K) 9 ST(K)=E*CURV(K)*D/2. IF(FI(K)-FIC) 14,13,14 13 P1=DK(K)/RL(K) R1=E*RI*(P1**2) R2=2.*R1*SIN(LAM) 14 IF(IDK) 3,2,3 3 CONTINUE C------MIRROR THESE COORDINATES TO GET THE OTHER END IF(FI(N).EQ.FI(N+1)) N=N-1 NP1=N+1 N2=2*N+1 NP2=N+2 DO 20 KK=NP2,N2 K=N2-KK+1 R(KK)=R(K) CURV(KK)=CURV(K) FI(KK)=-FI(K) ST(KK)=ST(K) RL(KK)=2.*RL(NP1)-RL(K) X(KK,1)=2.*X(NP1,1)-X(K,1) 20 X(KK,2)=X(K,2) C------WRITE THE UNTRANSFORMED COORDINATES NF=N2 IF(FIN.NE.0) NF=NP1 DO 85 K=1,NF DYDX=CURV(K)/COS(FI(K)) PHIDD=FI(K)*180./3.1415926 IF(IABS(NK).LT.4) GO TO 86 85 WRITE(3,84) K,X(K,1),X(K,2),R(K),RL(K),PHIDD 84 FORMAT(1X,I2,5(2X,F12.5)) 86 IF(NK.LE.0) GO TO 81 C------TRANSFORM AND WRITE C=COS(FIT) S=SIN(FIT) IF(NK.LT.4) GO TO 82 WRITE(3, 7)P1,R1,R2 7 FORMAT(//,' P1 = ',E12.5,5X,'R1 = ',E12.5,5X,'R2 = ', 2E12.5,/) WRITE(3,12) 12 FORMAT(//,' K',7X,'XTR',11X,'YTR',11X,'CURV', 29X,' PHI T',9X,'ST',/) 82 DO 81 K=1,NF X(K,3)=X(K,1)*C+X(K,2)*S X(K,4)=X(K,1)*S-X(K,2)*C FI(K)=FIT-FI(K) PHIDD=FI(K)*180./3.1415926 IF(NK.LT.4) GO TO 81 WRITE(3,84) K,X(K,3),X(K,4),CURV(K),PHIDD,ST(K) 81 CONTINUE RETURN END