*20
///PROGRAM TANGENT.
	 
/CALCULATES AND TYPES OUT RADIANS, COSINE
/TANGENT, AND DEGREES.
	 
	LMODE
	SEGMNT 5
	*20
	 
BEG,	STARTF
	SETWRD
	0742
D1,	LIF 4
	INTRACT
	CJ1
	M1		/CALC COS
	  		/ANGLE(DEG):
CJ1,	T1
	J1
T1,	0
J1,	JMP D1		/CR
	JMP .+1		/NUM
	JMP RADIAN	/DEG TO RAD
	JMP TYPRAD
	JMP COSINE
	JMP TYPCOS
	 
D2,	LIF 4
	INTRACT
	CJ2
	M2		/CALC ARCTAN
	   		/TANGENT:
CJ2,	T1
	J2
J2,	JMP D2		/CR
	JMP .+1		/NUM
	JMP ARCTAN
	JMP TYPRAD
	JMP DEGREE	/RAD TO DEG
	JMP TYPDEG
	JMP BEG
	 
//SUBROUTINE RADIAN.
/CALLS:  JMP RADIAN
/        ENTER WITH DEGREES IN FAC.
/        EXIT WITH RADIANS IN FAC.
/        RAD=DEG X 2PI/360
/        RAD=DEG / 57.2958
	 
/        JMP DEGREE
/        ENTER WITH RADIANS IN FAC.
/        EXIT WITH DEGREES IN FAC.
/        DEG=RAD X 360/2PI
/        DEG=RAD X 57.2958
	 
/SIGN IS CARRIED THROUGH.
	 
RADIAN,	FDIV
	FCON
	JMP 0
	 
DEGREE,	FMUL
	FCON
	JMP 0
	 
FCON,	6		/57.2958
	3451
	3563
	 
//END SUBROUTINE RADIAN.
// SUBROUTINE COSINE.
	 
/ENTER WITH ANGLE IN RADIANS IN FAC.
/LEAVE WITH COSINE IN FAC.
	 
	 
/FORMULA: COSX= 1 + A2*X^2 + A4*X^4
/         A2= -.49670
/         A4= +.03705
	 
/WHERE, 0<X<PI\2
	 
COSINE,	STORE
	XFAC
	ADD 0
	STC .+11
	LOAD
	A4
	JMP MULT
	FADD
	A2
	JMP MULT
	FADD
	FP1
	0		/LEAVE
	 
A2,	7776		/-.4967
	4015
	4105
	 
A4,	7773		/+.03705
	2276
	0337
	 
FP1,	1
	2000
	0
	 
MULT,	FMUL
	XFAC
	FMUL
	XFAC
	JMP 0
	 
XFAC,	0
	0
	0
//END SUBROUTINE COSINE.
// SUBROUTINE ARCTAN.
	 
/ENTER WITH TANGENT IN FAC.
/EXIT WITH ANGLE IN RADIANS IN FAC.
	 
/FORMULA:
/ARCTANX=PI\4 + C1(XFAC) + C3(XFAC)^3
/             + C5(XFAC)^5
	 
/WHERE XFAC= (X-1)\(X+1)
/      0<X,<INFINITY
/      C1=+.995354
/      C3=-.288679
/      C5=+.079331
/    PI\4=+.7854
	 
	 
ARCTAN,	FADD
	FP1
	ADD 0
	STC ARCTX
	STORE
	XFAC		/X+1
	LOAD
	XFAC
	FSUB
	FP2		/X-1
	FDIV
	XFAC
	STORE
	XFAC		/X-1\X+1
	 
	LOAD
	C5
	JMP MULT
	FADD
	C3
	JMP MULT
	FADD
	C1
	JMP MULT+2
	FADD
	PID4
ARCTX,	0		/LEAVE
	 
C1,	0000		/+.995354
	3766
	3703
	 
C3,	7776		/-.288679
	5541
	4442
	 
C5,	7774		/+.079331
	2423
	6045
	 
PID4,	0000		/PI\4 OR .7854
	3110
	3776
	 
FP2,	2
	2000
	0
	 
//END SUBROUTINE ARCTAN.
	 
/ROUTINE TO TYPOUT RADIANS, COSINE,
/AND DEGREES.
TYPRAD,	LDA
	0
	STC TYPX
	OUTPUT
	BUFRAD+4
	LIF 4
	MESOUT
	BUFRAD
	JMP TYPX
	 
