SUBROUTINE WRKFIL(NREC,ARRAY,IFUNC)
C COPYRIGHT 1983,1984,1985 GLENN C.EVERHART
C PERMISSION IS GRANTED TO COPY, BUT NOT FOR PROFIT
C ** MUCH SIMPLER VERSION OF WRKFIL FOR VAX ONLY **
C USES BIG ARRAY (QFDAT) INSTEAD OF LOCAL PAGE.
C
C WORKFILE PSEUDO-MAINTAINER FOR VAX
C
C THIS ROUTINE IS INTENDED TO PERMIT THE SCRATCH FILE OF
C PORTACALC TO BE DISPENSED WITH BY USING A LARGE IN-MEMORY
C ARRAY. A BITMAP WILL SET UP WHEN THE ELEMENT IS INIT'ED AND
C THE DEFAULT ELEMENT WILL BE COMPUTED AND RETURNED
C IF AN UNINITIALIZED ELEMENT IS USED.
	INCLUDE 'VKLUGPRM.FTN'
	PARAMETER CUP=1
C
C
	INTEGER*4 NRC
	INTEGER*2 NRC2(2)
	EQUIVALENCE(NRC2(1),NRC)
C RECORD NUMBER TO ACCESS
	INTEGER*2 NREC,NRECWK
	LOGICAL*1 ARRAY(128)
	INTEGER*2 IFUNC
	INTEGER*2 IPGMAX,LPGMXF,IPGMOD,LPGMOD
	COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C
	INTEGER*2 NCEL,NXINI
	COMMON/NCEL/NCEL,NXINI
	INTEGER*2 MFID,IFID(8,LFMX),MFMOD
	INTEGER*2 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	LOGICAL*1 LFID(16,LFMX)
	integer*4 nnn,LLL,IPM,IHASH,JHASH,IBF,N,IPAG,KQ
	INTEGER*4 NNNW
	EQUIVALENCE(IFID(1,1),LFID(1,1))
	COMMON/FRM/MFID,IFID,MFMOD
	LOGICAL*1 LI,LJ,IBYTE
C DATA AREA. HANDLE AS "VIRTUAL FILE".
	INTEGER*4 QFID(LFM4X)
	EQUIVALENCE(QFID(1),LFID(1,1))
	INTEGER*4 QFDAT(LPDM),QVDAT(IPDM)
C HERE ADD DEFINITIONS FOR QLFID AND QIFID WHICH ARE THE WHOLE AREA
C TO BE USED. MAKE IT ALL ONE GIANT PAGE.
	LOGICAL*1 QLFID(16,LPDMF)
	INTEGER*2 QIFID(8,LPDMF)
	EQUIVALENCE(QLFID(1,1),QIFID(1,1),QFDAT(1))
	COMMON/QVCMN/QVDAT,QFDAT
C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2
	LOGICAL*1 DEFFMT(10),DVFMT(12)
	EQUIVALENCE(DVFMT(2),DEFFMT(1))
	COMMON/DEFVBX/DVFMT
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.)
	LOGICAL*1 FMTDAT(9,45)
	COMMON/FMTBFR/FMTDAT
C
C
C DEFINE FILE AREAS FOR MAPPING FILES...
C ONE INPUT FILE, TO BE ACCESSED AS A RANDOM ACCESS FILE OF 128 BYTE
C RECORDS OF DATA IF RANDOM, OR AS A FORMULA FILE IF SEQUENTIAL, AND
C ONE OUTPUT FILE TO BE WRITTEN THE SAME WAY. INPUT FILE CAN BE
C INPUT - ONLY OR READ/WRITE.
C
C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL)
C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED.
C
C MFIOPN =	0	IF NOT OPEN
C		1	IF OPEN FOR READ ONLY, SEQUENTIAL
C		2	IF OPEN READ ONLY, RANDOM
C		3	IF OPEN READ/WRITE, RANDOM.
C
C MFOOPN =	0	IF NOT OPEN
C		1	IF OPEN WRITE SEQUENTIAL
C		2	IF OPEN WRITE RANDOM
C
C OTHER OPTIONS DON'T MAKE SENSE.
C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS
C MFILUN,MFOLUN ARE LOGICAL UNITS.
	INTEGER*2 MFILO,MFOLO
	INTEGER*2 MFIOPN,MFIRL,MFIRH,MFICL,MFICH
	INTEGER*2 MFOOPN,MFORL,MFORH,MFOCL,MFOCH
	INTEGER*2 MFILUN,MFOLUN,MFIFLG,MFOFLG
	COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH,
     1  MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG
