PROGRAM CALCULATE
     HEXADECIMAL, DECIMAL, OCTAL, CHARACTER CONVERSION AND
     INTEGER AND FLOATING POINT CALCULATOR.
     J.M. BISHOP, U.N.D., 8/77
	VAX VERSION, 5/82, 11/82, 10/83
	LEFT IN FLECS TO MINIMIZE REWRITING (DISALLOWS F77 ELSE)
	RECORDING ADDED 3/84
     DIMENSION MREG(20),FREG(20)
     EQUIVALENCE(MREG(1),FREG(1)),(IREG,REG),(INDEC,FINDEC)
     EQUIVALENCE (IOUT,FOUT)
     DATA MREG/20*0/
     CHARACTER*1 IOP,IBASE,IPRMT,ICALC,MORHELP
     CHARACTER*1 IHD/'D'/,IHH/'H'/,IHO/'O'/,IHC/'C'/,IHB/'B'/
     CHARACTER*1 IHI/'I'/,IHF/'F'/,IHQ/'Q'/,IHE/'E'/,IHA/'A'/
     CHARACTER*1 IHN/'N'/,IHX/'X'/,IHL/'L'/,IHM/'M'/,IHP/'P'/
     CHARACTER*1 IHR/'R'/,IHPL/'+'/,IHMI/'-'/,IHST/'*'/,IHEQ/'='/
     CHARACTER*1 IHSL/'/'/,IHS/'S'/,IHT/'T'/
CHARACTER*1 DBASE/'D'/
CHARACTER*80 CINP, COP*10, CNUM*20
CHARACTER*1 CARCON/' '/
CHARACTER*1 HT/'9'X/
CHARACTER*80 FILENAME
     LOGICAL SHORT/.FALSE./
     LOGICAL LFLOAT/.FALSE./
LOGICAL AUTO/.TRUE./
LOGICAL DEBUG/.FALSE./
LOGICAL RECORD/.FALSE./
LOGICAL FOPEN/.FALSE./
	LOGICAL TBIT
     DIMENSION IBOUT(8)
CHARACTER*2 IN
     CHARACTER*2 Q/'Q'/
     REAL*8 DTIME,DATE,TIME1,DATE1
LOGICAL RETRY/.FALSE./
DATA PI/3.1415926/
DEGRAD=PI/180.
      
     SELECTION SECTION
      
   1 CONTINUE
     WHEN (SHORT)
     PRINT 605
 605 FORMAT(' SELECT MODE: I/F/$/H/Q?')
     FIN
     ELSE
     PRINT 610
 610 FORMAT(' DECIMAL, OCTAL, HEXADECIMAL CALCULATOR'/
    C  /' SELECT MODE: INTEGER CALCULATOR, FLOATING POINT OR $ '
    C  ,'CALCULATOR,'/13X,' HELP, OR QUIT:'/' I/F/$/H/Q?')
SHORT=.TRUE.
     FIN
     READ (*,126,END=990) LIN,ICALC
	DEFAULT TO FLOATING MODE
IF(LIN.EQ.0) ICALC='F'
	FORCE TO UPPERCASE
STAT=STR$UPCASE(ICALC,ICALC)
IF(ICALC.EQ.'$') THEN
	$ MODE IS FLOATING WITH $ BASE
	ICALC='F'
	DBASE='$'
	ENDIF
IF(ICALC.EQ.IHH) 
CALL PRINHELP
GO TO 1
FIN
     IF(ICALC.EQ.IHQ) STOP
      
     CALCULATOR SECTION
      
 100 CONTINUE
     IF(ICALC.EQ.IHI) LFLOAT=.FALSE.
     IF(ICALC.EQ.IHF) LFLOAT=.TRUE.
                OPERATION LOOP
 120 CONTINUE
RETRY=.FALSE.
                READ OPERATION, BASE AND NUMBER
     PRINT 125
 125 FORMAT(' OP[B] #?',$)
      READ 130, IOP,IBASE
  130 FORMAT(2A1)
