CAINDMSAHTAB -- RENUMBER IND ARRAY OR INTERPOLATE W/TABLE FOR TRAC 00000001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE SAREN -- ASSIGN UNIQUE NUMBER TO RECEIVERS AND SHOTS 00000010 CA AUTHOR D. REED 00000060 CA DESIGNER D. REED 00000070 CA SYSTEM IBM OR CRAY. 00000071 CA LANGUAGE VS FORTRAN 00000080 CA WRITTEN 02-03-77 00000090 C REVISED 05-15-79 H.JULIAN. CONVERT FROM ASSEMBLER TO FORTRAN 00000100 C REVISED 06-22-79 REP. ADD CALLS TO USBUFR 00000110 C REVISED 10-03-84 NAM. VSFORTRAN CONVERSION. CHANGED NUM IN 00000111 C ENTRY SAREN TO NUMA. 00000112 C REVISED 04-29-86 JMP. DUAL IBM/CRAY VERSION. 00000113 CA 00000120 CA 00000140 CA CALL SAREN(ISW,INDEX,BUFV,NT,NUMTAB,LEN,MINNUM,NUMINC,ISEQ,IER) 00000150 CA 00000151 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000152 CA 00000153 CA IN ISW I4 =1 FOR RECEIVERS; 2 FOR SHOTS 00000154 CA IN INDEX I4 INDEX ARRAY FROM TRAC. WILL BE RENUM. 00000155 CA IN BUFV I4 USBUFR ARRAY OF VARIABLES 00000160 CA IN NT I4 LENGTH OF INDEX ARRAY 00000170 CA IN LEN I4 LENGTH OF NUMTAB 00000180 CA IN MINNUM I4 MINIMUM NUMBER 00000190 CA IN NUMINC I4 NUMBER INCREMENT ROUNDED UP TO NEAREST 10000000200 CA IN ISEQ I4 STARTING NUMBER TO BE USED IN RENUMBERING 00000210 CA INDEX ARRAY. SEQ IS INCREMENTED BY 00000220 CA NUMBER OF UNIQUE NUMBERS IN INDEX ARRAY. 00000230 CA OUT NUMTAB I4 HASHING TABLE CONTAINING ORIGINAL NUMBER, 00000240 CA INDEX INTO INDEX ARRAY AND POINTERS. 00000250 CA OUT IER I4 ERROR RETURN CODE. 00000260 CA 0 = NORMAL RETURN. 00000270 CA 1 = NUMTAB ARRAY TOO SHORT TO CONTAIN ALL00000280 CA ENTRIES NEEDED TO RENUMBER INDEX 00000290 CA ARRAY. 00000300 CA 00000320 CA SAREN ASSIGNS A UNIQUE SEQUENTIAL NUMBER TO EACH REC. OR SHOT 00000330 CA NUMBER IN THE INDEX ARRAY. THE SEQUENTIAL NUMBERS ARE STORED IN 00000340 CA THE INDEX ARRAY. A TABLE IS BUILT CONTAINING THE ORIGINAL #'S 00000350 CA AND THE CORRESPONDING ASSIGNED SEQUENTIAL #'S. LAST SEQUENTIAL 00000360 CA NUMBER USED IS RETURNED IN SEQ. 00000370 CAEND 00000380 CTITLE SAINTP -- LINEAR INTERPOLATION FOR SHOT/RECEIVER SOLUTION 00000390 CA AUTHOR D. REED 00000391 CA DESIGNER D. REED 00000392 CA LANGUAGE FORTRAN H 00000393 CA WRITTEN 02-03-77 00000394 CA REVISED 05-15-79 H.JULIAN. CONVERT FROM ASSEMBLER TO FORTRAN 00000395 CA REVISED 06-22-79 REP. ADD CALLS TO USBUFR 00000396 CA 00000397 CA 00000400 CA CALL SAINTP(NUM, NUMTAB, LEN, X, NUMSOL, KSURF) 00000410 CA 00000411 CA INPUT NUM = ORIGINAL SHOT OR REC. # FOR INTERPOLATION I4 00000420 CA NUMTAB= HASHING TABLE CONTAINING NUM AND INDICES. I4 00000430 CA LEN = NUMBER OF ENTRIES IN NUMTAB I4 00000440 CA X = SOLUTION ARRAY. SEQ. #'S IN TABLE INDEX R8 00000450 CA KSURF = SOLUTION FOLD INDICATOR ARRAY I2 00000460 CA OUTPUT NUMSOL= INTERPOLATED SOLUTION VALUE FOR NUM R8 00000470 CA 00000480 CA SAINTP SEARCHES FOR THE CLOSEST VALUES TO NUM IN THE HASHING 00000490 CA TABLE, RETRIEVES THE X INDICES AND DOES A LINEAR INTERPOLATION 00000500 CA TO GIVE NUMSOL. 00000510 CAEND 00000520 CTITLE SADITP -- LINEAR INTERPOLATION FOR CDP RNMO SOLUTION 00000530 CA AUTHOR D. REED 00000531 CA DESIGNER D. REED 00000532 CA LANGUAGE FORTRAN H 00000533 CA WRITTEN 02-03-77 00000534 CA REVISED 05-15-79 H.JULIAN. CONVERT FROM ASSEMBLER TO FORTRAN 00000535 CA REVISED 06-22-79 REP. ADD CALLS TO USBUFR 00000536 CA 00000537 CA 00000540 CA CALL SADITP(NUM, LEN, X, KSURF, CDPSOL) 00000550 CA 00000551 CA INPUT NUM = CDP INDEX FOR INTERPOLATION I4 00000560 CA LEN = NUMBER OF CDP SOLUTIONS IN KSURF & X I4 00000570 CA X = SOLUTION ARRAY R8 00000580 CA KSURF = SOLUTION FOLD INDICATOR ARRAY I2 00000590 CA OUTPUT CDPSOL= INTERPOLATED SOLUTION VALUE FOR NUM R8 00000600 CA 00000610 CA SADITP SEARCHES THE CDP INDICES FOR THE CLOSEST VALUES 00000620 CA HAVING SOLUTIONS AND DOES A LINEAR INTERPOLATION TO 00000630 CA GIVE CDPSOL. 00000640 CAEND 00000650 C 00000660 SUBROUTINE SAHTAB 00000661 ENTRY SAREN(ISW,INDEX,BUFV,NT,NUMTAB,LEN,MINNUM,NUMINC,ISEQ,IER) 00000662 C 00000670 C ------------------------------------------- 00000680 C 00000690 INTEGER BUFV(4) 00000700 INTEGER*2 KSURF 00000710 INTEGER DA 00000715 DOUBLE PRECISION X,SOL 00000720 DIMENSION INDEX(1),NUMTAB(1),X(1),KSURF(1) 00000730 LEN3=LEN*3 00000740 C OVERFLOW POINTS TO LAST TRIPLE IN HASH TABLE 00000750 IOVFL=(LEN-1)*3+1 00000760 J=1 00000770 DA = 1 00000780 CALL USBUFR (0, INDEX, BUFV, DA, J) 00000790 CALL ARSET(NUMTAB,LEN3,0) 00000800 DO 500 00000810 *I=1,NT 00000820 NUMA = INDEX(J+ISW)/NUMINC-MINNUM/NUMINC+1 00000830 IREM=NUMA-NUMA/LEN*LEN 00000840 C *3 BECAUSE THERE ARE 3 WORDS PER ENTRY 00000850 C +1 BECAUSE FORTRAN INDEX STARTS AT 1, NOT 0. 00000860 K=IREM*3+1 00000870 IF(NUMTAB(K+1) .NE. 0) GO TO 220 00000880 C CELL IS EMPTY. STORE ORIGINAL SHOT (OR RECEIVER) 00000890 C NUMBER IN FIRST WORD OF HASH TABLE CELL. 00000900 NUMTAB(K)=INDEX(J+ISW) 00000910 C STORE SEQUENTIAL NUMBER IN 2ND WORD OF HASH TABLE CELL. 00000920 NUMTAB(K+1)=ISEQ 00000930 C REPLACE ORIGINAL SHOT (OR REC) NUMBER IN INPUT 00000940 C ARRAY BY SEQUENTIAL NUMBER. 00000950 INDEX(J+ISW)=ISEQ 00000960 GO TO 400 00000970 C THE CELL IS OCCUPIED. 00000980 220 IF(INDEX(J+ISW) .NE. NUMTAB(K)) GO TO 300 00000990 C THE ORIGINAL NUMBER IN THE INDEX ARRAY IS THE SAME AS IN 00001000 C THE HASH TABLE CELL. DUPLICATE SHOT OR RECEIVER NUMBERS. 00001010 C REPLACE ORIGINAL SHOT (OR REC) NUMBER IN INPUT 00001020 C ARRAY BY SEQUENTIAL NUMBER. 00001030 INDEX(J+ISW)=NUMTAB(K+1) 00001040 GO TO 470 00001050 300 CONTINUE 00001060 C A SYNONYM HAS BEEN FOUND, BUT THE ORIGINAL 00001070 C SHOT (OR REC) NUMBERS ARE NOT IDENTICAL. 00001080 IF(NUMTAB(K+2) .NE. 0) GO TO 320 00001090 C CHAIN POINTER = 0. CHAIN NEXT OVERFLOW CELL TO IT 00001100 C AND DECREASE THE OVERFLOW POINTER. 00001110 310 IF(IOVFL .LE. 0) GO TO 550 00001120 C IF THE OVERFLOW CELL IS FULL, BUMP POINTER TO NEXT. 00001130 IF(NUMTAB(IOVFL) .EQ. 0) GO TO 315 00001140 IOVFL=IOVFL-3 00001150 GO TO 310 00001160 315 NUMTAB(K+2)=IOVFL 00001170 NUMTAB(IOVFL)=INDEX(J+ISW) 00001180 NUMTAB(IOVFL+1)=ISEQ 00001190 INDEX(J+ISW)=ISEQ 00001200 IOVFL=IOVFL-3 00001210 GO TO 400 00001220 320 CONTINUE 00001230 C CHAIN POINTER IS NOT ZERO, GET THE ADDRESS OF 00001240 C THE OVERFLOW CELL. 00001250 K=NUMTAB(K+2) 00001260 GO TO 220 00001270 400 CONTINUE 00001280 ISEQ=ISEQ+1 00001290 470 CALL USBUFR (2, INDEX, BUFV, DA, J) 00001300 500 CONTINUE 00001310 CALL USBUFR (-2, INDEX, BUFV, DA, J) 00001320 510 IER=0 00001330 GO TO 600 00001340 550 CONTINUE 00001350 WRITE(6,560) 00001360 560 FORMAT(' ***HASHING TABLE NOT LARGE ENOUGH*** ') 00001370 IER=1 00001380 600 CONTINUE 00001390 RETURN 00001400 C 00001410 C ---------------------------------------------------------- 00001420 ENTRY SAINTP(NUM,NUMTAB,LEN,X,SOL,KSURF) 00001430 C ---------------------------------------------------------- 00001440 C 00001450 MIN=-999999 00001460 MAX= 999999 00001470 C LOOP THRU TABLE SEARCHING FOR CLOSEST ENTRYS TO GIVEN # 00001480 J=1 00001490 DO 700 00001500 *I=1,LEN 00001510 C GET SEQ # TO POINT TO SOLUTION FLAG. 00001520 K=NUMTAB(J+1) 00001530 C IF SEQ. # FROM CELL IS 0, THE CELL IS EMPTY. 00001540 IF(K .EQ. 0) GO TO 680 00001550 C IS THERE A SOLUTION? 0=NO SOLUTION. 00001560 IF (KSURF(K) .EQ. 0) GO TO 680 00001570 C COMPARE ORIGINAL # IN TABLE TO GIVEN #. 00001580 IF(NUMTAB(J) .NE. NUM) GO TO 620 00001590 C THE # TO BE INTERPOLATED IS PRESENT 00001600 C IN THE HASH TABLE AND HAS A SOLUTION. 00001610 C GET THE SOLUTION AND RETURN. 00001620 SOL=X(K) 00001630 GO TO 510 00001640 620 IF(NUMTAB(J) .GT. NUM) GO TO 630 00001650 C FIND MAX # < GIVEN #. 00001660 C NUMTAB(J) < NUM. 00001670 C IF THIS LOWER NUMBER IS .GT. THE PREVIOUS LOWER, SAVE IT. 00001680 IF(NUMTAB(J) .LE. MIN) GO TO 680 00001690 MIN=NUMTAB(J) 00001700 MINSEQ=K 00001710 GO TO 680 00001720 C FIND MIN # > GIVEN #. 00001730 C NUMTAB(J) > NUM. 00001740 C IF THIS HIGHER NUMBER IS .LT. THE PREVIOUS HIGHER, SAVE IT. 00001750 630 IF(NUMTAB(J) .GE. MAX) GO TO 680 00001760 MAX=NUMTAB(J) 00001770 MAXSEQ=K 00001780 680 J=J+3 00001790 700 CONTINUE 00001800 710 IF(MIN .EQ. 999999 .OR. MAX .EQ. -999999) GO TO 720 00001810 IF(MIN .EQ. -999999 .OR. MAX .EQ. 999999) GO TO 720 00001820 XMIN=MIN 00001830 XMAX=MAX 00001840 XNUM=NUM 00001850 SOL=X(MINSEQ)+(XNUM-XMIN)*(X(MAXSEQ)-X(MINSEQ))/(XMAX-XMIN) 00001860 GO TO 510 00001870 C THE GIVEN # CANNOT BE BRACKETED. SET TO 0. 00001880 720 SOL=0.0 00001890 GO TO 510 00001900 C 00001910 C ----------------------------------------------------------------- 00001920 ENTRY SADITP(NUM,LEN,X,KSURF,SOL) 00001930 C ----------------------------------------------------------------- 00001940 C 00001950 IF(NUM .LT. 1 .OR. NUM .GT. LEN) GO TO 720 00001960 C IF THE GIVEN NUMBER HAS A SOLUTION, GET IT. 00001970 IF(KSURF(NUM) .EQ. 0) GO TO 800 00001980 SOL=X(NUM) 00001990 GO TO 510 00002000 800 IDELT=LEN-NUM 00002010 IF(IDELT .NE. 0) GO TO 810 00002020 MAX=999999 00002030 GO TO 850 00002040 C SEARCH KSURF FROM NUM+1 TO UPPER END OF ARRAY. 00002050 810 NUM1=NUM+1 00002060 DO 820 00002070 *I=NUM1,LEN 00002080 II=I 00002090 IF(KSURF(I) .NE. 0) GO TO 830 00002100 820 CONTINUE 00002110 C NO UPPER SOLUTION. 00002120 MAX=999999 00002130 GO TO 850 00002140 830 MAX=II 00002150 MAXSEQ=II 00002160 850 IF(NUM .NE. 1) GO TO 860 00002170 C NO LOWER SOLUTION. 00002180 MIN=-999999 00002190 GO TO 710 00002200 860 INUM=NUM-1 00002210 C SEARCH KSURF FROM NUM-1 BACK TO 1. 00002220 DO 870 00002230 *I=1,INUM 00002240 II=INUM-I+1 00002250 C IS THERE A SOLUTION HERE? 00002260 IF(KSURF(II) .NE. 0) GO TO 880 00002270 870 CONTINUE 00002280 C NO LOWER SOLUTION. 00002290 MIN=-999999 00002300 GO TO 710 00002310 C SAVE SOLUTION INDEX. 00002320 880 MIN=II 00002330 MINSEQ=II 00002340 GO TO 710 00002350 END 00002360