CTITLESAPRCPD -- CALCULATES THE TIME/VELOCITY OR DEPTH/VELOCITY ARRAYS
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA
CA     DESIGNER    JAMES SUN
CA     AUTHOR      JAMES SUN
CA     LANGUAGE    FORTRAN 77
CA     SYSTEM      IBM / CRAY
CA     WRITTEN     09/24/84
C      REVISED     09/10/90 JJC - MODIFIED TO MEET EDP STANDARDS.
CA
CA
CA CALLING PROCEDURE:
CA     SUBROUTINE SAPRCPD(CDPN,IZDEX,V,VEL,IXBEG,ISINC,INDXA,INDXB,
CA    +  NUMH,NX,NZ,DZ,VDTM,IOPT,NT,DT,IPR)
CA
C   CALLING ARGUMENTS
CA
CA     INPUT   CDPN  = SHOT /DEPTH POINT                          I4
CA     INPUT   IZDEX = 2-D INDEX ARRAY FOR DEPTH OF HORIZONS      I4
CA     INPUT   V     = 2-D ARRAY FOR HORIZON VELOCITY FIELD       R4
CA     OUTPUT  VEL   = VELOCITY ARRAY                             R4
CA     INPUT   IXBEG = BEGINNING OF DEPTH / SHOT POINT            I4
CA     INPUT   IXINC = INCREMENT OF DEPTH / SHOT POINT            I4
CA     INPUT   INDXA = INDEX IN THE MODEL CORRESPONDING TO IXBEG  I4
CA     INPUT   INDXB = INDEX IN THE MODEL CORRESPONDING TO IXEND  I4
CA     INPUT   NUMH  = NUMBER OF HORIZONS                         I4
CA     INPUT   NX    = NO. OF X GRIDS OF THE MODEL                I4
CA     INPUT   NZ    = NUMBER OF OUTPUT DEPTH STEPS               I4
CA     INPUT   DZ    = DEPTH STEP SIZE (FT/METER)                 R4
CA     INPUT   VDTM  = REPLACEMENT VELOCITY                       R4
CA     INPUT   IOPT  = PLOT DISPLAY OPTION                        I4
CA                      'DVEL' = DEPTH/VELOCITY TRACE PLOT (WRIT)
CA                      'DCLR' = DEPTH/COLOR PLOT (UNISEC / QULR)
CA                      'TVEL' = TIME/VELOCITY TRACE PLOT  (WRIT)
CA                      'TCLR' = TIME/COLOR PLOT  (UNISEC / QULR)
CA     IN/PUT  NT    = NUMBER OF SAMPLES IN A TRACE (=NS)         I4
CA     IN/PUT  DT    = SAMPLING RATE                              R4
CA     INPUT   IPR   = PRINT UNIT                                 I4
CA
CA     THIS SUBROUTINE CALCULATES THE DIFFERENT OUTPUTS FOR PLOTTING
CA     DISPLAYS.
C
CA    ARRAY DIMENSION REQUIREMENT:                                      15630800
CA         VEL - NZ                                                     15630900
CA       IZDEX - NX*NUMH                                                15631000
CA           V - NX*NUMH                                                15632000
C
C**************************************************************
C                                                             *
C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE          *
C                                                             *
C ARSET                                                       *
C                                                             *
C**************************************************************
C
      SUBROUTINE SAPRCPD(CDPN,IZDEX,V,VEL,IXBEG,ISINC,INDXA,INDXB,      15634000
     +  NUMH,NX,NZ,DZ,VDTM,IOPT,NT,DT,IPR)                              15635000
C                                                                       15636000
C
      IMPLICIT   INTEGER(A-Z)
C
C
      REAL     V
      REAL     VEL
      REAL     DZ
      REAL     VDTM
      REAL     DT
      REAL     TTOTAL
      REAL     ZZ
      REAL     VV
C
C
      CHARACTER*4 IOPT
C
C
      DIMENSION   VEL(   1)                                             15637000
      DIMENSION IZDEX(NX,1)                                             15638000
      DIMENSION     V(NX,1)                                             15638000
C                                                                       15640000
C
      IF (INDXA .LE. INDXB) THEN
         KSIGN = ISIGN ( 1,ISINC )
      ELSE
         KSIGN = -ISIGN ( 1,ISINC )
      ENDIF
C                                                                       15700000
C
      IX = (CDPN-IXBEG )  / KSIGN + INDXA
C
C
      IX = MAX0 ( IX,1 )
      IX = MIN0 ( IX,NX )
C                                                                       15760000
C
      IF (IOPT .EQ. 'TVEL'  .OR.  IOPT .EQ. 'TCLR') THEN
         NZT = NT
         TTOTAL = 0.
         ZZ = 1.
         VV = V(IX,1)
      ELSE
         NZT = NZ
      ENDIF
C                                                                       15760000
C                                                                       15760000
      IF (VDTM .NE. 0.) THEN
         CALL ARSET ( VEL, NZT, VDTM )
         VV = VDTM
      ENDIF
C                                                                       15810000
C
      DO 110 IH = 1, NUMH
C                                                                       15850000
C
         IF (IZDEX(IX,IH) .NE. 0) THEN
C                                                                       15850000
C
            IF (IOPT .EQ. 'TVEL'  .OR.  IOPT .EQ. 'TCLR') THEN
               TTOTAL=2.*(FLOAT(IZDEX(IX,IH))-ZZ)*DZ/VV+TTOTAL
               IZTBEG = TTOTAL / DT + 1
               ZZ = IZDEX(IX,IH)
               VV = V(IX,IH)
            ELSE
               IZTBEG = IZDEX(IX,IH)
            ENDIF
C                                                                       15850000
C
            IF (IZTBEG .NE. 0) THEN
CDIR$          IVDEP
               DO 100 IZT = IZTBEG, NZT
                  VEL(IZT) = V(IX,IH)
  100          CONTINUE
            ENDIF
C                                                                       15900000
C
         ENDIF
  110 CONTINUE
C                                                                       15920000
C                                                                       15930000
      RETURN
      END