C
C
C IFUNC SPECIFIES WHAT TO DO:
C	=0	READ INTO ARRAY
C	=1	WRITE FROM ARRAY INTO WRKARY
C	=2	INITIALIZE (JUST CLEARS BITMAP HERE)(OPEN)
C	=3	CLOSE (CLEARS BITMAP HERE)
	IF(IFUNC.LT.0.OR.IFUNC.GT.3)RETURN
	JFUN=IFUNC+1
	GOTO (1000,2000,3000,4000),JFUN
1000	CONTINUE
C READ
	CALL FVLDGT(NREC,1,IBYTE)
	IF(IBYTE.NE.0)GOTO 1001
C UNINITIALIZED ARRAY ELEMENT: SET IT UP.
	DO 1003 N=1,128
1003	ARRAY(N)=0
	ARRAY(1)='P'
	ARRAY(2)='#'
	ARRAY(3)='#'
C ADD EXTRA 0 SO WE CAN TELL WHY LOCATE FAILED
	ARRAY(118)=15
	DO 1004 N=1,9
1004	ARRAY(N+119)=DEFFMT(N)
C RETURN THE DEFAULT FORMAT NOW.
	RETURN
1001	CONTINUE
	DO 1053 N=1,128
1053	ARRAY(N)=0
	ARRAY(119)=IBYTE
	ARRAY(118)=15
	ARRAY(1)='0'
C LET ARRAY INITIALLY BE SET SENSIBLY..
	DO 1054 N=1,9