READ (*,126,END=990)LINP,CINP26	FORMAT(Q,A)
	IF CR, THEN PROMPT AGAIN
IF(LINP.LE.0) GO TO 120
	FORCE TO UPPERCASE
STAT=STR$UPCASE(CINP,CINP)
	MAP LEADING COMMA INTO PLUS (VT100 KEYPAD) (BEFORE RECORD)
IF(CINP(1:1).EQ.',') CINP(1:1)='+'
	SEARCH FOR COMMENT ON INPUT
LINC=LINP
LOCT=INDEX(CINP(1:LINC),HT)
LOCEX=INDEX(CINP(1:LINC),'!')
IF(LOCT.NE.0) LINP=MIN(LINP,LOCT-1)
IF(LOCEX.NE.0) LINP=MIN(LINP,LOCEX-1)
	IF RECORDING, WRITE OUT THE INPUT
IF(RECORD) WRITE(9,111) CINP(1:LINC)11	FORMAT(' Input: ',A)

	DECODE INPUT
	SEARCH FOR DELIMITING BLANK
LOP=INDEX(CINP(1:LINP),' ')-1
IF(LOP.GT.0) THEN
	BLANK FOUND, OPERAND FOLLOWS
	COP=CINP(1:LOP)
	GO TO 135
	ENDIF
IF(LOP.EQ.0) THEN
	NULL OP IS ENTER
	COP='E'
	LOP=1
	GO TO 135
	ENDIF
IF(LOP.LT.0) THEN
		NO BLANK ENTERED, IF ONLY NUMERIC ENTRY, ASSUME 'ENTER'
	IF(CINP(1:1).GE.'0'.AND.CINP(1:1).LE.'9') THEN
		LOP=0
		COP='E'
		GO TO 135
		ENDIF
		ALLOW LEADING . ON NUMBER WITH NO PRECEDING BLANK
	IF(CINP(1:1).EQ.'.') THEN
		LOP=0
		COP='E'
		GO TO 135
		ENDIF
		CHECK FOR SINGLE CHAR OP + NUMBER
	IF(CINP(2:2).GE.'0'.AND.CINP(2:2).LE.'9') THEN
		LOP=1
		COP=CINP(1:1)
		GO TO 135
		ENDIF
		ALLOW LEADING . ON NUMBER WITH NO PRECEDING BLANK
	IF(CINP(2:2).EQ.'.') THEN
		LOP=1
		COP=CINP(1:1)
		GO TO 135
		ENDIF
		NOT NUMERIC, WHOLE ENTRY IS COMMAND
	LOP=LINP
	COP=CINP(1:LINP)
	ENDIF35	IOP=COP(1:1)
LBASE=0
	MAP NEW CODES
IF(IOP.EQ.'^') IOP=IHP
IF(COP.EQ.'LN') THEN
	COP='LN '
	LOP=3
	ENDIF
	DO CONTROL CODES
IF(LOP.GE.3) THEN
	IF(COP(1:3).EQ.'REC') THEN
			TURN ON RECORD MODE (WRITE INPUT AND OUTPUT TO FILE)
		RECORD=.TRUE.
		IF(.NOT.FOPEN) THEN
				READ FILE NAME AND OPEN FILE36				PRINT 13737				FORMAT(' Enter File Name (<cr> for none):',$)
			READ 126, LFILE,FILENAME
			IF(LFILE.EQ.0) THEN
				FOPEN=.FALSE.
				RECORD=.FALSE.
				GO TO 120
				ENDIF
				FORCE TO UPPERCASE
			STAT=STR$UPCASE(FILENAME,FILENAME)
			OPEN (UNIT=9,FILE=FILENAME(1:LFILE),
1				STATUS='NEW',IOSTAT=ISTAT,ERR=138)
			FOPEN=.TRUE.
			GO TO 12038				PRINT *,' FILE CANNOT BE OPENED, IOSTAT=',
