SUBROUTINE SET(JQ,NSET) C//////////////////////////////////////////////////////////////// C/ / C/ Program-id. SET / C/ Date-written. Jan. 16th 1984 / C/ File-name. SET.FOR (Ver2.0) / C/ Remarks. Subroutine SET.FOR page 62. / C/ Subroutine SET is the heart of the / C/ information storage and retrieval / C/ system. SET performs three functions: / C/ 1. Initialize the filing array NSET / C/ 2. Updates the pointer system. / C/ 3. Maintain statistics on the number / C/ of entries in each file. / C/ / C//////////////////////////////////////////////////////////////// C C * Default size of INTEGER = 2 bytes in F80 C INTEGER*4 NSET(6,1) C COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST, 1 NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED, 2 TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4) C COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4), 1 MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4), C 2 QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON, 3 NDAY,NYR,JCLR C C --- INIT should be one for initialization of file C IF (INIT - 1) 27,28,27 C C --- Initialize file to zero. Set up pointers C must initialize KRANK(JQ) C must initialize INN(JQ) C 28 KOL = 7777 KOF = 8888 KLE = 9999 MX = IM + 1 MXX = IM + 2 C C --- Inirtialize pointing cells of NSET and zero other cells C of NSET C DO 1 I=1,ID DO 2 J=1,IM NSET(J,I) = 0 2 CONTINUE NSET(MXX,I) = I - 1 NSET(MX,I) = I + 1 1 CONTINUE NSET(MX,ID) = KOF DO 3 K=1,NOQ NQ(K) = 0 MLC(K) = 0 MFE(K) = 0 MAXNQ(K) = 0 MLE(K) = 0 ENQ(K) = 0.0 VNQ(K) = 0.0 QTIME(K) = TNOW 3 CONTINUE C C --- First available column = 1 C MFA = 1 INIT = 0 OUT = 0.0 RETURN C C --- MFEX is first entry in file which has not been compared C with ITEM to be inserted. C 27 MFEX = MFE(JQ) C C --- KNT is a check code to indicate that no comparisons have C been made. C KNT = 2 C C --- KS is the row on which items of file JQ are ranked. C KS = KRANK(JQ) C C --- Test for putting value in or out C if out equals one an item is to be removed from file JQ C If OUT is less than ONE an item is to be inserted in C file JQ C IF (OUT-1.0) 8,5,100 C C --- Putting an entry in file JQ C 8 NXFA = NSET(MX,MFA) C C --- If INN(JQ) equals two the file is a HVF file. If INN(JQ) C is one the file is a LVF file. For LVF files try to insert C Stating at end of file. MLEX is last entry in file which C has not been compared with items to be inserted. C IF (INN(JQ) - 1) 100,7,6 7 MLEX = MLE(JQ) C C --- If MLEX is zero file is empty. item to be inserted will be C only item in file. C IF (MLEX) 100,10,11 10 NSET(MXX,MFA) = KLE MFE(JQ) = MFA C C --- There is no successor of item inserted. Since item was C inserted in column MFA the last entry of file JQ is in C column MFA. C 17 NSET(MX,MFA) = KOL MLE(JQ) = MFA C C --- Set new MFA equal to successor of old MFA. that is NXFA C 14 MFA = NXFA IF (MFA - KOF) 237,238,238 237 NSET(MXX,MFA) = KLE C C ---Update statistics of file JQ C 238 XNQ = NQ(JQ) ENQ(JQ) = ENQ(JQ) + XNQ * (TNOW - QTIME(JQ)) VNQ(JQ) = VNQ(JQ) + XNQ * XNQ * (TNOW - QTIME(JQ)) QTIME(JQ) = TNOW NQ(JQ) = NQ(JQ) + 1 MAXNQ(JQ) = MAX0(MAXNQ(JQ),NQ(JQ)) MLC(JQ) = MFE(JQ) RETURN C C --- Test ranking value of new item against value of item C in column C 11 IF (NSET(KS,MFA)-NSET(KS,MLEX)) 12,13,13 C C --- Insert item after column MLEX. C 13 MSU = NSET(MX,MLEX) NSET(MX,MLEX) = MFA NSET(MXX,MFA) = MLEX GO TO (18,17),KNT C C --- Since KNT equals one a comparison was made and there C is A. C 18 NSET(MX,MFA) = MSU NSET(MXX,MSU) = MFA GO TO 14 C C --- Set KNT to one since a comparison was made. C 12 KNT = 1 C C --- Test MFA against predecessor of MLEX by letting C MLEX equal predecessor of MLEX. C MLEX = NSET(MXX,MLEX) IF (MLEX-KLE) 11,16,11 C C --- If MLEX had no predecessor MFA is first in file C 16 NSET(MXX,MFA) = KLE MFE(JQ) = MFA C C C 26 NSET(MX,MFA) = MFEX NSET(MXX,MFEX) = MFA GO TO 14 C C --- FOR HVF OPERATION TRY TO INSERT ITEM STARTING AT BEGINNING C OF FILE JQ. C 6 IF (MFEX) 100,10,19 C C --- Test ranking value of new item against value of C item in column MFEX. C 19 IF (NSET(KS,MFA)-NSET(KS,MFEX)) 20,21,21 C C --- If new value if lower. MFA must be compared against C successor of MFEX. C 20 KNT = 1 C C --- Let MPRE = MFEX and let MFEX be the successor of MFEX. C MPRE = MFEX MFEX = NSET(MX,MFEX) IF (MFEX-KOL) 19,24,19 C C --- If new value is higher, it should be inserted between C MFEX and ITS. C 21 GO TO (22,16),KNT 22 KNT = 2 C C --- MFA is to be inserted after MPRE. Make MPRE the prdece C ssor of MFA and MFA the successor of MPRE. C 24 NSET(MXX,MFA) = MPRE NSET(MX,MPRE) = MFA C C --- If KNT was not reset to 2, thre is no successor of MFA C pointers are updated at statement 17. C GO TO (17,26), KNT C C --- Removal of an item from file JQ. C 5 OUT = 0.0 C C --- Update pointing system to account for removal of MLC(JQ) C MMLC = MLC(JQ) C C --- Reset out to 0 and clear column removed. C DO 32 I=1,IM NSET(I,MMLC) = 0 32 CONTINUE JL = NSET(MX,MMLC) JK = NSET(MXX,MMLC) IF (JL - KOL) 33,34,33 33 IF (JK - KLE) 35,36,35 35 NSET(MX,JK) = JL NSET(MXX,JL) = JK C C --- Update pointers. C 37 NSET(MX,MMLC) = MFA NSET(MXX,MMLC) = KLE IF (MFA - KOF) 234,235,235 234 NSET(MXX,MFA) = MMLC 235 MFA = MLC(JQ) MLC(JQ) = MFE(JQ) C C --- Update file statistaics C XNQ = NQ(JQ) ENQ(JQ) = ENQ(JQ) + XNQ * (TNOW - QTIME(JQ)) VNQ(JQ) = VNQ(JQ) + XNQ * XNQ * (TNOW - QTIME(JQ)) QTIME(JQ) = TNOW NQ(JQ) = NQ(JQ) - 1 RETURN C C --- MLC was first entry but not last entry. update pointers. C 36 NSET(MXX,JL) = KLE MFE(JQ) = JL GO TO 37 34 IF (JK - KLE) 38,39,38 C C --- MLC was last entry but not first entry. Update pointers. C 38 NSET(MX,JK) = KOL MLE(JQ) = JK GO TO 37 C C --- MLC was both the last and first entry, therefore, it is C the only entry. C 39 MFE(JQ) = 0 MLE(JQ) = 0 GO TO 37 100 CALL ERROR(88,NSET) CALL EXIT END