CTITLEJSVADM -- JOBGEN & COMMON BLANK CALCULATION
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR       JAMES SUN
CA    DESIGNER     JAMES SUN
CA    SYSTEMS      IBM / CRAY
CA    WRITTEN      04-07-87
C     REVISED      06-19-87 BY JCS  FOR CRAY
C     REVISED      06-19-87 BY JCS  PAD ZERO-TRACES FOR END-ON CABLE
C     REVISED      02-08-88 BY JCS  USE PHASE SHIFT FOR CONSTANT
C                                   VELOCITY WATER LAYER
C     REVISED      02/15/90 JJC - MODIFIED TO MEET EDP SPARC STANDARDS.
C     REVISED      06/12/90 JCS - 1) FIXED ERRORS IN ICC CALCULATION
C                                 2) USED SAVKGET TO CALCULATE MEMORY
C                                     REQUIRED FOR SAVRRID ROUTINE
C                                 3) CHANGED THE CPU ESTIMATION
C     REVISED      06/18/90 JCS   ADDED 'DEN' CARD THAT ALLOWS:
C                                 1) DECIMATING THE RECEIVERS
C                                 2) OUTPUTING 2 TRACES PER SHOT
C     REVISED      02/13/91 CLJ - CORRECTED ERROR IN NINT(LOCSAV)
C                                   CALCULATION FOR SPLIT SPREAD CASE
C                                   AS REQUESTED BY JAMES SUN.
C     REVISED      02/16/91 JCS   CORRECTED ERROR FOR SPLIT SPREAD CASE
C     REVISED      07/16/91 JCS   CHANGED TO USE P32 AND U32 TO PACK/
C                                   UNPACK INTO 32 BITS BEFORE STORING
C                                   ON DISK WORKFILES B,J,L,M,E,G,K
C     REVISED      12/11/91 JCS   PRINT DISK SPACE REQUIREMENT
C     REVISED      12/18/91 JJC   FOR IBM VERSION.
C     REVISED      03/02/92 JCS   CORRECTED ERROR IN DISK SPACE
C                                   CALCULATION
C     REVISED      03/02/92 JCS   CHANGED ALLOWED VALUE FOR 'DEN' CARD
CA
CA
CA    CALL JSVADM (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE, ERCODE)
CA
CA          INPUT  KPNA   = PROCESS NAME                            A4
CA          INPUT  KPRNO  = PROCESS NUMBER                          I4
CA          INPUT  OCCUR  = OCCURRENCE NUMBER FOR PROCESS KPNA WITH I4
CA                          KPRNO
CA          OUTPUT PSIZE  = REGION SIZE OF PROGRAM IN -KBYTES       I4
CA          OUTPUT CSIZE  = RESERVED BLANK COMMON SIZE IN WORDS     I4
CA          OUTPUT UCSIZE = UNRESERVED BLANK COMMON SIZE IN WORDS   I4
CA          OUTPUT ERCODE = ERROR CODE (=16 IF NOT ABLE TO COMPUTE  I4
CA                                     THE REQUIRED PARAMETERS)
CA
CA
CA    COMPUTES THE PROGRAM SIZE (PSIZE) AND AMOUNT OF BLANK COMMON
CA    (CSIZE) NEEDED BY SPARC DEVELOPMENT PROCESS  VADM  REQUIRING
CA    SPECIAL CALCULATIONS.
C
C
C
C     EJECT
C
      SUBROUTINE JSVADM (KPNA, KPRNO, OCCUR, PSIZE, CSIZE, UCSIZE,
     *                   ERCODE)
C
      IMPLICIT  INTEGER   (A-Z)
C
CJCS  EXTERNAL  FOIP
C
C
      CHARACTER*4  KPNA
      CHARACTER*80 CARD
C
C                 INTEGER CONSTANTS -- LOCAL
C
      INTEGER FCF
      INTEGER IPR
      INTEGER THL
      INTEGER INDX(13)
C
      REAL LCGRPI
C
C                 REAL    CONSTANTS -- LOCAL
C
      REAL     ANTRNC
      REAL     DXSS
      REAL     CPUEST
      REAL     PI2
      REAL     DT
      REAL     DW
      REAL     WLO
      REAL     WHI
      REAL     XMIN
      REAL     XMAX
      REAL     XBEG
      REAL     CFACT
      REAL     DZ
      REAL     ZDTM
      REAL     TEMP
C
      DATA    FCF     /   1 /
      DATA    IPR     /  98 /
CJCS  DATA    THL     / 190 /
      DATA    THL     /  95 /
C
CJJ               GET LINE CARD PARAMETERS
C
      DA = 1
      CALL FORC ('LINE', 0, DA, CARD,                           * 8000)
C
      LCRLEN = S1CVBN (CARD, 41, 5)
      LCSI   = S1CVBN (CARD, 46, 5)
      LCPI   = S1CVBN (CARD, 51, 5)
      IF (LCPI .EQ. 0) LCPI = LCSI
C
      CALL USCHFT (CARD, 56, 5, LCGRPI)
C
C     IF (LCPI .EQ. 0) GO TO                                      9800
C     ABOVE LINE IS COMMENTED BUT INTENTIONALY LEFT FOR CLARITY.
C     THE LCPI NON ZERO CHECK SHOULD BE DONE IN JSCORE OR JSRND AND
C     THEREFORE IS REDUNDANT HERE.
C
      NS = LCRLEN/LCPI
