CTITLESAPILT -- BUILD PILOT TRACE FOR CURRENT CDP 00000201 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D.D. THOMPSON 00000300 CA DESIGNER D.D. THOMPSON 00000400 CA LANGUAGE FORTRAN H 00000500 CA SYSTEM S / 370 00000600 CA WRITTEN 09-01-79 00000700 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00000800 C 00000900 CA CALL SAPILT (PILOTS, NDPPP, PLEN, TRACE, WGT, SHFT, CPSTAK, 00001000 CA * SUMLAG, SUMWGT, XX) 00001100 CA 00001200 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00001300 CA 00001400 CA IN/OUT PILOTS R4 PILOT STACKS FOR THIS AND PRECEEDING CDP IN 00001500 CA A ROLLING BUFFER ARRANGEMENT (SAMPLES 1 TO 00001600 CA NDPPP*PLEN) AND THE CURRENT PILOT TRACE 00001700 CA (SAMPLES NDPPP*PLEN+1 TO (NDPPP+1)*PLEN). 00001800 CA PRECLEAR PILOTS BEFORE FIRST CALL AND DO 00001900 CA NOT ALTER THEREAFTER. 00002000 CA 00002100 CA IN NDPPP I4 # DEPTH POINTS PER PILOT 00002200 CA IN PLEN I4 # SAMPLES IN PILOT 00002300 CA IN TRACE R4 CURRENT INPUT TRACE (LENGTH PLEN) 00002400 CA IN WGT R4 WEIGHT FOR THIS TRACE 00002500 CA IN SHFT R4 TIME SHIFT (IN SAMPLES) TO APPLY TO TRACE 00002600 CA IN/OUT CPSTAK I4 CURRENT PILOT STACK POINTER. ON FIRST 00002700 CA CALL SET TO ZERO AND DO NOT ALTER THEREAFTER.00002800 CA IN/OUT SUMLAG R4 WEIGHTED SUM OF LAGS FOR THIS CDP. SET TO 00002900 CA ZERO ON FIRST CALL AND DO NOT ALTER THERE- 00003000 CA AFTER. 00003100 CA IN/OUT SUMWGT R4 SUM OF WEIGHTS FOR THIS CDP. SET TO ZERO ON 00003200 CA FIRST CALL AND DO NOT ALTER THEREAFTER. 00003300 CA IN XX R4 SCRATCH ARRAY OF LENGTH PLEN. 00003400 CA 00003500 CA THIS ENTRY UPDATES PILOT STACK FOR CURRENT CDP AS 00003600 CA INDIVIDUAL TRACES ARE ENTERED. 00003700 CA 00003800 CTITLE SAUPLT -- UPDATE PILOT STACK WITH PILOT FROM CURRENT CDP 00003900 CA AUTHOR D.D. THOMPSON 00004000 CA DESIGNER D.D. THOMPSON 00004100 CA LANGUAGE FORTRAN H 00004200 CA SYSTEM S / 370 00004300 CA WRITTEN 09-01-79 00004400 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00004500 C REVISED 11-03-82 N. SHETH ADD CODE TO APPLY FILTER. 00004600 C 00004700 CA CALL SAUPLT (PILOTS, NDPPP, PLEN, WGTS, CPSTAK, SUMLAG, 00004800 CA * SUMWGT, XX, FFTLN3,YY, UNIT3, FILT, FLTR) 00004900 CA 00005000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00005100 CA 00005200 CA IN/OUT PILOTS R4 PILOT STACKS FOR THIS AND PRECEEDING CDP IN 00005300 CA A ROLLING BUFFER ARRANGEMENT (SAMPLES 1 TO 00005400 CA NDPPP*PLEN) AND THE CURRENT PILOT TRACE 00005500 CA (SAMPLES NDPPP*PLEN+1 TO (NDPPP+1)*PLEN). 00005600 CA PRECLEAR PILOTS BEFORE FIRST CALL AND DO 00005700 CA NOT ALTER THEREAFTER. 00005800 CA IN NDPPP I4 # DEPTH POINTS PER PILOT 00005900 CA IN PLEN I4 # SAMPLES IN PILOT 00006000 CA IN WGTS R4 CDP WEIGHTING ARRAY (LENGTH PLEN). WGTS(I) =00006100 CA WEIGHT TO APPLY TO STACK WHICH IS 'I' CDP 00006200 CA POSITIONS AWAY FROM NEXT CDP. 00006300 CA IN CPSTAK I4 CURRENT PILOT STACK POINTER. ON FIRST 00006400 CA CALL SET TO ZERO AND DO NOT ALTER THEREAFTER.00006500 CA IN/OUT SUMLAG R4 WEIGHTED SUM OF LAGS FOR THIS CDP. SET TO 00006600 CA ZERO ON FIRST CALL AND DO NOT ALTER THERE- 00006700 CA AFTER. 00006800 CA IN/OUT SUMWGT R4 SUM OF WEIGHTS FOR THIS CDP. SET TO ZERO ON 00006900 CA FIRST CALL AND DO NOT ALTER THEREAFTER. 00007000 CA IN XX R4 SCRATCH ARRAY OF LENGTH PLEN. 00007100 CA IN FFTLN3 I4 FFT LENGTH FOR FILTERING 00007200 CA IN YY R4 SCRATCH ARRAY FOR VPUT/VGET FOR FILTERING 00007300 CA IN UNIT3 I4 ARRAY PROCESSOR UNIT NUMBER FOR FILTER 00007400 CA IN FILT I4 ADDRESS OF APRL FOR AP3838 FILTERING 00007500 CA IN FLTR I4 FITER OPTION FLAG. 00007600 CA = 0 NO FILTER, = 1 FILTER. 00007700 CA 00007800 CA 00007900 CA 00008000 CA 00008100 CA THIS ENTRY IS CALLED AFTER THE LAST TRACE IN A GATHER HAS BEEN 00008200 CA SENT TO ENTRY 'SAPILT'. HERE THE PILOT STACKS ARE TIME SHIFTED 00008300 CA BY MINUS THE WEIGHTED AVERAGE OF THE INDIVIDUAL LAGS FOR THIS 00008400 CA LATEST CDP AND A NEW PILOT IS FORMED AT THE END OF PILOTS. 00008500 CA 00008600 SUBROUTINE SAPILT (PILOTS, NDPPP, PLEN, TRACE, WGT, SHFT, CPSTAK, 00008700 * SUMLAG, SUMWGT, XX) 00008800 C 00008900 IMPLICIT INTEGER (A-Z) 00009000 EXTERNAL S1ATP 00009100 C 00009200 C REAL ARRAYS IN PARAMETER LIST 00009300 C 00009400 REAL PILOTS (1) 00009500 REAL TRACE (1) 00009600 REAL WGTS (1) 00009700 REAL XX (1) 00009800 REAL YY (1) 00009900 C 00010000 C REAL VARIABLES IN PARAMETER LIST 00010100 C 00010200 REAL SHFT 00010300 REAL SUMLAG 00010400 REAL SUMWGT 00010500 REAL WGT 00010600 C 00010700 REAL S 00010800 C 00010900 C COMPUTE POINTERS 00011000 C 00011100 KPI = CPSTAK * PLEN 00011200 KPQ = PLEN * NDPPP 00011300 LL = PLEN 00011400 C 00011500 C STATIC SHIFT INPUT TRACE BY MEASURED LAG VALUE. 00011600 C 00011700 CALL STATIC (TRACE, LL, XX, LL, SHFT, 1.) 00011800 C 00011900 C ADD WEIGHTED, SHIFTED TRACE INTO CURRENT PILOT STACK 00012000 C 00012100 DO 10 I = 1, PLEN 00012200 10 PILOTS(I+KPI) = PILOTS(I+KPI) + XX(I) * WGT 00012300 C 00012400 C UPDATE LAG AND WEIGHTED SUMS 00012500 C 00012600 SUMLAG = SUMLAG + SHFT * WGT 00012700 SUMWGT = SUMWGT + WGT 00012800 RETURN 00012900 C 00013000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00013100 C C00013200 C SAUPLT ENTRY C00013300 C C00013400 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00013500 C 00013600 ENTRY SAUPLT (PILOTS, NDPPP, PLEN, WGTS, CPSTAK, SUMLAG, SUMWGT, 00013700 * XX, FFTLN3, YY, UNIT3, FILT, FLTR ) 00013800 C 00013900 C FORM POINTERS 00014000 C 00014100 KPI = CPSTAK * PLEN 00014200 KPQ = PLEN * NDPPP 00014300 C 00014400 C COMPUTE MINUS THE WEIGHTED AVERAGE LAGS FOR LAST CDP. 00014500 C 00014600 IF (SUMWGT .NE. 0.) SUMLAG = - SUMLAG / SUMWGT 00014700 C 00014800 C CLEAR PILOT 00014900 C 00015000 CALL ARSET (PILOTS(KPQ+1), PLEN, 0.) 00015100 C 00015200 C APPLY STATIC SHIFT TO EACH PILOT STACK CORRESPONDING 00015300 C TO THE ABOVE AVERAGE. 00015400 C 00015500 DO 20 J = PLEN, KPQ, PLEN 00015600 JJ = J - PLEN + 1 00015700 LL = PLEN 00015800 CALL STATIC (PILOTS(JJ), LL, XX, LL, SUMLAG, 1.) 00015900 C 00016000 20 CALL ARMVE (XX, PILOTS(JJ), PLEN) 00016100 C 00016200 C PERFORM WEIGHTED STACK OF PILOT STACKS TO FORM NEW PILOT 00016300 C 00016400 I = 1 00016500 30 II = I + KPQ 00016600 C 00016700 DO 40 J = 1, NDPPP 00016800 JJ = CPSTAK - J + 2 00016900 IF (JJ .LT. 1) JJ = JJ + NDPPP 00017000 C 00017100 40 PILOTS(II) = PILOTS(II) + PILOTS( (J-1)*PLEN+I ) * WGTS(JJ) 00017200 I = I + 1 00017300 IF ( I .LE. PLEN ) GO TO 30 00017400 C 00017500 C ADD FILTER APPLICATION HERE. 00017600 C BANDPASS FILTER THE PILOT TRACE. ADD CODE FOR VPSS CALL 00017700 C 00017800 IF (FLTR .EQ. 0) GO TO 70 00017900 C 00018000 DO 50 JJ = 1, PLEN 00018100 II = JJ + KPQ 00018200 IF (PILOTS(II) .NE. 0.0) GO TO 60 00018300 C 00018400 50 CONTINUE 00018500 C 00018600 JJ = PLEN + 1 00018700 C 00018800 60 CONTINUE 00018900 CALL ARSET ( YY , FFTLN3, 0.0) 00019000 CALL ARMVE (PILOTS(KPQ+1), YY , PLEN ) 00019100 CALL VPSS (UNIT3, 'EXCW', FILT) 00019200 CALL ARMVE ( YY , PILOTS(KPQ+1) , PLEN ) 00019300 CALL ARSET (PILOTS(KPQ+1), JJ-1, 0.0 ) 00019400 C 00019500 70 CONTINUE 00019600 C 00019700 C AND COMPUTE SUM OF SQUARES. 00019800 C 00019900 S = 0. 00020000 DO 80 I = 1, PLEN 00020100 II = I + KPQ 00020200 80 S = S + PILOTS(II)**2 00020300 C 00020400 IF (S .EQ. 0.) GO TO 100 00020500 S = 1. / SQRT(S) 00020600 C 00020700 C NORMALIZE PILOT BY SQUARE ROOT OF SUM OF THE SQUARES. 00020800 C 00020900 DO 90 I = 1, PLEN 00021000 II = I + KPQ 00021100 C 00021200 90 PILOTS(II) = S * PILOTS(II) 00021300 C 00021400 C RESET SUMS TO ZERO, UPDATE PILOT-STACK POINTER AND 00021500 C CLEAR PILOT STACK FOR NEXT CDP. 00021600 C 00021700 100 SUMLAG = 0. 00021800 SUMWGT = 0. 00021900 CPSTAK = CPSTAK + 1 00022000 IF(CPSTAK .GE. NDPPP) CPSTAK = 0 00022100 CALL ARSET(PILOTS(CPSTAK*PLEN+1), PLEN, 0.) 00022200 C 00022300 RETURN 00022400 END 00022500