SUBROUTINE RECALC
C COPYRIGHT (C) 1983 GLENN EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY.
C RECALCULATE COMMAND
C RECOMPUTE ALL ELEMENTS OF SPREADSHEET WHERE VALID.
C
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1,EL=12
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32 ! REAL ROWS, COLS
C	PARAMETER DRW = 8
C	PARAMETER DCL = 8 ! DISPLAY MAX ROWS, COLS.
C	PARAMETER RRCL = 1024
C PARAMETER RRCL=RRW*RCL
C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON
C SCREEN. ROW 0 IN DISPLAY IS THE 27 ACCUMULATORS A-Z AND %, WITH
C % BEING THE LAST-COMPUTED VALUE FROM THE CALC PROGRAM, WHICH
C KNOWS HOW TO ACCESS THE DATA BUT IS JUST PASSED COMMAND STRINGS
C FROM THE DISK BASED FILE HERE.
	LOGICAL*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	InTEgeR*4 FORMFG,RCFGX,PZAP,RCONE
	InTEgeR*4 RCMODE,IRCE1,IRCE2
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,
     1  RCMODE,IRCE1,IRCE2
	DIMENSION FORM(128),FVLD(RRWP,RCLP)
	InTEgeR*4 DLFG
	COMMON/DLFG/DLFG
C DLFG=0 IF NO D## SEEN AND 1 IF D## SEEN.
	COMMON/FVLDC/FVLD
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
C FVLD=-2 OR -3 = DISPLAY FORMULA
C FVLD=3 NUMERIC, COMPUTE ONCE THEN SET FVLD TO 2
C FVLD=2 NUMERIC CONSTANT, ALREADY COMPUTED... DO NOT RECOMPUTE.
C
C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2
C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN.
	InTEgeR*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	InTEgeR*4 TYPE(RRWP,RCLP),VLEN(9)
	LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP)
	InTEgeR*4 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	InTEgeR*4 KDRW,KDCL
	COMMON /DOT/KDRW,KDCL
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	InTEgeR*4 PRS,PCS,DRS,DCS
	COMMON/VEWHAK/IVWHK
	INTEGER*4 IVWHK
	PRS=PROW
	PCS=PCOL
	DRS=DROW
	DCS=DCOL
	IF(RCMODE.EQ.2)GOTO 5500
C THE FOLLOWING 2 LOOPS DEFINE ORDER OF CALCULATION.
C HERE THIS IS: OUTER LOOP ON ROWS (ACROSS), INNER LOOP ON COLUMNS (DOWN).
	DO 1 N2=1,RCLACT
	IF(IVWHK.EQ.0)GOTO 8220
C VIEW HACK HERE
C DISPLAY ROW NUMBER FOLLOWED BY BARE CR DURING RECALC
	CALL UVT100(CUP,LLDSP,1)
	KKKK=13
C 13 IS ASCII CARRIAGE RETURN
	WRITE(6,8221)N2,KKKK
8221	FORMAT(' ',I5,1A1)
8220	CONTINUE
	N1=1
220	CONTINUE
C	DO 2 N1=1,RRW
C USE FVPEEK TO CHECK WHERE FIRST CELL TO DO IS HERE. SHOULD BE
C FASTER THAN STANDARD LOOP METHOD.
ccc	CALL FVPEEK(N1,N2,N1)
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IF (FVLD(1,1).LE.0) GOTO 2
	IRRX=(N2-1)*RRW+N1
C	CALL REFLEC(N2,N1,IRRX)
C IF CONSTANT WAS COMPUTED ALREADY, NO NEED TO RECOMPUTE. SKIP IT.
C NOTE: WE MUST ALWAYS RECOMPUTE IF R COMMAND WAS GIVEN...
	IF ((RCONE.EQ.0).AND.(FVLD(1,1).EQ.2)) GOTO 2
	KDRW=N1
	KDCL=N2
	PROW=N1
	PCOL=N2
C SEE IF THIS PHYS COL HAS A DISPLAY COL. AND IF SO SET THAT UP.
C ONLY SET TO DISPLAYED LOCS HERE TO MINIMIZE SEARCH TIME.
	IF(DLFG.EQ.0)GOTO 95
C NO SEARCH FOR DROW AND DCOL IF NO D## FORMS MAY USE IT.
C NEED SEARCH IF RCMODE > 1 SINCE WE MUST SEE IF WE'RE ON DISPLAY.
C IF RCMODE = 1 THEN WE JUST SEE IF THIS IS ENTER CELL
	DO 10 M1=1,DRWV
	DO 20 M2=1,DCLV
	M1X=M1
	M2X=M2
	IF(NRDSP(M1,M2).EQ.N1.AND.NCDSP(M1,M2).EQ.N2)GOTO 9
20	CONTINUE
10	CONTINUE
C IF WE FALL THRU HERE, CELL ISN'T ON DISPLAY AREA ANYWHERE.
C IF NOT ENTERED CELL, SKIP IT...
C ALSO GO HERE IF RCMODE IS 0 OR 1 AND NO D## ENTRIES EXIST.
95	CONTINUE
	IF(RCMODE.LE.0)GOTO 9
C TEST AND CALC ONLY IF ENTRY HERE... ELSE SKIP IT.
	IF(PROW.NE.IRCE1.OR.PCOL.NE.IRCE2)GOTO 2
C SKIP OUT IN NEW MODES IF NOT ON DISPLAY
9	CONTINUE
C IF NO DISPLAY ROW, LEAVE AT LOW RIGHT...
C USE SAVED VALUES SO WE DON'T RELY ON DO LOOP INDEX AFTER LOOP END.
	DROW=M1X
	DCOL=M2X
	CALL WRKFIL(IRRX,FORM,0)