C
C ======================================================================
C        INITIALIZATION
C ======================================================================
C
      PSIZE = 20
C
      ICC = 0
C
C ======================================================================
C        READ INPUT CARD (3) ('DEN' CARD)
C ======================================================================
C
      JGGI = 1
      JSSO = 1
      DAC = 1
    5 CALL FORC (KPNA, KPRNO, DAC, CARD, * 6   )
      IF (S1CPCH (CARD, 8, 'DEN', 1, 3) .NE. 0) GO TO 5
C
      IF (S1CPCH (CARD, 11, '     ', 1, 5) .NE. 0)
     +      JGGI = S1CVBN(CARD,11,5)
      IF (S1CPCH (CARD, 16, '     ', 1, 5) .NE. 0)
     +      JSSO = S1CVBN(CARD,16,5)
C
    6 CONTINUE
CCC   WRITE(IPR,9001) JGGI,JSSO
C
      IF(JGGI.LT.1 .OR. JGGI.GT.3) GO TO 8120
      IF(JSSO.LT.1 .OR. JSSO.GT.3) GO TO 8130
C
C
C ======================================================================
C        READ INPUT CARD (1)
C ======================================================================
C
      DAC = 1
   10 CALL FORC (KPNA, KPRNO, DAC, CARD, * 8010)
      IF (S1CPCH (CARD, 8, '   ', 1, 3) .NE. 0) GO TO 10
      IF (S1CPCH (CARD, 7, 'S', 1, 1) .NE. 0) GO TO 8020
C
      ISBEG = S1CVBN(CARD,11,5)
      ISEND = S1CVBN(CARD,16,5)
      ISINC = S1CVBN(CARD,21,5)
      ISADV = S1CVBN(CARD,26,5)
      IFLO  = S1CVBN(CARD,31,5)
      IFHI  = S1CVBN(CARD,36,5)
C     IDZ   = S1CVBN(CARD,41,5)
      CALL USCHFT(CARD,41,5,DZ)
      IZMAX = S1CVBN(CARD,46,5)
      IDCLD = S1CVBN(CARD,61,5)
      IDZ0  = S1CVBN(CARD,66,5)
      NTRNC = S1CVBN(CARD,71,5)
C
CC    NZ=IZMAX/DZ
      IDZ=DZ+0.5
C
      NTRNC=MIN0(NTRNC,4)
      NTRNC=MAX0(NTRNC,2)
      ANTRNC=FLOAT(NTRNC-1)/FLOAT(NTRNC)
C
      IF (ISBEG .EQ. 0) GO TO 8030
      IF (ISEND .EQ. 0) GO TO 8040
      IF (ISADV .EQ. 0) ISADV=100
      IF (IFLO  .EQ. 0) GO TO 8060
      IF (IFHI  .EQ. 0) GO TO 8070
      IF (ISINC .EQ. 0) ISINC = 1
C
      IF (LCGRPI .EQ. 0) GO TO 8100
C
C     IF (ISADV .LT. 100) GO TO 8150
      IF (MOD(ISADV,100) .NE. 0) GO TO 8150
C
      JSINC=ISINC
      JSADV=ISADV
      IF(MOD(ISINC,JSSO) .EQ. 0) THEN
        JSINC=ISINC/JSSO
        JJSSO= JSSO
      ELSE IF(MOD(ISADV,JSSO*100) .EQ. 0) THEN
        JSADV=ISADV/JSSO
        JJSSO=-JSSO
      ELSE
        GO TO 8140
      ENDIF
      JSSO=JJSSO
C
      IDXGG = LCGRPI*100.+0.5
      IDXSS = IDXGG*ISADV*IABS(ISINC)/100
C
      JDXGG = IDXGG*JGGI
      JDXSS = IDXSS/IABS(JSSO)
CCC   WRITE(IPR,2010) JSADV,JSINC,JSSO,JDXSS
      DXSS = FLOAT(JDXSS)/100.
CCC   WRITE(IPR,2001) ISBEG,ISEND,ISADV,IFLO,IFHI,IDXSS
      IF(JDXSS.LT.JDXGG) THEN
        GO TO 8090
      ENDIF
C
C ======================================================================
C        READ INPUT CARD (2)
C ======================================================================
C
C
      DAC = 1
   20 CALL FORC (KPNA, KPRNO, DAC, CARD, *8200 )
      IF(S1CPCH(CARD,8,'CLD',1,3) .NE. 0) GO TO 20
      JDCLD = S1CVBN(CARD,11,5)
      IF(JDCLD.NE.IDCLD) GO TO 20
C
C
      K = 0
      DO 50 I = 16, 80, 5
      K = K + 1
      IF (S1CPCH (CARD,I+4,'X',1,1).NE.0) GO TO 30
      LOCSAV = K
      INDX(K) = -999
      GO TO 50
   30 IF (S1CPCH (CARD,I,'     ',1,5).EQ.0) GO TO 40
      INDX(K) = S1CVBN (CARD,I,5)
      GO TO 50
   40 K = K -1
   50 CONTINUE