1				ISTAT
			GO TO 136
			ENDIF
		GO TO 120
		ENDIF
	IF(COP(1:5).EQ.'NOREC') THEN
			TURN OFF RECORD MODE
		RECORD=.FALSE.
		GO TO 120
		ENDIF
	IF(COP.EQ.'AUTO') THEN
			AUTOPRINT MODE (PRINT RESULT AUTOMATICALLY)
		AUTO=.TRUE.
		GO TO 120
		ENDIF
	IF(COP.EQ.'NOAUTO') THEN
			NO AUTO PRINT
		AUTO=.FALSE.
		GO TO 120
		ENDIF
	IF(COP.EQ.'DEBUG') THEN
			DEBUG PRINTOUT TURNED ON
		DEBUG=.TRUE.
		GO TO 120
		ENDIF
	IF(COP.EQ.'NODEBUG') THEN
			NO DEBUG PRINT
		DEBUG=.FALSE.
		GO TO 120
		ENDIF
	IF(COP.EQ.'CMODE') THEN
			CHANGE MODE (INTEGER/REAL)
		GO TO 1
		ENDIF
	IF(COP.EQ.'DBASE') THEN
			CHANGE BASE
		DBASE=CINP(LOP+2:LOP+2)
		IF(DBASE.NE.'D'.AND.DBASE.NE.'O'.AND.DBASE.NE.'H') THEN
			IF(DBASE.EQ.'T') DBASE='A'
			IF(DBASE.NE.'$'.AND.DBASE.NE.'A') THEN
		PRINT *, ' DEFAULT BASE "',DBASE,'" NOT ACCEPTABLE'
			DBASE='D'
			ENDIF
			ENDIF
		GO TO 120
		ENDIF
	ENDIF
	SET DEFAULT BASE
IBASE=DBASE
	IF BASE SPECIFIED USE IT AND TRUNCATE OP CODE
IF(LOP.EQ.2) THEN
	IBASE=COP(2:2)
		CHECK BASE FOR VALIDITY
	IF(IBASE.GE.'A'.OR.IBASE.EQ.'$') THEN
		IF(IBASE.EQ.'T') IBASE='A'
		LOP=1
		LBASE=1
		ENDIF
	ENDIF
      SOME OPS HAVE NO BASE AND NUMBER
IF(LOP.LE.1) THEN
     SELECT (IOP)
     (IHC) GO TO 160
     (IHQ) GO TO 160
     (IHM) GO TO 160
     (IHS) GO TO 160
     (IHN) GO TO 160
     (IHH) GO TO 160
     (IHI) GO TO 160
     (IHF) GO TO 160
     (IHT) GO TO 160
     FIN
ENDIF
     IF(IOP.EQ.IHEQ.AND.IBASE.NE.IHM) GO TO 16040	CONTINUE
                READ IN NUMBER
      IF(.NOT.SHORT) PRINT 145
  145 FORMAT(' #')
LNUM=LINP-LOP-LBASE
CNUM=CINP(LOP+LBASE+1:LINP)
IF(LNUM.LE.0) THEN
	IF NO NUMBER ENTERED, USE CURRENT REGISTER CONTENTS
	INDEC=IREG
	GO TO 160
	ENDIF
	DISPLAY MEMORY NO. #
     IF(IOP.EQ.IHD.AND.LOP.EQ.1)
      PRINT 147
      READ *,INDEC
READ(CNUM,'(I<LNUM>)') INDEC
     GO TO 160
     FIN
     SELECT(IBASE)
                DECIMAL
     (IHD)
      PRINT 147
      WHEN (LFLOAT) READ *,FINDEC
      ELSE READ *,INDEC
     WHEN (LFLOAT) READ(CNUM,'(F<LNUM>.0)') FINDEC
     ELSE READ(CNUM,'(I<LNUM>)') INDEC
     FIN
                OCTAL
     (IHO)
      PRINT 147
      READ *,INOCT
READ(CNUM,'(O<LNUM>)') INOCT
     INDEC=INOCT
     FIN
                HEXADECIMAL
     (IHH)
      PRINT 147
  147 FORMAT(' ?',$)
      READ 52, INHEX