1054	ARRAY(N+119)=DEFFMT(N)
C WE MAY MODIFY FORMAT LATER TOO...
C NOW HAVE A NON-DEFAULT ELEMENT TO READ... GO THROUGH SYMBOL TBL LOGIC
C FOR THESE, WE USE 16-BYTE "CELLS" WHICH HAVE THE FOLLOWING FORMAT:
C	ID	2 BYTES (CELL ADDRESS, MUST BE 1 OR MORE FOR VALID)
C	FLAG	1 BYTE  (TYPE OF CELL:
C				0 = UNUSED
C				1 = 1 OF 1 CELLS
C				2 = NONTERMINAL OF MORE THAN 1 CELL
C				3 = LAST OF >1 CELLS
C	FORMAT	1 BYTE  (INDEX OF FORMAT STRING FOR THIS CELL; FORMATS
C				ARE STORED RESIDENT, UP TO 45 OF THEM,
C				SET BY DF COMMAND.)
C	FORMULA	12 BYTES  (FORMULA TEXT)
C SET UP HASH CODE NOW FOR THE WAY WE NEED...
CC NOW HAVE THE DESIRED MEMORY PAGE; READ THE FORMULA INTO ARRAY
CC BUFFER.
	IARSUB=1
CC FOR SIMPLICITY FORGET THE HASHCODE WITHIN MEMORY BUFFERS, JUST SEARCH
CC FROM START...
	IFLAG=0
	IFMT=0
	JHASH=NREC*9
c  use 9 times the record id for hash value so that longer formulae
c get spaced out better.
	NRECWK=NREC

	DO 2500 NN=1,LFMY
	n=mod((nn+jhash),LPDMF)+1
C SKIP IF WE GET 0 ID CELL INDICATING NEVER-INITIALIZED CELL.
	IF(NN.GT.2.AND.QIFID(1,N).EQ.0)GOTO 2505
C SKIP OUT IF HIT A VIRGIN CELL AFTER 3 TRIES
	IF(QIFID(1,N).NE.NRECWK)GOTO 2500
	IFLAG=QLFID(3,N)
	IF(IFMT.EQ.0)IFMT=QLFID(4,N)
	DO 2502 K=1,12
	LI=QLFID(K+4,N)
C COPY FORMULA TEXT INTO ARRAY. END ON NULLS...
	IF(LI.LE.0)GOTO 2500
	ARRAY(IARSUB)=LI
C KEEP NULLS AFTER ANYTHING ENTERED...
	ARRAY(IARSUB+1)=0
	ARRAY(IARSUB+2)=0
	IARSUB=IARSUB+1
2502	CONTINUE
	IF(IFLAG.EQ.1.OR.IFLAG.EQ.3)GOTO 2505
2500	CONTINUE
2505	CONTINUE
C GET FORMAT NOW...
	IF(IFMT.LE.0)RETURN
	DO 2510 N=1,9
2510	ARRAY(119+N)=FMTDAT(N,IFMT)
C NOW MODFIY BY READING FROM FILE IF PRESET TO DO SO.
	CALL FNDRC(NREC,ARRAY,JFUN)
	GOTO 5000
2000	CONTINUE
C WRITE
C NOW SET INIT'D BIT; WRITE ARRAY ELEMENT OUT.
C FIRST FIND FORMAT AREA OR SET IT UP.
	IFMT=0
	LFF=0
C FAKE OUT THE SAVING OF FVLD INFO IN THIS ARRAY TOO.
C THIS IS INCOMPLETE AND NO LITTLE OF A KLUDGE BUT THE CODE WILL
C GENERALLY SET THEM TOGETHER, AND THIS GUARANTEES THAT IF
C FURTHER SETS TRY TO SET FVLD TO ARRAY(119), THEY'LL WORK AS
C THEY SHOULD.
C HERE SET MAX ARRAY ELEMENTS USED
C EXPECT (ID2-1)*RRW+ID1
C ID1 IS RRW DIM, ID2 IS RCL DIM
	NRC2(1)=NREC
	IRUSED=MOD(NRC,RRW)
	ICUSED=((NRC-IRUSED)/RRW)+1
	IF(ICUSED.GT.RCLACT)RCLACT=ICUSED
	IF(IRUSED.GT.RRWACT)RRWACT=IRUSED
C SET RRWACT, RCLACT
	IF(ARRAY(119).NE.0)CALL FVLDST(NREC,1,ARRAY(119))
	DO 2011 N=1,45
	IF(FMTDAT(1,N).LE.0.AND.LFF.EQ.0)LFF=N
C SAVE FIRST FREE FORMAT AREA IN CASE THIS IS A NEW FORMAT...
	DO 2010 M=1,9
	IF(ARRAY(M+119).NE.FMTDAT(M,N))GOTO 2011
2010	CONTINUE
	IFMT=N
	GOTO 2012
2011	CONTINUE
C ON FALL THROUGH, WE FOUND NOTHING FOR IT...
C USE HIS FORMAT UNLESS WE HAVE NO ROOM, IN WHICH CASE USE LAST AREA
	IF(LFF.EQ.0)LFF=45
	IFMT=LFF
	DO 2013 N=1,9
2013	FMTDAT(N,LFF)=ARRAY(119+N)
C SAVE FORMAT DATA WE NOW POINT TO...
2012	CONTINUE
C NOW THE HARDER PART... MUST WRITE THE ARRAY'S FORMULA TOO...
C	IPM=(LPGMXF*64/LFM)+1
	IARSUB=1
C FOR SIMPLICITY FORGET THE HASHCODE WITHIN MEMORY BUFFERS, JUST SEARCH
C FROM START...
C OMIT THE ZEROING WHEN READING IN FROM FILE EXCEPT IN /MERGE MODE
	JHASH=NREC*9
	IF(NXINI.NE.0)GOTO 6233
c note that because we detect virgin entries (0 contents), we pay
c essentially no penalty for having one giant page. Here we only
c optimize storage by using no more for formulas than is really
c needed. We also avoid continual copying to/from a working page
c which is needed in the PDP11 (or MSDOS) environment. The system
c needs a fair amount of virtual address space to make this work,
c but VMS provides that.
	DO 1490 NN=1,LFMY
	n=mod((nn+jhash),LPDMF)+1
	IF(NN.GE.2.AND.QIFID(1,N).EQ.0)GOTO 6233
	IF(QIFID(1,N).NE.NREC)GOTO 1490
C ZERO OLD RECORDS OF THIS ONE...
	NCEL=NCEL-1
	IF(NCEL.LT.0)NCEL=0
	DO 1498 KK=1,8
C SET TO -1 TO FLAG NON VIRGIN CELL BUT NOTHING IN IT.
1498	QIFID(KK,N)=-1
1490	CONTINUE
6233	CONTINUE
	IFLAG=0
	DO 1500 NN=1,LFMY
	n=mod((nn+jhash),LPDMF)+1
	IF(QIFID(1,N).NE.-1.AND.QIFID(1,N).NE.0
     1     .AND.QIFID(1,N).NE.NREC)GOTO 1500
C FOUND A NULL NODE...
C FILL IT IN NOW.
	NCEL=NCEL+1
	QIFID(1,N)=NREC
	IFLAG=1
	QLFID(4,N)=IFMT
	QLFID(3,N)=IFLAG
	DO 1502 K=1,12
	LI=ARRAY(IARSUB)
	IF(LI.LE.0)GOTO 1505
C CHOP IT OFF AT 109 ALSO...
	IF(IARSUB.GT.109)GOTO 1560
	QLFID(K+4,N)=LI
	IARSUB=IARSUB+1
1502	CONTINUE
C NONTERMINAL COPY...NEED ANOTHER CELL. FIRST TEST FOR EXACT FIT,
C HOWEVER.
	IF(ARRAY(IARSUB).LE.0)GOTO 1560
	IFLAG=2
	QLFID(3,N)=IFLAG
C NOW GO GET MORE SPACE FOR NEXT NODE.
C NOTE IT COULD RUN OUT, BUT JUST PUNT THAT.
	GOTO 1500
1560	CONTINUE
	IF(IFLAG.EQ.1)IFLAG=3
	QLFID(3,N)=IFLAG
C SETS UP EITHER 1 OR 3 FOR TERMINAL NODES
	GOTO 1505
C ESCAPE FROM LOOP ON ENDS...
1500	CONTINUE
C HERE WE RAN OUT OF ROOM. TOO BAD...CAN'T REALLY HELP IT OR
C DO MUCH. JUST FORGET IT.
C HOWEVER, PRINT A MESSAGE ON SCREEN AT LEAST...
	CALL UVT100(CUP,1,1)
	WRITE(6,8970)
8970	FORMAT(' Formula area overflowed. Save, use larger version.')
1505	CONTINUE
C DONE NOW.
C TAKE ARRAY AND WRITE TO AUX FILE IF REQUIRED TO DO SO HOWEVER.
	CALL FNDRC(NREC,ARRAY,JFUN)
	GOTO 5000
3000	CONTINUE
C OPEN (CLR BITMAP)
	MFID=0
	GOTO 5000
4000	CONTINUE
C CLOSE (CLR BITMAP)
c	CLOSE(UNIT=7,DISP='DELETE')
	MFID=0
5000	RETURN
	END
	SUBROUTINE FNDRC(IREC,ARRAY,IFCT)
	INTEGER*2 IREC,IRRR,ICCC,IRREC,IFCT
	LOGICAL*1 ARRAY(128)
C IREC= INPUT INDEX
C IRRR,ICCC ARE EQUIV COL,ROW INDICES
C IRREC = RECORD EQUIV. IN FILE
C IFCT = 1 FOR READ, 2 FOR WRITE
C IF 1, THEN USE READING INTO ARRAY.
C IF 2, THEN WRITING FROM ARRAY TO FILE.
C ARRAY GETS MODIFIED AS NEEDED.
	INCLUDE 'VKLUGPRM.FTN'
C
C
C DEFINE FILE AREAS FOR MAPPING FILES...
C ONE INPUT FILE, TO BE ACCESSED AS A RANDOM ACCESS FILE OF 128 BYTE
C RECORDS OF DATA IF RANDOM, OR AS A FORMULA FILE IF SEQUENTIAL, AND
C ONE OUTPUT FILE TO BE WRITTEN THE SAME WAY. INPUT FILE CAN BE
C INPUT - ONLY OR READ/WRITE.
C
C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL)
C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED.
C
C MFIOPN =	0	IF NOT OPEN
C		1	IF OPEN FOR READ ONLY, SEQUENTIAL
C		2	IF OPEN READ ONLY, RANDOM
C		3	IF OPEN READ/WRITE, RANDOM.
C
C MFOOPN =	0	IF NOT OPEN
C		1	IF OPEN WRITE SEQUENTIAL
C		2	IF OPEN WRITE RANDOM
C
C OTHER OPTIONS DON'T MAKE SENSE.
C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE
C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS
C MFILUN,MFOLUN ARE LOGICAL UNITS.
	INTEGER*2 MFIOPN,MFIRL,MFIRH,MFICL,MFICH
	INTEGER*2 MFOOPN,MFORL,MFORH,MFOCL,MFOCH
	INTEGER*2 MFILUN,MFOLUN,MFIFLG,MFOFLG
	COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH,
     1  MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG
	LOGICAL*1 WRK(128)