CCC   WRITE(IPR,2002) LOCSAV,K,(INDX(I),I=1,K)
C
C     S--R-R-R.......
C
      IF(LOCSAV .EQ. 1) THEN
      DO 100 I=4,K,2
  100 IF(INDX(I) .NE. 100) GO TO 8210
C
      II1=INDX(2)/JGGI
      II2=(INDX(2)+INDX(4))/JGGI
      IF(MOD(II1,100) .LE. MOD(II2,100)) THEN
        INDX(2)=II1
      ELSE
        INDX(2)=II2
        INDX(3)=INDX(3)+ISIGN(1,INDX(K)-INDX(3))
      ENDIF
        INDX(K)=INDX(K)-MOD(INDX(K)-INDX(3),JGGI)
C
      IGBEG=INDX(3)
      IGEND=INDX(K)
      IG00=MIN0(IGBEG,IGEND)
      JGBEG=IGBEG-IG00+1
      JGEND=IGEND-IG00+1
C     IDXSG=(INDX(2)+50)/100*IDXGG
      INDX(2)=(INDX(2)+50)/100
      IDXSG=INDX(2)*JDXGG
      INDX(2)=INDX(2)*100
C
      INC=+JGGI
      IF(IGEND.LT.IGBEG) INC=-JGGI
      JX=IDXSG/IDXGG
      DO 101 IG=JGBEG,JGEND,INC
      JX=JX+1
  101 NG=JX
      IF(NG.NE.1) NG=NG+10
C     WRITE(IPR,2002) LOCSAV,K,(INDX(I),I=1,K)
C
C     ......R-R-R--S
C
      ELSE IF(LOCSAV .EQ. K) THEN
      DO 110 I=2,K-3,2
  110 IF(INDX(I) .NE. 100) GO TO 8210
C
      II1=INDX(K-1)/JGGI
      II2=(INDX(K-1)+INDX(K-3))/JGGI
      IF(MOD(II1,100) .LE. MOD(II2,100)) THEN
        INDX(K-1)=II1
      ELSE
        INDX(K-1)=II2
        INDX(K-2)=INDX(K-2)+ISIGN(1,INDX(1)-INDX(K-2))
      ENDIF
        INDX(1)=INDX(1)-MOD(INDX(1)-INDX(K-2),JGGI)
C
      IGBEG=INDX(1)
      IGEND=INDX(K-2)
      IG00=MIN0(IGBEG,IGEND)
      JGBEG=IGBEG-IG00+1
      JGEND=IGEND-IG00+1
C     IDXSG=(INDX(K-1)+50)/100*IDXGG
      INDX(K-1)=(INDX(K-1)+50)/100
      IDXSG=INDX(K-1)*JDXGG
      INDX(K-1)=INDX(K-1)*100
C
      INC=+JGGI
      IF(IGEND.LT.IGBEG) INC=-JGGI
      JX=0
      DO 111 IG=JGBEG,JGEND,INC
      JX=JX+1
  111 NG=JX
C     NG=NG+IDXSG/IDXGG
      NG=NG+IDXSG/JDXGG
      IF(NG.NE.1) NG=NG+10
CCC   WRITE(IPR,2002) LOCSAV,K,(INDX(I),I=1,K)
C
C     R-R-R...--S--...R-R-R
C
      ELSE
      DO 120 I=2,LOCSAV-3,2
  120 IF(INDX(I) .NE. 100) GO TO 8210
      DO 121 I=LOCSAV+3,K,2
  121 IF(INDX(I) .NE. 100) GO TO 8210
C
      II1=INDX(LOCSAV-1)/JGGI
      II2=INDX(LOCSAV+1)/JGGI
      IF(MOD(II1,100) .LE. MOD(II2,100)) THEN
        ITEMP=INDX(LOCSAV-2)
        INDX(LOCSAV-1)=INDX(LOCSAV-1)/JGGI
C       INDX(LOCSAV+1)=(INDX(LOCSAV+1)+100)/JGGI
        INDX(LOCSAV+1)=(INDX(LOCSAV+1)+100*(JGGI-1))/JGGI
        INDX(LOCSAV+2)=INDX(LOCSAV+2)+1*(JGGI-1)
      ELSE
        ITEMP=INDX(LOCSAV+2)
        INDX(LOCSAV+1)=INDX(LOCSAV+1)/JGGI
C       INDX(LOCSAV-1)=(INDX(LOCSAV-1)+100)/JGGI
        INDX(LOCSAV-1)=(INDX(LOCSAV-1)+100*(JGGI-1))/JGGI
        INDX(LOCSAV-2)=INDX(LOCSAV-2)-1*(JGGI-1)
      ENDIF
C     INDX(1)=INDX(1)-MOD(INDX(1)-INDX(ITEMP),JGGI)
      INDX(1)=INDX(1)-MOD(INDX(1)-ITEMP,JGGI)
C     INDX(K)=INDX(K)-MOD(INDX(K)-INDX(ITEMP),JGGI)
      INDX(K)=INDX(K)-MOD(INDX(K)-ITEMP,JGGI)
C
C     IDXGSG=INDX(LOCSAV-1)+INDX(LOCSAV+1)
      TEMP=FLOAT(INDX(LOCSAV-1)+INDX(LOCSAV+1))/100.
      ITEMP=NINT(TEMP)*100