READ(CNUM,'(Z<LNUM>)') INHEX
     INDEC=INHEX
     FIN
                CHARACTER
     (IHC)
      PRINT 147
      READ 155, INCHAR
  155 FORMAT(A4)
IF(LNUM.GT.4) LNUM=4
READ(CNUM,'(A<LNUM>)') INCHAR
     INDEC=INCHAR
     FIN
		 $ DOLLARS
('$')
     READ(CNUM,'(-2PF<LNUM>.0)') FINDEC
IF (.NOT.LFLOAT) INDEC=FINDEC
FIN
		 ANGLES/TIME
('A')
	FIND COLONS
LCOL1=INDEX(CNUM,':')
LCOL2=0
IF(LCOL1.NE.0) LCOL2=INDEX(CNUM(LCOL1+1:LNUM),':')
IF(LCOL2.GT.0) LCOL2=LCOL2+LCOL1
IF(LCOL1.EQ.0) LCOL1=LNUM+1
IF(LCOL2.EQ.0) LCOL2=LNUM+1
LNUM1=LCOL1-1
LNUM2=LCOL2-LCOL1-1
LNUM3=LNUM-LCOL2
FIN1=0.
FIN2=0.
FIN3=0.
IF(LNUM1.GT.0) THEN
	IF(LNUM1.GT.1) READ(CNUM,'(F<LNUM1>.0)') FIN1
	IF(LNUM1.EQ.1) THEN
		READ(CNUM,'(I<LNUM1>)') IFIN1
		FIN1=IFIN1
		ENDIF
	ENDIF
IF(LNUM2.GT.0) THEN
	IF(LNUM2.GT.1) READ(CNUM(LCOL1+1:LNUM),'(F<LNUM2>.0)') FIN2
	IF(LNUM2.EQ.1) THEN
		READ(CNUM(LCOL1+1:LNUM),'(I<LNUM2>)') IFIN2
		FIN2=IFIN2
		ENDIF
	ENDIF
IF(LNUM3.GT.0) THEN
	IF(LNUM3.GT.1) READ(CNUM(LCOL2+1:LNUM),'(F<LNUM3>.0)') FIN3
	IF(LNUM3.EQ.1) THEN
		READ(CNUM(LCOL2+1:LNUM),'(I<LNUM3>)') IFIN3
		FIN3=IFIN3
		ENDIF
	ENDIF
FINDEC=ABS(FIN1)+(FIN2/60.)+(FIN3/3600.)
IF(FIN1.LT.0) FINDEC=-FINDEC
FIN
                MEMORY NUMBER
     (OTHERWISE) 
      PRINT 147
      READ *,INDEC
READ(CNUM,'(I<LNUM>)') INDEC
     FIN
     FIN
 160 CONTINUE
	DEBUG PRINTOUT
IF(DEBUG) THEN
PRINT *,' RETRY', RETRY
PRINT *,' LOP,LBASE,LNUM', LOP,LBASE,LNUM
PRINT *,' IOP,COP,CNUM,CINP,IBASE:', IOP,'|',COP,'|',
1	CNUM,'|',CINP,'|',IBASE
PRINT *,' INDEC,FINDEC', INDEC,FINDEC
ENDIF

                IF MEMORY OP, GET CONTENTS OF REGISTER
     IF(IOP.NE.IHD.AND.IOP.NE.IHEQ.AND.IBASE.EQ.IHM)
     WHEN(INDEC.GT.0.AND.INDEC.LE.20) INDEC=MREG(INDEC)
     ELSE INDEC=IREG
     FIN
                DO OPERATION
IF(LOP.LE.1) THEN
     SELECT (IOP)
                CLEAR MAIN REGISTER
     (IHC) IREG=0
                ENTER A NUMBER INTO MAIN REGISTER
     (IHE) IREG=INDEC
                ADD TO MAIN REGISTER
     (IHPL)
     WHEN (LFLOAT) REG=REG+FINDEC
     ELSE IREG=IREG+INDEC
     FIN
                SUBTRACT FROM MAIN REGISTER
     (IHMI)
     WHEN (LFLOAT) REG=REG-FINDEC
     ELSE IREG=IREG-INDEC
     FIN
                MULTIPLY MAIN REGISTER
     (IHST)
     WHEN (LFLOAT)
