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*4 N4
        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),LINTGR
        COMMON/TYP/IATYP,ITYP,LINTGR
	INTEGER*2 DLFG
	COMMON/DLFG/DLFG
C DLFG FLAGS IF D## FORMS SEEN
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,MPMOD
        COMMON/VB/MPAG,LVALBF,MPMOD
        INTEGER*2 MFID,IFID(8,LFM),MFMOD
        LOGICAL*1 LFID(16,LFM)
        EQUIVALENCE(IFID(1,1),LFID(1,1))
        COMMON/FRM/MFID,IFID,MFMOD
C DATA FILE AREA...
	INTEGER*4 QVDAT,QFDAT
	DIMENSION QVDAT(IPDM),QFDAT(LPDM)
	COMMON/QVCMN/QVDAT,QFDAT
C
        COMMON /NCEL/NCEL,NXINI
        IBP=1
	LINTGR=0
	MPMOD=0
	MFMOD=0
	DLFG=0
C NO D## 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...
C        CLOSE(UNIT=7,DISP='DELETE')
C        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...
C        IF(IPGMAX.GT.(LVBF/100))OPEN(UNIT=9,FILE='PVBL.TMP',
C     1  ACCESS='DIRECT',DISPOSE='DELETE',FORM='UNFORMATTED',
C     2  INITIALSIZE=NBK,BLOCKSIZE=500,RECORDTYPE='FIXED',
C     3  RECL=125,STATUS='NEW')
        NBK=LPGMXF*2
C        IF(LPGMXF.GT.(LFM/64))OPEN(UNIT=7,FILE='PFMT.TMP',
C     1  ACCESS='DIRECT',DISPOSE='DELETE',FORM='UNFORMATTED',
C     2  INITIALSIZE=NBK,BLOCKSIZE=512,RECORDTYPE='FIXED',
C     3  RECL=128,STATUS='NEW')
C SET NOTHING IN MEMORY YET
        MFID=0
        MPAG=0
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)
C        IF(IPGMAX.LE.(LVBF/100))GOTO 11
C        DO 10 N=1,NPG
	DO 10 N4=1,IPDM
	QVDAT(N4)=0
