CTITLESADNMO -- DIFFERENTIAL MOVEOUT APPLICATION 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00020000 CA DESIGNER DANIEL POLAK 00030000 CA LANGUAGE FORTRAN H 00040000 CA SYSTEM IBM 3081/3033 00050000 CA WRITTEN 03-02-82 00060000 C REVISED 03-26-82 JBC. CORRECTED REVERSE NORMAL MOVEOUT 00070000 C BY APPLYING CORRECTED VELOCITY 00080000 C FUNCTION TO DETERMINE LAST VALID 00090000 C OUTPUT POINT 00100000 C REVISED 10-06-82 ESN. REPLACE COMMON/P/ WITH COMMON/APSTAT/00110000 C FOR AP STATUS. 00120000 C REVISED 08-06-85 RSK. CHANGED VPSS MODIFICATIONS TO GO 00130000 C WITH EITHER STANDARD FORMAT OR THE 00140000 C VPSS/XA 31 BIT FORMAT. 00150000 CA 00160000 CA CALL SADNMO (XIN, XOUT, VEL, SAMPR, NOSAMP, CCW1, CCW2, APUNIT, 00170000 CA * APNMO, APOMN, APPRM1, APPRM2, REJECT, TRACE) 00180000 CA 00190000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00200000 CA 00210000 CA IN XIN I4 OFFSET DISTANCE OF INPUT TRACE 00220000 CA IN XOUT I4 OFFSET DISTANCE OF OUTPUT TRACE 00230000 CA IN VEL R4 VELOCITY FUNCTION 00240000 CA IN SAMPR R4 SAMPLE INTERVAL IN SECONDS 00250000 CA IN NOSAMP I4 NUMBER OF SAMPLES IN THE TRACE 00260000 CA IN CCW1 I4 CCW FOR NORMAL MOVOUT AP TASK 00270000 CA IN CCW2 I4 CCW FOR REVERSE NORMAL MOVEOUT TASK 00280000 CA IN APUNIT I4 ARRAY PROCESSOR UNIT NUMBER 00290000 CA IN APNMO I4 APRL ADDRESS FOR NORMAL MOVEOUT AP TASK 00300000 CA IN APOMN I4 APRL FOR REVERSE NORMAL MOVEOUT AP TASK 00310000 CA IN APPRM1 R4 AP PARAMETERS FOR NORMAL MOVEOUT 00320000 CA IN APPRM2 R4 AP PARAMETERS FOR REVERSE NORMAL MOVEOUT 00330000 CA IN REJECT R4 WORK ARRAY OF LENGTH NOSAMP 00340000 CA IN/OUT TRACE R4 SEISMIC TRACE 00350000 CA 00360000 CA 00370000 CA THIS SUBROUTINE APPLIES DIFFERENTIAL NORMAL OR REVERSE NORMAL 00380000 CA MOVEOUT TO THE INPUT TRACE BY EXECUTING THE APPROPRIATE ARRAY 00390000 CA PROCESSOR TASK. THE AP TASKS MUST BE TRANSLATED AND HAVE 00400000 CA THEIR PARAMETERS INITIALIZED PRIOR TO EXECUTION OF THIS 00410000 CA SUBROUTINE. 00420000 CA 00430000 C EJECT 00440000 C 00450000 SUBROUTINE SADNMO (XIN, XOUT, VEL, SAMPR, NOSAMP, CCW1, CCW2, 00460000 * APUNIT, APNMO, APOMN, APPRM1, APPRM2, REJECT, 00470000 * TRACE) 00480000 C 00490000 IMPLICIT INTEGER (A-Z) 00500000 C 00510000 COMMON /APSTAT/ STATUS 00520000 C 00530000 C INTEGER ARRAYS IN THE PARAMETER LIST 00540000 C 00550000 INTEGER CCW1 (1) 00560000 INTEGER CCW2 (1) 00570000 C 00580000 C REAL ARRAYS IN THE PARAMETER LIST 00590000 C 00600000 REAL APPRM1 (1) 00610000 REAL APPRM2 (1) 00620000 REAL REJECT (1) 00630000 REAL TRACE (1) 00640000 REAL VEL (1) 00650000 C 00660000 C REAL VARIABLES 00670000 C 00680000 REAL FXOUT 00690000 REAL SAMPR 00700000 REAL TXL 00710000 C 00720000 C PERFORM NORMAL OR REVERSE NORMAL MOVEOUT BASED ON THE DISTANCES 00730000 C 00740000 IF (XOUT - XIN) 100, 300, 200 00750000 C NMO, NONE, OMN 00760000 C 00770000 C***********************************************************************00780000 C 00790000 C APPLY DIFFERENTIAL NORMAL MOVEOUT 00800000 C 00810000 100 STATUS = 0 00820000 APPRM1(1) = XIN 00830000 APPRM1(2) = XOUT 00840000 I = LOC(TRACE(1)) 00850000 CCCCCCCALL S1MVCH (I, 2, CCW1(7), 2, 3) 00860000 CALL CCWMOD (I,CCW1(7)) 00870000 CCCCCCCALL S1MVCH (I, 2, CCW1(11), 2, 3) 00880000 CALL CCWMOD (I,CCW1(11)) 00890000 C 00900000 CALL VPSS (APUNIT, 'EXCW', APNMO) 00910000 IF (STATUS .LT. 0) GO TO 100 00920000 C 00930000 GO TO 300 00940000 C 00950000 C***********************************************************************00960000 C 00970000 C APPLY DIFFERENTIAL REVERSE NORMAL MOVEOUT 00980000 C 00990000 200 STATUS = 0 01000000 APPRM2(1) = XIN 01010000 APPRM2(2) = XOUT 01020000 I = LOC(TRACE(1)) 01030000 CCCCCCCALL S1MVCH (I, 2, CCW2(7), 2, 3) 01040000 CALL CCWMOD (I,CCW2(7)) 01050000 CCCCCCCALL S1MVCH (I, 2, CCW2(11),2, 3) 01060000 CALL CCWMOD (I,CCW2(11)) 01070000 C 01080000 CALL VPSS (APUNIT, 'EXCW', APOMN) 01090000 IF (STATUS .LT. 0) GO TO 200 01100000 C 01110000 C FIND THE LAST VALID OUTPUT POINT 01120000 C 01130000 J = NOSAMP 01140000 K = 0 01150000 FXOUT = XOUT 01160000 TX = FXOUT / TRACE(1) + 1 01170000 IF (TX .GT. NOSAMP) TX = NOSAMP 01180000 C 01190000 210 TXL = FXOUT / TRACE(J) 01200000 TXL = SQRT (J * J + TXL * TXL) 01210000 N = TXL 01220000 IF (N .LE. NOSAMP) GO TO 220 01230000 J = J - 1 01240000 K = K + 1 01250000 GO TO 210 01260000 C 01270000 C COMPRESS THE ARRAY PROCESSOR OUTPUT INTO THE OUTPUT TRACE 01280000 C 01290000 220 L = NOSAMP 01300000 INDEX = NOSAMP + 22 01310000 C 01320000 DO 230 I = 1, NOSAMP 01330000 J = NOSAMP - I - K 01340000 IF (L .LT. TX) GO TO 240 01350000 IF (REJECT(J) .LT. 0.0) GO TO 230 01360000 TRACE(L) = APPRM2(INDEX+J-1) 01370000 L = L - 1 01380000 C 01390000 230 CONTINUE 01400000 C 01410000 240 CALL ARSET (TRACE, TX-1, 0.0) 01420000 C 01430000 300 RETURN 01440000 END 01450000