C 2-PAGE WSHEET
        SUBROUTINE WSSET
C WORK SHEET MANAGMENT ROUTINES
C HANDLE SPREADSHEET "IN MEMORY" STORAGE
C COPYRIGHT GLENN EVERHART 1983
C
C ALL RIGHTS RESERVED
C
C WSSET - INITIALIZE STORAGE TO START CONDITIONS
        INCLUDE 'VKLUGPRM.FTN'
C EXPECT IMPLEMENTATION TO USE A COMMON BITMAP AND PROVIDE A VARIABLE
C NCEL TO TELL HOW MANY CELLS ARE IN USE
C NEXT BITMAPS IMPLEMENT FVLD
	PARAMETER CUP=1
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
        INTEGER*2 IPGMAX,LPGMXF
        COMMON/FILEMX/IPGMAX,LPGMXF
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C USE LUN 7 FOR FORMULAS, 9 FOR VALUES FILE IF NEEDED...
        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
	INTEGER*2 DLFG
	COMMON/DLFG/DLFG
        LOGICAL*1 ITYP(BRRCL)
        INTEGER*2 IATYP(27),LINTGR
        COMMON/TYP/IATYP,ITYP,LINTGR
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45)
        COMMON/FMTBFR/FMTDAT
        LOGICAL*1 DVF(12),DFMT(10)
        EQUIVALENCE(DVF(2),DFMT(1))
        COMMON/DEFVBX/DVF
        INTEGER*2 LVALBF(5,LVBF),MPAG(2),MPMOD
	DIMENSION MPMOD(2),MFMOD(2)
        COMMON/VB/MPAG,LVALBF,MPMOD
        INTEGER*2 MFID(2),IFID(8,LFM),MFMOD
        LOGICAL*1 LFID(16,LFM)
        EQUIVALENCE(IFID(1,1),LFID(1,1))
        COMMON/FRM/MFID,IFID,MFMOD
	INTEGER*2 MFLAST,MFBASE,MVLAST,MVBASE
	COMMON/VBCTL/MFLAST,MFBASE,MVLAST,MVBASE
C
        COMMON /NCEL/NCEL,NXINI
        IBP=1
	LINTGR=0
	MPMOD(1)=0
	MFMOD(1)=0
	MPMOD(2)=0
	MFMOD(2)=0
	DLFG=0
C FLAG DLFG=0 ==> NO D## FORMS YET
        DO 2 N=1,9
2       FMTDAT(N,1)=DFMT(N)
        DO 3 N=2,45
        DO 3 NN=1,9
3       FMTDAT(NN,N)=0
        DO 1 N=1,8
        LBITS(N)=128/IBP
1       IBP=IBP+IBP
        DO 4 N=1,BRRCL
C CLEAR BITMAPS NOW
        FV1(N)=0
        FV2(N)=0
        FV4(N)=0
4       ITYP(N)=0
C OPEN THE WORK FILES SO WE DON'T NEED TO LATER...
C LUN 7 IS FORMULAS; LUN 9 IS VALUES
C HOWEVER, IF IPGMAX IS LESS THAN LVBF/205 (INDICATING ENTIRE FILE
C FITS IN MEMORY) DON'T OPEN LUN 9 AND IF LPGMXF IS < LFM/64, LIKEWISE
C FOR LUN 7.
C INITIALLY CLOSE FILES IN CASE THEY WERE OPEN...
        CLOSE(UNIT=7,DISP='DELETE')
        CLOSE(UNIT=9,DISP='DELETE')
C NOW OPEN THEM AS RANDOM ACCESS FILES.
        NBK=IPGMAX*2
C KEEP VALUE PAGES IN 500 BYTE UNITS, NOT 512 BYTE UNITS, TO COME
C OUT EVEN...
        IF(IPGMAX.GT.(LVBF/100))OPEN(UNIT=9,FILE='PVBL.TMP',
     1  ACCESS='DIRECT',DISPOSE='DELETE',FORM='UNFORMATTED',
     2  INITIALSIZE=NBK,BLOCKSIZE=500,RECORDTYPE='FIXED',
     3  RECL=125,STATUS='NEW')
        NBK=LPGMXF*2
        IF(LPGMXF.GT.(LFM/64))OPEN(UNIT=7,FILE='PFMT.TMP',
     1  ACCESS='DIRECT',DISPOSE='DELETE',FORM='UNFORMATTED',
     2  INITIALSIZE=NBK,BLOCKSIZE=512,RECORDTYPE='FIXED',
     3  RECL=128,STATUS='NEW')
C SET NOTHING IN MEMORY YET
        MFID(1)=0
        MPAG(1)=0
	MFID(2)=0
	MPAG(2)=0
	MFLAST=1
	MFBASE=0
	MVLAST=1
	MVBASE=0