C
      INDX(LOCSAV-1)=(INDX(LOCSAV-1)+50)/100
      INDX(LOCSAV-1)=INDX(LOCSAV-1)*100
C     INDX(LOCSAV+1)=(INDX(LOCSAV+1)+50)/100
C     INDX(LOCSAV+1)=INDX(LOCSAV+1)*100
      INDX(LOCSAV+1)=ITEMP-INDX(LOCSAV-1)
C
      IDXGSG=INDX(LOCSAV-1)+INDX(LOCSAV+1)
      IF(MOD(IDXGSG,100) .NE. 0) GO TO 8210
      IGBEG=INDX(1)
      IGEND=INDX(K)
      IG00=MIN0(IGBEG,IGEND)
      JGBEG=IGBEG-IG00+1
      JGEND=IGEND-IG00+1
      IDXGS=(INDX(LOCSAV-1)+50)/100*JDXGG
C
      INC=+JGGI
      IF(IGEND.LT.IGBEG) INC=-JGGI
C
      JG2=INDX(LOCSAV-2)-IG00+1
      JG3=INDX(LOCSAV+2)-IG00+1
C     CALL ARSET(INDX,960,-9999)
      JX=0
      DO 122 IG=JGBEG,JG2,INC
      JX=JX+1
  122 NG=JX
      JX=NG+IDXGSG/100
      DO 123 IG=JG3,JGEND,INC
      NG=JX
  123 JX=JX+1
CCC   WRITE(IPR,2002) LOCSAV,K,(INDX(I),I=1,K)
C
      ENDIF
C
      IRATIO=JDXSS/JDXGG
      MODNG=MOD(NG,IRATIO)
      IF(MODNG.NE.0) THEN
      NG=NG+(IRATIO-MODNG)
      ENDIF
C
      MG=MAX0(JGBEG,JGEND)
CCC   WRITE(IPR,2003) IGBEG,IGEND,MG,NG,JDXGG
C
      NELMT=NG/IRATIO
      N2KE=IFIX(ALOG(FLOAT(NELMT)*1.1)/ALOG(2.))+1
      N2KG=IFIX(ALOG(FLOAT(NG)*1.1)/ALOG(2.))+1
      NKE=2**N2KE
      NKG=2**N2KG
C
C ======================================================================
C        READ INPUT CARD (3)
C ======================================================================
C
C
C
      NSFCS=0
      DAC = 1
   60 CALL FORC (KPNA, KPRNO, DAC, CARD, * 70 )
      IF(S1CPCH(CARD,8,'FCS',1,3) .NE. 0) GO TO 60
C
      ISFBEG = S1CVBN (CARD, 11, 5 )
      ISFEND = S1CVBN (CARD, 16, 5 )
      ISFINC = S1CVBN (CARD, 21, 5 )
C
      IF(ISINC.GE.0) THEN
        ISFBEG=MIN0(ISFBEG,ISFEND)
        ISFEND=MAX0(ISFBEG,ISFEND)
        ISFINC=IABS(ISFINC)
      ELSE
        ISFBEG=MAX0(ISFBEG,ISFEND)
        ISFEND=MIN0(ISFBEG,ISFEND)
        ISFINC=-IABS(ISFINC)
      ENDIF
C
      IF(ISINC.LT.0) GO TO 65
      IF( ISFBEG.LT.ISBEG .OR. ISFEND.GT.ISEND ) THEN
         GO TO 8700
      ELSE IF (ISFBEG.EQ.ISFEND) THEN
         NSFCS = 1
         ISFINC = 0
CCC      WRITE(IPR,2005) ISFBEG, ISFEND, ISFINC, NSFCS
      ELSE IF (ISFINC .EQ. 0) THEN
         GO TO 8700
      ELSE
         NSFCS=(ISFEND-ISFBEG)/ISFINC+1
CCC      WRITE(IPR,2005) ISFBEG, ISFEND, ISFINC, NSFCS
      ENDIF
      GO TO 80
C
   65 CONTINUE
      IF( ISFBEG.GT.ISBEG .OR. ISFEND.LT.ISEND ) THEN
         GO TO 8700
      ELSE IF (ISFBEG.EQ.ISFEND) THEN
         NSFCS = 1
         ISFINC = 0
CCC      WRITE(IPR,2005) ISFBEG, ISFEND, ISFINC, NSFCS
      ELSE IF (ISFINC .EQ. 0) THEN
         GO TO 8700
      ELSE
         NSFCS=(ISFEND-ISFBEG)/ISFINC+1
CCC      WRITE(IPR,2005) ISFBEG, ISFEND, ISFINC, NSFCS
      ENDIF
      GO TO 80
C
   70 CONTINUE
CCC   WRITE(IPR,2006)
      NSFCS=0
C
   80 CONTINUE
C
C ======================================================================
C        READ INPUT CARD (4)
C ======================================================================
C
      DAC = 1
   90 CALL FORC (KPNA, KPRNO, DAC, CARD, * 8600 )
      IF(S1CPCH(CARD,8,'MOD',1,3) .NE. 0) GO TO 90
      NUMH   = S1CVBN (CARD, 11, 5 )
      CALL   USCHFT(DATA,16,10,XMIN)
      CALL   USCHFT(DATA,26,10,XMAX)
        IF(S1CPCH(DATA,56,'          ',1,10).EQ.0) THEN
         XBEG=XMIN
        ELSE
         CALL   USCHFT(DATA,56,10,XBEG)
        ENDIF