WHEN (IBASE.NE.'$') REG=REG*FINDEC
ELSE REG=(REG*FINDEC)/100.
FIN
     ELSE IREG=IREG*INDEC
     FIN
                DIVIDE MAIN REGISTER
     (IHSL)
     WHEN (LFLOAT) 
WHEN (IBASE.NE.'$') REG=REG/FINDEC
ELSE REG=REG*100./FINDEC
FIN
     ELSE IREG=IREG/INDEC
     FIN
                RAISE MAIN REGISTER TO A POWER
     (IHP)
     WHEN (LFLOAT) 
	PROTECT AGAINST LOGS OF NEG NUMBERS
WHEN(REG.LT.0.) REG=REG**INT(FINDEC)
ELSE REG=REG**FINDEC
FIN
     ELSE IREG=IREG**INDEC
     FIN
                SQUARE ROOT
     (IHS)
     WHEN (LFLOAT) 
	PROTECT AGAINST SQRT OF NEG NUMBERS
WHEN(REG.GE.0) REG=SQRT(REG)
ELSE REG=-SQRT(ABS(REG))
FIN
     ELSE
	PROTECT AGAINST SQRT OF NEG NUMBERS
WHEN(IREG.GE.0) IREG=SQRT(FLOAT(IREG))
ELSE IREG=-SQRT(FLOAT(ABS(IREG)))
FIN
     FIN
                CHANGE SIGN OF MAIN REGISTER
     (IHM)
     WHEN (LFLOAT) REG=-REG
     ELSE IREG=-IREG
     FIN
                LOGICAL AND
     (IHA) IREG=IAND(IREG,INDEC)
                LOGICAL OR
     (IHO) IREG=IOR(IREG,INDEC)
                LOGICAL EXCLUSIVE OR
     (IHX) IREG=IEOR(IREG,INDEC)
                LOGICAL NOT OR COMPLEMENT
     (IHN) IREG=NOT(IREG)
                LEFT SHIFT
     (IHL) IREG=ISHFT(IREG,INDEC)
                RIGHT SHIFT
     (IHR) IREG=ISHFT(IREG,-INDEC)
                CONVERT TO INTEGER
     (IHI) IREG=REG
                CONVERT TO FLOATING POINT
     (IHF) REG=IREG
                OUTPUT MAIN REGISTER
     (IHEQ)
     IOUT=IREG
ASSIGN 120 TO NEXT
CARCON=' '
     GO TO 165
     FIN
                OUTPUT A MEMORY REGISTER
     (IHD)
ASSIGN 120 TO NEXT
IF(INDEC.EQ.0) THEN
	REGISTER 0 IMPLIES PRINT ALL REGISTERS
	ASSIGN 190 TO NEXT90		INDEC=INDEC+1
	IF(INDEC.GT.20) THEN
		ASSIGN 120 TO NEXT
		GO TO 120
		ENDIF
	ENDIF
     WHEN(INDEC.GT.0.AND.INDEC.LE.20) IOUT=MREG(INDEC)
     ELSE IOUT=IREG
     PRINT 195, INDEC
 195 FORMAT(' MEMORY ',I2,': ',$)
IF(RECORD) WRITE(9,195) INDEC
CARCON='+'
     GO TO 165
     FIN
                QUIT
     (IHQ)
IF(FOPEN) THEN
	PRINT *, 'Input and Output recorded in file ',FILENAME
	ENDIF