C MARK BUFFER 1 AS LAST ONE BUT BOTH REALLY EMPTY AT START
C ZERO MEMORY BUFFER AND FILES
C SET TO -1 SO WE CAN RECOGNIZE VIRGIN CELLS
        DO 9 N=1,LVBF
        DO 9 M=1,5
9       LVALBF(M,N)=-1
        NPG=(IPGMAX*2)
        IF(IPGMAX.LE.(LVBF/100))GOTO 11
        DO 10 N=1,NPG
10      WRITE(9'N)((LVALBF(K,KKK),K=1,5),KKK=1,50)
11      CONTINUE
C AGAIN FLAG VIRGIN CELLS WITH ID OF -1
        DO 12 N=1,LFM
        DO 12 M=1,8
12      IFID(M,N)=-1
	NPG=LPGMXF*2
        IF(LPGMXF.LE.(LFM/64))GOTO 14
        DO 13 N=1,NPG
13      WRITE(7'N)((IFID(K,KKK),K=1,8),KKK=1,32)
14      CONTINUE
C SET ALL AC'S TO TYPE FLOATING...
        DO 8 N=1,27
8       IATYP(N)=2
C TYPE 2 IS REALS (DEFAULT)
        NCEL=0
	NXINI=0
        RETURN
        END
C
	SUBROUTINE FVPEEK(ID1,ID2,IGO)
C PEEK INTO FV1 THRU FV4 INDICES TO FIND COMPUTABLE CELLS. REQUIRES
C FV4 BIT OFF, FV1 OR F2 BIT ON (OR BOTH). DESIGNED AS WAY FOR
C RECALC TO CHEAT AND SKIP QUICKLY BY CELLS NOT IN MAP. IGO GETS
C START INDEX FOR ID1 WITHIN RANGE OF ID1 FROM 1 TO RRW
C
	INCLUDE 'VKLUGPRM.FTN'
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
        COMMON/FVLDM/FV1,FV2,FV4
	IGO=ID1
C DEFAULT IS ID1 IS GIVEN TO IGO.
C        ID=(ID2-1)*RRW+ID1
	IRRR=ID2*RRW
	ID=IRRR-RRW+ID1
        IBYT=((ID-1)/8)+1
	IRRR=((IRRR-1)/8)+1
C IGO MUST NEVER GET BIGGER THAN RRW
	DO 1 N=IBYT,IRRR
	III=N
	IF(FV1(N).NE.0.OR.FV2(N).NE.0)GOTO 2
C SKIP BY UNLESS FV1 OR FV2 BITS ARE SET. ALLOW LABELS BY HERE SINCE
C THIS IS A CRUDE TEST FOR MOSTLY TOTALLY UNINITIALIZED CELLS.
1	CONTINUE
C ON FALL THROUGH WE LEAVE III AT MAX TO SKIP THIS AREA
2	CONTINUE
	N=((III-1)*8)+1
C COMPUTE FIRST CELL OF BITMAP BLK WE FOUND, RETURN IT AS NEW INDEX
C UNLESS ALREADY PAST IT...
	N=N-RRW*(ID2-1)
C NOTE WE PICK RRW IF N IS BIGGER SINCE WE CHECK ON AN INNER LOOP ONLY.
	IF(N.GT.IGO)IGO=MIN0(N,RRW)
	RETURN
	END
        SUBROUTINE TYPGET(ID1,ID2,IVAL)
C
C TYPGET - GET TYPE(RRW,RCL) ARRAY WORDS BACK
C RETURN TYPE(ID1,ID2) IN IVAL, BUT NOT REALLY...
        INCLUDE 'VKLUGPRM.FTN'
C NEXT BITMAPS IMPLEMENT FVLD
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
	INTEGER*2 ICREF,IRREF
	COMMON/MIRROR/ICREF,IRREF
        COMMON/BITS/LBITS
        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        LOGICAL*1 ITYP(BRRCL)
        INTEGER*2 IATYP(27),IVAL,LINTGR
        COMMON/TYP/IATYP,ITYP,LINTGR
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45)
        COMMON/FMTBFR/FMTDAT
        LOGICAL*1 ITST
        IF(ID1.LE.27.AND.ID2.LE.1)GOTO 1000
	IVAL=2
	IF(LINTGR.EQ.0)RETURN
	CALL FVLDGT(ID1,ID2,ITST)
	IF(ITST.EQ.0)GOTO 500
	CALL REFLEC(ID2,ID1,ID)
C        ID=(ID2-1)*RRW+ID1
        IBT=(ID-1)/8
        IBIT=((ID-1).AND.7)+1
        ITST=ITYP(IBT).AND.LBITS(IBIT)
500     IVAL=2
        IF(ITST.NE.0)IVAL=4
        RETURN
1000    CONTINUE
C AN AC. RETURN FULL TYPE WORD
        IVAL=IATYP(ID1)
        RETURN
        END
        SUBROUTINE TYPSET(ID1,ID2,IVAL)
C
C TYPSET - STORE IVAL IN TYPE(RRW,RCL) ARRAY
        INCLUDE 'VKLUGPRM.FTN'
C NEXT BITMAPS IMPLEMENT FVLD
	INTEGER*2 IVAL
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        LOGICAL*1 ITYP(BRRCL)
        INTEGER*2 IATYP(27),LINTGR
        COMMON/TYP/IATYP,ITYP,LINTGR
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45)
        COMMON/FMTBFR/FMTDAT
	INTEGER*2 ICREF,IRREF
	COMMON/MIRROR/ICREF,IRREF
        LOGICAL*1 ITST,ITST2
        IF(ID2.LE.1.AND.ID1.LE.27)GOTO 200