C
C
	IF(MFIOPN.EQ.0.AND.MFOOPN.EQ.0)RETURN
C DON'T DO ANY WORK IF NO FILE ARE OPEN...JUST SKIP OUT FAST.
	NRC=IREC
	IRRR=MOD(NRC,RRW)
	ICCC=((NRC-IRUSED)/RRW)+1
C NOW HAVE OFFSETS IN INPUT RECORD
C (GUARTANTEED TO BE IN REAL SHEET...REFLECT NOT REQUIRED.)
	IF(MFIOPN.LE.0)GOTO 1000
	IF(IFCT.EQ.2.AND.MFIOPN.LE.2)GOTO 1000
	IF(MFIFLG.EQ.0)GOTO 1000
C ONLY WRITE INTO FILE(IFCT=2) IF FILE OPENED FOR UPDATE.
C FIRST SEE IF THIS RECORD IS IN RANGE WE CARE ABOUT.
	IF(IRRR.LT.MFIRL.OR.IRRR.GT.MFIRH.OR.ICCC.LT.MFICL
     1  .OR.ICCC.GT.MFICH)GOTO 1000
C IF WE MADE IT HERE WE HAVE A RECORD IN THE "IN" FILE RANGE
C TO DEAL WITH.
	NRR=MFIRH-MFIRL+1
	NCC=MFICH-MFICL+1
	NNRR=IRRR-MFIRL+1
	NNCC=ICCC-MFICL+1
	KREC=(NNRR-1)*NCC+NNCC
	IF(IFCT.EQ.2)GOTO 500
	IF(MFIOPN.EQ.1)READ(MFILUN,400,END=5000,ERR=5000)WRK