C NOW HAVE THE FORMULA LINE. PASS TO DOENTRY TO HANDLE IT.
	LLST=110
	DO 56 NNN=1,109
	LLST=111-NNN
	IF(FORM(LLST-1).GT.32)GOTO 57
	FORM(LLST)=0
56	CONTINUE
57	CONTINUE
C FIND REAL LAST FORMULA CHARACTER
	LFST=1
	FORM(LLST)=0
	FORM(LLST+1)=0
	LFST=1
	FORM(111)=0
	IF(FORM(118).NE.15)GOTO 2
	CALL DOENTR(FORM,LFST,LLST)
C IF WE JUST COMPUTED A CONSTANT, FLAG IT COMPUTED AND SKIP IT.
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IF(FVLD(1,1).EQ.3)CALL FVLDST(N1,N2,2)
2	CONTINUE
	N1=N1+1
	IF(N1.LE.RRWACT)GOTO 220
1	CONTINUE
   	GOTO 5600
5500	CONTINUE
C RCMODE=2 AND NOT RM MODE
C (IN RM MODE, RECALC IS NOT CALLED...)
	DO 1701 M2=1,DCLV
	IF(IVWHK.EQ.0)GOTO 8222
C VIEW HACK HERE
C DISPLAY ROW NUMBER FOLLOWED BY BARE CR DURING RECALC
	CALL UVT100(CUP,LLDSP,1)
	KKKK=13
C 13 IS ASCII CARRIAGE RETURN
	WRITE(6,8221)M2,KKKK
8222	CONTINUE
	DO 1702 M1=1,DRWV
C TO HANDLE DISPLAY WHEREVER IT MAY BE, FIND ID OF PHYS CELL AND
C CONVERT TO PHYS ROW, COL AGAIN REGARDLESS OF ALIAS...
C (NOTE CALC ORDER IS THEREFORE DISPLAY ORDER, NOT SHEET ORDER...)
	K=NRDSP(M1,M2)
	KK=NCDSP(M1,M2)
	CALL REFLEC(KK,K,IV1)
	NRC=IV1-1
	N1=MOD(NRC,RRW)+1
	N2=((NRC-N1+1)/RRW)+1
C COMPUTE PHYS ROW, COL FROM DISPLAY COORDINATES.
C USE FVPEEK TO CHECK WHERE FIRST CELL TO DO IS HERE. SHOULD BE
C FASTER THAN STANDARD LOOP METHOD.
C *** NOTE HOWEVER THAT IT COULD SLOW US UP... DEPENDS ON EFFICIENCY
C OF FVLDGT AND FVPEEK.
C  ... NEED BADLY TO SPEED UP FVLDGT AND FVPEEK TO GET THIS LOOP TO RUN FAST.
C
C CHECK THAT WE'RE WITHIN BOUNDS SET, TO SPEED THIS MODE UP.
	IF(N1.GT.RRWACT.OR.N2.GT.RCLACT) GOTO 1702
C
	CALL FVLDGT(N1,N2,FVLD(1,1))
	IIFV=(FVLD(1,1))
	IF (IIFV.LE.0) GOTO 1702
C FORGET THIS CELL IF NOT A COMPUTABLE ONE...
	IRRX=IV1
C IF CONSTANT WAS COMPUTED ALREADY, NO NEED TO RECOMPUTE. SKIP IT.
C NOTE: WE MUST ALWAYS RECOMPUTE IF R COMMAND WAS GIVEN...
	IF ((RCONE.EQ.0).AND.(FVLD(1,1).EQ.2)) GOTO 1702
	KDRW=N1
	KDCL=N2
	PROW=N1
	PCOL=N2
	DROW=M1
	DCOL=M2
	CALL WRKFIL(IRRX,FORM,0)
C NOW HAVE THE FORMULA LINE. PASS TO DOENTRY TO HANDLE IT.
	LFST=1
C FIND END OF FORMULA FOR MATH ROUTINES TO TRY TO SPEED
C THEM UP A BIT.
C (ALSO GUARANTEE WE HAVE LOTS OF NULLS AT END TO TERMINATE INDEX ROUTINES)
	DO 756 N=1,109
	LLST=111-N
	IF(FORM(LLST-1).GT.32)GOTO 757
	FORM(LLST)=0
756	CONTINUE
757	CONTINUE
	FORM(LLST)=0
	FORM(111)=0
C CALL DOENTR TO DO THE ACTUAL COMPUTATION WORK...
	CALL DOENTR(FORM,LFST,LLST)
C IF WE JUST COMPUTED A CONSTANT, FLAG IT COMPUTED AND SKIP IT.
	IF(IIFV.EQ.3)CALL FVLDST(N1,N2,2)
1702	CONTINUE
1701	CONTINUE
C END OF COMPUTATION OVER DISPLAYS
C	GOTO 5600
5600	CONTINUE
	PROW=PRS
	PCOL=PCS
	DROW=DRS
	DCOL=DCOL
C FORCE FUNCTION WORKS ONCE ONLY.
	RCONE=0
	RCMODE=IABS(RCMODE)
C RCMODE GETS ABS VALUE AFTER ONE CALL SO WE'RE SURE NEG FLAGS
C GET RESET...
	IRCE1=0
	IRCE2=0
C RESET ENTER FLAGS TOO ONCE USED...
	RETURN
	END
	SUBROUTINE DOENTR(FORM,LOW,LHIGH)