C SKIPPED THE AC'S HERE. RETURN INSTANTLY IF NO INTEGER
C CELLS HAVE BEEN DEFINED (WHICH WILL BE MOST OF THE TIME)
	IF(LINTGR.EQ.0.AND.IABS(IVAL).EQ.2)RETURN
	LINTGR=1
C        ID=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,ID)
        IBT=(ID-1)/8
        IBIT=((ID-1).AND.7)+1
        ITST2=.NOT.LBITS(IBIT)
        ITST2=ITYP(IBT).AND.ITST2
        ITST=ITYP(IBT).OR.LBITS(IBIT)
        ITYP(IBT)=ITST2
        IF(IVAL.NE.-2.AND.IVAL.NE.2)ITYP(IBT)=ITST
	RETURN
200	CONTINUE
        IATYP(ID1)=IVAL
        RETURN
        END
        SUBROUTINE FVLDGT(ID1,ID2,IVAL)
C
C FVLDGT - RETURN FVLD BYTE GIVEN 2 DIMS OF ITS "LOCATION"
        INTEGER*2 ID1,ID2
        LOGICAL*1 IVAL
        INCLUDE 'VKLUGPRM.FTN'
C NEXT BITMAPS IMPLEMENT FVLD
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
        COMMON/FVLDM/FV1,FV2,FV4
	INTEGER*2 ICREF,IRREF
	COMMON/MIRROR/ICREF,IRREF
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        LOGICAL*1 ITYP(BRRCL)
        INTEGER*2 IATYP(27)
        COMMON/TYP/IATYP,ITYP
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45)
        COMMON/FMTBFR/FMTDAT
        LOGICAL*1 I1,I2,I4
	IF(ID2.GT.0)GOTO 2000
C TRICK ENTRY USING ID IN FIRST ARG, 0 IN 2ND ARG...
C TELL XVBLST/XVBLGT ABOUT FV4 STATE (SET BY CALL WITH -4 BYTE ON FVLDST)
	ID=ID1
        IBT=((ID-1)/8)+1
        IBIT=((ID-1).AND.7)+1
        I1=FV1(IBT).AND.LBITS(IBIT)
        I2=FV2(IBT).AND.LBITS(IBIT)
        I4=FV4(IBT).AND.LBITS(IBIT)
	IVAL=0
C RETURN NONZERO IF ANY BITS ARE SET.
	IF((I1+I2+I4).NE.0)IVAL=1
	RETURN
2000	CONTINUE
C        ID=(ID2-1)*RRW+ID1
	IF(ID2.EQ.1.AND.ID1.LE.RRCL)ID=ID1
	IF(ID2.NE.1.OR.ID1.GT.RRCL)CALL REFLEC(ID2,ID1,ID)
        IBT=((ID-1)/8)+1
        IBIT=((ID-1).AND.7)+1
        I1=FV1(IBT).AND.LBITS(IBIT)
        I2=FV2(IBT).AND.LBITS(IBIT)
        I4=FV4(IBT).AND.LBITS(IBIT)
        IVL=0
        IF(I1.NE.0)IVL=1
        IF(I2.NE.0)IVL=IVL+2
        IF(I4.NE.0)IVL=-IVL
        IVAL=IVL
C READS OFF FVLD BYTE FROM 3 BITS, HIGH ONE IS SIGN. TREAT AS SIGN-
C MAGNITUDE NUMBER IN RANGE -3 TO +3,
        RETURN
        END
        SUBROUTINE FVLDST(ID1,ID2,IVAL)
C
C FVLDST - SET THE BYTE IN FVLD ARRAY
        INCLUDE 'VKLUGPRM.FTN'
