File CD.F4

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

	SUBROUTINE CORD(NA,NB)
	COMMON/A/ PHI(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)
	DIMENSION  AA(3),BB(3),RAB(3),EN(3),
	2ENRF(3),ENNR(3)
	IGA=0
	RC=(TID-WOD)*.5
	DO 1 KK=1,2
	K=NA
	IF(KK.EQ.2) K=NB
	IF(K.EQ.4) RC=0.0
	P(1,K)=XY(1,K)-RC*SIN(PHI(K))
	P(2,K)=(XY(2,K)+RC*COS(PHI(K)))*COS(GAM(K)) + DY(K)
	P(3,K)=(XY(2,K)+RC*COS(PHI(K)))*SIN(GAM(K))
	P(4,K)=XY(1,K)
	P(5,K)=XY(2,K)*COS(GAM(K)) + DY(K)
	P(6,K)=XY(2,K)*SIN(GAM(K))
	E(1,K)=COS(PHI(K))
	E(2,K)=SIN(PHI(K))*COS(GAM(K))
	E(3,K)=SIN(PHI(K))*SIN(GAM(K))
	DO 1 II=1,3
	R(II,K)=P(II,K)+Q*E(II,K)
	RSN(II,K)=-E(II,K)*PL + R(II,K)
	RBH(II,K)=R(II,K) - (PL-BT)*E(II,K)
1	RSB(II,K)=E(II,K)*SL + R(II,K)
	IREF=NA
	INRF=NB
5	DO 2 K=1,3
2	RAB(K)=R(K,INRF)-R(K,IREF)
	DO 3 K=1,3
	AA(K)=E(K,IREF)
3	BB(K)=E(K,INRF)
	CALL CROSS(BB,AA,EN)
	SM=0.0
	DO 4 K=1,3
4	SM=SM+EN(K)**2
	DO 41 K=1,3
41	EN(K)=EN(K)/SQRT(SM)
	CALL CROSS(AA,EN,ENRF)
	CALL CROSS(BB,EN,ENNR)
	CALL DOT(RAB,AA,RABE)
	CALL DOT(AA,BB,E12)
	BET=ACOS(E12)
	CALL DOT(ENRF,ENNR,AB)
	B=SD/2.
	A=B*ABS(AB)
	CALL DOT(RAB,ENRF,G)
	CALL DOT(RAB,EN,H)
	CALL COSOLV(G,H,A,B,BET,SD,RABE,IGA,CD)
	IF(IGA.EQ.0) GO TO 6
	IF(IGA.EQ.2) GO TO 12
	IREF=NB
	INRF=NA
	GO TO 5
6	C(NA,NB)=CD
	RETURN
12	C(NA,NB)=0.0
	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