C +++++++++++++++++++++++++++++++++++
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1,EL=12
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32 ! REAL ROWS, COLS
C	PARAMETER DRW = 8
C	PARAMETER DCL = 8 ! DISPLAY MAX ROWS, COLS.
C	PARAMETER RRCL = 1024
C PARAMETER RRCL=RRW*RCL
	LOGICAL*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	DIMENSION FORM(128),FVLD(RRWP,RCLP)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
	InTEgeR*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	InTEgeR*4 TYPE(RRWP,RCLP),VLEN(9)
	LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP)
	REAL*8 ACY
	EQUIVALENCE(ACY,AVBLS(1,27))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	COMMON/FVLDC/FVLD
C +++++++++++++++++++++++++++++++++++
C ENABLE { FORMS TO HANDLE ALL POSSIBLE EQUATIONS.
	CALL FRMEDT(FORM,LLST)
	IITR=0
5050	continue
	IITR=IITR+1
	FORM(111)=0
	LCURR=LOW
C DO AN ENTRY. MUST SCAN FOR MULTIPLE STATEMENTS PER LINE AND ALSO
C RECOGNIZE FUNCTION NAMES.
	lsl=2
	If(form(lcurr).eq.'~'.and.form(lcurr+1).eq.'\')
     1   Goto 5052
C Skip a statement starting with ~\ so this can be used as a flag
C that a display should use a text name later in the formula. done
C here rather than in RECALC so that the TEst command will work
C with these formulae also.
C  Must find second ~ in formula to start display text, if any,
C which facility allows a cell to contain commands/formulae AND
C to contain a display value separate from the commands. One would
C normally execute a TE __{cellname command to evaluate the formula
C part. The initial chars ~\ will act as special case for displays
C to display the text, not the number.Yet another global flag may control
C this, since there will be times the number will be necessary.
1000	CONTINUE
	LSL=INDEX(FORM(LCURR),'\')
	IF(LSL.EQ.0)LSL=LHIGH
C CLAMP AT 80 CHARS LONG INPUT.
	IF(LSL.LE.79)GOTO 1200
C STMT HAS NO MULTIPLES. SQUASH IT TO USE ONLY 1ST PART...
	LSL=79
	LCURR=LHIGH
	FORM(80)=0
1200	CONTINUE
C PERMIT < TO MEAN WE GO BACK INTO THE CURRENT FORMULA
C IF WE HAVE BEEN LESS THAN 100 TIMES AND IF % IS
C POSITIVE.
	IF(FORM(LCURR).NE.'<')GOTO 5051
	IF(ACY.GT.0..AND.IITR.LT.200)GOTO 5050
C SKIP DOSTMT CALL IF WE HAD < SINCE THAT'S NOT A LEGAL
C FUNCTION...
	GOTO 5052
5051	CONTINUE
	CALL DOSTMT(FORM(LCURR),LSL)
5052	IF (LCURR.GE.LHIGH)RETURN
	LCURR=LCURR+LSL
	If(Lcurr.lt.Lhigh)GOTO 1000
	Return
	END
	SUBROUTINE DOSTMT(LINE,LLAST)
C HANDLE 1 STATEMENT PARSING (DOES A BIT MORE OF THE WORK WITH THE
C PART OF THE LINE STRIPPED TO HAVE EXACTLY ONE COMMAND IN IT.
	LOGICAL*1 LINE(110)
C +++++++++++++++++++++++++++++++++++
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1,EL=12
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32 ! REAL ROWS, COLS
C	PARAMETER DRW = 8
C	PARAMETER DCL = 8 ! DISPLAY MAX ROWS, COLS.
C	PARAMETER RRCL = 1024
C PARAMETER RRCL=RRW*RCL
	LOGICAL*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	DIMENSION FORM(128),FVLD(RRWP,RCLP)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
	COMMON/FVLDC/FVLD
	InTEgeR*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	InTEgeR*4 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XVBLS(RRWP,RCLP)
	LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP)
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(JVBLS(1,1,1),XVBLS(1,1))
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	REAL*8 ACX,ACY,AACY
	EQUIVALENCE(ACY,AVBLS(1,27))
	integer*4 iacy,IIJACY,IIJAC2(2)
	EQUIVALENCE(IACY,AVBLS(1,27))
	EQUIVALENCE(IIJACY,IIJAC2(1))
	EQUIVALENCE(IIJAC2(1),AACY)
	InTEgeR*4 KDRW,KDCL
	COMMON /DOT/KDRW,KDCL
	LOGICAL*1 ILINE(106)
	InTEgeR*4 ILNFG,ILNCT
	COMMON/ILN/ILNFG,ILNCT,ILINE
C +++++++++++++++++++++++++++++++++++
	CALL FNAME(LINE,LLAST,INDEXF)
C ABOVE GETS FUNCTION NAMES.
C	NAME	INDEXF
C	MIN	1
C	MAX	2
C	AVG	3
C	SUM	4
C	STD	5	(STD DEVIATION)
C	IF	6	(IF STMT)
C	AND	7
C	OR	8
C	NOT	9
C	CNT	10 (COUNTS NONZERO ENTRIES)
C	NPV	11 NET PRESENT VALUE
C	LKP	12 LOOKUP IN LIST, GIVE OFFSET 0 BASED
C	LKN	13	LOOKUP NEGATIVE (INVERSE OF LKP)
C	LKE	14	LOOKUP EQUAL
C	XOR	15	EXCLUSIVE OR
C	EQV	16	EQUIVALENCE (TRUE IF BITS EQUAL)
C	MOD	17	V1 MODULO V2
C	REM	18	REMAINDER OF V1/V2
C	SGN	19	SIGN OF V1 (-1.,0., OR +1.)
C	IRR	20	INTERNAL RATE OF RETURN
C	RND	21	RANDOM NUMBER BETWEEN 0. AND 1.
C	PMT	22	Payment function
C	PVL	23	Present Value function
C	AVE	24	Average excluding zero cells
C	CHS	25	Choose nth arg. index where n given by 1st arg.
c	ATM	26	Arc tan of 2 args (full circle)
C USE [ AND ] TO DELIMIT FUNCTION ARGS.
	IF(INDEXF.LT.1.OR.INDEXF.GT.26)GOTO 1000
C HERE IF A FUNCTION OR AN IF STMT (FORMAT= IF [varRELvar]stmt|else-stmt)
C
C ALLOW CALC TO HANDLE ALL BUT IF STMTS
	IF(INDEXF.NE.6)GOTO 1000
C
	LLB=INDEX(LINE,'[')
	LRB=INDEX(LINE,']')
C *** ERROR WITH FORMAT -- NO [ SEEN IN TIME. JUST IGNORE IT.
	IF(LLB.GT.LLAST)RETURN
	IF(LRB.GT.LLAST)LRB=LLAST
C	IF(INDEXF.EQ.6)GOTO 2000
CC ISOLATE MATH FUNCTIONS
C	CALL DOMFCN(LINE,LLB,LRB,INDEXF,ACX)
CC GET % ABOVE
C	CALL TYPGET(KDRW,KDCL,TYPE(1,1))
C	IF(ABS(TYPE(1,1)).NE.2)GOTO 1760
C	CALL XVBLST(KDRW,KDCL,ACX)
CC	XVBLS(KDRW,KDCL)=ACX
CC LEAVE RESULT IN % TOO.
C	ACY=ACX
C	CALL TYPSET(27,1,TYPE(1,1))
CC	TYPE(27,1)=TYPE(KDRW,KDCL)
C	RETURN
C1760	JVBLS(1,1,1)=ACX
C	CALL JVBLST(1,KDRW,KDCL,JVBLS(1,1,1))
CC	JVBLS(1,KDRW,KDCL)=ACX
C	RETURN
2000	CONTINUE
C HANDLE AN "IF" STATEMENT
	CALL DOIF(LINE,LLB,LRB,LLAST)
C PASS LLAST TO DOIF SINCE WE DON'T EXPECT ] AS LAST CHAR OF STMT.
C NO DIRECT SET OF VRBL HERE...
	RETURN
1000	CONTINUE
C HERE JUST HAVE SOMETHING TO PASS TO CALC. DO SO.
	ILNFG=1
	LMX=LLAST-1
	DO 1001 N1=1,LMX
1001	ILINE(N1)=LINE(N1)
	ILNCT=LMX
C PROTECT CALC FROM ANY PART OF A LINE LONGER THAN 80 CHARS (ITS MAX)
	IF(ILNCT.GT.80)ILNCT=80
	CALL CALC
C STORE EXPRESSION RESULT.
C CHANGE TYPE OF RESULT IF NEED TO
	CALL TYPGET(KDRW,KDCL,LMX)
	CALL TYPGET(27,1,N1)
C REUSE COUPLE LOCAL VARIABLES
	LMX=IABS(LMX)
	N1=IABS(N1)
	IF(N1.EQ.9)N1=2
	IF(N1.NE.2)N1=4
	AACY=ACY
	IF(N1.EQ.LMX)GOTO 2760
	IF(N1.EQ.2)IIJACY=ACY
	IF(N1.NE.2)AACY=IACY
C 2 IMPLIES REAL, 4 IMPLIES INTEGER STORAGE
2760	CONTINUE
	CALL XVBLST(KDRW,KDCL,AACY)
C	XVBLS(KDRW,KDCL)=ACY
	RETURN
	END
	SUBROUTINE FNAME(LINE,LLAST,INDEXF)
C RETURN FUNCTION NAME IF ANY
	LOGICAL*1 LINE(110)
	INTEGER*4 FNAM(26)
	LOGICAL*1 FCHNM(4,26)
	EQUIVALENCE(FNAM(1),FCHNM(1,1))
	DATA FNAM/'MIN ','MAX ','AVG ','SUM ','STD ','IF  ',
     1  'AND ','IOR ','NOT ','CNT ','NPV ','LKP ',
     2  'LKN ','LKE ','XOR ','EQV ','MOD ','REM ','SGN ','IRR ',
     3  'RND ','PMT','PVL','AVE','CHS','ATM'/
	INDEXF=0
	DO 1 N1=1,26
	DO 2 N2=1,3
	IF(LINE(N2).NE.FCHNM(N2,N1))GOTO 1
2	CONTINUE
C IF WE FALL THROUGH, WE HAVE A VALID FCN NAME INDEX IN INDEXF
	INDEXF=N1
	GOTO 3
1	CONTINUE
3	CONTINUE
	RETURN
	END
	SUBROUTINE TEST(LOGTYP,FLAG,V1,V2)
	InTEgeR*4 FLAG
	REAL*8 V1,V2
	FLAG=0
	IF(LOGTYP.EQ.1.AND.V1.GT.V2)FLAG=1
	IF(LOGTYP.EQ.2.AND.V1.LT.V2)FLAG=1
	IF(LOGTYP.EQ.3.AND.V1.EQ.V2)FLAG=1
	IF(LOGTYP.EQ.4.AND.V1.NE.V2)FLAG=1
	IF(LOGTYP.EQ.5.AND.V1.GE.V2)FLAG=1
	IF(LOGTYP.EQ.6.AND.V1.LE.V2)FLAG=1
C TEST LOGICAL RELATIONS FOR IF STATEMENT, FLAG=1 IF TRUE, 0 ELSE.
	RETURN
	END
	SUBROUTINE MTHINI(INDEXF,AC,SS,CTR,ACX)
	DIMENSION EP(20)
	REAL*8 EP,PV,FV
	COMMON/ERNPER/EP,PV,FV,KIRR
	REAL*8 AC,SS,CTR,ACX
	KIRR=0
	SS=0.
	CTR=0.
	ACX=0.
	DO 1 N=1,20
1	EP(N)=0.
	AC=0.
	IF(INDEXF.EQ.1)AC=1.E20
	IF(INDEXF.EQ.2)AC=-1.E20
	RETURN
	END
	SUBROUTINE DOMATH(INDEXF,VAR,AC,SS,CTR,ACX)
	REAL*8 AC,SS,CTR,ACX,RWRK1,RWRK2
	DIMENSION EP(20)
	REAL*8 EP,PV,FV
	COMMON/ERNPER/EP,PV,FV,KIRR
	REAL*8 VAR,TE
	INTEGER*4 IWRK1,IWRK2,IDUM
	InTEgeR*4 KLKC,KLKR
	REAL*8 AACP,AACQ
	COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
	IF(INDEXF.NE.1)GOTO 100
C MIN
	IF(VAR.GE.AC)GOTO 105
	AC=VAR
	AACP=KLKC
	AACQ=KLKR
105	CONTINUE
C	IF(VAR.LT.AC)AC=VAR
	ACX=AC
100	IF(INDEXF.NE.2)GOTO 200
C MAX
	IF(VAR.LE.AC)GOTO 107
	AC=VAR
	AACP=KLKC
	AACQ=KLKR
C SAVE SELECTED COORDS
107	CONTINUE
C	IF(VAR.GT.AC)AC=VAR
	ACX=AC
200	IF(INDEXF.NE.3)GOTO 300
C AVG
	AC=AC+VAR
	CTR=CTR+1.
	ACX=AC/CTR
300	IF(INDEXF.NE.4)GOTO 400
C SUM
	AC=AC+VAR
	ACX=AC
400	IF(INDEXF.NE.5)GOTO 500
C STD (STANDARD DEVIATION SQUARED)
	AC=AC+VAR
	SS=SS+(VAR*VAR)
	CTR=CTR+1.
	ACX=(SS-((AC*AC)/CTR))/CTR
500	CONTINUE
	IF(INDEXF.NE.7)GOTO 600
C AND
	IF(SS.NE.0.)IWRK1=AC
	IF(SS.EQ.0.)IWRK1=VAR
	SS=1.
	IWRK2=VAR
	IWRK1=IWRK1.AND.IWRK2
	AC=IWRK1
	ACX=AC
600	IF(INDEXF.NE.8)GOTO 700
C INCLUSIVE OR
	IWRK1=AC
	IWRK2=VAR
	IWRK1=IWRK1.OR.IWRK2
	AC=IWRK1
	ACX=AC
700	IF (INDEXF.NE.9)GOTO 800
C NOT
	IWRK1=VAR
	IWRK1=.NOT.IWRK1
	AC=IWRK1
	ACX=AC
800	IF(INDEXF.NE.10)GOTO 1000
C CNT
C COUNT NONZERO ENTRIES
	IF(VAR.NE.0.)AC=AC+1.
	ACX=AC
1000	CONTINUE
	IF(INDEXF.NE.11)GOTO 1100
C NPV
	IF(SS.EQ.0.)GOTO 1050
	CTR=CTR+1.
C	AC=AC+VAR*CTR/SS
	AC=AC+VAR/(SS**(CTR-1))
	ACX=AC
	GOTO 1200
1050	CONTINUE
	SS=VAR+1.
	ACX=0.
1100	if(indexf.ne.12) GOTO 1200
C LKP
	IF(SS.NE.0.)GOTO 1150
	SS=1.
	AC=VAR
	ACX=-1.
	GOTO 1200
1150	CONTINUE
C	IF(VAR.GE.AC.AND.ACX.LT.0.)ACX=CTR
	IF(VAR.LT.AC.OR.ACX.GE.0.)GOTO 1155
	ACX=CTR
	AACP=KLKC
	AACQ=KLKR
1155	CONTINUE
	CTR=CTR+1.
1200	CONTINUE
	IF(INDEXF.NE.13)GOTO 1300
C LKN
	IF(SS.NE.0.)GOTO 1250
	SS=1.
	AC=VAR
	ACX=-1.
	GOTO 1300
1250	CONTINUE
C	IF(VAR.LE.AC.AND.ACX.LT.0.)ACX=CTR
	IF(VAR.GT.AC.OR.ACX.GT.0.)GOTO 1256
	ACX=CTR
	AACP=KLKC
	AACQ=KLKR
1256	CONTINUE
	CTR=CTR+1.
1300	CONTINUE
	IF(INDEXF.NE.14)GOTO 1400
C LKE
	IF(SS.NE.0.)GOTO 1350
	SS=1.
	AC=VAR
	ACX=-1.
	GOTO 1400
1350	CONTINUE
C	IF(VAR.EQ.AC.AND.ACX.LT.0.)ACX=CTR
	IF(VAR.NE.AC.OR.ACX.GE.0.)GOTO 1355
	ACX=CTR
	AACP=KLKC
	AACQ=KLKR
1355	CONTINUE
	CTR=CTR+1.
1400	CONTINUE
	IF(INDEXF.NE.15)GOTO 1500
C XOR
	IF(SS.NE.0)IWRK1=AC
	IF(SS.EQ.0)IWRK1=VAR
	SS=SS+1.
	IF(SS.EQ.1.)GOTO 1405
	IWRK2=VAR
	IWRK3=IWRK1.OR.IWRK2
	IWRK1=IWRK1.AND.IWRK2
	IWRK1=IWRK3-IWRK1
1405	AC=IWRK1
	ACX=AC
1500	CONTINUE
	IF(INDEXF.NE.16)GOTO 1600
C EQV
C NOTE THE EQUIVALENCE FUNCTION IS JUST THE COMPLEMENT OF
C THE XOR FUNCTION. DO THE COMPLEMENT VIA THE .NOT. OPERATOR.
	IF(SS.NE.0)IWRK1=AC
	IF(SS.EQ.0)IWRK1=VAR
	SS=SS+1.
	IF(SS.EQ.1.)GOTO 1505
	IWRK2=VAR
	IWRK3=IWRK1.OR.IWRK2
	IWRK1=IWRK1.AND.IWRK2
	IWRK1=IWRK3-IWRK1
	IWRK1=.NOT.IWRK1
1505	AC=IWRK1
	ACX=AC
1600	CONTINUE
	IF(INDEXF.NE.17)GOTO 1700
C MOD
C MODULO (V1 MOD V2)
	IF(SS.NE.0)RWRK1=AC
	IF(SS.EQ.0)RWRK1=VAR
	SS=SS+1.
	IF(SS.EQ.1.)GOTO 1605
	RWRK2=VAR
	RWRK1=DMOD(RWRK1,RWRK2)
1605	AC=RWRK1
	ACX=AC
1700	CONTINUE
	IF(INDEXF.NE.18)GOTO 1800
C REMAINDER -- INTEGER MODULO
	IF(SS.NE.0)IWRK1=AC
	IF(SS.EQ.0)IWRK1=VAR
	SS=SS+1.
	IF(SS.EQ.1.)GOTO 1705
	IWRK2=VAR
	IWRK1=JMOD(IWRK1,IWRK2)
1705	AC=IWRK1
	ACX=AC
1800	CONTINUE
	IF(INDEXF.NE.19)GOTO 1900
C SGN
C RETURN 1.0 * SIGN OF ARGUMENT.
	AC=DSIGN(1.0D0,VAR)
	ACX=AC
1900	CONTINUE
	IF(INDEXF.NE.20)GOTO 2000
C IRR - INTERNAL RATE OF RETURN
	AC=0.
	ACX=0.
	IF(KIRR.LT.20)KIRR=KIRR+1
	IF(KIRR.EQ.1)PV=VAR
	IF(KIRR.EQ.2)FV=VAR
	IF(KIRR.LT.3)RETURN
C IRR[PV,FV,RETURNS...]
	IWRK1=KIRR-2
	EP(IWRK1)=VAR
	RWRK1=.15
	RWRK2=.25
C ITERATIVELY SOLVE FOR INTERNAL RATE OF RETURN.
1903	TE=0.
	SS=FV/((1.D0+RWRK1)**(IWRK1))
	DO 1905 IWRK2=1,IWRK1
	AC=EP(IWRK2)/((1.D0+RWRK1)**IWRK2)
	SS=SS+AC
1905	CONTINUE
	RWRK2=RWRK1*(SS+TE)/PV
	IF(DABS(RWRK1-RWRK2).LT..00001)GOTO 1910
	RWRK1=RWRK2
	GOTO 1903
1910	CONTINUE
	AC=RWRK2
	ACX=AC
2000	CONTINUE
	IF(INDEXF.NE.21)GOTO 2100
C RND
	AC=RNDF(IDUM)
	ACX=AC
2100	CONTINUE
	IF(INDEXF.NE.22)GOTO 2200
C PMT FUNCTION
C PMT[PRINCIPAL, INTEREST, NPERIODS] ARE ARGS
C PAYMENT (MORTGAGE PAYMENT PER PERIOD
C COMPUTED AS PAYMENT=PRINCIPAL*(INTEREST/(1-(1+INTEREST)**NPERIODS))
C (CORRECT EVEN IF INTEREST=0
C (REUSE COUNTER USED IN IRR ARGUMENTS HERE)
	AC=0.
	ACX=0.
	KIRR=KIRR+1
	EP(KIRR)=VAR
	IF(KIRR.LT.3)RETURN
C FIRST GET ALL THE INPUTS, THEN DO THE REAL RESULT.
	AC=EP(1)*(EP(2)/(1.-((1.+EP(2))**(-EP(3)))))
	ACX=AC
	RETURN
2200	CONTINUE
	IF(INDEXF.NE.23)GOTO 2300
C PVL FUNCTION
C PVL[PAYMENT,INTEREST,NPERIODS] ARE ARGS
C PRESENT VALUE COMPUTED AS
C PV=PAYMENT*(1.-(1.+INTEREST)**-NPERIODS)/INTEREST
C (REUSE COUNTER USED IN IRR ARGUMENTS HERE)
	AC=0.
	ACX=0.
	KIRR=KIRR+1
	EP(KIRR)=VAR
	IF(KIRR.LT.3)RETURN
C FIRST GET ALL THE INPUTS, THEN DO THE REAL RESULT.
	AC=EP(1)*EP(3)
	IF(EP(3).EQ.0..OR.EP(2).EQ.0.)GOTO 2205
	AC=EP(1)*((1.-(1.+EP(2))**(-EP(3)))/EP(2))
2205	ACX=AC
	RETURN
2300	CONTINUE
	IF(INDEXF.NE.24)GOTO 2400
C AVE AVERAGE EXCLUDING ZERO CELLS
	IF(VAR.EQ.0.)GOTO 2305
	AC=AC+VAR
	CTR=CTR+1.
2305	ACX=AC/DMAX1(CTR,1.0D0)
2400	CONTINUE
	IF(INDEXF.NE.25)GOTO 2500
C CHS
C CHOOSE FROM ARGS USING 1ST ARG AS COUNT INTO RANGE...
C (SIMILAR TO CLASSICAL "CHOOSE" FUNCTION...)
C RETURNS 0.0 OR VALUE OF NTH ARG WHERE N IS INDEX OF ARG...
C	IF(KIRR.EQ.0)ACX=0.
	KIRR=KIRR+1
	IF(KIRR.EQ.1)IWRK1=VAR+1.
	IF(KIRR.NE.IWRK1)GOTO 2450
C SAVE LOCATION ALSO OF CELLS.
C THIS ALLOWS US TO FIND ADDRESSES OF SELECTED CELLS IN CHOOSE FOR ADDRESS MATH.
	AACP=KLKC
	AACQ=KLKR
	SS=VAR
2450	CONTINUE
	ACX=SS
	AC=ACX
	RETURN
2500	CONTINUE
	IF(INDEXF.NE.26)GOTO 2600
C AT2  ARCTAN OF 2 ARGS
	IF(SS.NE.0)RWRK1=AC
	IF(SS.EQ.0)RWRK1=VAR
	SS=SS+1.
	IF(SS.LE.1.1)GOTO 2505
	RWRK2=VAR
C GET 4 QUADRANT ARCTANGENT
	RWRK1=DATAN2(RWRK1,RWRK2)
2505	AC=RWRK1
	ACX=AC
	RETURN
2600	CONTINUE
	RETURN
	END
	SUBROUTINE DOMFCN(LINE,LLB,LRB,INDEXF,ACX)
C LLB = LOC OF [
C LRB = LOC OF ]
C INDEXF IS AS ABOVE. GUARANTEED IN RANGE 1-5.
	LOGICAL*1 LINE(110)
C +++++++++++++++++++++++++++++++++++
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1,EL=12
C	PARAMETER RRW = 32
C	PARAMETER RCL = 32 ! REAL ROWS, COLS
C	PARAMETER DRW = 8
C	PARAMETER DCL = 8 ! DISPLAY MAX ROWS, COLS.
C	PARAMETER RRCL = 1024
C PARAMETER RRCL=RRW*RCL
	LOGICAL*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	DIMENSION FORM(128),FVLD(RRWP,RCLP)
C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE
C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S
C SO INITIALLY IGNORE.
	InTEgeR*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	InTEgeR*4 TYPE(RRWP,RCLP),VLEN(9)
	REAL*8 XVBLS(RRWP,RCLP)
	LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP)
	INTEGER*4 JVBLS(2,RRWP,RCLP)
	EQUIVALENCE(JVBLS(1,1,1),XVBLS(1,1))
	REAL*8 XXX
	EQUIVALENCE(VBLS(1,1,1),XVBLS(1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	REAL*8 ACX,ACY
	REAL*8 AC,SS,CTR
	EQUIVALENCE(ACY,AVBLS(1,27))
	REAL*8 ACP,ACQ
	EQUIVALENCE(ACP,AVBLS(1,16)),(ACQ,AVBLS(1,17))
	InTEgeR*4 KDRW,KDCL
	COMMON /DOT/KDRW,KDCL
	LOGICAL*1 ILINE(106)
	InTEgeR*4 ILNFG,ILNCT
	COMMON/ILN/ILNFG,ILNCT,ILINE
	COMMON/FVLDC/FVLD
	InTEgeR*4 KLKC,KLKR
	REAL*8 AACP,AACQ
	COMMON/MSCMN/KLKC,KLKR,AACP,AACQ
C +++++++++++++++++++++++++++++++++++
C
C FIRST GET A VARIABLE NAME. ALL MATH FUNCTIONS REQUIRE VARIABLE
C NAMES SINCE THEIR VARIABLES ARE THEIR ONLY VALID ARGS.
	CALL MTHINI(INDEXF,AC,SS,CTR,ACX)
C SET UP PROPER INITS
C KV2=1 IF A 2ND VBL EXISTS
	LCR=LLB+1
	AACP=ACP
	AACQ=ACQ
C INITIALIZE P, Q SAVE ACCUMULATORS TO LET DOMATH SIGNAL
C COORDS OF SELECTED ITEMS IN P,Q FOR SELECTION TYPE FUNCTIONS.
100	CONTINUE
	KV2=0
	LB=LCR
	LE=LRB-1
	IF(LB.GE.LE)RETURN
	CALL VARSCN(LINE,LB,LE,LASST,ID1,ID2,IVALID)
	IF(IVALID.EQ.0)RETURN
	IF(LINE(LASST).NE.':')GOTO 110
	LB=LASST+1
	LE=LRB-1
	CALL VARSCN(LINE,LB,LE,LASST,ID1B,ID2B,IVALID)
	IF(IVALID.NE.0)KV2=1
110	CONTINUE
	CALL XVBLGT(ID1,ID2,XVBLS(1,1))
	XXX=XVBLS(1,1)
C	XXX=XVBLS(ID1,ID2)
	CALL TYPGET(ID1,ID2,TYPE(1,1))
C USE EQUIVALENCE OF JVBLS AND XVBLS
	IF(ABS(TYPE(1,1)).NE.2)XXX=JVBLS(1,1,1)
	KLKC=ID1
	KLKR=ID2-1
	CALL DOMATH(INDEXF,XXX,AC,SS,CTR,ACX)
	IF(KV2.EQ.0)GOTO 200
	IF(ID1.NE.ID1B) GOTO 120
	IF(ID2.GT.ID2B)GOTO 200
	M=ID2+1
	DO 121 MM=M,ID2B
	CALL XVBLGT(ID1,MM,XVBLS(1,1))
	XXX=XVBLS(1,1)
	CALL TYPGET(ID1,MM,TYPE(1,1))
C	XXX=XVBLS(ID1,MM)
	IF(ABS(TYPE(1,1)).NE.2)XXX=JVBLS(1,1,1)
	KLKC=ID1
	KLKR=MM-1
	CALL DOMATH(INDEXF,XXX,AC,SS,CTR,ACX)
121	CONTINUE
	GOTO 200
120	CONTINUE
	IF(ID2.NE.ID2B)GOTO 130
	IF(ID1.GT.ID1B)GOTO 200
	M=ID1+1
	DO 131 MM=M,ID1B
	CALL XVBLGT(MM,ID2,XVBLS(1,1))
	XXX=XVBLS(1,1)
C	XXX=XVBLS(MM,ID2)
	CALL TYPGET(MM,ID2,TYPE(1,1))
	IF(ABS(TYPE(1,1)).NE.2)XXX=JVBLS(1,1,1)
	KLKC=MM
	KLKR=ID2-1
	CALL DOMATH(INDEXF,XXX,AC,SS,CTR,ACX)
131	CONTINUE
130	CONTINUE
200	CONTINUE
C IF NEXT CHAR IS A COMMA, SKIP IT AND KEEP UP SCAN UNLESS DONE
	IF(LINE(LASST).EQ.',')GOTO 300
	ACP=AACP
	ACQ=AACQ
C USE P, Q ACCUMULATORS FROM DOMATH (OR THE ONES WE SAVED EARLIER...)
	RETURN
300	LCR=LASST+1
	GOTO 100
	END
	SUBROUTINE DOIF(LINE,LLB,LRB,LLAST)
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1,EL=12
	LOGICAL*1 LINE(110)
	REAL*8 V1,V2
	V1=0.
	V2=0.
	LS=LRB-LLB+1
	CALL GETLOG(LINE(LLB),LS,LOGTYP,LASST)
	LOV1=LLB
	LHIV1=LASST+LLB-1
	IF(LOV1.GE.LHIV1)GOTO 100
C USE SUM FUNCTION HERE AS TYPE OF FCN
	LT=4
	CALL DOMFCN(LINE,LOV1,LHIV1,LT,V1)
100	CONTINUE
	IF(LOGTYP.EQ.0)GOTO 1000
	LOV2=LASST+2+LLB
	LHIV2=LRB
	IF(LOV2.GE.LHIV2)GOTO 200
	LT=4
	CALL DOMFCN(LINE,LOV2,LHIV2,LT,V2)
200	CONTINUE
	CALL TEST(LOGTYP,LFLAG,V1,V2)
	IF(LFLAG.EQ.0)GOTO 700
C HERE HAVE "TRUE" ALTERNATIVE OF IF STMT
	LBAR=INDEX(LINE,'|')
	LBAR=MIN0(LBAR,LLAST)
	LSTM=LRB+1
C LSTM TO LBAR IS NOW THE STMT TO EVALUATE. SINCE WE ALREADY HAVE A
C ROUTINE TO EVALUATE A STMT, DO SO. NOTE PARTIAL RECURSION, SO
C NO NESTED IFS ALLOWED, AND CALL MUST PERMIT RECURSION ON YOUR
C MACHINE OR FORGET IT. (OK ON PDP11, VAX).
	LSZ=LBAR-LSTM+1
	IF(LSZ.LT.1)GOTO 1000
	CALL DOSTMT(LINE(LSTM),LSZ)
	GOTO 1000
700	CONTINUE
C HERE HAVE "FALSE" ALTERNATIVE OF IF STMT
	LBAR=INDEX(LINE,'|')+1
	LBAR=MIN0(LBAR,LLAST)
	LSZ=LLAST-LBAR+1
	IF(LSZ.LT.1)GOTO 1000
	CALL DOSTMT(LINE(LBAR),LSZ)
1000	CONTINUE
C THAT'S ALL.
	RETURN
	END
	SUBROUTINE GETLOG(LINE,LMX,LOGTYP,LASST)
	LOGICAL*1 LINE(110)
	LOGICAL*1 LFN(4,6)
	INTEGER*4 LF(6)
	EQUIVALENCE(LF(1),LFN(1,1))
	DATA LF/'.GT.','.LT.','.EQ.','.NE.','.GE.','.LE.'/
C LOGTYP RELATIONSHIP TO RELATIONSHIPS OF 2 VARIABLES
C IS DEFINED IN ABOVE DATA STMT.
C IF LINE CONTAINS STRING IN NAME, RETURN TYPE AND END LOC.
	LMX4=LMX-3
	DO 100 LL=1,6
	LOGTYP=LL
	DO 1 N1=1,LMX4
	IF(LINE(N1  ).NE.LFN(1,LL))GOTO 2
	IF(LINE(N1+1).NE.LFN(2,LL))GOTO 2
	IF(LINE(N1+2).NE.LFN(3,LL))GOTO 2
	IF(LINE(N1+3).NE.LFN(4,LL))GOTO 2
C HERE HAVE A MATCH
	LASST=N1
C RETURN LOC OF NEXT CHAR AFTER RELATION.
	GOTO 200
2	CONTINUE
1	CONTINUE
100	CONTINUE
	LOGTYP=0
200	CONTINUE
	RETURN
	END