C NEXT BITMAPS IMPLEMENT FVLD
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 IVAL
	INTEGER*2 ICREF,IRREF
	COMMON/MIRROR/ICREF,IRREF
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        LOGICAL*1 ITYP(BRRCL)
        INTEGER*2 IATYP(27)
        COMMON/TYP/IATYP,ITYP
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45)
	INTEGER*2 IVV,I1,I2,I3
        COMMON/FMTBFR/FMTDAT
C        LOGICAL*1 I4
	IF(ID2.EQ.1.AND.ID1.LE.RRCL)GOTO 7800
C        ID=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,ID)
	GOTO 7801
7800	CONTINUE
	ID=ID1
7801	CONTINUE
        IBT=((ID-1)/8)+1
        IBIT=((ID-1).AND.7)+1
C ZERO ALL 3 FVLD BITS FIRST
        FV1(IBT)=FV1(IBT).AND..NOT.LBITS(IBIT)
        FV2(IBT)=FV2(IBT).AND..NOT.LBITS(IBIT)
        FV4(IBT)=FV4(IBT).AND..NOT.LBITS(IBIT)
	IVVV=IVAL
        IVV=IABS(IVVV)
        I3=0
        IF(IVAL.LT.0)I3=1
	I1=0
	I2=0
        I2=IVV.AND.2
        I1=IVV.AND.1
C NOTE WE ASSUME HEAVILY THAT LOGICAL OPERATIONS WORK BY BINARY
C ANDS AND ORS IN DATA.
        IF(I1.NE.0)FV1(IBT)=FV1(IBT).OR.LBITS(IBIT)
        IF(I2.NE.0)FV2(IBT)=FV2(IBT).OR.LBITS(IBIT)
        IF(I3.NE.0)FV4(IBT)=FV4(IBT).OR.LBITS(IBIT)
        RETURN
        END
        SUBROUTINE VBLGET(ID1,ID2,ID3,IVAL)
C
C VBLGET - GET BYTE OF 3 DIM VBLS ARRAY, ORIGINALLY
C  DIMENSIONED (8,RRW,RCL). HANDLE BY CALLING XVBLGT TO GET
C  CORRECT 8 BYTE VARIABLE, AND PULLING OUT CORRECT ONE
        INTEGER*2 ID1,ID2,ID3
        LOGICAL*1 IVAL,LL(8)
        REAL*8 XX
        EQUIVALENCE(LL(1),XX)
        CALL XVBLGT(ID2,ID3,XX)
        IVAL=LL(ID1)
        RETURN
        END
        SUBROUTINE VBLSET(ID1,ID2,ID3,IVAL)
C VBLSET - SET BYTE OF 3 DIM VBLS ARRAY, ORIGINALLY
C  DIMENSIONED (8,RRW,RCL). HANDLE BY CALLING XVBLST TO GET
C  CORRECT 8 BYTE VARIABLE, AND PUTTING IN CORRECT ONE
        INTEGER*2 ID1,ID2,ID3
        LOGICAL*1 IVAL,LL(8)
        REAL*8 XX
        EQUIVALENCE(LL(1),XX)
C GET THE DESIRED 8 BYTES, THEN CHANGE THE ONE WE WANT. THEN...
        CALL XVBLGT(ID2,ID3,XX)
        LL(ID1)=IVAL
C PUT BACK THE 8 BYTES.
        CALL XVBLST(ID2,ID3,XX)
        RETURN
        END
        SUBROUTINE JVBLGT(ID1,ID2,ID3,IVAL)
C
C JVBLGT - GET INTEGER*4 WORD OF 3 DIM VBLS ARRAY, ORIGINALLY
C  DIMENSIONED (2,RRW,RCL). HANDLE BY CALLING XVBLGT TO GET
C  CORRECT 8 BYTE VARIABLE, AND PULLING OUT CORRECT ONE
        INTEGER*2 ID1,ID2,ID3
        INTEGER*4 IVAL,LL(2)
        REAL*8 XX
        EQUIVALENCE(LL(1),XX)
        CALL XVBLGT(ID2,ID3,XX)
        IVAL=LL(ID1)
        RETURN
        END
        SUBROUTINE JVBLST(ID1,ID2,ID3,IVAL)
C JVBLST - SET I*4 WORD OF 3 DIM VBLS ARRAY, ORIGINALLY
C  DIMENSIONED (2,RRW,RCL). HANDLE BY CALLING XVBLST TO GET
C  CORRECT 8 BYTE VARIABLE, AND PUTTING IN CORRECT ONE
        INTEGER*2 ID1,ID2,ID3
        INTEGER*4 IVAL,LL(2)
        REAL*8 XX
        EQUIVALENCE(LL(1),XX)
C GET THE DESIRED 8 BYTES, THEN CHANGE THE ONES WE WANT. THEN...
        CALL XVBLGT(ID2,ID3,XX)
        LL(ID1)=IVAL
