CTITLESPZM2DA -- RETRIEVE THE VELOCITY MODEL FROM DATA CARDS
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA
CA   DESIGNER     JAMES SUN
CA   AUTHOR       JAMES SUN
CA   LANGUAGE     CRAY FORTRAN
CA   SYSTEM       IBM AND CRAY
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/24/90 JJC - CHANGED ARGUMENTS VDTM AND ZDTM FOR
C                                SAHVQC AND SAHZQC.
C    REVISED      07/23/90 CLJ - ALLOW PREP TO RUN ON THE IBM
C    REVISED      08/06/90 CLJ - ADD ERROR MESSAGE FOR UNDEFINED
C                                VELOCITY FIELD
C
CA
CA CALLING PROCEDURE:
CA     SUBROUTINE SPZM2DA(RA,IXBEG,IXEND,DX,NZ,DZ,NUMH,
CA    +            KPNA,KPRNO,KPNUSM,CARD,IABT,IPR,LOPR,NT,DT)
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  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
CA   INPUT  LOPR   = VELOCITY SMOOTHING WINDOW LENGTH                 I4
CA   INPUT  NT     = NUMBER OF TIME SAMPLES                           I4
CA   INPUT  DT     = LINE CARD SAMPLE RATE IN SECONDS                 R4
C
C   THIS SUBROUTINE RETRIEVES THE VELOCITY MODEL INFORMATION FROM
C   INPUT DATA CARDS.
C
      SUBROUTINE SPZM2DA(RA,IXBEG,IXEND,DX,NZ,DZ,NUMH,
     +  KPNA,KPRNO,KPNUSM,CARD,IABT,IPR,LOPR,NT,DT)
C
      IMPLICIT   INTEGER(A-Z)
C
      REAL     RA
      REAL     DX
      REAL     DZ
      REAL     DT
      REAL     DTL
      REAL     DZL
C
      CHARACTER*80  CARD
C
C
      DIMENSION RA(1)
C
C
          COMMON /USER/ SLOCAL(50), ULOCAL(350)
C
          EQUIVALENCE   (NZL   , ULOCAL(23)),
     *                  (DZL   , ULOCAL(24)),
     *                  (NTL   , ULOCAL(29)),
     *                  (DTL   , ULOCAL(30)),
     *                  (INDXA , ULOCAL(49)),
     *                  (INDXB , ULOCAL(50)),
     *                  (IXBEGL, ULOCAL(51))
C
          NZL    = NZ
          DZL    = DZ
          NTL    = NT
          DTL    = DT
          IXBEGL = IXBEG
C
C
          IABT=0
C
C
          KA=1
          CALL SAVKGET(IXBEG,IXEND,1,DX,NUMH,NXMOD,INDXA,INDXB,
     +          KA,KB,KC,KD,KE,KF,KG,KH,KO,KP,KQ,KR,KS,KT,ICC,
     *          KPNA,KPRNO,CARD,IABT,IPR)
C
C
          IF(ICC.GT.KPNUSM) THEN
            IABT=1
            WRITE(IPR,8000) ICC,KPNUSM
 8000       FORMAT('  *** ICC .GT. KPNUSM ***',/,
     *             '         ICC =',I10,/,
     *             '      KPNUSM =',I10)
            GO TO 9999
          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(KH),RA(KO),NXMOD,DX,DZ,RA(KP),RA(KQ),RA(KR),
     *                 RA(KS),RA(KT),NUMH,KPNA,KPRNO,CARD,IABT,IPR)
          IF(IABT.EQ.1) GO TO 9999
C                                                                       02233400
C
          CALL SAHZQC(RA(KA),NXMOD,NZ,NUMH,IXBEG,1,INDXA,INDXB,DZ,IPR,  02233500
     *                NGS,0.)
C                                                                       02233600
C
          CALL SAHVQC(RA(KB),NXMOD,NZ,NUMH,IXBEG,1,INDXA,INDXB,IPR,     02233700
     *                NGS,0.)                                           02233700
C
C                            CHECK FOR UNDEFINED AREA IN VELOCITY FIELD
C
          IPPSW = 1
          CALL SAZM2DA(RA(KD),DUMMY1,DUMMY2,DUMMY3,RA(KA),RA(KB),RA(KC),
     *                 LOPR,NUMH,DUMMY4,NXMOD,IABT,IPR,IPPSW)
          IF(IABT .NE. 0) GO TO 9999
C                                                                       02233600
C                                                                       02233600
          CALL ARSET(RA,ICC,0)
C                                                                       67412000
C
 9999     CONTINUE
          RETURN
          END