C
      NX0=NINT((XBEG-XMIN)/FLOAT(IDXSS))
      XMIN=XBEG-NX0*FLOAT(IDXSS)
      NXMOD=NINT((XMAX-XMIN)/FLOAT(IDXSS))+1
C
CCC   WRITE(IPR,2007) NUMH
C
C ======================================================================
C        READ INPUT CARD (5)
C ======================================================================
C
      ZDTM=0.
C
      DAC = 1
  200 CALL FORC (KPNA, KPRNO, DAC, CARD, * 210 )
      IF(S1CPCH(CARD,8,'DTM',1,3) .NE. 0) GO TO 200
      CALL USCHFT (CARD, 11, 10 ,ZDTM)
C
  210 CONTINUE
      NZ=INT((IZMAX-ZDTM+0.00001)/DZ)
      IF(NZ.GT.NS) THEN
        GO TO 8050
      ENDIF
C
C =====================================================================
C                           ICC
C =====================================================================
C
C
C  (1) IDXSS:
C
C      O-O-O-O-O-X-X-X-X-X-..............-X-X-X-O-O-O-O
C      |<-NGS->| |<----------NSHOT----------->|
C
       NSHOT = (ISEND-ISBEG)/ISINC + 1
       NSHOT = (NSHOT-1)*IABS(JSSO)+1
       IRATIO=JDXSS/JDXGG
       NGS=(NG-1)/IRATIO
       NXS=NSHOT+2*NGS
C     WRITE(IPR,7171) ISEND,ISBEG,ISINC,NSHOT,JDXSS,JDXGG,IRATIO,NG,NGS,
C    +                JSSO,NXS
C7171 FORMAT( '  ISEND =',I5,
C    +      /,'  ISBEG =',I5,
C    +      /,'  ISINC =',I5,
C    +      /,'  NSHOT =',I5,
C    +      /,'  JDXSS =',I5,
C    +      /,'  JDXGG =',I5,
C    +      /,'  IRATIO=',I5,
C    +      /,'  NG    =',I5,
C    +      /,'  NGS   =',I5,
C    +      /,'  JSSO  =',I5,
C    +      /,'  NXS   =',I5)
C
C  (2) IDXGG:
C
C      O-O-O-O-O-X-X-X-X-X-..............-X-X-X-O-O-O-O
C      |<-NG1->| |<-----------NSG------------>|
C
       NSG=(NSHOT-1)*IRATIO+1
       NXG=NSG+2*(NG-1)
C
       PI2=3.141592654*2.
       NT = NS
       DT = FLOAT(LCPI)*1.E-3
C      N2W =IFIX(ALOG(FLOAT(NT)*1.04)/ALOG(2.))+1
C      N2W =IFIX(ALOG(FLOAT(NT)*1.00)/ALOG(2.))+1
C      NW=2**N2W
       CALL SAFFTL(NT,NW)
       NWD2=NW/2
       WLO=FLOAT(IFLO)*PI2
       WHI=FLOAT(IFHI)*PI2
       DW=PI2/DT/FLOAT(NW)
       IW1=INT((WLO+0.00001)/DW)+1
       IW1=MAX0(IW1,1)
       IW2=INT((WHI+0.00001)/DW)+1
       IW2=MIN0(IW2,NWD2)
       LW=IW2-IW1+1
C
CCC    WRITE(IPR,2004) NT, NW, IW1, IW2, LW
C
       NXG2=NXG*2
       NG2=NG*2
       NG4=NG*4
C
C      IDZ0=IDZ0 - 10*DZ
       IDZ0=IDZ0 - 200
       IDZ0=MAX0(IDZ0,0)
       IF(IDZ0 .LE. 10*IDZ) IDZ0=0
C
       KTAPER = 1
       KOOH   = KTAPER + 100
       KOH1   = KOOH   + THL
       K0     = KOH1   + THL
       IF(IDZ0.NE.0) THEN
       K01= K0 + MG
       K02= K01+ NKE/2
       K03= K02+ NKG/2
       K04= K03+ NKE*5
       K05= K04+ NKG*5
       K06= K05+ NZ
       KX = K06+ NZ
       ELSE
       K05= K0 + MG
       K06= K05+ NZ
       KX = K06+ NZ
       ENDIF
       KY = KX + NZ
       KZ = KY + NZ
       KWOB = KZ + NZ
       KA = KWOB + NZ
       KA = MAX0(KA,KY+NSFCS)
       KB = KA + LW
C
C     WRITE(IPR,7871) KTAPER,KOOH,KOH1,K0,K05,K06,KX,KY,KZ,KWOB,KA,KB
C7871 FORMAT(' KTAPER =',I8,/,
C    +       '   KOOH =',I8,/,
C    +       '   KOH1 =',I8,/,
C    +       '     K0 =',I8,/,
C    +       '    K05 =',I8,/,
C    +       '    K06 =',I8,/,
C    +       '     KX =',I8,/,
C    +       '     KY =',I8,/,
C    +       '     KZ =',I8,/,
C    +       '   KWOB =',I8,/,
C    +       '     KA =',I8,/,
C    +       '     KB =',I8)
C
       NBLK=1
       NTB=NT
       NWB=NW
       KB = KB + NZ
       KBFX = KB + 3*NW/2+1
 230   IF(NWB.LE.64 .OR. NBLK.GE.5) GO TO 240
