SUBROUTINE WRKFIL(NREC,ARRAY,IFUNC)
C COPYRIGHT 1983 GLENN C.EVERHART
C PERMISSION IS GRANTED TO COPY, BUT NOT FOR PROFIT
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'
C
C
	INTEGER NREC ! RECORD NUMBER TO ACCESS
	LOGICAL*1 ARRAY(128)
	INTEGER IFUNC
C
C THE ACTUAL WORK ARRAY: 128 BY RRCL
	LOGICAL * 1 WRKARY(128,RRCL)
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
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)
	LOGICAL*1 BMAP(BRRCL)
	INTEGER BITS(8)
	DATA BITS/1,2,4,8,16,32,64,128/
	IF(IFUNC.LT.0.OR.IFUNC.GT.3)RETURN
	JFUN=IFUNC+1
	GOTO (1000,2000,3000,4000),JFUN
1000	CONTINUE
C READ
	IBYTE=1+((NREC-1)/8)
	IBIT=1+((NREC-1).AND.7)
C COMPUTE BIT IN BITMAP TO SEE IF THIS CELL IS INITIALIZED AND
C SET INIT'D BIT UNCONDITIONALLY; WE INIT THE CELL
C HERE IF IT WASN'T.
	IWRK=BMAP(IBYTE)
	IPAT=IWRK.AND.BITS(IBIT)
	IPAT2=IWRK.OR.BITS(IBIT)
C SET INIT'D BIT...
	BMAP(IBYTE)=IPAT2
	IF(IPAT.NE.0)GOTO 1001
C UNINITIALIZED ARRAY ELEMENT: SET IT UP.
	DO 1003 N=1,128
1003	WRKARY(N,NREC)=0
	WRKARY(1,NREC)='0'
	WRKARY(2,NREC)='.'
	WRKARY(118,NREC)=15
	DO 1004 N=1,9
1004	WRKARY(N+119,NREC)=DEFFMT(N)
1001	CONTINUE
C NOW WITH (POSSIBLY NEWLY INITIALIZED) WRKARY ELEMENT,
C FILL IN RETURN RESULT.
	DO 1002 N=1,128
1002	ARRAY(N)=WRKARY(N,NREC)
	GOTO 5000
2000	CONTINUE
C WRITE
	IBYTE=1+((NREC-1)/8)
	IBIT=1+((NREC-1).AND.7)
	IWRK=BMAP(IBYTE)
	IPAT2=IWRK.OR.BITS(IBIT)
C SET INIT'D BIT...
	BMAP(IBYTE)=IPAT2
C NOW SET INIT'D BIT; WRITE ARRAY ELEMENT OUT.
	DO 2001 N=1,128
2001	WRKARY(N,NREC)=ARRAY(N)
	GOTO 5000
3000	CONTINUE
C OPEN (CLR BITMAP)
	DO 3001 N=1,BRRCL
3001	BMAP(N)=0
	GOTO 5000
4000	CONTINUE
C CLOSE (CLR BITMAP)
	DO 4001 N=1,BRRCL
4001	BMAP(N)=0
5000	RETURN
	END