CATITLESPVADMA -- RETRIEVE THE VELOCITY MODEL FROM DATA CARDS
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA
CA     AUTHOR        JAMES C. SUN
CA     LANGUAGE      CRAY FORTRAN
CA     SYSTEM        IBM AND CRAY
CA     WRITTEN       03/26/87
C      REVISED       02/15/90 JJC - MODIFIED TO MEET EDP SPARC STANDARDS
C      REVISED       02/20/90 JJC - RENAMED VADMPP TO SPVADMA.
C                                   RENAMED VKGET TO SAVKGET.
C                                   RENAMED VGRID TO SAVGRID.
C                                   RENAMED ZQC   TO SAHZQC.
C                                   RENAMED VQC   TO SAHVQC.
C      REVISED       11/06/90 CLJ - ALLOW PREP TO RUN ON THE IBM AND
C                                   ADD ERROR MESSAGE FOR UNDEFINED
C                                   VELOCITY FIELD
C      REVISED       03/06/91 JCS - ADD NXMOD TO SAVADMA CALLING
C                                   PARAMETER LIST
C
CA    CALL SPVADMA(RA,ISBEG,ISEND,ISINC,IDXSS,NGS,NZ,DZ,NUMH,
CA   +            ZDTM,VDTM,KPNA,KPRNO,KPNUSM,CARD,IABT,IPR)
CA
CA   INPUT  RA     = ADDRESS OF THE FIRST ELEMENT OF RESERVED MEMORY. I4
CA   INPUT  ISBEG  = STARTING DEPTH POINT.                            I4
CA   INPUT  ISEND  = ENDING   DEPTH POINT.                            I4
CA   INPUT  ISINC  = SHOT POINT NUMBER INCREMENT                      I4
CA   INPUT  IDXSS  = SHOT INTERVAL * 100                              I4
CA   INPUT  NGS    = NUMBER OF SHOTS PADDED ON EACH SIDE              I4
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
      SUBROUTINE SPVADMA(RA,ISBEG,ISEND,ISINC,IDXSS,NGS,NZ,DZ,NUMH,
     +            ZDTM,VDTM,KPNA,KPRNO,KPNUSM,CARD,IABT,IPR)
C
      IMPLICIT INTEGER (A-Z)
C
      REAL     DXSS
      REAL     DZ
      REAL     VDTM
      REAL     ZDTM
      REAL     RA
C
      CHARACTER*80  CARD
C
      DIMENSION RA(1)
C
          COMMON  /USER/ SLOCAL(50), ULOCAL(450)
C
          EQUIVALENCE (NZL      , ULOCAL( 22))
          EQUIVALENCE (NGSL     , ULOCAL( 33))
          EQUIVALENCE (ISINCL   , ULOCAL( 40))
          EQUIVALENCE (ISBEGL   , ULOCAL( 47))
          EQUIVALENCE (NXMOD    , ULOCAL( 90))
          EQUIVALENCE (INDXA    , ULOCAL( 91))
          EQUIVALENCE (INDXB    , ULOCAL( 92))
C
          NZL = NZ
          NGSL   = NGS
          ISBEGL = ISBEG
          ISINCL = ISINC
C
      DXSS=IDXSS/100.
C     DZ=IDZ
      IABT=0
C
C     WRITE(IPR,1000) DXSS,DZ,NUMH
C1000 FORMAT('  ** IN SPVADMA ** ',/,
C    +       '      DXSS =',E12.5,/,
C    +       '        DZ =',E12.5,/,
C    +       '      NUMH =',I5)
C
C                       GET INFO FOR VELOCITY BUILDER (INDEXES)
C
      KA=1
      CALL SAVKGET(ISBEG,ISEND,ISINC,DXSS,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
        IF(ICC.GT.KPNUSM) THEN
        IABT=1
        WRITE(IPR,1001) ICC,KPNUSM
 1001   FORMAT('  *** ICC .GT. KPNUSM ***',/,
     +         '         ICC =',I10,/,
     +         '      KPNUSM =',I10)
        RETURN
        ENDIF
        CALL ARSET(RA,ICC,0)
C
C                       BUILD 2-D VELOCITY GRID & DEPTH GRID
C
        CALL SAVGRID(RA(KA),RA(KB),RA(KC),RA(KD),RA(KE),RA(KF),RA(KG),
     +             RA(KH),RA(KO),NXMOD,DXSS,DZ,RA(KP),RA(KQ),RA(KR),
     +             RA(KS),RA(KT),NUMH,KPNA,KPRNO,CARD,IABT,IPR)
C       NSHOT=(ISEND-ISBEG)/ISINC+1
C       CALL PTST2I('IZDX',RA(KA+INDXA-1),NXMOD,NUMH,NSHOT,1,IPR)
C       CALL PTST2R('VKCV',RA(KB+INDXA-1),NXMOD,NUMH,NSHOT,1,IPR)
C       IABT=1
        IF(IABT.NE.0) GO TO                                       9999
C
C                       HORIZON DEPTH QC PLOT
C
      CALL SAHZQC(RA(KA),NXMOD,NZ,NUMH,ISBEG,ISINC,INDXA,INDXB,DZ,IPR,
     +         NGS,ZDTM)
C
C                       HORIZON VELOCITY QC PLOT
C
      CALL SAHVQC(RA(KB),NXMOD,NZ,NUMH,ISBEG,ISINC,INDXA,INDXB,IPR,
     +         NGS,VDTM)
C
C                       CHECK FOR UNDEFINED AREAS IN THE VELOCITY FIELD
C
          IPPSW = 1
          CALL SAVADMA(RA(KC),DUMMA1,DUMMA2,RA(KA),RA(KB),RA(KG),
C    +                 DUMMS1,NUMH,DUMMS2,IABT,IPR,IPPSW)
     +                 DUMMS1,NUMH,DUMMS2,IABT,IPR,IPPSW,NXMOD)
C
C
      CALL ARSET(RA,ICC,0)
C
 9999 CONTINUE
C
      RETURN
      END