CTITLE SALMPAE - CALCULATE ANGLE RANGE AND PARTIAL STACK C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CABS SALMPAE - CALCULATE ANGLE RANGE AND PARTIAL STACK C CSUBROUTINE SALMPAE C C SUBROUTINE SALMPAE(DATAIN,VEL,VELINT,NS,DX,FLV,NX,ANG,NANG,JBEG, C 1 JEND,FSR,TAKOFF,TSHIFT,P,DATA,WRKX,IDB,IPR) C C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991. C C ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, C REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE C PRIOR CONSENT OF ATLANTIC RICHFIELD COMPANY. C C CA DESIGNER C. Y. YOUNG CA AUTHOR C. Y. YOUNG CA LANGUAGE VS FORTRAN CA SYSTEM IBM CA WRITTEN JULY 1988 CA CA PURPOSE OF PROGRAM: CA CA THIS SUBROUTINE CALCULATES THE ANGLE RANGE AND PARTIAL STACK CA WITHIN THE ANGLE RANGES. IT FLATTENS AN EVENT USING ONE VELOCITY CA VALUE SPECIFIED WITHIN THE TIME WINDOW. THIS ROUTINE IS USED CA WHEN ATTEMPTING TO GENERATE PSEUDO TAU-P TRACES FOR 'ATOM'. CA C************************************************************** C * C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE * C * C SALMPAI * C * C************************************************************** C CA CA ARGUMENTS: CA CA DATAIN INPUT REAL REAL ARRAY OF LENGTH NS * NX WHICH CA CONTAINS THE INPUT CDP DATA. CA CA VEL INPUT REAL REAL ARRAY OF THE SPATIALLY INTERPO- CA LATED RMS VELOCITY FUNCTION FOR THIS CA CDP FROM THE 'VELF' FUNCTION. CA CA VELINT INPUT INT REAL ARRAY OF LENGTH NS WHICH CONTAINS CA THE INTERVAL VELOCITY FOR THE SAMPLE CA POINTS. CA CA NS INPUT INT NUMBER OF SAMPLES IN A TRACE. CA CA DX INPUT INT INTEGER ARRAY OF LENGTH NX WHICH CON- CA TAINS THE OFFSETS FOR THE CDP GATHER. CA CA FLV INPUT INT INTEGER ARRAY OF LENGTH NX WHICH CON- CA TAINS THE SAMPLE INDEX OF THE FIRST CA LIVE VALUE. CA CA NX INPUT INT MAXIMUM NUMBER OF TRACES IN A CDP THAT CA WILL BE USED FOR INCIDENT ANGLE CA ANALYSIS. THIS VALUE MAY BE FEWER THAN CA THE NUMBER OF TRACES IN A GATHER. CA CA ANG INPUT REAL REAL ARRAY OF LENGTH 2 * NANG WHICH CA CONTAINS THE INCIDENT ANGLE RANGES CA FOR ANALYSIS. (ACTUALLY THE SINE OF CA THE ANGLES.) CA CA NANG INPUT INT THE NUMBER OF START ANGLES FOR THE CA ANGLE RANGES. THERE CAN BE OVERLAP CA OF THE ANGLE RANGES. CA CA JBEG INPUT INT TIME SAMPLE INDEX FOR THE TOP OF THE CA ANALYSIS WINDOW FOR THIS CDP. CA CA JEND INPUT INT TIME SAMPLE INDEX FOR THE BOTTOM OF CA THE ANALYSIS WINDOW FOR THIS CDP. CA CA FSR INPUT REAL SAMPLE RATE IN SECONDS. CA CA TAKOFF INPUT CHAR KIND OF INCIDENT ANGLE TO BE USED IN CA THE CALCULATION. 'TAKOF' FOR THE USE CA OF THE RAY TAKE-OFF ANGLES AT THE SUR- CA FACE. 'LOCAL' FOR THE USE OF THE LOCAL CA ANGLES OF INCIDENCE. CA TSHIFT INPUT INT SAMPLE INDEX FOR START OF NMO TIME CA SHIFT. CA CA P OUTPUT REAL REAL ARRAY OF LENGTH NX WHICH WILL CA CONTAIN THE INCIDENT ANGLE (SINE OF CA THE ANGLE) FOR A GIVEN ZERO OFFSET CA TIME WITHIN THE JBEG TO JEND TIME CA WINDOW CA CA DATA OUTPUT REAL REAL ARRAY OF LENGTH NS * NANG WHICH CA WILL CONTAIN THE PARTIAL STACK OF IN- CA CIDENT ANGLE TRACES. CA CA WRKX OUTPUT REAL REAL ARRAY OF LENGTH NS FOR STORAGE CA OF TIMES USED FOR INTERPOLATION. CA CA IDB INPUT INT DEBUG PRINT FLAG. IF A POSITIVE NON- CA ZERO INTEGER THEN DEBUG PRINTS WILL CA OCCUR. CA CA IPR INPUT INT SPARC LOGICAL PRINT DEVICE FOR PRINT- CA ING INFORMATION FROM THIS SUBROUTINE. CA CA EJECT CAEND C*********************************************************************** C C LOCAL VARIABLES C C IHIN I*4 LOCAL NUMBER OF TRACES IN GATHER FOR C ANALYSIS. MAY BE DIFFERENCT THAN NX. C JN I*4 TIME INDEX FOR JBEG PLUS START TIME FOR NMO. C JT I*4 INDEX OF TRACE NUMBER WITH INCIDENT ANGLE C IN THE RANGE. C JWIN I*4 FIRST TIME INDEX IN WINDOW. C K I*4 INDEX TO INCIDENT ANGLE. C NANG2 I*4 MAXIMUM NUMBER OF WINDOW START INCIDENT C ANGLES. C TX R*4 LOCAL VARIABLE USED TO CALCULATE NMO TIME. C TXF R*4 MOVE OUT TIME FOR NMO SHIFT. C T0 R*4 LOCAL ZERO-OFFSET TIME INDEX. C C*********************************************************************** C SUBROUTINE SALMPAE(DATAIN,VEL,VELINT,NS,DX,FLV,NX,ANG,NANG,JBEG, 1 JEND,FSR,TAKOFF,TSHIFT,P,DATA,WRKX,IDB,IPR) C C CALCULATE ANGLE RANGE AND PARTIAL STACK WITHIN THE ANGLE RANGE. C (GENERATE PSEUDO TAU-P TRACES FOR OTHER APPLICATIONS). C FLATTEN EVENT USING ONE VELOCITY VALUE SPECIFIED WITHIN THE TIME C WINDOW C C VEL = RMS VELOCITY C VELINT = INTERVAL VELOCITY C IMPLICIT INTEGER (A-Z) C REAL DATA(NS,*),DATAIN(NS,*),WRKX(*) REAL VELINT(*),DX(*),P(*),VEL(*),FLV(*),ANG(*) REAL FSR,TX,TXF,T0 C CHARACTER*5 TAKOFF C IHIN = NX C NANG2 = NANG * 2 C IF (IDB .GT. 0) THEN WRITE ( IPR, 9000 ) ( ANG(I), I = 1, NANG2 ) 9000 FORMAT ('0*** ANG ***'/(2X,10E12.5)) WRITE ( IPR, 9010 ) ( DX(I), I = 1, IHIN ) 9010 FORMAT ('0*** XDST ***'/(2X,10E12.5)) ENDIF C C T0 = JBEG * FSR T0 = T0 * T0 C C DETERMINE HOW MANY TRACES TO BE USED C I = 0 100 CONTINUE C I = I + 1 IF (JBEG .LT. FLV(I)) GO TO 120 IF (I .EQ. NX) GO TO 120 GO TO 100 120 CONTINUE C IHIN = I JN = JBEG + TSHIFT C DO 140 I = 1, IHIN TX = SQRT ( T0 + (DX(I) / VEL(JN) ) ** 2 ) P(I) = (VELINT(1) / VEL(JN) ) * DX(I) / TX / VEL(JN) 140 CONTINUE C IF (TAKOFF .EQ. 'LOCAL') THEN DO 160 I = 1, IHIN P(I) = (VELINT(JN) / VELINT(1) ) * P(I) 160 CONTINUE C ENDIF C C CHECK FOR DEBUG PRINT C IF (IDB .GT. 0) WRITE ( IPR, 9020 ) ( P(I), I = 1, IHIN ) 9020 FORMAT ('0*** RAY ***'/(2X,10E12.5)) JWIN = JEND - JBEG + 1 JT = 0 C DO 260 K = 1, NANG JTT = 0 JT1 = JT + 1 IF (JT1 .LE. IHIN) THEN C DO 200 I = JT1, IHIN IF (P(I) .GT. ANG(NANG2)) GO TO 180 IF (DATAIN(JBEG, I) .EQ. 0.0 .AND. DATAIN(JBEG+1, I) 1 .EQ. 0.0) GO TO 180 IF (P(I) .GT. ANG(2*K-1) .AND. P(I) .LT. ANG(2*K)) THEN JT = I JTT = 1 GO TO 220 ENDIF C 180 CONTINUE C 200 CONTINUE C 220 CONTINUE C IF (JTT .NE. 0) THEN IF (IDB .GT. 0) WRITE ( IPR, * ) 'JT,JN,VEL(JN),K = ', 1 JT, JN, VEL(JN), K TXF = SQRT ( T0 + (DX(JT) / VEL(JN) ) ** 2 ) / FSR ITX = IFIX ( TXF ) C DO 240 I = 1, JWIN WRKX(I) = ITX + I - 1 240 CONTINUE C CALL SALMPAI ( WRKX, DATAIN(ITX + 1, JT), JWIN, 2, TXF, 1 1.0, DATA(JBEG, K), JWIN, 1 ) C C CHECK FOR DEBUG PRINT C IF (IDB .GT. 0) WRITE ( IPR, * ) 1 'TIME STEP AND ANGLE = ', ITX, TXF, P(JT), JT C ENDIF ENDIF 260 CONTINUE C RETURN END