File BN.F4

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

	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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search