CTITLE SALMPA0 - CONSTANT ANGLE GATHER C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C C DESIGNER C. Y. YOUNG C AUTHOR C. Y. YOUNG C LANGUAGE FORTRAN 77 C DATE JAN. 28,1987 C REVISED JULY 26,1988 C C C CALL SALMPA0(OH,ICC,AUTO3,IABORT,RA) C CALL SALMPA1(OH,OTR,VEL,PASS,IABORT,RA,SA) C CALL SALMPA2(OH,OTR,VEL,PASS,IABORT,RA,SA) C CALL SALMPA3(OH,OTR,VEL,PASS,IABORT,RA,SA) C C C THIS IS A SPARC DEVELOPMENT PROGRAM C C PURPOSE: TO COMPUTE THE COMMON ANGLE GATHER BY PARTIAL STACK OF CDP C DATA WITHIN CONSTANT ANGLE RANGE. C EVERY SAMPLE POINT C INPUT: DEPTH POINT GATHER WITH NORMAL MOVE-OUT APPLIED C OUTPUT: CONSTANT ANGLE GATHER C C************************************************************** C * C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE * C * C USPHD FORP S1CPCH SALMPAB ARSET SALMPAA * C SALMPAC USRTHV ARMVE SALMPAD SALMPAE USSTHV * C * C************************************************************** C C======================================================================= C C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). C C DATTR ( 96) = ARRAY FOR ATTRIBUTES OF DATA I*4 C DENTRY ( 104) = ARRAY FOR STORAGE OF PARAMETER RECORDS I*4 C C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). C C ANGINC = INCIDENT START ANGLE INCREMENT IN DEGREES R*4 C AUTO3 = AUTOMATIC BOUNDARY DETECTION FLAG I*4 C CDPN = VARIABLE IN COMMON /HEAD/ WHICH CONTAINS THE INPUT TRACE C CDP NUMBER I*4 C CDPT = VARIABLE IN COMMON /HEAD/ WHICH CONTAINS THE INPUT TRACE C CDP TRACE NUMBER I*4 C DAP = COUNTER FOR PARAMETER READ & WRITE SUBROUTINES I*4 C DAW = COUNTER FOR 'WIN' PARAMETER RECORDS I*4 C DCTYP = PARAMETER RECORD TYPE 'PTS ' OR 'WIN ' C*4 C DEPTHP = CHARACTER STRING 'DEPTH PT' C*8 C FLV = VARIABLE HOLDING THE FIRST LIVE VALUE TRACE HEADER VALUE C FROM THE INPUT TRACE I*4 C FSR = FLOATING POINT SAMPLE RATE IN SECONDS R*4 C C IANGR = STARTING INCIDENT ANGLE IN DEGREES I*4 C IANGE = ENDING INCIDENT ANGLE IN DEGREES I*4 C ICC = NUMBER OF RESERVED WORDS REQUIRED BY PROCESS I*4 C ICOUNT = VARIABLE TO KEEP COUNT OF CDP-TIME WINDOW PAIRS I*4 C IHIN = THE NUMBER OF TRACES IN GATHER TO BE USED IN ANALYSIS. C THIS ALSO IS THE NUMBER OF ANGLE TRACES I*4 C IHOUT = THIS IS THE COUNT OF TRACES BE SENT OUT OF PROCESS I*4 C INANGW = RESERVED COMMON INDEX FOR STORAGE OF ANGLE WINDOWS I*4 C INCDPI = RESERVED COMMON INDEX FOR STORAGE OF INTERPOLATE CDP C VALUES FOR THE CDP-TIME PAIRS I*4 C INDATA = RESERVED COMMON INDEX FOR STORAGE OF OUTPUT ANGLE C GATHER I*4 C INDEPTH= RESERVED COMMON INDEX FOR STORAGE OF DEPTH VALUES I*4 C INFLV = RESERVED COMMON INDEX FOR STORING THE FIRST LIVE VALUE C INDEX OF THE INPUT GATHER I*4 C INHEAD = RESERVED COMMON INDEX FOR STORING THE TRACE HEADERS OF C INPUT GATHER I*4 C C INICDP = RESERVED COMMON INDEX FOR STORING THE INPUT CDP NUMBERS C OF THE CDP-TIME WINDOW PAIRS I*4 C ININCI = RESERVED COMMON INDEX FOR STORING THE INCIDENT ANGLE C CALCULATION I*4 C ININPUT= RESERVED COMMON INDEX FOR HOLDING THE INPUT GATHER I*4 C C ININTV = RESERVED COMMON INDEX FOR STORING INTERVAL VELOCITY I*4 C INITIME= RESERVED COMMON INDEX FOR STORING THE INPUT TIME WINDOW C VALUES FOR THE CDP-TIME WINDOW PAIRS I*4 C INOFF = RESERVED COMMON INDEX FOR STORING INPUT GATHER OFFSET C VALUES I*4 C INTBEGI= RESERVED COMMON INDEX FOR STORING INTERPOLATED TIME C VALUES FROM THE CDP-TIME PAIRS I*4 C INWORK = RESERVED COMMON INDEX FOR WORK ARRAY USED IN INTER- C POLATION I*4 C IPR = VARIABLE TO HOLD SPARC PRINT UNIT FOR PROCESS I*4 C ITAKE = FLAG TO INDICATE IF RAY TAKE-OFF ANGLE AT THE SURFACE OR C IF LOCAL INCIDENT ANGLE IS TO BE USED I*4 C IXBEG = STARTING CDP NUMBER OF PROCESSING RANGE I*4 C IXEND = ENDING CDP NUMBER OF PROCESSING RANGE I*4 C JBEG = START TIME SAMPLE INDEX FOR ANALYSIS WINDOW I*4 C JEND = END TIME SAMPLE INDEX FOR ANALYSIS WINDOW I*4 C KNT = LOCAL VARIABLE TO COUNT THE PAIRS OF CDP-TIME WINDOW C TOPS I*4 C MAXCTP = PARAMETER STATEMENT VALUE FOR MAXIMUM ALLOWED NUMBER C OF CDP TOP-TIME WINDOW PAIRS I*4 C C NANG = THE NUMBER OF STARTING INCIDENT ANGLES OF RANGES I*4 C NOP = THE NUMBER OF 'WIN' PARAMETER RECORDS I*4 C NOPAR = NUMBER OF PARAMETERS ON SEISPARM RECORD I*4 C NPAIRS = NUMBER OF CDP TOP-TIME WINDOW PAIRS FROM PARM REC. I*4 C NS = COMMON /HEAD/ VARIABLE WHICH IS THE NUMBER OF SAMPLES C IN THE TRACE I*4 C NSIZE = THE NUMBER OF CDP WITHIN THE PROCESSING RANGE I*4 C NX = MAXIMUM NUMBER OF TRACES/CDP FOR ANGLE TRACES I*4 C ORTN = COMMON /HEAD/ VARIABLE WHICH IS THE 'ORTN' VALUE I*4 C PASS = FLAG WHICH DETERMINES THE TRACE DISPOSITION OPTION I*4 C PMODE = PROCESSING MODE I*4 C PT = THE NUMBER OF RADIANS PER DEGREE R*4 C PTS = CHARACTER STRING 'PTS ' C*4 C RECSIZE= PARAMETER STATEMENT INDICATING THE ATTRIBUTE SIZE IN C WORDS FOR THE SEISPARM RECORD I*4 C C TAKOFF = CHARACTER STRING INDICATING KIND OF INCIDENT ANGLE TO C USE ('TAKOF', 'LOCAL') C*5 C TAUPFLG= PARAMTER INPUT FLAG WHICH INDICATES THAT PSEUDO TAU-P C TRACE IS TO BE GENERATED RATHER THAN ANGLE TRACES. USED C FOR APPLICATIONS LIKE 'ATOM' I*4 C TBEG = START TIME IN MS FOR ANALYSIS WINDOW I*4 C TEND = END TIME IN MS FOR ANALYSIS WINDOW I*4 C THL = COMMON /HEAD/ VARIABLE CONTAINING HEADER LENGTH I*4 C TICD = COMMON /HEAD/ VARIABLE FOR TRACE IDENTIFICATION CODEI*4 C TSHIFT = START TIME FOR NMO SHIFT IN PSEUDO TAU-P TRACES I*4 C TWINLEN= TIME WINDOW LENGTH FOR ANALYSIS I*4 C TYPPNT = CHARACTER STRING WHICH IS SET TO DEPTHP C*8 C WIN = CHARACTER STRING 'WIN ' C*4 C WINSIZE= ANGLE WINDOW SIZE FOR EACH RANGE R*4 C XDST = COMMON /HEAD/ VARIABLE CONTAINING TRACE OFFSET VALUEI*4 C C======================================================================= C EJECT C C FORMAT OF PARAMETER RECORDS 'PTS ' C C C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 C :_______:________:_______:_______:_______:_______:__:_:____:_______: C : LMPA : INVOC. : 'PTS ': NOT : NOT : # OF :L/:P:NOT : NOT : C :_______:_NUMBER_:_______:__USED_:__USED_:_PARMS_:N_:M:USED:__USED_: C C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 C :________:_______:________:________:________:_______:_______:_______: C : START : END : MAX TRC:TIME WIN:_START__:__END__:_ANGLE_:ANGLE : C :__CDP__ :__CDP__:PER CDP_:_LEN____:_ANGLE__:_ANGLE_:_WINDOW:WIN_INC: C C WORD 17 WORD 18 WORD 19 WORD 20 WORD 21 WORD 22 WORD 23 C :________:_______:________:________:________:_______:_______: C :TYPE_OF :TAU-P :START T :NO. CDP-: NOT : : NOT : C :ANG_FLG_:FLAG___:FOR NMO_:WIN_PAIR:__USED__: : USED : C C WORD 24 .... WORD 104 C :_______: .... :_______: C : NOT : .... : NOT : C :_USED__: .... :_USED__: C C C FORMAT OF PARAMETER RECORDS 'WIN ' C C C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 C :_______:________:_______:_______:_______:_______:__:_:____:_______: C : LMPA : INVOC. : 'WIN ': NOT : NOT : # OF :L/:P:NOT : NOT : C :_______:_NUMBER_:_______:__USED_:__USED_:_PARMS_:N_:M:USED:__USED_: C C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 104 C :________:_______:________:________:________:_______:_______:_______: C : CDP NO.: TOP OF: CDP NO.: TOP OF : CDP NO.: TOP OF: .... : .... : C : (1) :__WIN__: (2) :__WIN___: .... :__WIN__: .... : .... : C C C EJECT C C======================================================================= C C LAYOUT OF RESERVED AREA RA C C ________________________________ C INDATA --> : OUTPUT ANGLE GATHER : C : (NS*NX WORDS) : C :______________________________: C INICDP --> : AREA FOR WINDOW CDP NUMBER: C : (NPAIRS WORDS) : C :______________________________: C INITIME --> : AREA FOR WINDOW TIME VALUE: C : (NPAIRS WORDS) : C :______________________________: C ININPUT --> : AREA FOR INPUT DATA : C : (NS*NX WORDS) : C :______________________________: C ININCI --> : AREA FOR INCIDENCE ANGLE : C : (2*NX WORDS) : C :______________________________: C ININTV --> : AREA FOR INTERVAL VELOCITY: C : (NS WORDS) : C :______________________________: C INDEPTH --> : AREA FOR DEPTH VALUE : C : (NS WORDS) : C :______________________________: C INOFF --> : AREA FOR OFFSET VALUES : C : (NX WORDS) : C :______________________________: C INANGW --> : AREA FOR ANGLE WINDOWS : C : (2*NX WORDS) : C :______________________________: C INFLV --> : AREA FOR FIRST LIVE VALUE : C : (NX WORDS) : C :______________________________: C INHEAD --> : AREA FOR TRACE HEADERS : C : (NX*THL WORDS) : C :______________________________: C INWORK --> : AREA FOR WORK ARRAY : C : (NS WORDS) : C :______________________________: C INCDPI --> : AREA FOR INTERPOLATED CDP : C : (NSIZE WORDS) : C :______________________________: C INTBEGI --> : AREA FOR INTERPOLATED TIME: C : (NSIZE WORDS) : C :______________________________: C C C====================================================================== C EJECT C SUBROUTINE SALMPA0(OH,ICC,AUTO3,IABORT,RA) IMPLICIT INTEGER (A-Z) C DIMENSION OH(*), OTR(*), RA(*), SA(*),VEL(*) REAL RA, SA, VEL, OTR C C NOTE THAT THE VALUES IN THIS PARAMETER STATEMENT MAY BE USED C IN THE CORE CALCULATION SO THAT ANY CHANGES HERE MAY REQUIRE C CHANGES IN THE JS ROUTINE. C C MAXCTP - MAXIMUM NUMBER OF CDP-TOP OF TIME WINDOW C PAIRS THAT CAN BE HANDLED. C RECSIZE - ACTUAL SIZE OF ATTRIBUTE RECORD WRITTEN TO C SEISPARM FILE. DOES NOT INCLUDE THE FIRST C EIGHT WORDS WHICH ARE GENERAL TO EACH C RECORD. C PARAMETER (MAXCTP = 1000, RECSIZE = 96) C C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/26/91 COMMON /P/ STARTP ( 2) , M00000( 29) COMMON /P/ ACLNAM ( 5) , M00124( 68) COMMON /P/ KPNA COMMON /P/ KPRNO , M00420( 26) COMMON /P/ KPPRNT , M00528( 2) COMMON /P/ KPBUGF , M00540( 226) COMMON /P/ ENDP C CHARACTER*5 TAKOFF CHARACTER*8 DEPTHP CHARACTER*8 TYPPNT CHARACTER*4 DCTYP CHARACTER*4 PTS CHARACTER*4 WIN CHARACTER*4 PMODE C C C INTEGER ARRAYS--LOCAL C INTEGER DATTR (RECSIZE) INTEGER DENTRY (RECSIZE+8) C C================================================================= C C REAL VARIABLES--LOCAL C REAL XATTR(RECSIZE) REAL ANGINC, WINSIZE, FSR, PT C COMMON /HEAD/ ORTN,CDPN,CDPT,TICD,XDST,NS,SI,SSP,FN,THL COMMON /USER/ SLOCAL(50), ULOCAL(100) C EQUIVALENCE (DCTYP , DENTRY (03)) EQUIVALENCE (SPT , DENTRY (04)) EQUIVALENCE (SPE , DENTRY (05)) EQUIVALENCE (NOPAR , DENTRY (06)) EQUIVALENCE (PMODE , DENTRY (07)) EQUIVALENCE (SPLOCN , DENTRY (08)) EQUIVALENCE (DATTR(1) , DENTRY (09)) EQUIVALENCE (DATTR(1) , XATTR (01)) C C ESTABLISH EQUIVALENCE FOR REENTRANCY PURPOSES C EQUIVALENCE (PT ,ULOCAL( 1)) EQUIVALENCE (IPR ,ULOCAL( 2)) EQUIVALENCE (FSR ,ULOCAL( 3)) EQUIVALENCE (IXBEG ,ULOCAL( 4)) EQUIVALENCE (IXEND ,ULOCAL( 5)) EQUIVALENCE (NX ,ULOCAL( 6)) EQUIVALENCE (TWINLEN,ULOCAL( 7)) EQUIVALENCE (IANGB ,ULOCAL( 8)) EQUIVALENCE (IANGE ,ULOCAL( 9)) EQUIVALENCE (WINSIZE,ULOCAL(10)) EQUIVALENCE (ANGINC ,ULOCAL(11)) EQUIVALENCE (TAKOFF ,ULOCAL(12)) EQUIVALENCE (TAUPFLG,ULOCAL(14)) EQUIVALENCE (TSHIFT ,ULOCAL(15)) EQUIVALENCE (NPAIRS ,ULOCAL(16)) C EQUIVALENCE (INDATA ,ULOCAL(21)) EQUIVALENCE (INICDP ,ULOCAL(22)) EQUIVALENCE (INITIME,ULOCAL(23)) EQUIVALENCE (ININPUT,ULOCAL(24)) EQUIVALENCE (ININCI ,ULOCAL(25)) EQUIVALENCE (ININTV ,ULOCAL(26)) EQUIVALENCE (INDEPTH,ULOCAL(27)) EQUIVALENCE (INOFF ,ULOCAL(28)) EQUIVALENCE (INANGW ,ULOCAL(29)) EQUIVALENCE (INFLV ,ULOCAL(30)) EQUIVALENCE (INHEAD ,ULOCAL(31)) EQUIVALENCE (INWORK ,ULOCAL(32)) EQUIVALENCE (INCDPI ,ULOCAL(33)) EQUIVALENCE (INTBEGI,ULOCAL(34)) C EQUIVALENCE (TBEG ,ULOCAL(41)) EQUIVALENCE (TEND ,ULOCAL(42)) EQUIVALENCE (JBEG ,ULOCAL(43)) EQUIVALENCE (JEND ,ULOCAL(44)) EQUIVALENCE (IHIN ,ULOCAL(45)) EQUIVALENCE (IHOUT ,ULOCAL(46)) EQUIVALENCE (FLV ,ULOCAL(47)) EQUIVALENCE (NANG ,ULOCAL(48)) EQUIVALENCE (TYPPNT ,ULOCAL(49)) C DATA YES / 0 / DATA NO / 1 / DATA YES3 / 2 / DATA NO3 / 3 / C DATA DEPTHP /'DEPTH PT'/ DATA PTS /'PTS '/ DATA WIN /'WIN '/ DATA DATTR /96*0/ C C SET THE VALUE OF RADIANS PER DEGREE C PT = 4.0 * ATAN ( 1.0 ) / 180.0 C IPR = KPPRNT C C SET UP BOUNDARY DETECTION FLAG C IABORT = NO FSR = FLOAT ( SI ) * 1.E-6 C AUTO3 = YES C C READ INPUT CARDS C C INITIALIZATION C ============== C C FIRST TIME THROUGH C C C PRINT HEADING C CALL USPHD ( 2, ACLNAM, KPNA, KPRNO, 0, 0, KPPRNT ) C C C======================================================================= C C DETERMINE PROCESSING MODE C DAP = 1 100 CONTINUE CALL FORP ( KPNA, KPRNO, DAP, 104, DENTRY, *120 ) IF (DCTYP .NE. PTS) GO TO 100 IF (S1CPCH ( PMODE, 2, 'D', 1, 1 ) .EQ. 0) TYPPNT = DEPTHP C C======================================================================= C 120 CONTINUE C C----------------------------------------------------------------------- C C READ THE STARTING DEPTH POINT NUMBER FOR THIS PROCESSING RANGE C IXBEG = DATTR(1) C C READ THE ENDING DEPTH POINT NUMBER FOR THIS PROCESSING RANGE C IXEND = DATTR(2) C C----------------------------------------------------------------------- C C NUMBER OF TRACES PER CDP FOR ANALYSIS C C----------------------------------------------------------------------- C NX = DATTR(3) C C----------------------------------------------------------------------- C C TIME WINDOW LENGTH IN MS C C----------------------------------------------------------------------- C TWINLEN = DATTR(4) C C----------------------------------------------------------------------- C C START INCIDENT ANGLE IN DEGREES C C----------------------------------------------------------------------- C IANGB = DATTR(5) C C----------------------------------------------------------------------- C C ENDING INCIDENT ANGLE IN DEGREES C C----------------------------------------------------------------------- C IANGE = DATTR(6) C C----------------------------------------------------------------------- C C READ THE INCIDENT ANGLE WINDOW SIZE IN DEGREES C C----------------------------------------------------------------------- C C CHECK FOR BLANK FIELD TO SET DEFAULT VALUE OF 3 DEGREES C WINSIZE = XATTR(7) C C----------------------------------------------------------------------- C C READ THE INCIDENT ANGLE INCREMENT IN DEGREES C C----------------------------------------------------------------------- C ANGINC = XATTR(8) C C----------------------------------------------------------------------- C C OBTAIN THE KIND OF INCIDENT ANGLE TO USE C C----------------------------------------------------------------------- C ITAKE = DATTR(09) C C IF THE INCIDENT ANGLE CODE IS ZERO THEN USE RAY TAKE-OFF ANGLE C FROM THE SURFACE LOCATION. C IF THE INCIDENT ANGLE CODE IS UNITY THEN USE LOCAL INCIDENT ANGLE. C IF (ITAKE .EQ. 0) TAKOFF = 'TAKOF' IF (ITAKE .EQ. 1) TAKOFF = 'LOCAL' C C----------------------------------------------------------------------- C C READ THE PSEUDO TAU-P GENERATION FLAG C C----------------------------------------------------------------------- C TAUPFLG = DATTR(10) C C----------------------------------------------------------------------- C C READ THE START TIME FOR NMO SHIFT IN MS (IF TAU-P TRACE IS C GENERATED) C C----------------------------------------------------------------------- C TSHIFT = DATTR(11) C C----------------------------------------------------------------------- C C READ THE NUMBER OF CDP-TIME WINDOW TOP (MS) PAIRS C C----------------------------------------------------------------------- C NPAIRS = DATTR(12) C C----------------------------------------------------------------------- C SET THE NUMBER OF CDP WITHIN THE RANGE C NSIZE = IXEND-IXBEG + 1 C C*********************************************************************** C C PRINT INPUT PARAMETERS READ FROM DISK PARAMETER FILE C C*********************************************************************** C WRITE (KPPRNT,9130 ) TYPPNT, IXBEG, TYPPNT, IXEND WRITE (KPPRNT,9140 ) NX,TWINLEN,IANGB,IANGE,WINSIZE,ANGINC,TAKOFF, 1 TAUPFLG, TSHIFT C C----------------------------------------------------------------------- 9130 FORMAT ('0INCIDENT ANGLE GATHERS FROM ', A8,1X,I5,' TO ', 1A8,1X,I5,' PARAMETER VALUES SELECTED ARE'/1X,90('=')) C 9140 FORMAT('0MAXIMUM NUMBER OF TRACES FOR ANALYSIS:',I5,T60, 1 'TIME WINDOW LENGTH:',9X,I6,' MS'/1X, 2 'START INCIDENT ANGLE:',16X,I6,' DEGREES',T60, 3 'ENDING INCIDENT ANGLE:',6X,I6,' DEGREES'/1X, 4 'WINDOW SIZE:',25X,F6.2,' DEGREES',T60, 5 'ANGLE INCREMENT:',12X,F6.2,' DEGREES'/1X, 6 'INCIDENT ANGLE USED:',18X,A5,T60, 7 'PSEUDO TAU-P FLAG:',10X,I6/1X, 8 'START TIME FOR NMO SHIFT:',12X,I6,' MS'//) C C----------------------------------------------------------------------- C C CONVERT TSHIFT TO SAMPLE NUMBER C TSHIFT = TSHIFT * 1000 / SI C IF (TAKOFF .NE. 'LOCAL') THEN WRITE ( IPR, * ) 1 'TAKEOFF ANGLE FROM SURFACE LOCATION IS USED ' ELSE WRITE ( IPR, * ) 'LOCAL ANGLE OF INCIDENCE IS USED' ENDIF C C----------------------------------------------------------------------- C C SET UP RESERVED COMMON INDICIES C C START INDEX FOR OUTPUT ANGLE GATHER (NS,NANG) C INDATA = 1 C C START INDEX FOR WINDOW CDP NUMBER (MAXCTP) C INICDP = INDATA + NS * NX C C START INDEX FOR WINDOW TIME VALUE (MAXCTP) C INITIME = INICDP + MAXCTP C C START INDEX INPUT DATA (NS,NX) C ININPUT = INITIME + MAXCTP C C START INDEX INCIDENCE ANGLE RANGE (2*NX) C ININCI = ININPUT + NS * NX C C START INDEX INTERVAL VELOCITY (NS) C ININTV = ININCI + 2 * NX C C START INDEX DEPTH INTERVAL (NS) C INDEPTH = ININTV + NS C C START INDEX OFFSET DISTANCE (NX) C INOFF = INDEPTH + NS C C START INDEX ANGLE WINDOWS (2*NX) C INANGW = INOFF + NX C C START INDEX ARRAY OF FIRST LIVE VALUE IN TRACES (NX) C INFLV = INANGW + 2 * NX C C START INDEX TRACE HEADERS C INHEAD = INFLV + NX C C WORK X ARRAY (NS) C INWORK = INHEAD + THL * NX C C WORK ARRAY STORE INTERPOLATED CDP NO. FOR TIME PAIRS (NSIZE) C INCDPI = INWORK + NS C C WORK ARRAY STORE INTERPOLATED TIME PICKS (NSIZE) C INTBEGI = INCDPI + NSIZE C C TOTAL RESERVED SPACE C ICC = INTBEGI + NSIZE C C IF DEBUG PRINT SET THEN DUMP RESERVED COMMON INDICIES C IF (KPBUGF .GT. 0) THEN WRITE (IPR,*) 'INDATA = ', INDATA, ' INICDP =', INICDP WRITE (IPR,*) 'INITIME = ', INITIME, ' ININPUT =', ININPUT WRITE (IPR,*) 'ININCI = ', ININCI, ' ININTV =', ININTV WRITE (IPR,*) 'INDEPTH = ', INDEPTH, ' INOFF =', INOFF WRITE (IPR,*) 'INANGW = ', INANGW, ' INFLV =', INFLV WRITE (IPR,*) 'INHEAD = ', INHEAD, ' INWORK =', INWORK WRITE (IPR,*) 'INCDPI = ', INCDPI, ' INTBEGI =', INTBEGI WRITE (IPR,*) 'ICC = ', ICC ENDIF C C======================================================================= C C NOW READ THE CDP-TOP OF TIME WINDOW PAIR RECORDS C C======================================================================= C C SEARCH FOR 'WIN' RECORDS C NOP = 0 KNT = 0 DAW = 1 ICOUNT = 0 C 140 CONTINUE CALL FORP ( KPNA, KPRNO, DAW, 104, DENTRY, *180 ) IF (DCTYP .NE. WIN) GO TO 140 C C ADD TO COUNTER NOP RECORDS C NOP = NOP + 1 C DO 160 I = 1, NOPAR / 2 C RA(INICDP + ICOUNT + KNT) = DATTR(2 * I - 1) RA(INITIME + ICOUNT + KNT) = DATTR(2 * I) C C WRITE(IPR, *) 'DATTR(CDP),DATTR(TIME)',DATTR(2*I-1),DATTR(2*I) C WRITE(IPR, *) 'RA(CDP),RA(TIME)',RA(INICDP+KNT),RA(INITIME+KNT) C INCREMENT COUNT OF PAIRS OF VALUES C KNT = KNT + 1 C 160 CONTINUE C ICOUNT = ICOUNT + KNT KNT = 0 GO TO 140 C 180 CONTINUE C C CHECK IF COUNT OF PAIRS OF CDP-TIME WINDOW PAIRS DISAGREES C WITH THE INPUT VALUE C IF (NPAIRS .NE. ICOUNT) THEN IABORT = YES WRITE ( IPR, 9070 ) NPAIRS, ICOUNT 9070 FORMAT ('0*** INPUT COUNT OF CDP-TIME WINDOW PAIRS OF',I6, 1 ' DOES NOT AGREE WITH THE ACTUAL COUNT OF',I6,' ***') RETURN C END IF C C CHECK IF THERE IS AT LEAST ONE CDP-TIME PAIR C IF (NOP .EQ. 0) THEN IABORT = YES WRITE ( IPR, * ) ' NO WINDOW PARAMETER RECORDS FOUND' RETURN C END IF C RETURN C C******************************************************************* C******************************************************************* C ENTRY SALMPA1 ( OH, OTR, VEL, PASS, IABORT, RA, SA ) C C******************************************************************* C******************************************************************* C C IF INPUT CDP IS OUT OF RANGE THEN DO NOT PASS IT ON C C IF ((CDPN .LT. IXBEG .OR. CDPN .GT. IXEND ) .AND. (CDPN .GT. 1 IXBEG .OR. CDPN .LT. IXEND ) ) THEN C PASS = NO RETURN C ENDIF C C INITIALIZE TRACE IN AND OUT COUNTERS C IHIN = 0 IHOUT = 0 C C ON THE FIRST VALID CDP PERFORM THE WINDOW-TOP INTERPOLATION ON C THE VERY FIRST INPUT TRACE FOR ALL THE CDP RANGE C IF (CDPN .EQ. IXBEG) + CALL SALMPAB ( RA(INICDP), RA(INITIME), NPAIRS, + IXBEG, IXEND, RA(INCDPI), RA(INTBEGI), KPBUGF, IPR ) C DO 200 I = 1, NPAIRS C IF (CDPN .EQ. RA(I+INCDPI-1)) THEN TBEG = RA(I + INTBEGI - 1) GO TO 220 ENDIF C 200 CONTINUE C 220 CONTINUE C TEND = TBEG + TWINLEN IF (TBEG .LE. 0) TBEG = 100 TEND = MIN0 ( NS * SI / 1000, TEND ) C C CHANGE TO SAMPLE NUMBER INDEX FOR CALCULATION C JBEG = TBEG * 1000 / SI + 1 JEND = TEND * 1000 / SI IF (TSHIFT .EQ. 0) TSHIFT = (JEND - JBEG ) / 2 C IF ( KPBUGF .GT. 0) THEN WRITE(IPR,*) ' IXBEG,IXEND,NX,NS = ',IXBEG,IXEND,NX,NS WRITE(IPR,*) ' TBEG,TEND,JBEG,JEND = ',TBEG,TEND,JBEG,JEND WRITE(IPR,*) ' ICC = ',ICC ENDIF C CALL ARSET ( RA(1), ICC, 0.0 ) CALL SALMPAA (IANGB,IANGE,WINSIZE,ANGINC,NX,PT,RA(INANGW),NANG, 1 KPBUGF,IPR ) IABORT = NO WRITE ( IPR, * ) 'NUMBER OF TRACES PER CDP OUTPUT = ', NANG C C OBTAIN INTERVAL VELOCITIES FOR COMPUTATION OF INCIDENCE ANGLES C CALL SALMPAC ( VEL, NS, RA(ININTV), RA(INDEPTH), FSR, IPR ) C C WRITE(IPR,111)(RA(ININTV+I-1),RA(INDEPTH+I-1),I=1,NS) C111 FORMAT(' *** INTERVAL VEL AND DEPTH ***'/(6E15.5)) C IF (RA(ININTV) .EQ. 0.0 .AND. RA(ININTV+1) .EQ. 0.0) THEN IABORT = YES WRITE ( IPR, * ) 'NO VELOCITY FUNCTION SPECIFIED FOR CALCULATION' RETURN ENDIF C C******************************************************************* C******************************************************************* C ENTRY SALMPA2 ( OH, OTR, VEL, PASS, IABORT, RA, SA ) C C******************************************************************* C******************************************************************* C PASS = NO C CALL USRTHV ( OH, 'THFLV ', FLV ) C C CHECK IF THE NUMBER OF TRACES/CDP NEEDED IS ALREADY MET C IF SO IGNORE REMAINING TRACES IN GATHER BUT DO NOT SEND THEM OUT C IF (IHIN .EQ. NX) RETURN C RA(INFLV + IHIN) = FLV C C STORE TRACE IN RESERVED AREA C CALL ARMVE ( OH, RA(INHEAD + IHIN * THL), THL ) CALL ARMVE ( OTR, RA(NS * IHIN + ININPUT), NS ) RA(INOFF + IHIN) = XDST IHIN = IHIN + 1 C RETURN C C******************************************************************* C******************************************************************* C ENTRY SALMPA3 ( OH, OTR, VEL, PASS, IABORT, RA, SA ) C C******************************************************************* C******************************************************************* C C ENTER ENTRY 3 WHEN A NEW GATHER IS DETECTED OR WHEN DATA SET C ENDS C PASS = YES3 C C CHECK THAT TRACES BEING PASSED OUT DOES NOT EXCEED THE NUMBER C OF ANGLES FOR THE ANALYSIS. IF SO THEN DO NOT PASS THE OTHERS C BACK TO SPARC C IF (IHOUT .EQ. NANG) THEN C PASS = NO RETURN C ENDIF C IHOUT = IHOUT + 1 C C ON THE FIRST CALL TO THIS ENTRY FOR THIS CDP CALCULATE ANGLE C RANGE AND PARTIAL STACKS C IF (IHOUT .EQ. 1) THEN C C IF TAUPFLG IS ZERO THEN USE ALL TRACES WITHIN ANGLE RANGE C IF (TAUPFLG .EQ. 0) THEN C CALL SALMPAD (RA(ININPUT), VEL, RA(ININTV), NS, RA(INOFF), 1 RA(INFLV), IHIN, RA(INANGW), NANG, JBEG, JEND, FSR, TAKOFF, 2 RA(ININCI), RA(INDATA), KPBUGF, IPR) C C IF TAUPFLG IS NOT ZERO THEN WE ARE TRYING TO GENERATE PSEUDO TAU-P C TRACE FOR USE IN 'ATOM' C ELSE C CALL SALMPAE (RA(ININPUT), VEL, RA(ININTV), NS, RA(INOFF), 1 RA(INFLV), IHIN, RA(INANGW), NANG, JBEG, JEND, FSR, TAKOFF, 2 TSHIFT, RA(ININCI), RA(INDATA), RA(INWORK), KPBUGF, IPR) C ENDIF C ENDIF C CALL ARMVE ( RA(INHEAD + (IHOUT - 1 ) * THL), OH, THL ) CALL USSTHV ( OH, 'THCDPT ', IHOUT ) CALL ARMVE ( RA((IHOUT - 1 ) * NS + INDATA), OTR, NS ) C DO 240 I = 1, NS IF (ABS ( OTR(I) ) .GT. 1.0E-8) THEN CALL USSTHV ( OH, 'THTICD ', 1 ) GO TO 260 ENDIF C 240 CONTINUE C 260 CONTINUE C IF (KPBUGF .GT. 0) THEN WRITE ( IPR, * ) 'THCDPT = ', IHOUT WRITE ( IPR, 9050 ) ( OTR(I), I = 1, NS, 50 ) 9050 FORMAT ('0*** OTR ***'/(2X,10E12.5)) ENDIF C C RETURN C END