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*4 NRC
	INTEGER*2 NRC2(2)
	EQUIVALENCE(NRC2(1),NRC)
	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
	INTEGER*2 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	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
	NRC=0
	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)
	IF(IPAT.NE.0)GOTO 1001
C UNINITIALIZED ARRAY ELEMENT: SET IT UP.
C HOWEVER DON'T REFER TO BIG ARRAY UNLESS WRITTEN TO...READ ALWAYS AS DEFAULT
1008	CONTINUE
	DO 1003 N=1,128
1003	ARRAY(N)=0
	ARRAY(1)='P'
	ARRAY(2)='#'
	ARRAY(3)='0'
	ARRAY(4)='#'
	ARRAY(5)='0'
	ARRAY(118)=15
	DO 1004 N=1,9
1004	ARRAY(N+119)=DEFFMT(N)
	GOTO 5000
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.
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
	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