C
       NBLK=NBLK+1
       NTB=NWB*ANTRNC
       CALL SAFFTL(NTB,NWB)
       KB = KBFX + 13
       KBFX = KB + 3*NWB/2+1
       GO TO 230
 240   KTBLK = KBFX + 13
       KDELT = KTBLK + NSFCS*NBLK
       KC = KDELT + NSFCS
       KU = KC + NXS*NG2
       KD = KU + NXS*2
       KE = KD + NXG
       KF = KE + NXG2
       KG = KF + NXG2
       KH = KG + NXG2
       KO = KH + NXG2
       KP = KO + NXG2
       KQ = KP + NXG2
       KR = KQ + NXG2
       KS = KR + NXS*NG2
       KW = KS + NXG2
       KV = KW + NSFCS*2
C
       ICC = KV + NXG
C     WRITE(IPR,7872) KTBLK,KDELT,KC,KU,KD,KE,KF,KG,KH,KO,KP,KQ,KR,KS,
C    +                   KW,KV,ICC
C7872 FORMAT('  KTBLK =',I8,/,
C    +       '  KDELT =',I8,/,
C    +       '     KC =',I8,/,
C    +       '     KU =',I8,/,
C    +       '     KD =',I8,/,
C    +       '     KE =',I8,/,
C    +       '     KF =',I8,/,
C    +       '     KG =',I8,/,
C    +       '     KH =',I8,/,
C    +       '     KO =',I8,/,
C    +       '     KP =',I8,/,
C    +       '     KQ =',I8,/,
C    +       '     KR =',I8,/,
C    +       '     KS =',I8,/,
C    +       '     KW =',I8,/,
C    +       '     KV =',I8,/,
C    +       '    ICC =',I8)
       KK1 = KC + (NW+2)*NG
C      CALL PTSTAA('1   ',ICC,IPR)
       ICC = MAX0(ICC,KK1+(NW+2)*NG)
C
C
       JCC=KC+2*10*MAX0(NSHOT+NGS/2,NZ)
       ICC=MAX0(ICC,JCC)
C      CALL PTSTAA('2   ',JCC,IPR)
C--H
       LXS=(ICC-KC)/(NW+2)/2
       JCC=KC+(NW+2)*LXS*2
       ICC=MAX0(ICC,JCC)
C      CALL PTSTAA('H   ',JCC,IPR)
C--I
       JCC=KC+MAX0(NXG,NT)+2*NZ+NZ*NSFCS
       ICC=MAX0(ICC,JCC)
C      CALL PTSTAA('I   ',JCC,IPR)
C--J
       JCC=KC+NT+NZ+MAX0(NZ,2*NW+2)+2*NW+MAX0(2*NZ,2*NW+2)
     +                                           +2*10*MAX0(NT,NZ)
       ICC=MAX0(ICC,JCC)
C      CALL PTSTAA('J   ',JCC,IPR)
C
      IABT=0
      JSBEG=ISBEG
      JSEND=(ISEND-ISBEG)*JSSO+ISBEG
      JSINC=ISINC
      IF(MOD(ISINC,JSSO) .EQ. 0) THEN
       JSINC=ISINC/JSSO
      ENDIF
