CTITLESAMVOT - PERFORM NORMAL MOVEOUT CORRECTION FOR PROCESS AVEL C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C C CA AUTHOR H. W. SWAN CA DESIGNER H. W. SWAN CA SYSTEM IBM/CRAY CA LANGUAGE VS FORTRAN VERSION 2.2 CA WRITTEN 12-03-87 CA LAST REVISED 08-05-88 C C REVISED HWS 07-06-88 ADDED TAU-P CAPABILITY C SIMPLIFIED AND OPTIMIZED CODE C 07-19-88 FULLY VECTORIZED! CALLING C LIST CHANGED. C 08-05-88 CHANGED MOVEOUT FOR TAU-P C DATA, FOR COMPATIBILITY WITH C MIGRATION/INVERSION. C 02-01-89 FIXED BUG WHICH OCCURED IF C LSA > NSIN. C REVISED JJC 05-23-91 CHANGED IMPLICIT TO (A-Z). C REVISED JJC 12-17-91 MODIFIED TO MEET SPARC STANDARDS CA CA CA CALLING SEQUENCE: CA CA CALL SAMVOT(TRIN, SLOTH, COEF, TROUT, TRCOEF, IFRC, CA NSIN, NCOEF, FSA, LSA, XOFF, IFLV, T0, TSAMP, TPFLG, CA NFLV, NLLV) CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA ______ ________ ____ ___________ CA CA IN TRIN (R4) THE UNCORRECTED SEISMIC TRACE, PADDED WITH CA NCOEF ZEROS FOR INDEX VALUES IN THE RANGE CA (1-NCOEF:0) AND (NSIN+1:NSIN+NCOEF). CA (1-D ARRAY, DIMENSIONED (1-NCOEF:NSIN+NCOEF)) CA CA IN SLOTH (R4) THE PRESCRIBED MOVEOUT SLOTH FUNCTION: CA SLOTH IS DEFINED AS {VELOCITY ** (-2)}. CA (1-D ARRAY, DIMENSIONED 0:NSIN+1) CA CA IN COEF (R4) THE INTERPOLATION COEFFICIENTS ALA C. SICKING: CA (2-D ARRAY, DIMENSIONED NCOEF X 100) CA CA OUT TROUT (R4) THE NMO-CORRECTED OUTPUT TRACE CA (1-D ARRAY, DIMENSIONED NSIN) CA CA OUT TRCOEF (R4) A WORK AREA FOR THE FULLY VECTORIZED TRACE CA INTERPOLATION SCHEME: CA (3-D ARRAY, DIMENSIONED FSA:LSA X NCOEF X 2) CA CA OUT IFRC (R4) ANOTHER WORK ARRAY, DIMENSIONED FSA:LSA CA CA IN NSIN I4 THE LENGTH OF THE TRIN ARRAY. CA CA IN NCOEF I4 THE SIZE OF THE TRCOEF AND COEF ARRAYS. CA CA IN FSA I4 THE INDEX IN THE OUTPUT TRACE OF THE FIRST CA SAMPLE TO BE MOVED OUT CA CA IN LSA I4 THE INDEX IN THE OUTPUT TRACE OF THE LAST CA SAMPLE TO BE MOVED OUT CA CA IN XOFF R4 FOR X-T DATA (TPFLG=0): THE SHOT-RECEIVER CA OFFSET, EXPRESSED IN FEET. CA FOR TAU-P DATA (TPFLG=1): THE 'P' VALUE, CA EXPRESSED IN SECONDS/FEET. CA CA IN IFLV I4 THE INDEX OF THE FIRST LIVE SAMPLE OF THIS TRACE CA CA IN T0 R4 THE TIME CORRESPONDING TO TRIN(1) (SECS) CA CA IN TSAMP R4 THE SAMPLING INTERVAL (SECS) CA CA IN TPFLG I4 0 FOR X-T DATA; 1 FOR TAU-P DATA. CA CA OUT NFLV I4 THE INDEX OF THE FIRST LIVE VALUE AFTER MOVEOUT CA CA OUT NLLV I4 THE INDEX OF THE LAST LIVE VALUE AFTER MOVEOUT CA CA PURPOSE: CA CA THIS SUBROUTINE NORMAL MOVEOUT CORRECTS A TRACE, USING A CA PRESCRIBED STACKING VELOCITY PROFILE. CA CA CA SUBROUTINE SAMVOT(TRIN, SLOTH, COEF, TROUT, TRCOEF, IFRC, * NSIN, NCOEF, FSA, LSA, XOFF, IFLV, T0, TSAMP, TPFLG, * NFLV, NLLV) C CJJ IMPLICIT NONE IMPLICIT INTEGER (A-Z) C INTEGER NC2, NCOEF, I, K, FSA, LSA, NFLV, NLLV, ITNDX, N INTEGER IFRAC, JTMP, IFLV, NSIN, TPFLG, ISLEN, NSA REAL XOFF, COEF, TIME, TSAMP, T0, SLOTH, TROUT REAL TRCOEF, TRIN, DISPL, IFRC DIMENSION TRIN(1-NCOEF:NSIN+NCOEF), SLOTH(0:NSIN+1) DIMENSION TROUT(LSA), IFRC(FSA:LSA) DIMENSION TRCOEF(FSA:LSA, NCOEF, 2), COEF(NCOEF, 100) C DOUBLE PRECISION TNDX, TEMP, X2, GAIN REAL TNDX, TEMP, X2, GAIN PARAMETER (DISPL=0.495) EXTERNAL ARSET DATA ISLEN / 0 / NC2 = NCOEF/2 X2 = XOFF * XOFF NSA = LSA - FSA + 1 CALL ARSET(TRCOEF, 2*NSA*NCOEF, 0.0) C C INSERT THE LAST SET OF COEFFICIENTS C IF(NCOEF .NE. ISLEN) THEN ISLEN = NCOEF DO 200 I=1, NCOEF TEMP = 0.0 IF(I .EQ. NC2+1) TEMP = 1.0 200 COEF(I, 100) = TEMP ENDIF C C COMPUTE THE NEW TIMES FOR TAU-P DATA: C IF(TPFLG .EQ. 1) THEN DO 250 K=FSA, LSA TIME = (K-1)*TSAMP + T0 TEMP = 1D0 - X2/SLOTH(K) IF(TEMP .LT. 0) TEMP = 0 TROUT(K) = (TIME * SQRT(TEMP) - T0)/TSAMP - NC2 + DISPL 250 CONTINUE C C COMPUTE THE NEW TIMES FOR X-T DATA: C ELSE DO 300 K=FSA, LSA TIME = (K-1)*TSAMP + T0 TEMP = TIME**2 + X2*SLOTH(K) TROUT(K) = (SQRT(TEMP) - T0)/TSAMP - NC2 + DISPL 300 CONTINUE ENDIF C C COMPUTE THE FRACTIONS. C DO 380 K=FSA, LSA GAIN = TROUT(K) ITNDX = GAIN + NCOEF + 0.5 ITNDX = ITNDX - NCOEF TROUT(K) = NSIN + 0.5 IF(ITNDX .LT. NSIN .AND. ITNDX .GT. IFLV - NCOEF) * TROUT(K) = ITNDX TEMP = 1E2 * (GAIN - ITNDX) + 51 IF (TEMP .GT. 100.0) TEMP = 100.0 380 IFRC(K) = TEMP C C PREPARE TO INTERPOLATE THE TRACE AT THESE NEW TIMES. C C NOTE: THE "N = I" STATEMENT PREVENTS VECTORIZATION ON THE WRONG LOOP. C NFLV = 0 NLLV = NFLV DO 400 I=1, NCOEF N = I DO 400 K=FSA, LSA ITNDX = I + TROUT(K) JTMP = IFRC(K) TRCOEF(K,N,1) = COEF(I, JTMP) TRCOEF(K,N,2) = TRIN(ITNDX) 400 CONTINUE C C GET THE RANGE OF INDICES TO COMPUTE. C DO 410 K=FSA, LSA NFLV = K IF(TRCOEF(K, NC2+1, 1) .NE. 0.0) GO TO 420 410 CONTINUE 420 DO 430 K=LSA, FSA, -1 NLLV = K IF(TRCOEF(K, NC2+1, 1) .NE. 0.0) GO TO 450 430 CONTINUE C C DO THE ACTUAL INTERPOLATION. C 450 CALL ARSET(TROUT(FSA), NSA, 0.0) DO 500 I=1, NCOEF DO 500 K=NFLV, NLLV TROUT(K) = TROUT(K) + TRCOEF(K,I,1)*TRCOEF(K,I,2) 500 CONTINUE C C SCALE THE DATE BY COS(ANGLE) FOR TAU-P DATA. C IF(TPFLG .EQ. 1) THEN DO 600 K=NFLV, NLLV TEMP = 1D0 - X2/SLOTH(K) IF(TEMP .LE. 0) TEMP = 0 GAIN = SQRT(TEMP) TROUT(K) = TROUT(K) * GAIN 600 CONTINUE ENDIF RETURN END