C ABOVE WAS -1 FOR CASE OF WORKFILES
C	QVDAT(N4)=-1
C10      WRITE(9'N)((LVALBF(K,KKK),K=1,5),KKK=1,50)
10	CONTINUE
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
C        IF(LPGMXF.LE.(LFM/64))GOTO 14
C        DO 13 N=1,NPG
C13      WRITE(7'N)((IFID(K,KKK),K=1,8),KKK=1,32)
	DO 13 N4=1,LPDM
	QFDAT(N4)=-1
13	CONTINUE
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),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
        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
        LOGICAL*1 ITST,ITST2
        IF(ID2.LE.1.AND.ID1.LE.27)GOTO 200
	IF(LINTGR.EQ.0.AND.IABS(IVAL).EQ.2)RETURN
	LINTGR=1
        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
	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
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
C
        SUBROUTINE XVBLST(ID1,ID2,XX)
C
C XVBLST - STORE 8 BYTES IN VARIABLES ARRAY
C GIVEN DIMENSIONS FOR LOCATING THEM
	PARAMETER CUP=1
        INTEGER*2 ID1,ID2
	INTEGER*4 IPAG,IPM,LLL,IHASH,JHASH,NNN
        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 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,MPMOD
        COMMON/VB/MPAG,LVALBF,MPMOD
        INTEGER*2 LL(4)
        REAL*8 XA
        EQUIVALENCE(XA,LL(1))
	INTEGER*2 NCEL,NXINI
	COMMON/NCEL/NCEL,NXINI
C DATA FILE AREA...
	INTEGER*2 LVALB1(LVBF5)
	EQUIVALENCE(LVALB1(1),LVALBF(1,1))
	INTEGER*4 QVDAT,QFDAT
	DIMENSION QVDAT(IPDM),QFDAT(LPDM)
	REAL*8 QQDAT(RRW,RCL)
	EQUIVALENCE(QQDAT(1,1),QVDAT(1))
	INTEGER*2 QVDAT1
	DIMENSION QVDAT1(IPDM5)
	EQUIVALENCE(QVDAT(1),QVDAT1(1))
	COMMON/QVCMN/QVDAT,QFDAT
	INTEGER*4 I4,I44
	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
	QQDAT(ID1,ID2)=XX
	RETURN
C        ID=(ID2-1)*RRW+ID1
CC SET UP HASH CODE NOW FOR THE WAY WE NEED...
CC       IPM=(IPGMAX*200/LVBF)
C	IF(ID.LE.0)RETURN
CC CALL FVLDGT TO TELL IF ANYTHING IS SET FOR THE CELL...
C	CALL FVLDGT(ID1,ID2,LLTST)
C	IF(LLTST.NE.0)GOTO 3419
C	CALL FVLDST(ID1,ID2,-4)
CC TRICK ... SET UP SIGN BIT IN FVLD SO XVBLGT CAN FIND OUT IF
CC VARIABLE HAS EVER BEEN WRITTEN AND EXIT IF NOT. INDEPENDENT OF
CC USUAL SETTING OF FVLD SINCE IT USES "SIGN" BIT ONLY.
C3419	CONTINUE
C	IBF=(LVBF+49)/50
C	IF(IBF.LT.1)IBF=1
C	LLL=(IPGMAX*2)/IBF
C	IPM=LLL
C	IF(IPM.LE.0)IPM=1
C	IHASH=ID
C        JHASH=MOD(IHASH,LVBF)+1
C	IF(IPGMOD.NE.0)GOTO 3400
CC SPACE-OPTIMIZING PACKING
C        IPAG=(IHASH/LVBF)+1
C        IPAG=MOD(IPAG,IPM)+1
C	GOTO 3401
C3400	CONTINUE
CC SPEED-OPTIMIZING PACKING
C	FPG=FLOAT(IPGMOD)
C	IF(FPG.LT.0.)FPG=FPG+65536.
C	FPG=FLOAT(IHASH)*FLOAT(IPM)/FPG
C	IPAG=FPG
C	IPAG=MOD(IPAG,IPM)
C	IPAG=IPAG+1
CC	IPAG=1+(IHASH*IPM)/RRCL
C3401	CONTINUE
C        IF(IPAG.LE.0)IPAG=1
C        IF(MPAG.EQ.0)MPAG=IPAG
CC THE ABOVE ACCOUNTS FOR MEMORY FREE... WE TREAT FILE AS IPM
CC "PAGES" THE SIZE OF THE MEMORY AREA EACH. THIS MAKES IT RELATIVELY
CC EASY TO ALTER THE PROGRAM TO HANDLE MORE MEMORY TO THE EXTENT THE
CC COMPILER AND MACHINE ALLOW.
C        IF(IPAG.EQ.MPAG)GOTO 1000
C	IF(IPGMAX.LE.(LVBF/100))GOTO 1000
CC IF HERE, WE NEED A PAGE NOT IN MEMORY. SWAP THE CURRENT MEMORY PAGE
CC TO DISK AND BRING IN THE ONE DESIRED.
CC FILES ARE OPENED ALREADY HERE... USE LUN 9 HERE.
C        IRCLO=(MPAG-1)*IBF+1
C        IRCHI=MPAG*IBF
C        L=1
C        DO 500 N=IRCLO,IRCHI
CC IF PAGE WAS NEVER MODIFIED, NO NEED TO WRITE IT OUT.
C	IF(MPMOD.EQ.0)GOTO 500
C        LLL=L+49
C	N4=N
C	N44=1+((N4-1)*125)
C	KNKK=1+(L-1)*5
C	KNKK2=LLL*5
C	DO 801 K=KNKK,KNKK2
C	N4=K-1
C	N4=N4+N44
C801	QVDAT1(N4)=LVALB1(K)
CC        WRITE(9'N)((LVALBF(KK,K),KK=1,5),K=L,LLL)
C        L=L+50
C500     CONTINUE
C	MPMOD=0
C        MPAG=IPAG
CC NOW READ IN THE DESIRED RECORD, HAVING SET THE DESIRED IN-MEMORY FLAG
C        IRCLO=(MPAG-1)*IBF+1
C        IRCHI=MPAG*IBF
C        L=1
C        DO 501 N=IRCLO,IRCHI
C        LLL=L+49
C	N4=N
C	N44=1+((N4-1)*125)
C	KNKK=1+(L-1)*5
C	KNKK2=LLL*5
C	DO 802 K=KNKK,KNKK2
C	N4=K-1
C	N4=N4+N44
C802	LVALB1(K)=QVDAT1(N4)
CC        READ(9'N)((LVALBF(KK,K),KK=1,5),K=L,LLL)
C        L=L+50
C501     CONTINUE
C1000    CONTINUE
CC NOW THE PAGE NEEDED IS IN MEMORY (OR MAY HAVE BEEN ALL ALONG)
CC SET THE VALUE INTO IT AS REQUIRED...
CC NOW START LOOKING AT HASH ADDRESS FOR VARIABLE...LINEAR SEARCH AFTERWARDS
C	MPMOD=1
CC FLAG PAGE MODIFIED IF WE TOUCH IT.
CC ASSUME WE ALWAYS TOUCH IT HERE.
C	IF(NXINI.NE.0)GOTO 111
C        IH1=JHASH-1
C        DO 1 N=JHASH,LVBF
CC SKIP OUT ON HITTING VIRGIN CELL
C	IF(LVALBF(1,N).EQ.-1)GOTO 111
C        IF(LVALBF(1,N).NE.ID)GOTO 1
CC ZERO ALL REFS TO THIS CELL WE'RE ABOUT TO WRITE.
CC **** THIS IS QUITE TIME CONSUMING... OMIT IF POSSIBLE...
C        LVALBF(1,N)=0
C1       CONTINUE
C        IF(IH1.LT.1)RETURN
C        DO 33 N=1,IH1
CC SKIP OUT ON HITTING VIRGIN CELL
C	IF(LVALBF(1,N).EQ.-1)GOTO 111
C        IF(LVALBF(1,N).NE.ID)GOTO 33
CC ZERO ALL REFS TO THIS CELL WE'RE ABOUT TO WRITE.
CC **** THIS IS QUITE TIME CONSUMING... OMIT IF POSSIBLE...
C        LVALBF(1,N)=0
C33	CONTINUE
C111	CONTINUE
CC SINCE ZERO VALUES ARE RETURNED BY DEFAULT, DON'T BOTHER STORING THEM
C	IF(XX.EQ.0.)RETURN
C        IH1=JHASH-1
C        DO 2 N=JHASH,LVBF
C	NN=N
C	IF(LVALBF(1,N).EQ.-1)GOTO 4
C        IF(LVALBF(1,N).EQ.0)GOTO 4
C	IF(LVALBF(1,N).EQ.ID)GOTO 4
C2       CONTINUE
C        IF(IH1.LT.1)RETURN
C        DO 3 N=1,IH1
C	NN=N
CC LOOK BEFORE THE HASHCODE IF NO FREE CELLS AFTER IT.
C	IF(LVALBF(1,N).EQ.-1)GOTO 4
C        IF(LVALBF(1,N).EQ.0)GOTO 4
C	IF(LVALBF(1,N).EQ.ID)GOTO 4
C3       CONTINUE
CC TELL USER VALUE AREA OVERFLOWED, USING ROW 1 END
C	CALL UVT100(CUP,1,1)
C	WRITE(6,8900)
C8900	FORMAT('  Value Table Storage Overflowed - bigger vers needed')
C        RETURN
CC RETURN IF CAN'T FIND VALUE...TOO BAD
C4       CONTINUE
CC SAVE VALUE AS 4 16-BIT WORDS
C        XA=XX
CC SAVE ID AND VALUE IN CELL...
C	LVALBF(1,NN)=ID
C        DO 5 M=1,4
C5       LVALBF(M+1,NN)=LL(M)
C        RETURN
        END
C
        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*4 IPAG,IPM,LLL,IHASH,JHASH,NNN
        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
        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,MPMOD
C DATA FILE AREA...
	INTEGER*2 LVALB1(LVBF5)
	EQUIVALENCE(LVALB1(1),LVALBF(1,1))
	INTEGER*4 QVDAT,QFDAT
	DIMENSION QVDAT(IPDM),QFDAT(LPDM)
	INTEGER*2 QVDAT1
	REAL*8 QQDAT(RRW,RCL)
	EQUIVALENCE(QQDAT(1,1),QVDAT(1))
	DIMENSION QVDAT1(IPDM5)
	EQUIVALENCE(QVDAT(1),QVDAT1(1))
	COMMON/QVCMN/QVDAT,QFDAT
	INTEGER*4 I4,I44
        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
	XX=QQDAT(ID1,ID2)
	RETURN
C        ID=(ID2-1)*RRW+ID1
C        XX=0.
CC NOTE THAT HERE IF FVLD IS 0, THIS MEANS RESULT IS 0 REGARDLESS OF
CC OTHER STUFF...RETURN 0 IMMEDIATELY.
CC NOTE TRICK CALL WHICH SIGNALS ANY INITIALIZATION GETS EVALUATED.
C	CALL FVLDGT(ID,0,LWK)
C	IF(LWK.EQ.0)RETURN
CC SET UP HASH CODE NOW FOR THE WAY WE NEED...
CC        IPM=(IPGMAX*100/LVBF)+1
C	IBF=(LVBF+49)/50
C	IF(IBF.LT.1)IBF=1
C	LLL=(IPGMAX*2)/IBF
C	IPM=LLL
C	IF(IPM.LE.0)IPM=1
CC        IHHI=ID/256
CC        IHASH=ID.AND.255
CC        IHASH=IHASH*128+IHHI
C	IHASH=ID
C        JHASH=MOD(IHASH,LVBF)+1
C	IF(IPGMOD.NE.0)GOTO 3402
C        IPAG=(IHASH/LVBF)+1
C        IPAG=MOD(IPAG,IPM)+1
C	GOTO 3403
C3402	CONTINUE
CC SPEED-OPTIMIZING PACKING
C	FPG=FLOAT(IPGMOD)
C	IF(FPG.LT.0.)FPG=FPG+65536.
C	FPG=FLOAT(IHASH)*FLOAT(IPM)/FPG
C	IPAG=FPG
C	IPAG=MOD(IPAG,IPM)
C	IPAG=IPAG+1
CC	IPAG=1+(IHASH*IPM)/RRCL
C3403	CONTINUE
C        IF(IPAG.LE.0)IPAG=1
C        IF(MPAG.EQ.0)MPAG=IPAG
CC THE ABOVE ACCOUNTS FOR MEMORY FREE... WE TREAT FILE AS IPM
CC "PAGES" THE SIZE OF THE MEMORY AREA EACH. THIS MAKES IT RELATIVELY
CC EASY TO ALTER THE PROGRAM TO HANDLE MORE MEMORY TO THE EXTENT THE
CC COMPILER AND MACHINE ALLOW.
C        IF(IPAG.EQ.MPAG)GOTO 1000
C	IF(IPGMAX.LE.(LVBF/100))GOTO 1000
CC IF HERE, WE NEED A PAGE NOT IN MEMORY. SWAP THE CURRENT MEMORY PAGE
CC TO DISK AND BRING IN THE ONE DESIRED.
CC FILES ARE OPENED ALREADY HERE... USE LUN 9 HERE.
C        IRCLO=(MPAG-1)*IBF+1
C        IRCHI=MPAG*IBF
C        L=1
C        DO 500 N=IRCLO,IRCHI
C	IF(MPMOD.EQ.0)GOTO 500
C        LLL=L+49
C	N4=N
C	N44=1+((N4-1)*125)
C	KNKK=1+(L-1)*5
C	KNKK2=LLL*5
C	DO 801 K=KNKK,KNKK2
C	N4=K-1
C	N4=N4+N44
C801	QVDAT1(N4)=LVALB1(K)
Cc        WRITE(9'N)((LVALBF(KKK,K),KKK=1,5),K=L,LLL)
C        L=L+50
C500     CONTINUE
C	MPMOD=0
CC THIS ONLY READS, SO NEVER SET MPMOD=1 IN XVBLGT.
CC ON THE CONTRARY, SPECIFY IT AS UNTOUCHED AS YET HERE.
C        MPAG=IPAG
CC NOW READ IN THE DESIRED RECORD, HAVING SET THE DESIRED IN-MEMORY FLAG
C        IRCLO=(MPAG-1)*IBF+1
C        IRCHI=MPAG*IBF
C        L=1
C        DO 501 N=IRCLO,IRCHI
C        LLL=L+49
C	N4=N
C	N44=1+((N4-1)*125)
C	KNKK=1+(L-1)*5
C	KNKK2=LLL*5
C	DO 802 K=KNKK,KNKK2
C	N4=K-1
C	N4=N4+N44
C802	LVALB1(K)=QVDAT1(N4)
CC        READ(9'N)((LVALBF(KKK,K),KKK=1,5),K=L,LLL)
C        L=L+50
C501     CONTINUE
C1000    CONTINUE
CC NOW THE PAGE NEEDED IS IN MEMORY (OR MAY HAVE BEEN ALL ALONG)
CC SET THE VALUE INTO IT AS REQUIRED...
CC NOW START LOOKING AT HASH ADDRESS FOR VARIABLE...LINEAR SEARCH AFTERWARDS
C        IH1=JHASH-1
C        DO 2 N=JHASH,LVBF
C	NN=N
C	IF(LVALBF(1,N).EQ.-1)GOTO 3332
C        IF(LVALBF(1,N).EQ.ID)GOTO 4
C2       CONTINUE
C        IF(IH1.LT.1)RETURN
C        DO 3 N=1,IH1
CC LOOK BEFORE THE HASHCODE IF NO FREE CELLS AFTER IT.
C	NN=N
C	IF(LVALBF(1,N).EQ.-1)GOTO 3332
C        IF(LVALBF(1,N).EQ.ID)GOTO 4
C3       CONTINUE
C3332	XX=0.
C        RETURN
CC RETURN IF CAN'T FIND VALUE...TOO BAD
CC NOTE WE ALSO RETURN INSTANTLY IF WE SEE A VIRGIN CELL SINCE WE KNOW
CC THE REAL VALUE CANNOT LIE BEYOND IT.
C4       CONTINUE
CC GET VALUE AS 4 16-BIT WORDS
C        DO 5 M=1,4
C5       LL(M)=LVALBF(M+1,NN)
C        XX=XA
C        RETURN
        END