CTITLESAPSTK -- PARTIAL STACK
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR       T. J. TRULOCK
CA    DESIGNER     T. J. TRULOCK
CA    LANGUAGE     VS FORTRAN
CA    SYSTEM       IBM
CA    WRITTEN      03-09-89
C     REVISED      11-03-89 TJT. CHANGE CALL SATCOR TO CALL SATCORF.
C     REVISED      06-29-90 ESN. INCLUDE SENSE ARGUMENT IN CALL.
C     REVISED      01-31-91 CLJ  ADDED PRIMARY LAG AMOUNT ARGUMENT
C                                ADDED SPEAK TO CALL TO SATCORF
CA
CA    CALL SAPSTK (NPLT, SUMTR, PLTS, TRACES, PSTAK,
CA   *             WORK, NNSMPL, FFTLEN, LAG, PRLAG, XCORFN, SENSE)
CA
CA    IN/OUT ARGUMENT TYPE DESCRIPTION
CA
CA    IN     NPLT     I4   NUMBER OF PILOT TRACES IN SUMTR ARRAY
CA    IN     SUMTR    R4   PILOT TRACE ARRAY
CA    OUT    PLTS     R4   AREAL PILOT
CA    IN     TRACES   R4   PILOT TRACE AND 'NXCOR' TRACES FOR
CA                         CORRELATION WITH ZEROES ADDED FOR FFT
CA    IN     PSTAK    R4   SCRATCH WORK ARRAY FOR PILOT SUMS
CA    IN     WORK     R4   SCRATCH WORK ARRAY
CA    IN     NSMPLE   I4   LENGTH OF EACH TRACE WITHOUT ADDED ZEROES
CA    IN     FFTLEN   I4   LENGTH OF FFT
CA    IN     LAG      I4   NUMBER OF SAMPLES OF LAG TO EXAMINE IN
CA                         EACH DIRECTION (ASSUMED TO BE POSITIVE)
CA    IN     PRLAG    I4   NUMBER OF SAMPLES OF LAG TO EXAMINE IN
CA                         EACH DIRECTION FOR THE PRIMARY PEAK
CA    IN     XCORFN   R4   WORK AREA FOR CORRELATION FUNCTIONS
CA    IN     SENSE    R4   SENSITIVITY FACTOR FOR PILOT ALIGNMENT
CA
CA    LOCAL VALIABLES
CA
CA           MXNXCOR  I4   MAXIMUM NUMBER OF CORRELATIONS
CA           NXCOR    I4   NUMBER OF TRACES TO CORRELATE WITH PILOT
CA           STAT     R4   COMPUTED TIME SHIFTS IN SAMPLES
CA           AMP      R4   AMPLITUDE VALUE OF TRACES
CA           COR      R4   DOT PRODUCT OF TRACES AND PILOT FOR OPTIMAL
CA
CA
CA    THIS ROUTINE ALIGNS PILOT TRACES USING THE PARTIAL STACK METHOD
CA
      SUBROUTINE SAPSTK (NPLT, SUMTR, PLTS, TRACES, PSTAK,
     *                   WORK, NNSMPL, FFTLEN, LAG, PRLAG,
     *                   XCORFN, SENSE)
      IMPLICIT INTEGER  (A-Z)
      REAL   SUMTR    (1)
      REAL   PLTS     (1)
      REAL   TRACES   (2)
      REAL   PSTAK    (1)
      REAL   WORK     (1)
      REAL   XCORFN   (1)
C
      REAL   STAT
      REAL   AMP
      REAL   COR
      REAL   SPEAK
C
      MORE   = 0
      MXNXCR = 1
      NXCOR  = 1
      FFTLP2 = FFTLEN + 2
      TWOFFT = FFTLP2 + FFTLP2
C
C----- TRY 4 ITERATIONS FOR PILOT ALIGNMENT
C
      DO 600 K = 1, 4
C
C-----ZERO THE TRACE ARRAY AND SUMMING ARRAY
C
      CALL ARSET (TRACES, TWOFFT, 0.0)
      CALL ARSET (PSTAK, NNSMPL, 0.0)
C
C-----FORM PARTIAL STACK LEAVING OUT FIRST TRACE
C
      DO 200 J = 2, NPLT
      INDX = (J-1) * NNSMPL + 1
      CALL ARADF (PSTAK(1), SUMTR(INDX), PSTAK(1), NNSMPL)
  200 CONTINUE
C
C-----MOVE FIRST TRACE TO SATCORF ARRAY (SLOT1)
C-----MOVE PARTIAL STACK TO SATCORF ARRAY (SLOT2)
C
      CALL ARMVE (SUMTR, TRACES(1+   LAG), NNSMPL)
      CALL ARMVE (PSTAK, TRACES(1+FFTLP2), NNSMPL)
C
C-----DO XCOR AND GET SHIFT VALUE FOR FIRST TRACE
C-----PASS TRACES(2) TO SATCORF.  SATCORF INDEXES FROM 0(TRACES(1))
C
      CALL SATCORF (TRACES(2), WORK, NNSMPL, FFTLEN, LAG, PRLAG,
     *             NXCOR, MXNXCR, XCORFN, STAT, AMP, COR, SPEAK )
C
      IF(ABS(STAT) .GT. SENSE) MORE = 1
      LL = NNSMPL
      STAT = -STAT
      CALL STATIC (SUMTR(1), LL, WORK, LL, STAT, 1.)
C
      DO 300 J = 1, NNSMPL
  300 SUMTR(J) = WORK(J)
C
      DO 500 J = 2, NPLT
      INDX1 = (J-1) * NNSMPL
      INDX2 = (J-2) * NNSMPL
C
      CALL ARADF (PSTAK(1), SUMTR(1+INDX2), PSTAK(1), NNSMPL)
      CALL ARSBF (PSTAK(1), SUMTR(1+INDX1), PSTAK(1), NNSMPL)
C
      CALL ARSET (TRACES, TWOFFT, 0.0)
      CALL ARMVE (SUMTR(1+INDX1), TRACES(1+LAG), NNSMPL)
      CALL ARMVE (PSTAK, TRACES(1+FFTLP2), NNSMPL)
C
      CALL SATCORF (TRACES(2), WORK, NNSMPL, FFTLEN, LAG, PRLAG,
     *             NXCOR, MXNXCR, XCORFN, STAT, AMP, COR, SPEAK )
C
      IF(ABS(STAT) .GT. SENSE) MORE = 1
      LL = NNSMPL
      STAT = -STAT
      CALL STATIC (SUMTR(1+INDX1), LL, WORK, LL, STAT, 1.)
C
      DO 400 I = 1, NNSMPL
  400 SUMTR(I+INDX1) = WORK(I)
C
  500 CONTINUE
      IF(MORE .EQ. 0) GO TO 800
      MORE   = 0
  600 CONTINUE
C
C-----GENERATE AREAL PILOT
C
  800 DO 1000 J = 1, NPLT
      INDX = (J-1) * NNSMPL + 1
      CALL ARADF (PLTS(1), SUMTR(INDX), PLTS(1), NNSMPL)
 1000 CONTINUE
C
      RETURN
      END