STOP
FIN
                ASK FOR HELP
     (IHH)
     PRINT 200
 200 FORMAT(' OPERATIONS ARE (Enter only Cap part of operation):'/
1	' Enter, +, -, *, /, =, ^ or Power, Minus(+<->-), Clear,'/
2	' Display, Quit, Sqrt, And, Or, Xor, Not, Left, Right,'/
3	' Float, Int, Help, SIN, COS, TAN, ASIN, ACOS, ATAN,'/
4	' SIND, COSD, TAND, ASIND, ACOSD, ATAND, LN, LOG, EXP,'/
5	' SINH, COSH, TANH, SQRT, RADEG, DEGRAD, INV, FAC,'/
6	' DBASE, AUTO, NOAUTO, REC, NOREC, CMODE'/
    C  /' BASES ARE Dec, Hex, Oct, Char, Bin, Mem, $, Ang, Time, ',
8	'default is D'/
    C  ' FOR MORE HELP, TYPE "H", OTHERWISE <CR>')
MORHELP=' '
READ 126,LIN,MORHELP
	FORCE TO UPPERCASE
STAT=STR$UPCASE(MORHELP,MORHELP)
IF(MORHELP.EQ.IHH) CALL PRINHELP
     FIN
                GET TIME
     (IHT)
     DTIME=TIME1(DUMMY)
     DATE=DATE1(DUMMY)
     PRINT 205,DTIME,DATE
 205 FORMAT(' TIME IS ',A8,' ON ',A8)
IF(RECORD) WRITE(9,205) DTIME,DATE
     FIN
(OTHERWISE)
PRINT *, '"',COP,'" UNKNOWN'
     FIN
     FIN
ENDIF
IF(LOP.GE.2) THEN
	SELECT (COP)
	('SQRT')
			PROTECT AGAINST SQRT OF NEG NUMBERS
		WHEN(REG.GE.0) REG=SQRT(REG)
		ELSE REG=-SQRT(ABS(REG))
		FIN
	('EXP') REG=EXP(FINDEC)
	('LN ') 
		WHEN(FINDEC.GT.0.) REG=LOG(FINDEC)
		ELSE PRINT *, ' CANNOT DO LN(NEG NO.)'
		FIN
	('LOG')
		WHEN(FINDEC.GT.0.) REG=LOG10(FINDEC)
		ELSE PRINT *, ' CANNOT DO LOG(NEG NO.)'
		FIN
	('SIN') REG=SIN(FINDEC)
	('COS') REG=COS(FINDEC)
	('TAN') REG=TAN(FINDEC)
	('ATAN') REG=ATAN(FINDEC)
	('ACOS') REG=ACOS(FINDEC)
	('ASIN') REG=ASIN(FINDEC)
	('SIND') REG=SIND(FINDEC)
	('COSD') REG=COSD(FINDEC)
	('TAND') REG=TAND(FINDEC)
	('ATAND') REG=ATAND(FINDEC)
	('ACOSD') REG=ACOSD(FINDEC)
	('ASIND') REG=ASIND(FINDEC)
	('SINH') REG=SINH(FINDEC)
	('COSH') REG=COSH(FINDEC)
	('TANH') REG=TANH(FINDEC)
	('RADEG') REG=FINDEC/DEGRAD
	('DEGRAD') REG=FINDEC*DEGRAD
	('INV') REG=1./FINDEC
	('FAC')
			FACTORIAL
		FNUM=FINDEC
		REG=FNUM
		WHILE(FNUM.GT.2.)
			FNUM=FNUM-1.
			REG=REG*FNUM
			FIN
		FIN
	(OTHERWISE)
		ALLOW NO SEPARATING BLANK ON UNKNOWN,
		TAKE FIRST CHARACTER AND TRY AGAIN
	IF(.NOT.RETRY) THEN
		RETRY=.TRUE.
		LOP=1
		LBASE=0
			RESET DEFAULT BASE
		IBASE=DBASE
		GO TO 140
		ENDIF
	PRINT *, '"',COP,'" UNKNOWN'
	FIN
	FIN
	ENDIF
IF(AUTO) THEN
	IOUT=IREG
	IBASE=DBASE
	ASSIGN 120 TO NEXT
	CARCON=' '
	GO TO 165
	ENDIF
     GO TO 120
 165 CONTINUE
                OUTPUT OR SAVE
     SELECT (IBASE)
                DECIMAL
     (IHD)
     WHEN (LFLOAT)
     PRINT 168, CARCON,FOUT
 168 FORMAT(A,'=',G14.6)