C     CALL SAVKGET(ISBEG,ISEND,ISINC,DXSS,NUMH,NXMOD,INDXA,INDXB,
      CALL SAVKGET(JSBEG,JSEND,JSINC,DXSS,NUMH,NXMOD,INDXA,INDXB,
     +           KC,KCV,K2,K3,K4,K5,K6,K7,K8,K9,K10,K11,K12,K13,JCC,
     +           KPNA,KPRNO,CARD,IABT,IPR)
C
      IF(IABT .EQ. 1) GO TO 8110
      ICC=MAX0(ICC,JCC)
C      CALL PTSTAA('K   ',JCC,IPR)
C      CALL PTSTAA('K   ',ICC,IPR)
C
      IF(ICC.EQ.0) GO TO 9999
C
C=======================================================================
C     CPU ESTIMATION
C=======================================================================
C
CJCS  CFACT=(NSHOT+NGS)*NG*(NT-IDZ0/2400./DT)*(NZ-IDZ0/DZ)
CJCS  CPUEST=CFACT/.37E11*150.
CJCS  CPUEST=NINT(CFACT/.37E11*150.)
C  ** ESTIMATED XMP-CPU IS 0.65 MICRO-SEC /TRACE/FREQUENCY/DEPTH-STEP
C  ** ESTIMATED YMP-CPU IS 0.46 MICRO-SEC /TRACE/FREQUENCY/DEPTH-STEP
      CFACT=NSHOT*NG*LW*NZ
      CPUEST=CFACT*0.46E-6/60.
      WRITE(IPR,6789) CPUEST,CFACT
 6789 FORMAT(/,'  ESTIMATED CPU IS',F11.1,' MINUTES (',E12.5,')')
C
C=======================================================================
C     DISK SPACE LIMIT CHECK
C=======================================================================
C
       IDSKMX=150000000
C
C WORKFILE B, J, L, M
C
C      IDSKSZ=(LW+1)/2*NG*NXS*2
       LWQT=(LW+3)/4
CPACK  IF2=(NG*NXS*2+511)/512
       IF2=(NG*NXS  +511)/512
       IDSKSZ=LWQT*IF2*512
       IF(IDSKSZ .GT. IDSKMX) GO TO 8800
C
       IDSKB=4*IDSKSZ
C
C
C WORKFILE E,N,O,P
C
C      IDSKSZ=LW*NSFCS*NZ*2
CPACK  IDSKSZ=(NSFCS*NZ*2+511)/512
       IDSKSZ=(NSFCS*NZ  +511)/512
C2     IDSKSZ=IDSKSZ*512*LW
       IDSKSZ=IDSKSZ*512*LWQT
       IF(IDSKSZ .GT. IDSKMX) GO TO 8810
C
       IDSKE=4*IDSKSZ
C
C WORKFILE G,K,Q,R,S,T
C
CPACK  IDSKSZ=NT*NZ*(NSFCS+1)/2
       IDSKSZ=(NT+1)/2*NZ*(NSFCS+5)/6
       IF(IDSKSZ .GT. IDSKMX) GO TO 8820
C
       IDSKG=6*IDSKSZ
C
       WRITE(IPR,9829) NSFCS,NZ,LWQT,IDSKE,NT,IDSKG
 9829  FORMAT(' NSFCS,NZ,LWQT,NT =',4I5,' IDSKE,IDSKG =',2I10)
       WRITE(IPR,9830) IDSKB+IDSKE,IDSKE+IDSKG
C
C=======================================================================
C     NORMAL EXIT
C=======================================================================
C
      CSIZE = ICC
C
C
C      PART 3.   COMPUTE UNRESERVED BLANK COMMON SIZE IN WORDS (UCSIZE)
C
C     THIS VALUE IS THE TOTAL NUMBER OF WORDS USED IN UNRESERVED BLANK
C     COMMON  I.E. SCRATCH AREA OR 'SA' FOR SPARC  'SHELLS'.
C
      UCSIZE = 0
C
C
      WRITE(IPR,9000) PSIZE, CSIZE, UCSIZE
 9000 FORMAT(/5X,'JSVADM COMPLETED   PSIZE = ',I5,'  CSIZE = ',I10,
     +           '   UCSIZE = ',I5)
C
      RETURN
C
C =====================================================================
C                           ERROR EXITS
C =====================================================================
C
C
 8000 WRITE (IPR, 9080 )
      GO TO 9999
C
 8010 WRITE (IPR, 9010 ) KPNA, KPRNO
      GO TO 9999
C
 8020 WRITE (IPR, 9020 )
      GO TO 9999
C
 8030 WRITE (IPR, 9030 )
      GO TO 9999
C
 8040 WRITE (IPR, 9040 )
      GO TO 9999
C
 8050 WRITE (IPR, 9050 ) NZ,NS
      GO TO 9999
C
 8060 WRITE (IPR, 9060 )
      GO TO 9999
C
 8070 WRITE (IPR, 9070 )
      GO TO 9999
C
 8090 WRITE (IPR, 9090 ) JDXSS,JDXGG
      GO TO 9999
C
 8100 WRITE (IPR, 9100 )
      GO TO 9999
C
 8110 WRITE (IPR, 9110 )
      GO TO 9999
C
 8120 WRITE (IPR, 9120 )
      GO TO 9999
C
 8130 WRITE (IPR, 9130 )
      GO TO 9999
C
 8140 WRITE (IPR, 9140 )
      GO TO 9999
C
 8150 WRITE (IPR, 9150 )
      GO TO 9999
C
 8200 WRITE (IPR, 9200 ) KPNA, KPRNO
      GO TO 9999
C
 8210 WRITE (IPR, 9210 ) LOCSAV,K,(INDX(I),I=1,K)
      GO TO 9999
C
 8600 WRITE (IPR, 9600 ) KPNA, KPRNO
      GO TO 9999
C
 8700 WRITE (IPR, 9700 )
      GO TO 9999
C
 8800 WRITE (IPR, 9800 ) IDSKSZ,IDSKMX
      GO TO 9999
C
 8810 WRITE (IPR, 9810 ) IDSKSZ,IDSKMX
      GO TO 9999
C
 8820 WRITE (IPR, 9820 ) IDSKSZ,IDSKMX,NT,NZ,NSFCS
C
C =================================================================
C                       ERROR EXIT
C =================================================================
C
 9999 ERCODE = 16
      WRITE(IPR,9900)
C
      RETURN
C
C =================================================================
C                       FORMAT STATEMENTS
C =================================================================
C
 9001 FORMAT('  JGGI =',I5,'  JSSO =',I5)
C
 2001 FORMAT(' ISBEG =',I5,/,
     +       ' ISEND =',I5,/,
     +       ' ISADV =',I5,/,
     +       ' IFLO  =',I5,/,
     +       ' IFHI  =',I5,/,
     +       ' IDXSS =',I7)
C
 2002 FORMAT(/,'     LOCSAV =',I5,/,
     +          '     K      =',I5,/,
     +          '     INDX   =',10I5)
C
 2003 FORMAT(' IGBEG  =',I5,/,
     +       ' IGEND  =',I5,/,
     +       ' MG     =',I5,/,
     +       ' NG     =',I5,/,
     +       ' JDXGG  =',I7)
C
 2004 FORMAT(/,'   NT  =',I5,/,
     +         '   NW  =',I5,/,
     +         '   IW1 =',I5,/,
     +         '   IW2 =',I5,/,
     +         '   LW  =',I5)
C
 2005 FORMAT(/,' FOCUSING ANALYSIS PARAMETERS',/,
     +         '   ISFBEG  =',I5,/,
     +         '   ISFEND  =',I5,/,
     +         '   ISFINC  =',I5,/,
     +         '   NSFCS   =',I5)
C
 2006 FORMAT(/,' NO FOCUSING ANALYSIS REQUESTED')
C
 2007 FORMAT(/,' NUMH =',I5)
C
 2010 FORMAT(/,' JSADV,JSINC,JSSO,JDXSS =',3I5,I7)
C
 9010 FORMAT(/,' *** NO CARD(1) FOUND FOR ',A4,I1)
C
 9020 FORMAT(/,' *** ILLEGAL PROCESSING MODE ***',/,
     +          ' INPUT DATA MUST BE IN SHOTPOINT MODE')
C
 9030 FORMAT(/,' STARTING SHOTPOINT MISSING; IT IS REQUIRED')
C
 9040 FORMAT(/,' ENDING SHOTPOINT MISSING; IT IS REQUIRED')
C
 9050 FORMAT(/,' NZ > NT NOT ALLOWED;  NZ,NT =',2I5)
C
 9060 FORMAT(/,' HIGHEST FREQENCY MISSING; IT IS REQUIRED')
C
 9070 FORMAT(/,' LOWEST FREQENCY MISSING; IT IS REQUIRED')
C
 9080 FORMAT(/,' *** LINE CARD READING ERROR IN VADM')
C
 9090 FORMAT(/,' SHOT SPACING HAS TO BE INTEGER MULTIPLIER',
     +         ' OF RECEIVER SPACING',' JDXSS,JDXGG =',2I8)
C
 9100 FORMAT(/,' GROUP INTERVAL OF LINE CARD MISSING; IT IS REQUIRED')
C
 9110 FORMAT(/,' *** ERROR IN SAVKGET')
C
 9120 FORMAT(/,' *** JGGI (RECEIVER PROCESSING DENSITY)',
     +         ' HAS TO BE BETWEEN 1 TO 3 **')
C
 9130 FORMAT(/,' *** JSSO (TRACE OUTPUT DENSITY/SHOT)',
     +         ' HAS TO BE BETWEEN 1 TO 3 **')
C
 9140 FORMAT(/,' ** NEITHER ISADV NOR ISINC IS AN INTEGER MULTIPLIER',
     +         ' OF JSSO **')
C
 9150 FORMAT(/,' SHOT ADVANCE HAS TO BE INTEGER MULTIPLIER OF G. I.')
C
 9200 FORMAT(/,' *** NO CARD(2) FOUND FOR ',A4,I1)
C
 9210  FORMAT(/,'  ** RECEIVER SPACING CALCULATED FROM (CLD) CARD',
     +          ' NOT EQUAL TO G.I. OF LINE CARD **',/,
     +          '     LOCSAV =',I5,/,
     +          '     K      =',I5,/,
     +          '     INDX   =',10I5)
C
 9300 FORMAT (1X,A4,I1,5X,A4,3I5,1X,I5,I5,/,4(1X,24I5,/))
C
 9400 FORMAT (//,' *** ',A4,I1,' COMPLETED -- NO ERRORS,',
     *         /,' *** TOTAL NUMBER OF PARAMETER RECORDS = ',I5)
C
 9500 FORMAT (/,' *** ERROR WRITING PARAMETER RECORD ***')
C
 9600 FORMAT (/,' *** NO CARD(4) FOUND FOR ',A4,I1)
C
 9700 FORMAT (/,' *** ERROR IN CARD(3) ***')
C
 9800 FORMAT (/,' *** NOT ENOUGH DISK SPACE FOR WORKFILE B & J ***',/,
     +          '     IDSKSZ =',I12,/,
     +          '     IDSKMX =',I12)
C
 9810 FORMAT (/,' *** NOT ENOUGH DISK SPACE FOR WORKFILE E ***',/,
     +          '     IDSKSZ =',I12,/,
     +          '     IDSKMX =',I12)
C
 9820 FORMAT (/,' *** NOT ENOUGH DISK SPACE FOR WORKFILE G & K ***',/,
     +          '     IDSKSZ =',I12,/,
     +          '     IDSKMX =',I12,/,
     +          '     NT,NZ,NSFCS =',3I5)
C
 9830  FORMAT(/,' DISK SPACE BEFORE/DURING MIGRATION (WORDS): ',I10,/,
     +          ' DISK SPACE AFTER         MIGRATION (WORDS): ',I10)
C
 9900 FORMAT (/,' *** ERROR IN JSVADM CALCULATION ***')
C
      END