TYPCOS,	LDA
	0
	STC TYPX
	OUTPUT
	BUFCOS+4
	LIF 4
	MESOUT
	BUFCOS
	JMP TYPX
	 
TYPDEG,	LDA
	0
	STC TYPX
	OUTPUT
	BUFDEG+4
	LIF 4
	MESOUT
	BUFDEG
	JMP TYPX
	 
TYPX,	0
	 
/TYPOUT BUFFER FOLLOWS.
BUFRAD,	2201		/RA
	0411		/DI
	0116		/AN
	2375		/S=
	4040
	4040
	4040
	4040
	4543
BUFCOS,	0317		/CO
	2311		/SI
	1605		/NE
	7540		/=
	4040
	4040
	4040
	4040
	4543
BUFDEG,	0405		/DE
	0722		/GR
	0505		/EE
	2375		/S=
	4040
	4040
	4040
	4040
	4543
	 
/END TYPOUT BUFFER.
	 
/MESSAGES.
M1,	TEXT $CALCULATE COSINE$
	4543
	TEXT $ANGLE(DEG): $
M2,	TEXT $CALCULATE ARCTAN$
	4543
	TEXT $TANGENT:$
//PBLOCK
/COMMAND DECODER ASSIGNMENTS
	STOP=JMP 20
	SCAN=JMP 21
	STRSCN=JMP 21
	INUNIT=JMP 22
	STORIT=JMP 23
	GETFIL=JMP 24
	GETFST=JMP 24
	GETNAM=JMP 25
	GETNXT=JMP 25
	DIRINI=JMP 26
	DIRLST=JMP 27
	ASSIGN=JMP 30
	DEASS=JMP 31
	OUTUNIT=JMP 32
	LODBLK=JMP 33
	RUNBLK=JMP 34
	FIND=JMP 35
	CALL=JMP 37
	UNCALL=JMP 40
	RUNPRG=JMP 41
	INTRACT=JMP 42
	MESOUT=JMP 43
	DISK=JMP 44
	TABSET=JMP 45
	INTABLE=JMP 45
	MISSNG=JMP 47
	TABGET=JMP 50
	TABPUT=JMP 51
	TABZER=JMP 52
	MAKDIL=JMP 53
	TABINI=JMP 54
	MGETNAM=JMP 55
	MGETFIL=JMP 56
	MSTORIT=JMP 57
/
/COMMAND LOCATIONS.
/
	FILNAM=2320
	WORD1=2323
	WORD2=2324
	INBUF=2325
/COMMAND NUMBERS.
	YES=17
	NO=20
	SAMPL=21
	TABLE=22
	GO=23
	NEXT=24
	CU=25
	CONT=26
	ALL=27
	AVG=30
	A=31
	B=32
	C=33
	D=34
	E=35
	F=36
	G=37
	H=40
	II=41
	J=42
	PLOT=43
	PRINT=44
	T=45
/
/EXEC3 ASSIGNMENTS
/
	OPR=500
	IOF=6002
	ION=6001
	EXC=1710
	REXC=540
	RLSW=514
	RRSW=515
	IOCALL=511
	AWAKE=501
	QUIT=505
	PAUSE=507
	IOCLR=502
	SETCON=510
	SETCLK=503
	PLINE=524
	READ=512
	WRITE=532
	SETDSK=513
	 
/DEVICE ASSIGNMENTS
/
	KBD=13
	TLP=4
	LPT=24
	BPLT=30
	PLT=25
	CLK=2
	SCOPE=26
/FLOATING POINT DEFINITIONS.
/
	FAC=0
	STARTE=740
	FSUB=741
	FMUL=742
	FDIV=743
	LOAD=744
	STORE=745
	SETWRD=746
	INPUT=747
	OUTPUT=750
	ISTOR1=751
	SQRT=752
	DFLOAT=753
	SFLOAT=754
	FIX=755
	FADD=756
	ISTOR2=757
	STARTF=760
	FCOMP=761
	FZER=762
	FAPO=763
	FAZE=764
	RECIP=765
	NEXTIN=766
	SETIN=767
	SETOUT=770
	OUTBUF=771
	PACFAC=772
	SACFAC=773
	FACAC=774
	UNFIX=775
/
/END PBLOCK.
/END PROG TANGENT
/DEC 73
/JLC,FHD.