CAINDMSAHTBX -- RENUMBER IND ARRAY OR INTERPOLATE W/TABLE FOR TRAX 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR H. JULIAN 00020000 CA DESIGNER D. REED 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 5/15/79 00060000 C REVISED 04-07-80 RCD - TWO ELEMENT INDEX ARRAY 00070000 C REVISED 10-03-84 NAM. VSFORTRAN CONVERSION. CHANGED NUM IN 00080000 C ENTRY SAREN3 TO NUMA. 00090000 C REVISED 01-15-85 REP-ADD CALLS TO USBFRX & ADD IX TO ARG LIST00100000 C REVISED 08-14-85 REP-CHANGE NAMES TO HAVE 'X' SUFFIX INSTEAD 00110000 C OF '3'. 00120000 CTITLE SARENX -- ASSIGN UNIQUE SEQ. # TO SHOTS/RECEIVERS ON 3D LINE 00130000 CA 00140000 CA CALL SARENX(INDEX, IX, NT, NUMTAB, LEN, MINNUM, NUMINC, ISEQ, IER)00150000 CA 00160000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00170000 CA 00180000 CA IN INDEX I4 INDEX ARRAY FROM TRAX. WILL BE RENUMBERED. 00190000 CA IN IX I4 FIRST INDEX OF 2 DIMENSIONAL INDEX ARRAY. 00200000 CA IN NT I4 LENGTH OF INDEX ARRAY 00210000 CA IN LEN I4 LENGTH OF NUMTAB 00220000 CA IN MINNUM I4 MINIMUM NUMBER 00230000 CA IN NUMINC I4 NUMBER INCREMENT ROUNDED UP TO NEAREST 100 00240000 CA IN ISEQ I4 STARTING NUMBER TO USE IN RENUMBERING 00250000 CA INDEX ARRAY. ISEQ IS INCREMENTED BY THE 00260000 CA NUMBER OF UNIQUE NUMBERS IN INDEX ARRAY. 00270000 CA OUT NUMTAB I4 HASHING TABLE CONTAINING ORIGINAL NUMBER, 00280000 CA INDEX INTO INDEX ARRAY, AND POINTERS. 00290000 CA OUT IER I4 ERROR RETURN CODE. 00300000 CA 0 = NORMAL RETURN 00310000 CA 1 = NUMTAB ARRAY TOO SHORT TO CONTAIN ALL 00320000 CA ENTRIES NEEDED TO RENUMBER INDEX ARRAY. 00330000 CA 00340000 CA SARENX ASSIGNS A UNIQUE SEQUENTIAL NUMBER TO EACH REC. OR SHOT 00350000 CA NUMBER IN THE INDEX ARRAY. THE SEQUENTIAL NUMBERS ARE STORED IN 00360000 CA THE INDEX ARRAY. A TABLE IS BUILT CONTAINING THE ORIGINAL #'S 00370000 CA AND THE CORRESPONDING ASSIGNED SEQUENTIAL #'S. LAST SEQUENTIAL 00380000 CA NUMBER USED IS RETURNED IN SEQ. 00390000 CAEND 00400000 CTITLE SAINTX -- LINEAR INTERP. FOR SHOT/RECEIVER SOLUTION VALUE 00410000 CA 00420000 CA CALL SAINTX(NUM, NUMTAB, LEN, X, NUMSOL, KSURF) 00430000 CA 00440000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00450000 CA 00460000 CA IN NUM I4 ORIGINAL SHOT OR REC. # FOR INTERPOLATION 00470000 CA IN NUMTAB I4 HASHING TABLE CONTAINING NUM AND INDICES. 00480000 CA IN LEN I4 NUMBER OF ENTRIES IN NUMTAB 00490000 CA IN X R8 SOLUTION ARRAY. SEQ. #'S IN TABLE INDEX 00500000 CA IN KSURF I2 SOLUTION FOLD INDICATOR ARRAY 00510000 CA OUT NUMSOL R8 INTERPOLATED SOLUTION VALUE FOR NUM 00520000 CA 00530000 CA SAINTX SEARCHES FOR THE CLOSEST VALUES TO NUM IN THE HASHING 00540000 CA TABLE, RETRIEVES THE X INDICES AND DOES A LINEAR INTERPOLATION 00550000 CA TO GIVE NUMSOL. 00560000 CAEND 00570000 CTITLE SADITX -- LINEAR INTERPOLATION FOR A CDP SOLUTION VALUE 00580000 CA 00590000 CA CALL SADITX(NUM, LEN, X, KSURF, CDPSOL) 00600000 CA 00610000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00620000 CA 00630000 CA IN NUM I4 CDP INDEX FOR INTERPOLATION 00640000 CA IN LEN I4 NUMBER OF CDP SOLUTIONS IN KSURF & X 00650000 CA IN X R8 SOLUTION ARRAY 00660000 CA IN KSURF I2 SOLUTION FOLD INDICATOR ARRAY 00670000 CA OUT CDPSOL R8 INTERPOLATED SOLUTION VALUE FOR NUM 00680000 CA 00690000 CA SADITX SEARCHES THE CDP INDICES FOR THE CLOSEST VALUES 00700000 CA HAVING SOLUTIONS AND DOES A LINEAR INTERPOLATION TO 00710000 CA GIVE CDPSOL. 00720000 CAEND 00730000 CA 00740000 SUBROUTINE SAHTBX 00750000 C 00760000 COMMON COM(1) 00770000 INTEGER COM 00780002 REAL XCOM(1) 00790000 REAL*8 ZCOM(1) 00800000 EQUIVALENCE (COM(1),XCOM(1),ZCOM(1)) 00810000 C 00820000 C COMMON BUFFERING INFORMATION BLOCK 00830000 C 00840000 COMMON /BFINFO/ BYND(15), BIND(15), BOFF(15), BQND(15) 00850000 C 00860000 INTEGER BYND, BIND, BOFF, BQND 00870000 C 00880000 INTEGER IX 00890000 C 00900000 C 00910000 INTEGER*2 KSURF 00920000 C 00930000 REAL*8 SOL 00940000 REAL*8 X 00950000 C 00960000 C ARRAYS IN PARAMETER LIST 00970000 C 00980000 DIMENSION INDEX (2,1) 00990000 DIMENSION KSURF (1) 01000000 DIMENSION NUMTAB (1) 01010000 DIMENSION X (1) 01020000 C 01030000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC01040000 C C01050000 C SARENX ENTRY C01060000 C C01070000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC01080000 C 01090000 ENTRY SARENX (INDEX,IX, NT, NUMTAB,LEN, MINNUM, NUMINC, ISEQ, IER)01100000 C 01110000 LEN3 = LEN * 3 01120000 C 01130000 C OVERFLOW POINTS TO LAST TRIPLE IN HASHING TABLE 01140000 C 01150000 IOVFL = (LEN-1) * 3 + 1 01160000 CX J = 1 01170000 CALL ARSET(NUMTAB, LEN3, 0) 01180000 C 01190000 DO 80 I = 1, NT 01200000 IF (BIND(12) .EQ. 0) THEN 01210000 CALL USBFRX (INDEX, I, J, 1, BIND) 01220000 ELSE 01230000 J = 1 01240000 INDEX(IX,J) = COM(BIND(12)+2*I-3+IX) 01250000 ENDIF 01260000 NUMA = INDEX(IX,J) / NUMINC - MINNUM / NUMINC + 1 01270000 IREM = NUMA - NUMA / LEN * LEN 01280000 C 01290000 C *3 BECAUSE THERE ARE 3 WORDS PER ENTRY 01300000 C +1 BECAUSE FORTRAN INDEX STARTS AT 1, NOT 0. 01310000 C 01320000 K=IREM*3+1 01330000 IF (NUMTAB(K+1) .NE. 0) GO TO 10 01340000 C 01350000 C CELL IS EMPTY. STORE ORIGINAL SHOT (OR RECEIVER) 01360000 C NUMBER IN FIRST WORD OF HASHING TABLE CELL. 01370000 C 01380000 NUMTAB(K) = INDEX(IX,J) 01390000 C 01400000 C STORE SEQUENTIAL NUMBER IN 2ND WORD OF HASHING TABLE CELL 01410000 C 01420000 NUMTAB(K+1) = ISEQ 01430000 C 01440000 C REPLACE ORIGINAL SHOT (OR REC) NUMBER IN INPUT ARRAY BY 01450000 C SEQUENTIAL NUMBER. 01460000 C 01470000 INDEX(IX,J) = ISEQ 01480001 IF (BIND(12) .NE. 0) THEN 01490001 COM(BIND(12)+2*I-3+IX) = INDEX(IX,J) 01500000 ENDIF 01510000 GO TO 60 01520000 C 01530000 C THE CELL IS OCCUPIED. 01540000 C 01550000 10 IF(INDEX(IX,J) .NE. NUMTAB(K)) GO TO 20 01560000 C 01570000 C THE ORIGINAL NUMBER IN THE INDEX ARRAY IS THE SAME AS IN THE 01580000 C HASHING TABLE CELL. DUPLICATE SHOT OR RECEIVER NUMBERS. 01590000 C REPLACE ORIGINAL SHOT (OR REC.) NUMBER ON INPUT ARRAY BY 01600000 C SEQUENTIAL NUMBER. 01610000 C 01620000 INDEX(IX,J) = NUMTAB(K+1) 01630001 IF (BIND(12) .NE. 0) THEN 01640001 COM(BIND(12)+2*I-3+IX) = INDEX(IX,J) 01650000 ENDIF 01660000 GO TO 70 01670000 C 01680000 20 CONTINUE 01690000 C 01700000 C A SYNONYM HAS BEEN FOUND, BUT THE ORIGINAL SHOT (OR REC.) 01710000 C NUMBERS ARE NOT IDENTICAL. 01720000 C 01730000 IF(NUMTAB(K+2) .NE. 0) GO TO 50 01740000 C 01750000 C CHAIN POINTER = 0. CHAIN NEXT OVERFLOW CELL TO IT AND 01760000 C DECREASE THE OVERFLOW POINTER. 01770000 C 01780000 30 IF(IOVFL .LE. 0) GO TO 100 01790000 C 01800000 C IF THE OVERFLOW CELL IS FULL, BUMP POINTER TO NEXT. 01810000 C 01820000 IF(NUMTAB(IOVFL) .EQ. 0) GO TO 40 01830000 IOVFL = IOVFL - 3 01840000 GO TO 30 01850000 C 01860000 40 NUMTAB(K+2) = IOVFL 01870000 NUMTAB(IOVFL) = INDEX(IX,J) 01880000 NUMTAB(IOVFL+1) = ISEQ 01890000 INDEX(IX,J) = ISEQ 01900001 IF (BIND(12) .NE. 0) THEN 01910001 COM(BIND(12)+2*I-3+IX) = INDEX(IX,J) 01920000 ENDIF 01930000 IOVFL = IOVFL - 3 01940000 GO TO 60 01950000 C 01960000 50 CONTINUE 01970000 C 01980000 C CHAIN POINTER IS NOT ZERO, GET THE ADDRESS OF THE OVERFLOW CELL. 01990000 C 02000000 K = NUMTAB(K+2) 02010000 GO TO 10 02020000 C 02030000 60 CONTINUE 02040000 ISEQ = ISEQ + 1 02050000 C 02060000 CX 70 J = J + 2 02070000 70 CONTINUE 02080000 C 02090000 80 CONTINUE 02100000 C 02110000 90 IER = 0 02120000 GO TO 110 02130000 C 02140000 100 IER = 1 02150000 C 02160000 110 RETURN 02170000 C 02180000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC02190000 C C02200000 C SAINTX ENTRY C02210000 C C02220000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC02230000 C 02240000 ENTRY SAINTX (NUM, NUMTAB, LEN, X, SOL, KSURF) 02250000 C 02260000 C 02270000 MIN = -999999 02280000 MAX = 999999 02290000 C 02300000 C LOOP THRU TABLE SEARCHING FOR CLOSEST ENTRIES TO GIVEN # 02310000 C 02320000 J = 1 02330000 C 02340000 DO 150 I = 1, LEN 02350000 C 02360000 C GET SEQ # TO POINT TO SOLUTION FLAG. 02370000 C 02380000 K = NUMTAB(J+1) 02390000 C 02400000 C IF SEQ. # FROM CELL IS 0, THE CELL IS EMPTY. 02410000 C 02420000 IF(K .EQ. 0) GO TO 140 02430000 C 02440000 C IS THERE A SOLUTION? 0=NO SOLUTION. 02450000 C 02460000 IF (KSURF(K) .EQ. 0) GO TO 140 02470000 C 02480000 C COMPARE ORIGINAL # IN TABLE TO GIVEN #. 02490000 C 02500000 IF(NUMTAB(J) .NE. NUM) GO TO 120 02510000 C 02520000 C THE # TO BE INTERPOLATED IS PRESENT IN THE HASHING TABLE 02530000 C AND HAS A SOLUTION. GET THE SOLUTION AND RETURN. 02540000 C 02550000 SOL = X(K) 02560000 GO TO 90 02570000 C 02580000 120 IF(NUMTAB(J) .GT. NUM) GO TO 130 02590000 C 02600000 C FIND MAX # < GIVEN #. NUMTAB(J) < NUM. IF THIS LOWER NUMBER 02610000 C IS .GT. THE PREVIOUS LOWER, SAVE IT. 02620000 C 02630000 IF(NUMTAB(J) .LE. MIN) GO TO 140 02640000 MIN = NUMTAB(J) 02650000 MINSEQ = K 02660000 GO TO 140 02670000 C 02680000 C FIND MIN # > GIVEN #. NUMTAB(J) > NUM. IF THIS HIGHER NUMBER 02690000 C IS .LT. THE PREVIOUS HIGHER, SAVE IT. 02700000 C 02710000 130 IF(NUMTAB(J) .GE. MAX) GO TO 140 02720000 MAX = NUMTAB(J) 02730000 MAXSEQ = K 02740000 C 02750000 140 J = J + 3 02760000 C 02770000 150 CONTINUE 02780000 C 02790000 160 IF(MIN .EQ. 999999 .OR. MAX .EQ. -999999) GO TO 170 02800000 IF(MIN .EQ. -999999 .OR. MAX .EQ. 999999) GO TO 170 02810000 XMIN = MIN 02820000 XMAX = MAX 02830000 XNUM = NUM 02840000 SOL = X(MINSEQ) + (XNUM - XMIN) * ( X(MAXSEQ) - X(MINSEQ) ) / 02850000 * (XMAX - XMIN) 02860000 GO TO 90 02870000 C 02880000 C THE GIVEN # CANNOT BE BRACKETED. SET TO 0. 02890000 C 02900000 170 SOL = 0.0 02910000 GO TO 90 02920000 C 02930000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC02940000 C C02950000 C SADITX ENTRY C02960000 C C02970000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC02980000 C 02990000 ENTRY SADITX (NUM, LEN, X, KSURF, SOL) 03000000 C 03010000 C 03020000 IF(NUM .LT. 1 .OR. NUM .GT. LEN) GO TO 170 03030000 C 03040000 C IF THE GIVEN NUMBER HAS A SOLUTION, GET IT. 03050000 C 03060000 IF(KSURF(NUM) .EQ. 0) GO TO 180 03070000 SOL = X(NUM) 03080000 GO TO 90 03090000 C 03100000 180 IDELT = LEN - NUM 03110000 IF(IDELT .NE. 0) GO TO 190 03120000 MAX = 999999 03130000 GO TO 220 03140000 C 03150000 C SEARCH KSURF FROM NUM+1 TO UPPER END OF ARRAY. 03160000 C 03170000 190 NUM1 = NUM + 1 03180000 C 03190000 DO 200 I = NUM1, LEN 03200000 II = I 03210000 IF(KSURF(I) .NE. 0) GO TO 210 03220000 200 CONTINUE 03230000 C 03240000 C NO UPPER SOLUTION. 03250000 C 03260000 MAX = 999999 03270000 GO TO 220 03280000 C 03290000 210 MAX = II 03300000 MAXSEQ = II 03310000 C 03320000 220 IF(NUM .NE. 1) GO TO 230 03330000 C 03340000 C NO LOWER SOLUTION. 03350000 C 03360000 MIN = -999999 03370000 GO TO 160 03380000 C 03390000 230 INUM = NUM - 1 03400000 C 03410000 C SEARCH KSURF FROM NUM-1 BACK TO 1. 03420000 C 03430000 DO 240 I = 1, INUM 03440000 II = INUM - I + 1 03450000 C 03460000 C IS THERE A SOLUTION HERE? 03470000 C 03480000 IF(KSURF(II) .NE. 0) GO TO 250 03490000 240 CONTINUE 03500000 C 03510000 C NO LOWER SOLUTION. 03520000 03530000 MIN = -999999 03540000 GO TO 160 03550000 03560000 C SAVE SOLUTION INDEX. 03570000 C 03580000 250 MIN = II 03590000 MINSEQ = II 03600000 GO TO 160 03610000 C 03620000 9000 FORMAT(' *** HASHING TABLE NOT LARGE ENOUGH *** ') 03630000 C 03640000 END 03650000