IF(RECORD) WRITE(9,168) CARCON,FOUT
     FIN
     ELSE
     PRINT 170, CARCON,IOUT
 170 FORMAT(A,'=',I12)
IF(RECORD) WRITE(9,170) CARCON,IOUT
     FIN
     FIN
                OCTAL
     (IHO)
     PRINT 175, CARCON,IOUT
 175 FORMAT(A,'O= ',O12)
IF(RECORD) WRITE(9,175) CARCON,IOUT
     FIN
                HEXADECIMAL
     (IHH)
     PRINT 180, CARCON,IOUT
 180 FORMAT(A,'H= ',Z8)
IF(RECORD) WRITE(9,180) CARCON,IOUT
     FIN
                CHARACTER
     (IHC)
     PRINT 185, CARCON,IOUT
 185 FORMAT(A,'C= ',A4)
IF(RECORD) WRITE(9,185) CARCON,IOUT
     FIN
                SAVE TO MEMORY
     (IHM)
     IF(INDEC.GT.0.AND.INDEC.LE.20) MREG(INDEC)=IOUT
     FIN
                BINARY
     (IHB)
     DO (I=1,8) IBOUT(I)=0
     IF(BTEST(IOUT,0)) IBOUT(8)=IOR(IBOUT(8),'1'X)
     IF(BTEST(IOUT,1)) IBOUT(8)=IOR(IBOUT(8),'10'X)
     IF(BTEST(IOUT,2)) IBOUT(8)=IOR(IBOUT(8),'100'X)
     IF(BTEST(IOUT,3)) IBOUT(8)=IOR(IBOUT(8),'1000'X)
     IF(BTEST(IOUT,4)) IBOUT(7)=IOR(IBOUT(7),'1'X)
     IF(BTEST(IOUT,5)) IBOUT(7)=IOR(IBOUT(7),'10'X)
     IF(BTEST(IOUT,6)) IBOUT(7)=IOR(IBOUT(7),'100'X)
     IF(BTEST(IOUT,7)) IBOUT(7)=IOR(IBOUT(7),'1000'X)
     IF(BTEST(IOUT,8)) IBOUT(6)=IOR(IBOUT(6),'1'X)
     IF(BTEST(IOUT,9)) IBOUT(6)=IOR(IBOUT(6),'10'X)
     IF(BTEST(IOUT,10)) IBOUT(6)=IOR(IBOUT(6),'100'X)
     IF(BTEST(IOUT,11)) IBOUT(6)=IOR(IBOUT(6),'1000'X)
     IF(BTEST(IOUT,12)) IBOUT(5)=IOR(IBOUT(5),'1'X)
     IF(BTEST(IOUT,13)) IBOUT(5)=IOR(IBOUT(5),'10'X)
     IF(BTEST(IOUT,14)) IBOUT(5)=IOR(IBOUT(5),'100'X)
     IF(BTEST(IOUT,15)) IBOUT(5)=IOR(IBOUT(5),'1000'X)
     IF(BTEST(IOUT,16)) IBOUT(4)=IOR(IBOUT(4),'1'X)
     IF(BTEST(IOUT,17)) IBOUT(4)=IOR(IBOUT(4),'10'X)
     IF(BTEST(IOUT,18)) IBOUT(4)=IOR(IBOUT(4),'100'X)
     IF(BTEST(IOUT,19)) IBOUT(4)=IOR(IBOUT(4),'1000'X)
     IF(BTEST(IOUT,20)) IBOUT(3)=IOR(IBOUT(3),'1'X)
     IF(BTEST(IOUT,21)) IBOUT(3)=IOR(IBOUT(3),'10'X)
     IF(BTEST(IOUT,22)) IBOUT(3)=IOR(IBOUT(3),'100'X)
     IF(BTEST(IOUT,23)) IBOUT(3)=IOR(IBOUT(3),'1000'X)
     IF(BTEST(IOUT,24)) IBOUT(2)=IOR(IBOUT(2),'1'X)
     IF(BTEST(IOUT,25)) IBOUT(2)=IOR(IBOUT(2),'10'X)
     IF(BTEST(IOUT,26)) IBOUT(2)=IOR(IBOUT(2),'100'X)
     IF(BTEST(IOUT,27)) IBOUT(2)=IOR(IBOUT(2),'1000'X)
     IF(BTEST(IOUT,28)) IBOUT(1)=IOR(IBOUT(1),'1'X)
     IF(BTEST(IOUT,29)) IBOUT(1)=IOR(IBOUT(1),'10'X)
     IF(BTEST(IOUT,30)) IBOUT(1)=IOR(IBOUT(1),'100'X)
     IF(BTEST(IOUT,31)) IBOUT(1)=IOR(IBOUT(1),'1000'X)
     PRINT 188, CARCON,IBOUT
 188 FORMAT(A,'B= ',4(Z4.4,1X,Z4.4,2X))
