        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:
        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 DVF(12),DFMT(10)
        EQUIVALENCE(DVF(2),DFMT(1))
        COMMON/DEFVBX/DVF
        INTEGER*2 LVALBF(5,LVBF),MPAG
        COMMON/VB/MPAG,LVALBF
        INTEGER*2 MFID,IFID(8,LFM)
        LOGICAL*1 LFID(16,LFM)
        EQUIVALENCE(IFID(1,1),LFID(1,1))
        COMMON/FRM/MFID,IFID
C
        COMMON /NCEL/NCEL,NXINI
        IBP=1
        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=0
        MPAG=0
C ZERO MEMORY BUFFER AND FILES
        DO 9 N=1,LVBF
        DO 9 M=1,5
9       LVALBF(M,N)=0
        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
        DO 12 N=1,LFM
        DO 12 M=1,8
12      IFID(M,N)=0
	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)
        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)
        COMMON/FMTBFR/FMTDAT
        LOGICAL*1 ITST
	CALL FVLDGT(ID1,ID2,ITST)
	IF(ITST.EQ.0)GOTO 500
        IF(ID1.LE.27.AND.ID2.LE.1)GOTO 1000
        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
        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)
        COMMON/FMTBFR/FMTDAT
        LOGICAL*1 ITST,ITST2
        ID=(ID2-1)*RRW+ID1
        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
        IF(ID2.GT.1.OR.ID1.GT.27)RETURN
        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
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
        ID=(ID2-1)*RRW+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)
        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
        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
        ID=(ID2-1)*RRW+ID1
        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 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
        COMMON/VB/MPAG,LVALBF
        INTEGER*2 LL(4)
        REAL*8 XA
        EQUIVALENCE(XA,LL(1))
	INTEGER*2 NCEL,NXINI
	COMMON/NCEL/NCEL,NXINI
        ID=(ID2-1)*RRW+ID1
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+49)/50
	IF(IBF.LT.1)IBF=1
	LLL=(IPGMAX*2)/IBF
	IPM=LLL
	IF(IPM.LE.0)IPM=1
	IHASH=ID
        JHASH=MOD(IHASH,LVBF)+1
	IF(IPGMOD.EQ.0)GOTO 3400
C SPACE-OPTIMIZING PACKING
        IPAG=(IHASH/LVBF)+1
        IPAG=MOD(IPAG,IPM)+1
	GOTO 3401
3400	CONTINUE
C SPEED-OPTIMIZING PACKING
	FPG=FLOAT(IHASH)*FLOAT(IPM)/FLOAT(RRCL)
	IPAG=FPG
	IPAG=IPAG+1
C	IPAG=1+(IHASH*IPM)/RRCL
3401	CONTINUE
        IF(IPAG.LE.0)IPAG=1
        IF(MPAG.EQ.0)MPAG=IPAG
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(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-1)*IBF+1
        IRCHI=MPAG*IBF
        L=1
        DO 500 N=IRCLO,IRCHI
        LLL=L+49
        WRITE(9'N)((LVALBF(KK,K),KK=1,5),K=L,LLL)
        L=L+50
500     CONTINUE
        MPAG=IPAG
C NOW READ IN THE DESIRED RECORD, HAVING SET THE DESIRED IN-MEMORY FLAG
        IRCLO=(MPAG-1)*IBF+1
        IRCHI=MPAG*IBF
        L=1
        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
	IF(NXINI.NE.0)GOTO 111
        DO 1 N=1,LVBF
        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
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 N=JHASH,LVBF
	NN=N
        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 N=1,IH1
	NN=N
C LOOK BEFORE THE HASHCODE IF NO FREE CELLS AFTER IT.
        IF(LVALBF(1,N).EQ.0)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
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),LWK
        INTEGER*2 IATYP(27),LL(4)
	REAL*8 XA
	EQUIVALENCE(LL(1),XA)
        COMMON/TYP/IATYP,ITYP
        INTEGER*2 LVALBF(5,LVBF),MPAG
        COMMON/VB/MPAG,LVALBF
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
        ID=(ID2-1)*RRW+ID1
        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+49)/50
	IF(IBF.LT.1)IBF=1
	LLL=(IPGMAX*2)/IBF
	IPM=LLL
	IF(IPM.LE.0)IPM=1
C        IHHI=ID/256
C        IHHI=IHHI.AND.127
C        IHASH=ID.AND.255
C        IHASH=IHASH*128+IHHI
	IHASH=ID
        JHASH=MOD(IHASH,LVBF)+1
	IF(IPGMOD.EQ.0)GOTO 3402
        IPAG=(IHASH/LVBF)+1
        IPAG=MOD(IPAG,IPM)+1
	GOTO 3403
3402	CONTINUE
C SPEED-OPTIMIZING PACKING
	FPG=FLOAT(IHASH)*FLOAT(IPM)/FLOAT(RRCL)
	IPAG=FPG
	IPAG=IPAG+1
C	IPAG=1+(IHASH*IPM)/RRCL
3403	CONTINUE
        IF(IPAG.LE.0)IPAG=1
        IF(MPAG.EQ.0)MPAG=IPAG
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(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-1)*IBF+1
        IRCHI=MPAG*IBF
        L=1
        DO 500 N=IRCLO,IRCHI
        LLL=L+49
        WRITE(9'N)((LVALBF(KKK,K),KKK=1,5),K=L,LLL)
        L=L+50
500     CONTINUE
        MPAG=IPAG
C NOW READ IN THE DESIRED RECORD, HAVING SET THE DESIRED IN-MEMORY FLAG
        IRCLO=(MPAG-1)*IBF+1
        IRCHI=MPAG*IBF
        L=1
        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 N=JHASH,LVBF
	NN=N
        IF(LVALBF(1,N).EQ.ID)GOTO 4
2       CONTINUE
        IF(IH1.LT.1)RETURN
        DO 3 N=1,IH1
C LOOK BEFORE THE HASHCODE IF NO FREE CELLS AFTER IT.
	NN=N
        IF(LVALBF(1,N).EQ.ID)GOTO 4
3       CONTINUE
	XX=0.
        RETURN
C RETURN IF CAN'T FIND VALUE...TOO BAD
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