C PUT BACK THE 8 BYTES.
        CALL XVBLST(ID2,ID3,XX)
        RETURN
        END
        SUBROUTINE XVBLST(ID1,ID2,XX)
C
C XVBLST - STORE 8 BYTES IN VARIABLES ARRAY
C GIVEN DIMENSIONS FOR LOCATING THEM
        INTEGER*2 ID1,ID2
        REAL*8 XX
        INCLUDE 'VKLUGPRM.FTN'
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP),VT(8)
	REAL*8 XVT
	EQUIVALENCE(XVT,VT(1))
	REAL*8 XXV(RRWP,RCLP)
	EQUIVALENCE(XXV(1,1),VBLS(1,1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
	INTEGER*2 ICREF,IRREF
	COMMON/MIRROR/ICREF,IRREF
        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 NEXT BITMAPS IMPLEMENT FVLD
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        LOGICAL*1 ITYP(BRRCL)
        INTEGER*2 IATYP(27)
        COMMON/TYP/IATYP,ITYP
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45),LLTST
        COMMON/FMTBFR/FMTDAT
        INTEGER*2 LVALBF(5,LVBF),MPAG(2),MPMOD(2)
        COMMON/VB/MPAG,LVALBF,MPMOD
	INTEGER*2 MFLAST,MFBASE,MVLAST,MVBASE
	COMMON/VBCTL/MFLAST,MFBASE,MVLAST,MVBASE
        INTEGER*2 LL(4)
        REAL*8 XA
        EQUIVALENCE(XA,LL(1))
	INTEGER*2 NCEL,NXINI
	COMMON/NCEL/NCEL,NXINI
	IF(ID2.GT.1.OR.ID1.GT.27)GOTO 7780
C AN ACCUMULATOR. SET IT.
	XVT=XX
	DO 7781 IV=1,8
7781	AVBLS(IV,ID1)=VT(IV)
	RETURN
7780	CONTINUE
C        ID=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,ID)
C SET UP HASH CODE NOW FOR THE WAY WE NEED...
C       IPM=(IPGMAX*200/LVBF)
	IF(ID.LE.0)RETURN
C CALL FVLDGT TO TELL IF ANYTHING IS SET FOR THE CELL...
	CALL FVLDGT(ID1,ID2,LLTST)
	IF(LLTST.NE.0)GOTO 3419
	CALL FVLDST(ID1,ID2,-4)
C TRICK ... SET UP SIGN BIT IN FVLD SO XVBLGT CAN FIND OUT IF
C VARIABLE HAS EVER BEEN WRITTEN AND EXIT IF NOT. INDEPENDENT OF
C USUAL SETTING OF FVLD SINCE IT USES "SIGN" BIT ONLY.
3419	CONTINUE
	IBF=(LVBF+99)/100
C IBF IS NUMBER OF BLOCKS PER BUFFER, BLOCK=500 BYTES.
C IF LVBF=200, IBF=2 SINCE THERE ARE 200 * 10 BYTES TOTAL
C IN MEMORY, OR 1000 PER BUFFER OR 2 BLOCKS
	IF(IBF.LT.1)IBF=1
	LLL=(IPGMAX*2)/IBF
	IPM=LLL
	IF(IPM.LE.2)IPM=2
	IHASH=ID
        JHASH=MOD(IHASH,(LVBF/2))+1
	IF(IPGMOD.NE.0)GOTO 3400
C SPACE-OPTIMIZING PACKING
        IPAG=(IHASH/(LVBF/2))+1
        IPAG=MOD(IPAG,IPM)+1
	GOTO 3401
3400	CONTINUE
C SPEED-OPTIMIZING PACKING
	FPG=FLOAT(IPGMOD)
	IF(FPG.LT.0.)FPG=FPG+65536.
	FPG=FLOAT(IHASH)*FLOAT(IPM)/FPG
	IPAG=FPG
	IPAG=MOD(IPAG,IPM)
	IPAG=IPAG+1
C	IPAG=1+(IHASH*IPM)/RRCL
3401	CONTINUE
C        IF(IPAG.LE.0)IPAG=1
	IF(IPAG.EQ.MPAG(1).OR.IPAG.EQ.MPAG(2))GOTO 850
	IF(MPAG(1).NE.0)GOTO 851
	MPAG(1)=IPAG
	GOTO 850
851	IF(MPAG(2).EQ.0)MPAG(2)=IPAG
850	CONTINUE
	IF(MPAG(1).EQ.IPAG)GOTO 852
	IF(MPAG(2).NE.IPAG)GOTO 853
C MPAG(2)=IPAG
	MVLAST=2
	MVBASE=LVBF/2
	GOTO 1000
852	CONTINUE
	MVLAST=1
	MVBASE=0
	GOTO 1000