IF(RECORD) WRITE(9,188) CARCON,IBOUT
     FIN
		$ DOLLARS
     ('$')
     IF (.NOT.LFLOAT) FOUT=IOUT
     PRINT 198, CARCON,FOUT
 198 FORMAT(A,'=$',-2PF10.2)
IF(RECORD) WRITE(9,198) CARCON,FOUT
     FIN
		ANGLES/TIME
     ('A')
FSIGN=SIGN(1.0,FOUT)
FOUT=ABS(FOUT)
FOUT1=AINT(FOUT)
FOUT23=(FOUT-FOUT1)*60.
FOUT2=AINT(FOUT23)
FOUT3=(FOUT23-FOUT2)*60.
IFOUT1=FSIGN*FOUT1
IFOUT2=FOUT2
     PRINT 208, CARCON,IFOUT1,IFOUT2,FOUT3
 208 FORMAT(A,'=',I5,':',I2,':',F5.2)
IF(RECORD) WRITE(9,208) CARCON,IFOUT1,IFOUT2,FOUT3
     FIN

     FIN
     GO TO NEXT
	EXIT WITH ^Z
90	STOP
     END

	LOGICAL FUNCTION TBIT(IWD,IBIT)
	TEST BIT IBIT OF WORD IWD	! NO LONGER NEEDED
	LWD=ISHFT(IWD,-IBIT)
	LBIT=IAND(LWD,1)
	IF(LBIT.EQ.1) TBIT=.TRUE.
	IF(LBIT.NE.1) TBIT=.FALSE.
	RETURN
	END

     SUBROUTINE PRINHELP
CHARACTER LINE*80,IN*20
     OPEN (UNIT=22,FILE='NDHELP:CALCULATE.HLP',ERR=999,READONLY,
1	STATUS='OLD')
NLINE=00	READ(22,15,END=98,ERR=99) LLINE,LINE5	FORMAT(Q,A)
NLINE=NLINE+1
PRINT *,LINE(1:LLINE)
IF(NLINE.EQ.21) THEN
	WHEN SCREEN IS FULL, WAIT FOR ENTRY BEFORE CONTINUE
	PRINT 30,' ENTER <CR> TO CONTINUE, OR "Q" TO QUIT'
0		FORMAT(1X,A,$)
	READ 15,LIN,IN
		FORCE TO UPPERCASE
	STAT=STR$UPCASE(IN,IN)
	IF(IN(1:1).EQ.'Q') GO TO 99
	NLINE=0
	ENDIF
GO TO 10
	END OF FILE, ERROR, OR QUIT RECEIVED
8	PRINT 30,' END OF HELP, ENTER <CR> TO EXIT'
READ 15,LIN,IN
9	PRINT 10000	FORMAT(' END OF HELP')
CLOSE(UNIT=22,DISP='KEEP',ERR=110)10	RETURN
99	PRINT *,' HELP NOT AVAILABLE'
GO TO 99
     END