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 C DLFG FLAGS IF D## FORMS SEEN C C C DEFINE FILE AREAS FOR MAPPING FILES... C ONE INPUT FILE, TO BE ACCESSED AS A RANDOM ACCESS FILE OF 128 BYTE C RECORDS OF DATA IF RANDOM, OR AS A FORMULA FILE IF SEQUENTIAL, AND C ONE OUTPUT FILE TO BE WRITTEN THE SAME WAY. INPUT FILE CAN BE C INPUT - ONLY OR READ/WRITE. C C DEFINE ALSO DATA STRUCTURES TO HOLD CELL RANGES (IN ROW AND COL) C TO BE TREATED WITH THESE FILES, FLAG FOR HOW-OPEN, AND LUN USED. C C MFIOPN = 0 IF NOT OPEN C 1 IF OPEN FOR READ ONLY, SEQUENTIAL C 2 IF OPEN READ ONLY, RANDOM C 3 IF OPEN READ/WRITE, RANDOM. C C MFOOPN = 0 IF NOT OPEN C 1 IF OPEN WRITE SEQUENTIAL C 2 IF OPEN WRITE RANDOM C C OTHER OPTIONS DON'T MAKE SENSE. C MFIRL,MFIRH = RRW DIMENSION LOW, HIGH BOUND, INPUT FILE C MFICL,MFICH = RCL DIMENSION LOW, HIGH BOUND, INPUT FILE C MFORL,RH,MFOCL,CH = OUT FILE BOUNDS C MFILUN,MFOLUN ARE LOGICAL UNITS. INTEGER*2 MFIOPN,MFIRL,MFIRH,MFICL,MFICH INTEGER*2 MFOOPN,MFORL,MFORH,MFOCL,MFOCH INTEGER*2 MFILUN,MFOLUN,MFIFLG,MFOFLG COMMON/MFILES/MFIOPN,MFOOPN,MFIRL,MFIRH,MFICL,MFICH, 1 MFORL,MFORH,MFOCL,MFOCH,MFILUN,MFOLUN,MFIFLG,MFOFLG C C 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,LFMX),MFMOD LOGICAL*1 LFID(16,LFMX) 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. MFIOPN=0 MFOOPN=0 MFILUN=11 MFOLUN=12 MFIFLG=0 MFOFLG=0 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 NBK=LPGMXF*2 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 C DO 9 N=1,LVBF C DO 9 M=1,5 C9 LVALBF(M,N)=0 NPG=(IPGMAX*2) C DO 10 N4=1,IPDM C QVDAT(N4)=0 CC ABOVE WAS -1 FOR CASE OF WORKFILES C10 CONTINUE 11 CONTINUE C AGAIN FLAG VIRGIN CELLS WITH ID OF -1 C DO 12 N=1,LFM C DO 12 M=1,8 C12 IFID(M,N)=0 C LET 0 MEAN A VIRGIN CELL, -1 MEAN EMPTY BUT PREV. INIT'D. C SINCE VMS SUPPLIES ZERO VALUES BY DEFAULT, SKIP INITIALIZING HERE NPG=LPGMXF*2 C DO 13 N4=1,LPDM C QFDAT(N4)=0 C13 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 C ID=(ID2-1)*RRW+ID1 CALL REFLEC(ID2,ID1,ID) 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 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 logical*1 fvmsk(rcp) equivalence(fvmsk(1),fv1(1)) equivalence(fvmsk(2),fv2(1)) equivalence(fvmsk(4),fv4(1)) common/fvldm/fvmsk c 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 c IBT=((ID-1)/8)+1 c IBIT=((ID-1).AND.7)+1 c I1=FV1(IBT).AND.LBITS(IBIT) c I2=FV2(IBT).AND.LBITS(IBIT) c I4=FV4(IBT).AND.LBITS(IBIT) IVAL=0 C RETURN NONZERO IF ANY BITS ARE SET. c IF((I1+I2+I4).NE.0)IVAL=1 if(fvmsk(id).ne.0)ival=1 RETURN 2000 CONTINUE C ID=(ID2-1)*RRW+ID1 IF(ID2.EQ.1.AND.ID1.LE.RRCL)GOTO 7806 CALL REFLEC(ID2,ID1,ID) GOTO 7807 7806 CONTINUE ID=ID1 7807 CONTINUE c IBT=((ID-1)/8)+1 c IBIT=((ID-1).AND.7)+1 c I1=FV1(IBT).AND.LBITS(IBIT) c I2=FV2(IBT).AND.LBITS(IBIT) c I4=FV4(IBT).AND.LBITS(IBIT) c IVL=0 c IF(I1.NE.0)IVL=1 c IF(I2.NE.0)IVL=IVL+2 c IF(I4.NE.0)IVL=-IVL c IVAL=IVL ival=fvmsk(id) 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 logical*1 fvmsk(rcp) equivalence(fvmsk(1),fv1(1)) equivalence(fvmsk(2),fv2(1)) equivalence(fvmsk(4),fv4(1)) common/fvldm/fvmsk c 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 C ID=(ID2-1)*RRW+ID1 IF(ID2.EQ.1.AND.ID1.LE.RRCL)GOTO 7800 CALL REFLEC(ID2,ID1,ID) GOTO 7801 7800 ID=ID1 7801 CONTINUE c IBT=((ID-1)/8)+1 c IBIT=((ID-1).AND.7)+1 cC ZERO ALL 3 FVLD BITS FIRST c FV1(IBT)=FV1(IBT).AND..NOT.LBITS(IBIT) c FV2(IBT)=FV2(IBT).AND..NOT.LBITS(IBIT) c FV4(IBT)=FV4(IBT).AND..NOT.LBITS(IBIT) c IVVV=IVAL c IVV=IABS(IVVV) c I3=0 c IF(IVAL.LT.0)I3=1 c I1=0 c I2=0 c I2=IVV.AND.2 c I1=IVV.AND.1 cC NOTE WE ASSUME HEAVILY THAT LOGICAL OPERATIONS WORK BY BINARY cC ANDS AND ORS IN DATA. c IF(I1.NE.0)FV1(IBT)=FV1(IBT).OR.LBITS(IBIT) c IF(I2.NE.0)FV2(IBT)=FV2(IBT).OR.LBITS(IBIT) c IF(I3.NE.0)FV4(IBT)=FV4(IBT).OR.LBITS(IBIT) fvmsk(id)=ival 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 INTEGER*2 ICREF,IRREF COMMON/MIRROR/ICREF,IRREF 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 IID1=ID1 IID2=MAX0(ID2,1) IF(ID2.LT.1)GOTO 7802 IF(ID2.GT.1.OR.ID1.GT.27)GOTO 7780 C AN ACCUMULATOR. SET IT. C HAVE EVERYTHING HERE SO NO PROBLEMS WITH RECOGNIZING CELLS... XVT=XX DO 7781 IV=1,8 7781 AVBLS(IV,ID1)=VT(IV) RETURN 7780 CONTINUE 4000 CONTINUE IF(IID1.LE.RRW)GOTO 7801 IID1=IID1-RRW IID2=IID2+IRREF GOTO 4000 7801 CONTINUE IF(IID2.LE.RCL)GOTO 7802 IID2=IID2-RCL+1 IID1=IID1+ICREF GOTO 4000 7802 CONTINUE QQDAT(IID1,IID2)=XX 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) INTEGER*2 ICREF,IRREF COMMON/MIRROR/ICREF,IRREF 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 IID1=ID1 IID2=MAX0(ID2,1) IF(ID2.LT.1)GOTO 7802 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 4000 CONTINUE IF(IID1.LE.RRW)GOTO 7801 IID1=IID1-RRW IID2=IID2+IRREF GOTO 4000 7801 CONTINUE IF(IID2.LE.RCL)GOTO 7802 IID2=IID2-RCL+1 IID1=IID1+ICREF GOTO 4000 7802 CONTINUE XX=QQDAT(IID1,IID2) RETURN END