CTITLESAVKGET -- OBTAIN INDICIES FOR VELOCITY BUILDER C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA DESIGNER JAMES SUN CA AUTHOR JAMES SUN CA LANGUAGE FORTRAN CA SYSTEM IBM AND CRAY CA WRITTEN 02/08/89 CA C REVISED 03/31/89 JCS - REAPPLY MUTE TO THE DEPTH SECTION C REVISED 01/20/90 JJC - MODIFIED TO MEET EDP STANDARDS. C REVISED 02/05/90 JJC - RENAMED FROM VKGET SAVKGET. C REVISED 07/23/90 CLJ - ALLOW PREP TO RUN ON THE IBM C CA CA CALLING PROCEDURE: CA SUBROUTINE SAVKGET(IXBEG,IXEND,ISINC,DX,NUMH,NXMOD,INDXA,INDXB, CA + KA,KB,KC,KD,KE,KF,KG,KH,KO,KP,KQ,KR,KS,KT,ICC, CA + KPNA,KPRNO,DATA,IABT,IPR) CA C CALLING ARGUMENTS CA CA INPUT IXBEG = BEGINNING OF DEPTH / SHOT POINT I4 CA INPUT IXEND = ENDING OF DEPTH / SHOT POINT I4 CA INPUT ISINC = INCREMENT OF DEPTH / SHOT POINT I4 CA INPUT DX = DEPTH POINT SPACING R4 CA INPUT NUMH = NUMBER OF HORIZONS I4 CA OUTPUT NXMOD = NO. OF X GRIDS OF THE MODEL I4 CA OUTPUT INDXA = INDEX IN THE MODEL CORRESPONDING TO IXBEG I4 CA OUTPUT INDXB = INDEX IN THE MODEL CORRESPONDING TO IXEND I4 CA INPUT KA = ARRAY INDEX FOR USING RA I4 CA OUTPUT KB = ARRAY INDEX FOR USING RB I4 CA OUTPUT KC = ARRAY INDEX FOR USING RC I4 CA OUTPUT KD = ARRAY INDEX FOR USING RD I4 CA OUTPUT KE = ARRAY INDEX FOR USING RE I4 CA OUTPUT KF = ARRAY INDEX FOR USING RF I4 CA OUTPUT KG = ARRAY INDEX FOR USING RG I4 CA OUTPUT KH = ARRAY INDEX FOR USING RH I4 CA OUTPUT KO = ARRAY INDEX FOR USING RO I4 CA OUTPUT KP = ARRAY INDEX FOR USING RP I4 CA OUTPUT KQ = ARRAY INDEX FOR USING RQ I4 CA OUTPUT KR = ARRAY INDEX FOR USING RR I4 CA OUTPUT KS = ARRAY INDEX FOR USING RS I4 CA OUTPUT KT = ARRAY INDEX FOR USING RT I4 CA OUTPUT ICC = ARRAY INDEX FOR USING ICC I4 CA INPUT KPNA = PROCESS NAME I4 CA INPUT KPRNO = PROCESS NUMBER I4 CA OUTPUT IABT = ABORT FLAG I4 CA INPUT IPR = PRINT UNIT I4 CA CA THIS SUBROUTINE OBTAINS THE INDICIES FOR THE VELOCITY MODEL. CA C 13173000 SUBROUTINE SAVKGET(IXBEG,IXEND,ISINC,DX,NUMH,NXMOD,INDXA,INDXB, 13173104 + KA,KB,KC,KD,KE,KF,KG,KH,KO,KP,KQ,KR,KS,KT,ICC, 13173200 + KPNA,KPRNO,DATA,IABT,IPR) 13173500 C 13173600 IMPLICIT INTEGER(A-Z) C REAL DX REAL DXX REAL XBEG REAL XEND REAL XMAX REAL XMIN REAL X000 REAL X111 C INTEGER S1CVBN 13173700 INTEGER S1CPCH 13173800 C CHARACTER*80 DATA 13174000 C NSHOT=(IXEND-IXBEG)/ISINC+1 C IDAC=1 13174300 100 CALL FORC (KPNA, KPRNO, IDAC, DATA, * 120) 13174400 C IF (S1CPCH (DATA, 8, 'MOD', 1, 3) .NE. 0) GO TO 100 13174600 NUMH = S1CVBN(DATA,11,5) 13174700 CALL USCHFT(DATA,16,10,XMIN) 13174800 CALL USCHFT(DATA,26,10,XMAX) 13174900 C IF(S1CPCH(DATA,56,' ',1,10).EQ.0) THEN 13175011 XBEG=XMIN 13175109 ELSE 13175209 CALL USCHFT(DATA,56,10,XBEG) 13175309 ENDIF 13175409 C 13174500 C DXX=DX IF(S1CPCH(DATA,66,' ',1,5).NE.0) THEN 13175011 ISGN = S1CVBN(DATA,66,5) 13174700 IF(ISGN.NE.-1) ISGN = +1 DXX=ISGN*DX ENDIF 13175409 C IF(S1CPCH(DATA,71,' ',1,5).NE.0) THEN 13175011 JXBEG = S1CVBN(DATA,71,5) 13174700 MSHOT=(IXBEG-JXBEG)/ISINC XBEG=XBEG+MSHOT*DXX 13175109 ENDIF 13175409 C XEND=XBEG+(NSHOT-1)*DXX 13175109 IF(DXX.GE.0.) THEN X000=XBEG X111=XEND ELSE X000=XEND X111=XBEG ENDIF C 13175502 CJCS NX0=(X000-XMIN)/DX+0.5 13176716 C CJCS NX0=((X000-XMIN+0.00001)/DX) 13176716 NX0=INT((X000-XMIN+0.00001)/DX) 13176716 XMIN=X000-NX0*DX 13176816 C 13176902 C WRITE(IPR,8000) XMIN,XMAX,DXX,X000,X111,XBEG,XEND 13177003 8000 FORMAT(' XMIN (MINIMUM X IN LATERAL ) =',E12.5,/, 13177103 + ' XMAX (MAXIMUM X IN LATERAL ) =',E12.5,/, 13177202 + ' DXX (SPACING RELATED CDP/SHOT DIRECTION) =',E12.5,/, 13177202 + ' X000 (SMALLEST X VALUE OF THE MODEL ) =',E12.5,/, 13177202 + ' X111 (LARGEST X VALUE OF THE MODEL ) =',E12.5,/, 13177202 + ' XBEG (X VALUE OF THE REFERENCE CDP/SHOT ) =',E12.5,/, 13177302 + ' XEND (X VALUE OF THE END OF CDP/SHOT ) =',E12.5) 13177402 C 13177715 CJCS NXMOD=(XMAX-XMIN)/DX+1.5 13177805 NXMOD=NINT((XMAX-XMIN)/DX+1.) 13177805 C CC IF(ISINC.GE.0) THEN C IF(DXX.GE.0.) THEN CJCS INDXA=(X000-XMIN)/DX+1.5 13178013 INDXA=NINT((X000-XMIN)/DX+1.) 13178013 INDXB=INDXA+NSHOT-1 13178100 ELSE CJCS INDXB=(X000-XMIN)/DX+1.5 13178013 INDXB=NINT((X000-XMIN)/DX+1.) 13178013 INDXA=INDXB+NSHOT-1 13178100 ENDIF C CC ELSE CC IF(DXX.GE.0.) THEN CC INDXB=(X000-XMIN)/DX+1.5 13178013 CC INDXA=INDXB+NSHOT-1 13178100 CC ELSE CC INDXA=(X000-XMIN)/DX+1.5 13178013 CC INDXB=INDXA+NSHOT-1 13178100 CC ENDIF CC ENDIF C WRITE(IPR,8020) IXBEG,IXEND,NSHOT,INDXA,INDXB,NXMOD 13178200 8020 FORMAT(' IXBEG (STARTING DEPTH POINT ) =',I5,/, 13178300 + ' IXEND (ENDING DEPTH POINT ) =',I5,/, 13178400 + ' NCDPN (NO. OF DEPTH POINT ) =',I5,/, 13178500 + ' INDXA (INDEX CORRESPONDING TO IXBEG) =',I5,/, 13178600 + ' INDXB (INDEX CORRESPONDING TO IXEND) =',I5,/, 13178700 + ' NXMOD (NO. OF X GRIDS OF THE MODEL ) =',I5) 13178800 C IF(INDXA.LT.1 .AND. INDXB.LT.1) THEN 13178900 GO TO 140 ELSE IF(INDXA.GT.NXMOD .AND. INDXB.GT.NXMOD) THEN 13178900 GO TO 140 ENDIF C 13178900 KB = KA + NXMOD*NUMH 13180000 KC = KB + NXMOD*NUMH 13190000 KD = KC + NXMOD 13200000 KE = KD + NXMOD 13210000 KF = KE + NXMOD 13220000 KG = KF + NXMOD 13230000 KH = KG + NXMOD*2 13240000 KO = KH + NXMOD 13250000 KP = KO + NXMOD 13260000 KQ = KP + NXMOD 13270000 KR = KQ + NXMOD 13280000 KS = KR + NXMOD 13290000 KT = KS + NXMOD 13300000 ICC = KT + NXMOD 13310000 C IABT=0 13321000 RETURN 13322000 C 13323000 C 120 WRITE(IPR,8040) KPNA,KPRNO 13330000 GO TO 160 13331000 C 13360000 140 WRITE(IPR,8100) 13370000 C 13380000 C 160 IABT=1 13390001 RETURN 13400000 C 13401000 C 8040 FORMAT(' NO MOD CARD FOR ',A4,I1) 13401100 C 13402000 C 8060 FORMAT(' FOR SHOT/DEPTH POINT ',I4,' X =',E12.5,' <',E12.5) 13403000 C 13403100 C 8080 FORMAT(' FOR SHOT/DEPTH POINT ',I4,' X =',E12.5,' >',E12.5) 13403200 C 13403100 C 8100 FORMAT(' BOTH INDXA AND INDXB ARE OUTSIDE (1:NXMOD) RANGE') 13403200 C 13404000 C END 13410000