400	FORMAT(128A1)
	IF(MFIOPN.EQ.2)READ(MFILUN'KREC,ERR=5000)WRK
C HAVING READ THE INPUT FILE, GRAB THE FORMULA PART AND RETURN
C IT. FORGET FORMAT PART; LET THAT BE UNDER SPREADSHEET
C CONTROL.
	DO 450 KREC=1,110
450	ARRAY(KREC)=WRK(KREC)
	GOTO 1000
500	CONTINUE
C WRITE FROM ARRAY TO FILE ON RANDOM RECORD.
	WRITE(MFILUN'KREC,ERR=5000)ARRAY
1000	CONTINUE
	IF(MFOOPN.LE.0)GOTO 2000
	IF(IFCT.NE.2)GOTO 2000
	IF(MFOFLG.EQ.0)GOTO 2000
	IF(IRRR.LT.MFORL.OR.IRRR.GT.MFORH.OR.ICCC.LT.MFOCL
     1  .OR.ICCC.GT.MFOCH)GOTO 2000
	NRR=MFORH-MFORL+1
	NCC=MFOCH-MFOCL+1
	NNRR=IRRR-MFORL+1
	NNCC=ICCC-MFOCL+1
	KREC=(NNRR-1)*NCC+NNCC
	IF(MFOOPN.GT.1)WRITE(MFOLUN'KREC,ERR=6000)ARRAY
	IF(MFOOPN.EQ.1)WRITE(MFOLUN,400,ERR=6000)
     1  (ARRAY(KREC),KREC=1,110)
2000	CONTINUE
	RETURN
5000	CONTINUE
	CLOSE(UNIT=MFILUN)
	MFIOPN=0
	RETURN
6000	CONTINUE
	CLOSE(UNIT=MFOLUN)
	MFOOPN=0
	RETURN
	END