C
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CTITLESPPRCPA -- RETRIEVE THE VELOCITY MODEL FROM DATA CARDS
CA
CA   DESIGNER     JAMES SUN
CA   AUTHOR       JAMES SUN
CA   LANGUAGE     CRAY FORTRAN
CA   SYSTEM       CRAY ONLY
CA   WRITTEN      02/08/89
CA
C    REVISED      01/20/90 JJC - MODIFIED TO MEET EDP STANDARDS.
C    REVISED      02/05/90 JJC - RENAMED VGRID TO SAVGRID.
C                                RENAMED VKGET TO SAVKGET.
C                                RENAMED VQC TO SAHVQC.
C                                RENAMED ZQC TO SAHZQC.
C    REVISED      06/06/90 JCS - COPIED FROM SPPRCP
C                                ADDED ZDTM AND VDTM CALLING ARGUMENT
C                                ALOWED NEGATIVE IXINC
C    REVISED      09/10/90 JJC - MODIFIED TO MEET EDP STANDARDS.
C
CA
CA CALLING PROCEDURE:
CA     SUBROUTINE SPPRCPA(RA,IXBEG,IXEND,DX,NZ,DZ,NUMH,ZDTM,VDTM,
CA    +            KPNA,KPRNO,KPNUSM,CARD,IABT,IPR)
CA
C   CALLING ARGUMENTS
CA
CA   INPUT  RA     = ADDRESS OF THE FIRST ELEMENT OF RESERVED MEMORY. I4
CA   INPUT  IXBEG  = STARTING DEPTH POINT.                            I4
CA   INPUT  IXEND  = ENDING   DEPTH POINT.                            I4
CA   INPUT  DX     = DEPTH POINT SPACING.                             R4
CA   INPUT  NZ     = NO. OF GRID POINTS IN Z DIRECTION.               I4
CA   INPUT  DZ     = DEPTH STEP SIZE (FT).                            R4
CA   INPUT  NUMH   = MAXIMUM NO. OF HORIZONS.                         I4
CA   INPUT  ZDTM   = DATUM ELEVATION                                  R4
CA   INPUT  VDTM   = REPLACEMENT VELOCITY                             R4
CA   INPUT  KPNA   = PROCESS NAME.                                    I4
CA   INPUT  KPRNO  = PROCESS NUMBER.                                  I4
CA   INPUT  KPNUSM = NO. OF WORDS OF UNRESERVED MEMORY.               I4
CA   INPUT  CARD   = VELOCITY MODEL DEFINIATION CARDS.              CHAR
CA   INPUT  IABT   = ERROR TERMINATION FLAG.                          I4
CA   INPUT  IPR    = PRINTER UNIT.                                    I4
C
C   THIS SUBROUTINE RETRIEVES THE VELOCITY MODEL INFORMATION FROM
C   INPUT DATA CARDS.
C
C
C**************************************************************
C                                                             *
C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE          *
C                                                             *
C SAVKGET   ARSET     SAVGRID   SAHZQC    SAHVQC              *
C                                                             *
C**************************************************************
C
      SUBROUTINE SPPRCPA(RA,IXBEG,IXEND,DX,NZ,DZ,NUMH,ZDTM,VDTM,
     +  KPNA,KPRNO,KPNUSM,CARD,IABT,IPR)
C
      IMPLICIT   INTEGER(A-Z)
C
      REAL     RA
      REAL     DX
      REAL     DZ
      REAL     ZDTM
      REAL     VDTM
C
      CHARACTER*80  CARD
C
C
      DIMENSION RA(1)
      IABT = 0
C
      IF (IXEND .GE. IXBEG) THEN
         IXINC = 1
      ELSE
         IXINC = -1
      ENDIF
C
      KA = 1
      CALL SAVKGET ( IXBEG, IXEND, IXINC, DX, NUMH, NXMOD, INDXA, INDXB
     1   , KA, KB, KC, KD, KE, KF, KG, KH, KO, KP, KQ, KR, KS, KT, ICC,
     2   KPNA, KPRNO, CARD, IABT, IPR )
C
C
      IF (ICC .GT. KPNUSM) THEN
         IABT = 1
         WRITE ( IPR, 9000 ) ICC, KPNUSM
 9000   FORMAT('  *** ICC .GT. KPNUSM ***',/,
     1         '         ICC =',I10,/,
     2         '      KPNUSM =',I10)
         RETURN
      ENDIF
      CALL ARSET ( RA, ICC, 0 )
C
C
      CALL SAVGRID ( RA(KA),RA(KB),RA(KC),RA(KD),RA(KE),RA(KF),RA(KG),RA
     1   (KH),RA(KO),NXMOD,DX,DZ,RA(KP),RA(KQ),RA(KR),RA(KS),RA(KT),NUMH
     2   ,KPNA,KPRNO,CARD,IABT,IPR )
      IF (IABT .EQ. 1) RETURN
C                                                                       02233400
C
      CALL SAHZQC ( RA(KA),NXMOD,NZ,NUMH,IXBEG,IXINC,INDXA,INDXB,DZ,IPR,
     1   0,ZDTM )
C                                                                       02233600
C
      CALL SAHVQC ( RA(KB),NXMOD,NZ,NUMH,IXBEG,IXINC,INDXA,INDXB,IPR,0,
     1   VDTM )
C                                                                       02233600
C                                                                       02233600
      CALL ARSET ( RA, ICC, 0 )
C                                                                       67412000
C
      RETURN
      END