853	CONTINUE
C REPLACE LRU PAGE. MVLAST HAS MOST RECENTLY USED SO FLIP.
	MVLAST=3-MVLAST
C MVLAST IS EITHER 1 OR 2
	MVBASE=(LVBF/2)-MVBASE
C
C THE ABOVE ACCOUNTS FOR MEMORY FREE... WE TREAT FILE AS IPM
C "PAGES" THE SIZE OF THE MEMORY AREA EACH. THIS MAKES IT RELATIVELY
C EASY TO ALTER THE PROGRAM TO HANDLE MORE MEMORY TO THE EXTENT THE
C COMPILER AND MACHINE ALLOW.
C        IF(IPAG.EQ.MPAG)GOTO 1000
	IF(IPGMAX.LE.(LVBF/100))GOTO 1000
C IF HERE, WE NEED A PAGE NOT IN MEMORY. SWAP THE CURRENT MEMORY PAGE
C TO DISK AND BRING IN THE ONE DESIRED.
C FILES ARE OPENED ALREADY HERE... USE LUN 9 HERE.
        IRCLO=(MPAG(MVLAST)-1)*IBF+1
        IRCHI=MPAG(MVLAST)*IBF
        L=1+MVBASE
        DO 500 N=IRCLO,IRCHI
C IF PAGE WAS NEVER MODIFIED, NO NEED TO WRITE IT OUT.
	IF(MPMOD(MVLAST).EQ.0)GOTO 500
        LLL=L+49
        WRITE(9'N)((LVALBF(KK,K),KK=1,5),K=L,LLL)
        L=L+50
500     CONTINUE
	MPMOD(MVLAST)=0
        MPAG(MVLAST)=IPAG
C NOW READ IN THE DESIRED RECORD, HAVING SET THE DESIRED IN-MEMORY FLAG
        IRCLO=(MPAG(MVLAST)-1)*IBF+1
        IRCHI=MPAG(MVLAST)*IBF
        L=1+MVBASE
        DO 501 N=IRCLO,IRCHI
        LLL=L+49
        READ(9'N)((LVALBF(KK,K),KK=1,5),K=L,LLL)
        L=L+50
501     CONTINUE
1000    CONTINUE
C NOW THE PAGE NEEDED IS IN MEMORY (OR MAY HAVE BEEN ALL ALONG)
C SET THE VALUE INTO IT AS REQUIRED...
C NOW START LOOKING AT HASH ADDRESS FOR VARIABLE...LINEAR SEARCH AFTERWARDS
	MPMOD(MVLAST)=1
C FLAG PAGE MODIFIED IF WE TOUCH IT.
C ASSUME WE ALWAYS TOUCH IT HERE.
	IF(NXINI.NE.0)GOTO 111
        IH1=JHASH-1
        DO 1 MMN=JHASH,LVBF/2
	N=MMN+MVBASE
C SKIP OUT ON HITTING VIRGIN CELL
	IF(LVALBF(1,N).EQ.-1)GOTO 111
        IF(LVALBF(1,N).NE.ID)GOTO 1
C ZERO ALL REFS TO THIS CELL WE'RE ABOUT TO WRITE.
C **** THIS IS QUITE TIME CONSUMING... OMIT IF POSSIBLE...
        LVALBF(1,N)=0
1       CONTINUE
        IF(IH1.LT.1)RETURN
        DO 33 MMN=1,IH1
	N=MMN+MVBASE
C SKIP OUT ON HITTING VIRGIN CELL
	IF(LVALBF(1,N).EQ.-1)GOTO 111
        IF(LVALBF(1,N).NE.ID)GOTO 33
C ZERO ALL REFS TO THIS CELL WE'RE ABOUT TO WRITE.
C **** THIS IS QUITE TIME CONSUMING... OMIT IF POSSIBLE...
        LVALBF(1,N)=0
33	CONTINUE
111	CONTINUE
C SINCE ZERO VALUES ARE RETURNED BY DEFAULT, DON'T BOTHER STORING THEM
	IF(XX.EQ.0.)RETURN
        IH1=JHASH-1
        DO 2 MMN=JHASH,LVBF/2
	N=MMN+MVBASE
	NN=N
	IF(LVALBF(1,N).EQ.-1)GOTO 4
        IF(LVALBF(1,N).EQ.0)GOTO 4
	IF(LVALBF(1,N).EQ.ID)GOTO 4
2       CONTINUE
        IF(IH1.LT.1)RETURN
        DO 3 MMN=1,IH1
	N=MMN+MVBASE
	NN=N
C LOOK BEFORE THE HASHCODE IF NO FREE CELLS AFTER IT.
	IF(LVALBF(1,N).EQ.-1)GOTO 4
        IF(LVALBF(1,N).EQ.0)GOTO 4
	IF(LVALBF(1,N).EQ.ID)GOTO 4
3       CONTINUE
C TELL USER VALUE AREA OVERFLOWED, USING ROW 1 END
	CALL UVT100(CUP,1,1)
	WRITE(6,8900)
8900	FORMAT('  Value Table Storage Overflowed - bigger file needed')
        RETURN
C RETURN IF CAN'T FIND VALUE...TOO BAD
4       CONTINUE
C SAVE VALUE AS 4 16-BIT WORDS
        XA=XX
C SAVE ID AND VALUE IN CELL...
	LVALBF(1,NN)=ID
        DO 5 M=1,4
5       LVALBF(M+1,NN)=LL(M)
        RETURN
        END
        SUBROUTINE XVBLGT(ID1,ID2,XX)
C
C XVBLGT - LOAD 8 BYTES GIVEN DIMENSIONS FOR GETTING THEM
C 2 DIM ARRAY, DIM'D (RRW,RCL)
        INTEGER*2 ID1,ID2
        REAL*8 XX
        INCLUDE 'VKLUGPRM.FTN'
        INTEGER*2 IPGMAX,LPGMXF,IPGMOD,LPGMOD
        COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD
	INTEGER*2 TYPE(RRWP,RCLP),VLEN(9)
	LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP),VT(8)
	REAL*8 XVT
	EQUIVALENCE(XVT,VT(1))
	REAL*8 XXV(RRWP,RCLP)
	EQUIVALENCE(XXV(1,1),VBLS(1,1,1))
	COMMON/V/TYPE,AVBLS,VBLS,VLEN
C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF
C NEXT BITMAPS IMPLEMENT FVLD
        LOGICAL*1 FV1(BRRCL),FV2(BRRCL),FV4(BRRCL)
        LOGICAL*1 LBITS(8)
        COMMON/BITS/LBITS
	INTEGER*2 ICREF,IRREF
	COMMON/MIRROR/ICREF,IRREF
        COMMON/FVLDM/FV1,FV2,FV4
C THE FOLLOWING BITMAP IS FOR TYPE ARRAY, AND INTEGER ARRAY IS FOR
C TYPES OF AC'S STORAGE:
        LOGICAL*1 ITYP(BRRCL),LWK
        INTEGER*2 IATYP(27),LL(4)
	REAL*8 XA
	EQUIVALENCE(LL(1),XA)
        COMMON/TYP/IATYP,ITYP
	INTEGER*2 MFLAST,MFBASE,MVLAST,MVBASE
	COMMON/VBCTL/MFLAST,MFBASE,MVLAST,MVBASE
        INTEGER*2 LVALBF(5,LVBF),MPAG(2),MPMOD(2)
        COMMON/VB/MPAG,LVALBF,MPMOD
C
C NEXT ARE BUFFERS FOR HOLDING VALUES, AND MEMORY OCCUPANCY WORDS
C FOR EACH GIVING THE BLK # IN USE FOR THESE TABLES
C FORMAT BLOCK (ONE ONLY, 512 BYTES, BUT ORGANIZED AS 45 FORMAT
C AREAS WITH DATA.
        LOGICAL*1 FMTDAT(9,45)
        COMMON/FMTBFR/FMTDAT
	IF(ID2.GT.1.OR.ID1.GT.27)GOTO 7780
C AN ACCUMULATOR
C GET IT AS IF IT WERE A CELL
	DO 7781 IV=1,8
7781	VT(IV)=AVBLS(IV,ID1)
	XX=XVT
	RETURN
7780	CONTINUE
C        ID=(ID2-1)*RRW+ID1
	CALL REFLEC(ID2,ID1,ID)
        XX=0.
C NOTE THAT HERE IF FVLD IS 0, THIS MEANS RESULT IS 0 REGARDLESS OF
C OTHER STUFF...RETURN 0 IMMEDIATELY.
C NOTE TRICK CALL WHICH SIGNALS ANY INITIALIZATION GETS EVALUATED.
	CALL FVLDGT(ID,0,LWK)
	IF(LWK.EQ.0)RETURN
C SET UP HASH CODE NOW FOR THE WAY WE NEED...
C        IPM=(IPGMAX*100/LVBF)+1
	IBF=(LVBF+99)/100
	IF(IBF.LT.1)IBF=1
	LLL=(IPGMAX*2)/IBF
	IPM=LLL
	IF(IPM.LE.2)IPM=2
	IHASH=ID
        JHASH=MOD(IHASH,(LVBF/2))+1
	IF(IPGMOD.NE.0)GOTO 3402
        IPAG=(IHASH/(LVBF/2))+1
        IPAG=MOD(IPAG,IPM)+1
	GOTO 3403
3402	CONTINUE
C SPEED-OPTIMIZING PACKING
	FPG=FLOAT(IPGMOD)
	IF(FPG.LT.0.)FPG=FPG+65536.
	FPG=FLOAT(IHASH)*FLOAT(IPM)/FPG
	IPAG=FPG
	IPAG=MOD(IPAG,IPM)
	IPAG=IPAG+1
C	IPAG=1+(IHASH*IPM)/RRCL
3403	CONTINUE
C        IF(IPAG.LE.0)IPAG=1
	IF(IPAG.EQ.MPAG(1).OR.IPAG.EQ.MPAG(2))GOTO 851
	IF(MPAG(1).NE.0)GOTO 850
	MPAG(1)=IPAG
	GOTO 851
850	IF(MPAG(2).EQ.0)MPAG(2)=IPAG
851	CONTINUE
	IF(MPAG(1).EQ.IPAG)GOTO 852
	IF(MPAG(2).NE.IPAG)GOTO 853
C MPAG(2)=IPAG
	MVLAST=2
	MVBASE=LVBF/2
	GOTO 1000
852	CONTINUE
	MVLAST=1
	MVBASE=0
	GOTO 1000
853	CONTINUE
C USE LRU BUFFER AND FLIP USES
	MVLAST=3-MVLAST
C 1 OR 2
	MVBASE=(LVBF/2)-MVBASE
C THE ABOVE ACCOUNTS FOR MEMORY FREE... WE TREAT FILE AS IPM
C "PAGES" THE SIZE OF THE MEMORY AREA EACH. THIS MAKES IT RELATIVELY
C EASY TO ALTER THE PROGRAM TO HANDLE MORE MEMORY TO THE EXTENT THE
C COMPILER AND MACHINE ALLOW.
	IF(IPGMAX.LE.(LVBF/100))GOTO 1000
C IF HERE, WE NEED A PAGE NOT IN MEMORY. SWAP THE CURRENT MEMORY PAGE
C TO DISK AND BRING IN THE ONE DESIRED.
C FILES ARE OPENED ALREADY HERE... USE LUN 9 HERE.
        IRCLO=(MPAG(MVLAST)-1)*IBF+1
        IRCHI=MPAG(MVLAST)*IBF
        L=1+MVBASE
        DO 500 N=IRCLO,IRCHI
	IF(MPMOD(MVLAST).EQ.0)GOTO 500
        LLL=L+49
        WRITE(9'N)((LVALBF(KKK,K),KKK=1,5),K=L,LLL)
        L=L+50
500     CONTINUE
	MPMOD(MVLAST)=0
C THIS ONLY READS, SO NEVER SET MPMOD=1 IN XVBLGT.
C ON THE CONTRARY, SPECIFY IT AS UNTOUCHED AS YET HERE.
        MPAG(MVLAST)=IPAG
C NOW READ IN THE DESIRED RECORD, HAVING SET THE DESIRED IN-MEMORY FLAG
        IRCLO=(MPAG(MVLAST)-1)*IBF+1
        IRCHI=MPAG(MVLAST)*IBF
        L=1+MVBASE
        DO 501 N=IRCLO,IRCHI
        LLL=L+49
        READ(9'N)((LVALBF(KKK,K),KKK=1,5),K=L,LLL)
        L=L+50
501     CONTINUE
1000    CONTINUE
C NOW THE PAGE NEEDED IS IN MEMORY (OR MAY HAVE BEEN ALL ALONG)
C SET THE VALUE INTO IT AS REQUIRED...
C NOW START LOOKING AT HASH ADDRESS FOR VARIABLE...LINEAR SEARCH AFTERWARDS
        IH1=JHASH-1
        DO 2 MMN=JHASH,LVBF/2
	N=MMN+MVBASE
	NN=N
	IF(LVALBF(1,N).EQ.-1)GOTO 3332
        IF(LVALBF(1,N).EQ.ID)GOTO 4
2       CONTINUE
        IF(IH1.LT.1)RETURN
        DO 3 MMN=1,IH1
	N=MMN+MVBASE
C LOOK BEFORE THE HASHCODE IF NO FREE CELLS AFTER IT.
	NN=N
	IF(LVALBF(1,N).EQ.-1)GOTO 3332
        IF(LVALBF(1,N).EQ.ID)GOTO 4
3       CONTINUE
3332	XX=0.
        RETURN
C RETURN IF CAN'T FIND VALUE...TOO BAD
C NOTE WE ALSO RETURN INSTANTLY IF WE SEE A VIRGIN CELL SINCE WE KNOW
C THE REAL VALUE CANNOT LIE BEYOND IT.
4       CONTINUE
C GET VALUE AS 4 16-BIT WORDS
        DO 5 M=1,4
5       LL(M)=LVALBF(M+1,NN)
        XX=XA
        RETURN
        END