      SUBROUTINE PLOTEX( BUF, LBUF, IBUF, SCR, LSCR, ISCR, istop )
C     PLOTEX IS THE EXECUTION PHASE OF THE SEISMIC REFLECTION PROCESS PLOT
C  (SEISMIC SECTION PLOT).  THE USER'S PARAMETERS MUST BE IN
C  DISC FILE MUNIT (IN COMMON /PLOT/) AND THE TRACE WITH TRACE HEADER
C  WILL BE IN MEMORY ARRAY BUF.
C
C  ARGUMENTS:
C  BUF    - THE TRACE TO BE PROCESSED, INCLUDING THE TRACE HEADER.  THE FIRST
C           DATA SAMPLE MUST BE AT TIME DELAY.  THIS IS THE FLOATING
C           POINT (REAL) TRACE ARRAY.
C  LBUF   - THE LONG INTEGER TRACE ARRAY.  THIS IS REALLY THE SAME AS BUF, BUT
C           PRIME FORTRAN DOESN'T ALLOW EQUIVALENCING ANYTHING TO AN ARGUMENT.
C  IBUF   - THE SHORT INTEGER TRACE ARRAY.  NEEDED FOR 16 BIT TRACE HEADER
C           ADDRESSES.
C  SCR    - A SCRATCH ARRAY FOR READING THE PARAMETERS.  THEREFORE, SCR MUST
C           BE AT LEAST 56 32BIT WORDS BIG.  SCR MAY BE DESTROYED BY THE CALLING
C           ROUTINE.
C  LSCR   - THE SAME SCRATCH ARRAY BECAUSE OF THE EQUIVALENCING PROBLEM.
C
C  COPYRIGHTED BY:
C  PAUL HENKART, SCRIPPS INSTITUTION OF OCEANOGRAPHY, AUGUST 1983
C
c mod 15 Nov 89  to add annyp 8 (espn)
c mod 8 May 90 added seconds to the annotation by GMT
c mod 18 Jul 90 added anntyp 9
c mod 23 Jul 90 to correct error when stime < delay, thus the data has
c       to be shifted and zeroes inserted at the beginning of the trace.
c mod 2 aug 90 to make ftr, ltr and ninc work!
c mod Nov 90 to straighten out stime, nsecs, delay and nsamps
c mod 6 feb 91 to zero the back end of the plot when stime > delay
c Aug 91 - Add some of the OSU stuff (frange/lrange/, refplot)
c  20 Aug 91 - Add rstime
c mod 24 Jan 92 Iris-Segy where nsamps = lbuf(58) rather than ibuf(58)
c mod 30 Jan 92 - Allow negative stime by changing preset to -99999.
c mod 4 Feb 92 - Add hidden user parameter absval for special case
c              - Add hdr, ihdr, lhdr
c mod 6 June 93 - honor frange/lrange when hscale not used.
c mod Feb 95 - Add time line annotation
c mod 21 Nov 95 - When hscale and nsecs are given and nsecs > nsamps,
c                only plot nsamps.
c mod 10 Sept 96 - change GMT annotation to be day and GMT.
c mod 23 Sep 99 - Truncate the shot/rp number to 4 characters when using SH&TR
c mod 30 Mar 01 - Add lunhead - write each SEG-Y header to file on lunhead
c mod 1 May 01 - "straighten out" confusion over annotation by GMTRP and GMTSEC
c mod 18 Dec 01 - Add warnings if the plot window and data window do
c                 not overlap.
c mod 14 Oct 02 - Add anntyp2 and rectify
c mod 21 May 04 - anninc was not honored by fanno
c mod 6 Aug. 05 - Shot number of 0 was a show stopper.
c mod 29 Jul 06 - When stime is not given make it mod 10 mils
c mod 2 Aug 06 - Do NOT use fno when doing GMT because of decreasing shot numbers
c mod 12 Aug 06 - Don't try to plot the trace when the data is outside the plot
c mod 10 Oct 06 - fanno was incremented by annin before ann2 was done
c mod 14 Mar 07 - Add CHART
c mod 27 Apr 07 - HPATH file is headers only, so set number of sample to 0
c mod 8 May 07 - Add warning if CHART is given WBT needs to be given.
c mod 23 Jul 07 - set n2plot according to the plotter size when nsecs = 0.
c mod 14 Sep 07 - Add logic for CHART given but STIME is not.
c mod 23 May 08 - n2plot preset when nsecs=0 was bad
c mod 24 Jun 08 - With CHART, don't create a break too often
c               - CHART and stime < delay caused a bomb
c               - Chart with creating dead traces and annotation caused a bomb.
c                 I suspect it's a trplot bug with plot spaces and buffers.
c mod 4 Aug 08 - 23 May change made nsecs given to be ignored.
c mod 22 Aug 08 - chart stime was wrong.
c mod 19 Nov 08 - zero ddead traces AFTER getting out of the ap
c mod 13 Jan 09 - Use delay in seconds (buf(46)) so big delays work (>32k mils)
c mod 15 Aug 09 - Use NINT(delay*1000) for first time line
c mod 27 Aug 09 - Don't adjust stime to nearest 10 mils if si < 1 mil
c mod 22 Oct 10 - the 19 Nov 08 zeroed the saved trace in scr rather than buf!
c mod 28 Oct 10 - HPATH needs byte swap
c mod 23 Sep 11 - Modify the "too many plot samples" message.
C
      PARAMETER ( MAX_WBTS = 10)
      DIMENSION wbts(MAX_WBTS)
      DIMENSION BUF(*),LBUF(*),IBUF(*),SCR(*),LSCR(*),ISCR(*)
      INTEGER*2 IBUF,ISCR
      COMMON /READT/ ILUN,NUMHDR,NUMDAT,IUNHDR, ireeln, intrcs
      COMMON /PLOT/MUNIT,NLISTS,FTAG,TAGINC,FSPACE,NSPACE,SPACEI,IDIR,
     &       irecsp, lunhead, nraster
      INTEGER FTAG,TAGINC,FSPACE,SPACEI,FANNO,ANNTYP,DECIMF,ANNINC, hdr,
     &        anntyp2
      COMMON /SEISPL/ OFFSET,DEF,PCTFIL,VSCALE,TRPIN,JTYPE,TLINES(4),
     *       STIMEL,TIMEL,IUNPLT,WIGGLE,BIAS,LANN,ICDOTS,scalar,clip,
     *       itlan, irectify, ndptr, chart(2), size, itrim
      COMMON /lanno/ lanno, lanno2
      CHARACTER*8 LANNO, lanno2
      COMMON /MAXSCs/ NPRMU,RELAMP
      REAL*4 NSECS
      COMMON /SIOAP/ IASGND,IRELSE,IN,IOUT,NEXTAD,LAPSIZ,IFREE,IUSEAP,
     *     IDECIM
      COMMON /VERSAT/ NIBS,RNIBS
      INTEGER FNO,FDAY,FTR, ptype, frange, absval
      COMMON /edits/ ierror, iwarn, irun, now, icompt, isite, maxsamps,
     & nbperw, ireal
      COMMON /apmem/ a(5000000)
      LOGICAL FIRST
      SAVE
      DATA wbts/MAX_WBTS*0./, n_wbts/0/, lastspace/0/
      DATA NDONE/0/, delay/-1./, lastmn/-1/, n2plot/0/
      DATA ntnull/0/, ntlive/0/, ntother/0/, hscale/0./                 ! for OSU hscale that's not in here, but ....
      DATA FIRST /.TRUE./
c
      IF( istop .LT. 0 ) THEN
          IF( hscale .GT. 0. ) GOTO 240
          RETURN
      ENDIF
C****
C****     FIND THE PARAMETER LIST (ON DISC) FOR THIS SHOT (RP)
C****
      delay = buf(46)
      si = buf(49)
      IF(.NOT.FIRST) GO TO 90
   10 CONTINUE                                                          ! GET THE FIRST PARAMETER LIST INT0 MEMORY ARRAY SCR
      nprmu=1
      REWIND MUNIT
      READ(MUNIT) FNO,FDAY,FTR,LNO,LDAY,LTR,STIME,NSECS,VSCALE,DEF,
     *    TRPIN,RELAMP,ANNTYP,DECIMF,IHDRUN,NCOMMS,ANNINC,FANNO,ninc,
     *    hscale, plotsi, ptype, frange, lrange, rstime, absval, hdr,
     *    ihdr, lhdr, iwrap, anntyp2, ndptr
      IF( hscale .NE. 0 ) trpin = rnibs
      dist = lbuf(10)
      MLISTS=1
      IF( chart(2) .NE. 0 ) THEN
          nspace = 150
          IF( stime .LT. 0 ) THEN
              IF( buf(50) .LE. .0001 ) PRINT *,
     &' ***  WARNING  ***  CHART needs the water bottom TIME.  Use WBT.'
              IF( si .LT. .001 ) THEN
                  temp = buf(50) * 10.
                  itemp = INT(temp)
                  stime = FLOAT(itemp) / 10.
                  IF( buf(50) .GT. stime + (nsecs * chart(1)) + .05 )
     &                stime = stime + .05
                  IF( buf(50) .GT. stime + nsecs * chart(2) )
     &                stime = stime - .05
              ELSE
                  stime = INT(buf(50))
c****             don't let it be too close to either end
                  IF( buf(50) .GT. stime + (nsecs * chart(1))+ .5 )
     &                stime = stime + .5
                  IF( buf(50) .GT. stime + nsecs * chart(2) )
     &                stime = stime - .5
              ENDIF
          ENDIF
          IF( vscale .EQ. 0 ) THEN
              vscale = 1.25
              IF( si .LT. .001 ) vscale = 10.
          ENDIF
c          IF( nsecs .EQ. 0 ) nsecs = 12. / vscale
          IF( nsecs .EQ. 0 ) nsecs = nsamps * si
      ENDIF
      ostime=stime
c**** This is a tough one.  What does fno really mean anyway?
c**** This causes decreasing shot numbers to be dropped, so stop doing it
c      IF( fno .LT. 0 ) THEN
c          fno = lbuf(3)
c          IF( lbuf(7) .GT. 0 ) fno = lbuf(6)
c      ENDIF
   90 FIRST=.FALSE.
      range = lbuf(10)
      LNUM=LBUF(3)                                                      ! SHOT NUMBER
      LTRAC=LBUF(4)                                                     ! SHOT TRACE NUMBER
      IF( LBUF(7) .NE. 0 ) THEN                                         ! IS THE DATA SORTED ACCORDING TO RP?
          LNUM=LBUF(6)                                                  ! THE RP NUMBER
          LTRAC=LBUF(7)                                                 ! TRACE NUMBER WITHIN THE RP
      ENDIF
      IF( FDAY .NE. 0 ) LNUM=IBUF(80)*10000+IBUF(81)*100+ibuf(82)       ! convert into gmt fno
   95 CONTINUE
c      print *,' lnum=',lnum,' fno=',fno,' lno=',lno,' ninc=',ninc,
c     &' ltrac=',ltrac,' ftr=',ftr,' ltr=',ltr
c      print *,' 7=',lbuf(4),lbuf(7),' intrcs=',intrcs
      IF(LNUM.LT.FNO.AND.LTRAC.LT.FTR.AND.MLISTS.GT.1) GO TO 10         ! IS THIS SHOT BEFORE THIS PARAMETER LIST
      IF(LNUM.LT.FNO.OR.LTRAC.LT.FTR) RETURN                            ! IS THIS SHOT BEFORE ANY LIST?
      IF( ltrac .GT. ltr ) RETURN
      IF( ninc .GT. 1 ) THEN
          IF( lbuf(7) .NE. 0 ) THEN
              IF( lbuf(51) .EQ. -1) fno = fno + ninc                    ! if rp sorted and last trace of the rp
          ELSE
              IF( lbuf(4) .EQ. intrcs .OR. ltrac .EQ. ltr ) fno=fno+ninc
          ENDIF
      ENDIF
c      IF( hscale .EQ. 0 ) THEN
c          IF( frange .NE. 99999 .AND. range .LT. frange ) RETURN
c          IF( lrange .NE. 99999 .AND. range .GT. lrange ) RETURN
c      ENDIF
      IF( LNUM .GT. LNO ) THEN                                          ! USE THE PARAMETERS OF THIS LIST
          IF(MLISTS.GE.NLISTS) RETURN                                   ! ANY MORE USER PARAM LISTS ON DISC
C****
C****     GET ANOTHER USER PARAMETER LIST FROM DISC
C****
          MLISTS=MLISTS+1
          READ(MUNIT) FNO,FDAY,FTR,LNO,LDAY,LTR,STIME,NSECS,VSCALE,DEF,
     *       TRPIN,RELAMP,ANNTYP,DECIMF,IHDRUN,NCOMMS,ANNINC,FANNO,ninc,
     *       hscale, plotsi, ptype, frange, lrange, rstime, absval, hdr,
     *       ihdr, lhdr, iwrap, anntyp2
          GO TO 95
      ENDIF
C****
C****   GOT SOMETHING TO PLOT!!! DO IT.
C****
      nsamps = numdat
      IF( nsamps .GT. maxsamps ) THEN
          PRINT *,' ***  WARNING  ***  Trace not plotted - nsamps of ',
     &      nsamps, ' exceeds the maximum of ',maxsamps
          RETURN
      ENDIF
c**** MOVE THE TRACE FROM THE AP SIMULATOR TO MEMORY (IT SIMPLIFIES THINGS!
c**** rlseap gets it out of the ap simulator and sets in to 0, so,
c**** in = 0 means the data is in buf and in = 1 means it's in the ap
c**** iout = 0 means transfer it to buf!
      IOUT=0
      IF(IUSEAP.EQ.0.AND.IN.NE.0) CALL RLSEAP(BUF(NUMHDR+1),NUMDAT)
      DO 110 I=1,NUMHDR                                                 ! SAVE THE TRACE HEADER
  110 SCR(I)=BUF(I)
      IF( IN .EQ. 0 .OR. IUSEAP .EQ. 0 ) THEN                           ! IS THE DATA IN THE AP?
          DO 130 I=1,NSAMPS                                             ! DO THE MOVE IN MEMORY
  130     SCR(NUMHDR+I)=BUF(NUMHDR+I)
      ELSE
          CALL APGET(SCR(NUMHDR+1),IN,NSAMPS,2)                         ! SAVE THE TRACE IN THE SCRATCH AREA
      ENDIF
      IF( ibuf(15) .EQ. 2 ) THEN                                        ! zero out dead traces
           DO i = 0, nsamps-1
              buf(numhdr+i) = 0.
           ENDDO
      ENDIF
      IF( DECIMF .NE. 1 ) THEN                                          ! DO WE NEED TO DECIMATE THE DATA?
         NUMDAT = NSAMPS/DECIMF                                         ! OBVIOUSLY WE HAVE FEWER SAMPLES AFTER DECIMATION!
         NSAMPS = NUMDAT
         BUF(49) = BUF(49)*FLOAT(DECIMF)                                ! CHANGE THE SAMPLE INTERVAL
c****   the data to plot are in buf
         J = 1
         DO 160 I=1,NSAMPS                                              ! DO THE DECIMATION IN MEMORY
            BUF(NUMHDR+I)=BUF(NUMHDR+J)
  160    J = J+DECIMF
      ENDIF
      NDONE=NDONE+1                                                     ! COUNT THE NUMBER OF TRACES PLOTTED
      IF( plotsi .GT. 0. ) si = plotsi
      ST=STIME
      IF( STIME .EQ. -99999. ) THEN
          st = delay
          IF( si .GE. .001 ) THEN
              temp = delay * 1000
              itemp = NINT(temp)
              itemp = itemp / 10 * 10
              st = FLOAT(itemp) / 1000.
          ENDIF
      ENDIF
      stimel = st
      IF( rstime .NE. -99999. ) st = delay + rstime
      st = st - delay                                                   ! SUBTRACT OUT THE DEEP WATER DELAY
c****
c****  Replicate a "chart recorder" by adjusting the plot stime based
c****  on the water bottom time.  If the wb is rising and is close to
c****  the top of the plotter, decrease STIME.  If the wb is increasing
c****  and is below chart(2) (the middle of the plotter?), increase
c****  STIME.  The object is to keep the wb in the top of the plot.
c****    (46) = delay,  (50) = wbt
c****
      IF( chart(2) .NE. 0. .AND. buf(50) .NE. 0. ) THEN
          IF( n_wbts .NE. MAX_WBTS ) THEN
              n_wbts = n_wbts + 1
          ELSE
              DO i = 1, n_wbts - 1
                 wbts(i) = wbts(i+1)
              ENDDO
          ENDIF
          wbts(n_wbts) = buf(50)
          ave_wbt = wbts(1)
          IF( n_wbts .GT. 1 ) THEN
              DO i = 2, n_wbts
                 ave_wbt = ave_wbt + wbts(i)
              ENDDO
              ave_wbt = ave_wbt / FLOAT(n_wbts)
          ENDIF
          IF( (buf(50) .LT. stime + nsecs * chart(1)) .AND.
     &        (ave_wbt .LT. stime + nsecs * chart(1)) ) THEN
c****         The -.05 and +.05 (5%) fudge factor is needed to allow a little
c****         heave or wiggle so the next trace doesn't trigger another change.
              IF( si .GE. .001 ) THEN
                  stime = INT(buf(50)) - nsecs * (chart(2)-.05)
              ELSE
                  temp = buf(50) * 10.
                  itemp = INT(temp)
                  stime = FLOAT(itemp) / 10. - nsecs * (chart(2)-.05)
              ENDIF
          ELSEIF( (buf(50) .GT. stime + nsecs * (chart(2)+.05) ) .AND.
     &        (ave_wbt .GT. stime + nsecs * (chart(2)+.05) ) ) THEN
              IF( si .GE. .001 ) THEN
                  stime = INT(buf(50)) - nsecs * chart(1)
              ELSE
                  temp = buf(50) * 10.
                  itemp = INT(temp)
                  stime = FLOAT(itemp) / 10. - nsecs * chart(1)
              ENDIF
          ENDIF
          IF( stime .LT. 0. ) stime = 0.
          st = stime - delay
          IF( st .LT. 0. ) THEN
              st = 0.
              stime = delay
          ENDIF
      ENDIF
c****
      IF( nsecs .EQ. 0 .AND. n2plot .EQ. 0 ) n2plot = numdat
      IF( nsecs .GT. 0 .AND. n2plot .EQ. 0 ) THEN
          n2plot = nsecs / si + .5
c          IF( n2plot .GT. numdat ) n2plot = numdat
c      ELSE
c          n2plot = MIN(FLOAT(n2plot), (size-offset)/vscale/si)
c          IF( n2plot .GT. numdat ) n2plot = numdat
      ENDIF
      IF( n2plot .GT. maxsamps ) THEN
          PRINT *,' ***  ERROR  ***  Too many samples in the plot.'
          PRINT *,' Requested ',n2plot,' samples, max is ',maxsamps
          PRINT *,' Use parameters SECS or DECIMF to reduce the plot.'
          CALL EXIT
      ENDIF
      IF( delay .NE. buf(46) .AND. stime .LT. 0 .AND. hscale .EQ. 0.
     &    .AND. rstime .LE. -100. .AND. chart(1) .EQ. 0 ) THEN         ! should we make a gap in the plot for a new delay?
          DO i=1,nspace
             CALL trplot(scr(nsamps+1),si,n2plot,0,1,2)
          ENDDO
          ntother = ntother + nspace                                    ! count the blank traces for refraction
      ENDIF
c**** hate to do this, but ....
      IF( stimel + FLOAT(n2plot)*si .LT. delay ) THEN
          PRINT *,' ***  WARNING  ***  Plot window is before the data.'
          RETURN
      ENDIF
      IF( stime .GT. delay + REAL(ibuf(58)) * si ) THEN
          PRINT *,' ***  WARNING  ***  Plot window is after the data.'
          RETURN
      ENDIF
      IF( ostime .NE. stime .AND. ndone .GT. 1 .AND. hscale .EQ. 0.
c     &    .AND. rstime .LE. -100. .AND. lastspace .LT. ndone-100 ) THEN
     &    .AND. rstime .LE. -100. ) THEN
c****     watch out for too frequent jumps
c****     create a space in the plot when the time axis changes
          DO i=1,nspace
             CALL trplot(scr(nsamps+1),si,n2plot,0,1,2)
          ENDDO
          ntother = ntother + nspace
          IF( chart(2) .NE. 0 ) THEN
c****         If a chart, annotate the new scale (time lines)
              stimel = stime
              IF( tlines(1) .NE. 0. ) THEN
c                 annotate the new
                  CALL trplot(scr(nsamps+1),si,n2plot,0,1,-3)
              ENDIF
          ENDIF
          lastspace = ndone
      ENDIF
c**** If record space, then create a space before trace 1 of a shot
      IF( irecsp .EQ. 1 ) THEN
          IF( lbuf(7) .EQ. 0 .AND. lbuf(4) .EQ. 1 ) THEN
              DO i=1,nspace
                 CALL trplot(scr(nsamps+1),si,n2plot,0,1,2)
              ENDDO
              ftag = ndone
          ENDIF
      ENDIF
  240 ostime=stime
      IF( hscale .NE. 0 ) THEN
c      Why did this exist?  Before polint?
c          IF( n2plot .GT. nsamps ) n2plot = nsamps
          CALL refplot( hscale, scr(nsamps+1), buf, lbuf, frange,
     &         lrange, istop, prange, ishotskip, si, n2plot, absval )
          IF( ishotskip .NE. 0 ) THEN
              ndone = ndone - 1
              RETURN
          ENDIF
      ENDIF
      IF( istop .LT. 0 ) RETURN
c****
c****  If the plot starts after the beginning of the data, shift it so
c****     that it starts at the beginning AND zero the backend
c****
      ISTART = NUMHDR + NINT(ST/SI)
      IF( istart .GT. numhdr ) THEN
          idiff = istart - numhdr
          n = nsamps - idiff
c****   the data being plotted are in buf, not scr or the ap
          DO i = 1, n
              buf(numhdr+i) = buf(numhdr+idiff+i)
          ENDDO
          DO i = 1, idiff
              buf(numhdr+n+i) = 0.
          ENDDO
          nsamps = n
          istart = numhdr
      ENDIF
c****
c****  If the plot starts before the data, fill the front of the trace
c****
      IF( ISTART .LT. NUMHDR ) THEN
          N = -ISTART + NUMHDR                                          ! THIS IS THE NUMBER OF ZEROES WE NEED TO PAD THE FRONT OF THE DATA
c****   the data being plotted are in buf, not scr or the ap
          DO i = 1, nsamps                                       ! MOVE THE TRACE DOWN THE BUFFER TO MAKE ROOM FOR THE PAD
             BUF(NUMHDR+nsamps+n-I+1)=BUF(NUMHDR+nsamps-I+1)
          ENDDO
          DO I=1,N
             BUF(NUMHDR+I)=0.                                           ! PAD THE FRONT WITH ZEROES
          ENDDO
          ISTART = NUMHDR                                                ! THE DATA NOW STARTS AT THE BEGINNING OF BUF
          nsamps = nsamps + n
      ENDIF
c****
c****  If there is less data than the amount to plot, fill the back end
c****
      IF( ISTART - NUMHDR + NSAMPS .LT. n2plot ) THEN                   ! ARE WE PLOTTING MORE THAN THERE IS DATA?
          N = ISTART - NUMHDR + n2plot - nsamps                         ! PAD THE END OF THE TRACE WITH ZEROES
          IF( IN .EQ. 0 ) THEN                                          ! IS THE DATA IN THE AP?
              DO 505 I=1,N
  505         BUF(NUMHDR+nsamps+I)=0.
          ELSE
              CALL VCLR(IN+nsamps,1,N)                                  ! ZERO IT OUT IN THE AP
          ENDIF
          nsamps = nsamps + n
      ENDIF
c****
c****   Rectify the data if asked to
c****
      IF( irectify .NE. 0 ) THEN
          IF( in .NE. 0 .AND. iuseap .EQ. 1 ) STOP
          DO i = 1, n2plot
             buf(istart+i) = ABS(buf(istart+i))
          ENDDO
      ENDIF
c****
c****  If the plot is reverse direction, flip it and reverse it
c****
      IF( IDIR .EQ. -1 ) THEN                                           ! NEGATE THE TRACE IF THE PLOT IS BACKWARDS
          IF( IN .NE. 0 .AND. IUSEAP .EQ. 1 ) THEN                      ! DO IT IN THE AP IF IT IS ALREADY IN THE AP!
              INDX = IN + ISTART - NUMHDR                               ! THE INDEX IN THE AP OF THE FIRST SAMPLE TO PLOT
              CALL VNEG(INDX,1,NEXTAD,1,n2plot)
              CALL VMOV(NEXTAD+NSAMPS-1,-1,INDX,1,n2plot)               ! REVERSE THE ORDER
          ELSE
              DO 520 I = 1, n2plot
  520         BUF(ISTART+I) = -BUF(ISTART+I)
              N2 = n2plot / 2
              DO 530 I = 1, N2                                          ! NOW FLIP THE ORDER (SO THE PLOT IS UPSIDE DOWN)
                 TEMP = BUF(ISTART+I)
                 BUF(ISTART+I) = BUF(ISTART+n2plot+1-I)
                 BUF(ISTART+n2plot+1-I)=TEMP
  530         CONTINUE
c****         Shift the whole thing because the data starts at zero
c****          rather than 1!
              DO 540 i = n2plot, 2, -1
  540         buf(istart+i) = buf(istart+i-1)
              buf(istart+1) = 0.
          ENDIF
      ENDIF
C****
C****   DO THE TAGGING AND ANNOTATION
C****
      ITAG=0                                                            ! SET THE TAG SIGNAL TO NO TAG
      IF( anntyp .EQ. 5 ) GOTO 550                                      ! annotation by even minute?
      IF(FTAG.NE.NDONE.OR.TAGINC.EQ.0) GOTO 700
      ITAG=1
      FTAG=FTAG+TAGINC
      itemp = anntyp
      IF( anntyp .EQ. 6 .AND. hscale .NE. 0. ) THEN
          fanno = prange
          itemp = 1
      ENDIF
c**** annotate by even gmt interval?
  550 IF( anntyp .EQ. 5 ) THEN
c****  stupid compiler insists mod has same integer length!
          itemp = ibuf(82)
          IF( MOD(itemp,ANNINC) .NE. 0 .OR. ibuf(82) .EQ. lastmn )
     &        GOTO 700
          itemp = 4
          itag = 1
          lastmn = ibuf(82)
      ENDIF
      CALL getlanno( itemp, hdr, lhdr, ihdr,
     &     buf, lbuf, ibuf, fanno, lanno )
      CALL getlanno( anntyp2, hdr, lhdr, ihdr,
     &     buf, lbuf, ibuf, fanno, lanno2 )
      IF( anntyp .EQ. 4 .OR. anntyp .EQ. 1 ) fanno = fanno + anninc
C****
C****   NOW PLOT THE THING!
C****
  700 CONTINUE
      IF(IN.NE.0) IN=ISTART-NUMHDR+IN
      IF( ishotskip .NE. 1 ) THEN                                       ! refraction plot may have tossed it away!
          CALL TRPLOT(BUF(ISTART+1),SI,n2plot,0,1,ITAG)
          ntlive = ntlive + 1
          IF( lunhead .NE. 0 ) THEN
              lbuf(1) = nraster
              DO i = 1, 60
                 scr(i) = buf(i)
              ENDDO
              iscr(58) = 0
              IF( stime .NE. -99999. ) THEN
                  scr(46) = stime
                  iscr(55) = NINT(stime*1000.)
              ENDIF
              IF( icompt .EQ. 2 .OR. icompt .EQ. 4 ) THEN
                  CALL swap32( lscr(1), 7 )
                  CALL swap16( iscr(15), 1 )
                  CALL swap16( iscr(17), 1 )
                  CALL swap32( lscr(10), 8 )
                  CALL swap16( iscr(35), 2 )
                  CALL swap32( lscr(19), 4 )
                  CALL swap16( iscr(45), 2 )
                  CALL swap16( iscr(53), 7 )
                  CALL swap16( iscr(79), 6 )
                  CALL swap32( lscr(46), 15 )
              ENDIF
              CALL wrdisc( lunhead, scr, numhdr )
          ENDIF
      ENDIF
      LANNO=' '                                                         !  CLEAR THE ANNOTATION BUFFER
      index = istart + 1
      nums = numdat - n2plot
      n = n2plot
  710 CONTINUE
c**** Wrap the trace around if the user asked to.  The gotcha on nums >1
c**** is that if the trace is 4001 samples we'll put the last sample on
c**** a new line.
      IF(iwrap .NE. 0 .AND. nums .GT. 1) THEN
           index=index+n
           n=min0(n2plot,nums)
           CALL trplot(buf(index),si,n,0,1,0)
           ntother = ntother + 1
           nums=nums-n
           GOTO 710
      ENDIF
      IF( iwrap .NE. 0 .AND. hscale .EQ. 0. ) THEN
          DO i=1,nspace
             CALL trplot(scr,si,n2plot,0,1,2)
          ENDDO
          ntother = ntother + nspace
      ENDIF
      IF( FSPACE .EQ. NDONE .AND. ndone .GT. 0 ) THEN
          ITAG=2                                                        ! CREATE THE SPACES BETWEEN SHOTS/RPS
          DO i=1,nspace
             CALL trplot(scr,si,n2plot,0,1,2)
          ENDDO
          ntother = ntother + nspace
          FSPACE=FSPACE+SPACEI
      ENDIF
c**** If record space, then create a space after the last trace of
c**** a gather (process gather writes a -1 in word 51)
      IF( irecsp .EQ. 1 ) THEN
          IF( lbuf(7) .NE. 0 .AND. lbuf(51) .EQ. -1 ) THEN
              DO i=1,nspace
                 CALL trplot(scr,si,n2plot,0,1,2)
              ENDDO
              ftag = ndone + 1
              ntother = ntother + 1
          ENDIF
      ENDIF

C****
C****
      NUMDAT=ISCR(58)                                                   ! NOW RESTORE THE TRACE INTO THE PIPE
      ITEMP=NUMHDR+NUMDAT
      DO 810 I=1,ITEMP
  810 BUF(I)=SCR(I)
      RETURN
      END


C$Procedure      ZZGFSSOB ( GF, state of sub-observer point )

      SUBROUTINE ZZGFSSOB ( METHOD, TRGID, ET,    FIXREF,
     .                      ABCORR, OBSID, RADII, STATE  )

C$ Abstract
C
C     SPICE private routine intended solely for the support of SPICE
C     routines. Users should not call this routine directly due to the
C     volatile nature of this routine.
C
C     Return the state of a sub-observer point used to define
C     coordinates referenced in a GF search.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     GF
C     SPK
C     TIME
C     NAIF_IDS
C     FRAMES
C
C$ Keywords
C
C     GEOMETRY
C     PRIVATE
C     SEARCH
C
C$ Declarations

      IMPLICIT NONE

      INCLUDE               'gf.inc'
      INCLUDE               'zzgf.inc'
      INCLUDE               'zzabcorr.inc'

      CHARACTER*(*)         METHOD
      INTEGER               TRGID
      DOUBLE PRECISION      ET
      CHARACTER*(*)         FIXREF
      CHARACTER*(*)         ABCORR
      INTEGER               OBSID
      DOUBLE PRECISION      RADII  ( 3 )
      DOUBLE PRECISION      STATE  ( 6 )

C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     METHOD     I   Computation method.
C     TRGID      I   Target ID code.
C     ET         I   Computation epoch.
C     FIXREF     I   Reference frame name.
C     ABCORR     I   Aberration correction.
C     OBSID      I   Observer ID code.
C     RADII      I   Target radii.
C     STATE      O   State used to define coordinates.
C
C$ Detailed_Input
C
C     METHOD      is a short string providing parameters defining
C                 the computation method to be used. Any value
C                 supported by SUBPNT may be used.
C
C
C     TRGID      is the NAIF ID code of the target object.
C
C                *This routine assumes that the target is modeled
C                as a tri-axial ellipsoid.*
C
C
C     ET         is the time, expressed as ephemeris seconds past J2000
C                TDB, at which the specified state is to be computed.
C
C
C     FIXREF     is the name of the reference frame relative to which
C                the state of interest is specified.
C
C                FIXREF must be centered on the target body.
C
C                Case, leading and trailing blanks are not significant
C                in the string FIXREF.
C
C
C     ABCORR     indicates the aberration corrections to be applied to
C                the state of the target body to account for one-way
C                light time and stellar aberration. The orientation
C                of the target body will also be corrected for one-way
C                light time when light time corrections are requested.
C
C                Supported aberration correction options for
C                observation (case where radiation is received by
C                observer at ET) are:
C
C                   NONE           No correction.
C                   LT             Light time only.
C                   LT+S           Light time and stellar aberration.
C                   CN             Converged Newtonian (CN) light time.
C                   CN+S           CN light time and stellar aberration.
C
C                Supported aberration correction options for
C                transmission (case where radiation is emitted from
C                observer at ET) are:
C
C                   XLT            Light time only.
C                   XLT+S          Light time and stellar aberration.
C                   XCN            Converged Newtonian (CN) light time.
C                   XCN+S          CN light time and stellar aberration.
C
C                For detailed information, see the geometry finder
C                required reading, gf.req.  Also see the header of
C                SPKEZR, which contains a detailed discussion of
C                aberration corrections.
C
C                Case, leading and trailing blanks are not significant
C                in the string ABCORR.
C
C
C     OBSID      is the NAIF ID code of the observer.
C
C
C     RADII      is an array containing three radii defining
C                a reference ellipsoid for the target body.
C
C$ Detailed_Output
C
C     STATE     is the state of the sub-observer point at ET.
C               The first three components of STATE contain the
C               sub-observer point itself; the last three
C               components contain the derivative with respect to
C               time of the position. The state is expressed
C               relative to the body-fixed frame designated by
C               FIXREF.
C
C               Units are km and km/s.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     1)  If the aberration correction ABCORR is not recognized,
C         the error will be diagnosed by routines in the call tree
C         of this routine.
C
C     2)  If the frame FIXREF is not recognized by the frames
C         subsystem, the error will be diagnosed by routines in the
C         call tree of this routine.
C
C     3)  FIXREF must be centered on the target body; if it isn't,
C         the error will be diagnosed by routines in the call tree
C         of this routine.
C
C     4)  Any error that occurs while look up the state of the target
C         or observer will be diagnosed by routines in the call tree of
C         this routine.
C
C     5)  Any error that occurs while look up the orientation of
C         the target will be diagnosed by routines in the call tree of
C         this routine.
C
C     6)  If the input method is not recognized, the error
C         SPICE(NOTSUPPORTED) will be signaled.
C
C$ Files
C
C     Appropriate kernels must be loaded by the calling program before
C     this routine is called.
C
C     The following data are required:
C
C        - SPK data: ephemeris data for target and observer must be
C          loaded. If aberration corrections are used, the states of
C          target and observer relative to the solar system barycenter
C          must be calculable from the available ephemeris data.
C          Typically ephemeris data are made available by loading one
C          or more SPK files via FURNSH.
C
C        - PCK data: if the target body shape is modeled as an
C          ellipsoid, triaxial radii for the target body must be loaded
C          into the kernel pool. Typically this is done by loading a
C          text PCK file via FURNSH.
C
C        - Further PCK data: rotation data for the target body must be
C          loaded. These may be provided in a text or binary PCK file.
C
C        - Frame data: if a frame definition is required to convert the
C          observer and target states to the body-fixed frame of the
C          target, that definition must be available in the kernel
C          pool. Typically the definition is supplied by loading a
C          frame kernel via FURNSH.
C
C     In all cases, kernel data are normally loaded once per program
C     run, NOT every time this routine is called.
C
C$ Particulars
C
C     This routine isolates the computation of the sub-observer state
C     (that is, the sub-observer point and its derivative with respect
C     to time).
C
C     This routine is used by the GF coordinate utility routines in
C     order to solve for time windows on which specified mathematical
C     conditions involving coordinates are satisfied. The role of
C     this routine is to provide Cartesian state vectors enabling
C     the GF coordinate utilities to determine the signs of the
C     derivatives with respect to time of coordinates of interest.
C
C$ Examples
C
C     See ZZGFCOST.
C
C$ Restrictions
C
C     1)  This routine is restricted to use with ellipsoidal target
C         shape models.
C
C     2)  The computations performed by this routine are intended
C         to be compatible with those performed by the SPICE
C         routine SUBPNT. If that routine changes, this routine
C         may need to be updated.
C
C     3)  This routine presumes that error checking of inputs
C         has, where possible, already been performed by the
C         GF coordinate utility initialization routine.
C
C     4)  The interface and functionality of this set of routines may
C         change without notice. These routines should be called only
C         by SPICELIB routines.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     N.J. Bachman   (JPL)
C
C$ Version
C
C-    SPICELIB Version 2.0.0 12-MAY-2009 (NJB)
C
C        Upgraded to support targets and observers having
C        no names associated with their ID codes.
C
C-    SPICELIB Version 1.0.0 05-MAR-2009 (NJB)
C
C-&

C$ Index_Entries
C
C     sub-observer state
C
C-&

C
C     SPICELIB functions
C
      DOUBLE PRECISION      CLIGHT
      DOUBLE PRECISION      VDOT

      LOGICAL               EQSTR
      LOGICAL               FAILED
      LOGICAL               RETURN

C
C     Local parameters
C
      DOUBLE PRECISION      TDELTA
      PARAMETER           ( TDELTA = 1.D0 )

      INTEGER               BDNMLN
      PARAMETER           ( BDNMLN = 36 )

C
C     Local variables
C
      CHARACTER*(BDNMLN)    SVOBS
      CHARACTER*(BDNMLN)    SVTARG

      DOUBLE PRECISION      ACC    ( 3 )
      DOUBLE PRECISION      CORXFI ( 6, 6 )
      DOUBLE PRECISION      CORXFM ( 6, 6 )
      DOUBLE PRECISION      DALT   ( 2 )
      DOUBLE PRECISION      DLT
      DOUBLE PRECISION      FXOSTA ( 6 )
      DOUBLE PRECISION      FXPSTA ( 6 )
      DOUBLE PRECISION      FXPVEL ( 3 )
      DOUBLE PRECISION      FXTSTA ( 6 )
      DOUBLE PRECISION      LT
      DOUBLE PRECISION      OBSPNT ( 6 )
      DOUBLE PRECISION      OBSSTA ( 6, 2 )
      DOUBLE PRECISION      OBSTRG ( 6 )
      DOUBLE PRECISION      PNTSTA ( 6 )
      DOUBLE PRECISION      RAYSTA ( 6 )
      DOUBLE PRECISION      SA     ( 3 )
      DOUBLE PRECISION      SASTAT ( 6 )
      DOUBLE PRECISION      SAVEL  ( 3 )
      DOUBLE PRECISION      SCALE
      DOUBLE PRECISION      SPOINT ( 3 )
      DOUBLE PRECISION      SRFVEC ( 3 )
      DOUBLE PRECISION      SSBOBS ( 6 )
      DOUBLE PRECISION      SSBTG0 ( 6 )
      DOUBLE PRECISION      SSBTRG ( 6 )
      DOUBLE PRECISION      STEMP  ( 6 )
      DOUBLE PRECISION      T
      DOUBLE PRECISION      TRGEPC
      DOUBLE PRECISION      UPOS   ( 3 )
      DOUBLE PRECISION      XFORM  ( 6, 6 )

      INTEGER               CENTER
      INTEGER               CLSSID
      INTEGER               FRCLSS
      INTEGER               FRCODE
      INTEGER               I
      INTEGER               PRVOBS
      INTEGER               PRVTRG

      LOGICAL               ATTBLK ( ABATSZ )
      LOGICAL               FIRST
      LOGICAL               FND
      LOGICAL               FOUND
      LOGICAL               GEOM
      LOGICAL               NEAR
      LOGICAL               USELT
      LOGICAL               USESTL
      LOGICAL               XMIT

C
C     Saved variables
C
      SAVE                  FIRST
      SAVE                  SVOBS
      SAVE                  PRVOBS
      SAVE                  PRVTRG
      SAVE                  SVTARG

C
C     Initial values
C
      DATA                  FIRST / .TRUE. /

      DATA                  PRVOBS /  0 /
      DATA                  PRVTRG /  0 /

      DATA                  SVOBS / ' ' /
      DATA                  SVTARG / ' ' /

C
C     Standard SPICE error handling.
C
      IF ( RETURN () ) THEN
         RETURN
      END IF

      CALL CHKIN ( 'ZZGFSSOB' )

      IF (  FIRST  .OR. ( TRGID .NE. PRVTRG )  ) THEN

         CALL BODC2S ( TRGID, SVTARG )

         PRVTRG = TRGID

      END IF

      IF (  FIRST  .OR. ( OBSID .NE. PRVOBS )  ) THEN

         CALL BODC2S ( OBSID, SVOBS )

         PRVOBS = OBSID

      END IF

      FIRST = .FALSE.

C
C     Parse the aberration correction specifier.
C
      CALL ZZPRSCOR ( ABCORR, ATTBLK )

      GEOM   = ATTBLK( GEOIDX )
      USELT  = ATTBLK( LTIDX  )
      USESTL = ATTBLK( STLIDX )
      XMIT   = ATTBLK( XMTIDX )

C
C     Decide whether the sub-observer point is computed using
C     the "near point" or "surface intercept" method. Only
C     ellipsoids may be used a shape models for this computation.
C
      IF (  EQSTR( METHOD, 'Near point: ellipsoid' )  ) THEN

         NEAR = .TRUE.

      ELSE IF (  EQSTR( METHOD, 'Intercept: ellipsoid' )  ) THEN

         NEAR = .FALSE.

      ELSE

         CALL SETMSG ( 'Sub-observer point computation method # '
     .   //            'is not supported by this routine.'       )
         CALL ERRCH  ( '#', METHOD                               )
         CALL SIGERR ( 'SPICE(NOTSUPPORTED)'                     )
         CALL CHKOUT ( 'ZZGFSSOB'                                )
         RETURN

      END IF

      IF ( GEOM ) THEN
C
C        This is the geometric case.
C
C        We need to check the body-fixed reference frame here.
C
         CALL NAMFRM ( FIXREF, FRCODE )
         CALL FRINFO ( FRCODE, CENTER, FRCLSS, CLSSID, FND )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZGFSSOB' )
            RETURN
         END IF

         IF ( .NOT. FND ) THEN

            CALL SETMSG ( 'Input reference frame # was not '
     .      //            'recognized.'                     )
            CALL ERRCH  ( '#', FIXREF                       )
            CALL SIGERR ( 'SPICE(NOFRAME)'                  )
            CALL CHKOUT ( 'ZZGFSSOB'                        )
            RETURN

         END IF

         IF ( CENTER .NE. TRGID ) THEN

            CALL SETMSG ( 'Input reference frame # is centered '
     .      //            'on body # instead of body #.'        )
            CALL ERRCH  ( '#', FIXREF                           )
            CALL ERRINT ( '#', CENTER                           )
            CALL ERRINT ( '#', TRGID                            )
            CALL SIGERR ( 'SPICE(INVALIDFRAME)'                 )
            CALL CHKOUT ( 'ZZGFSSOB'                            )
            RETURN

         END IF

C
C        Get the state of the target with respect to the observer,
C        expressed relative to the target body-fixed frame. We don't
C        need to propagate states to the solar system barycenter in
C        this case.
C
         CALL SPKGEO ( TRGID, ET, FIXREF, OBSID, FXTSTA, LT )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZGFSSOB' )
            RETURN
         END IF

C
C        Compute the state of the observer with respect to the target
C        in the body-fixed frame.
C
         CALL VMINUG ( FXTSTA, 6, FXOSTA )

C
C        Now we can obtain the surface velocity of the sub-observer
C        point.
C
         IF ( NEAR ) THEN
C
C           The sub-observer point method is "near point."
C
            CALL DNEARP ( FXOSTA, RADII(1), RADII(2), RADII(3),
     .                    FXPSTA, DALT,     FOUND              )

            IF ( .NOT. FOUND ) THEN

               CALL SETMSG ( 'The sub-observer state could '
     .         //            'could not be computed because '
     .         //            'the velocity was not well '
     .         //            'defined. DNEARP returned "not found."' )
               CALL SIGERR ( 'SPICE(DEGENERATECASE)'                 )
               CALL CHKOUT ( 'ZZGFSSOB'                              )
               RETURN

            END IF

         ELSE
C
C           The sub-observer point method is "surface
C           intercept point." The ray direction is simply
C           the negative of the observer's position relative
C           to the target center.
C
            CALL VMINUG ( FXOSTA, 6, RAYSTA )

            CALL SURFPV ( FXOSTA,   RAYSTA,
     .                    RADII(1), RADII(2), RADII(3), FXPSTA, FOUND )

C
C           Although in general it's not an error for SURFPV to
C           be unable to compute an intercept state, it *is*
C           an error in this case, since the ray points toward
C           the center of the target.
C
            IF ( .NOT. FOUND ) THEN

               CALL SETMSG ( 'The sub-observer state could '
     .         //            'could not be computed because '
     .         //            'the velocity was not well '
     .         //            'defined. SURFPV returned "not found."' )
               CALL SIGERR ( 'SPICE(DEGENERATECASE)'                 )
               CALL CHKOUT ( 'ZZGFSSOB'                              )
               RETURN

            END IF

         END IF

      ELSE IF ( USELT ) THEN
C
C        Light time and possibly stellar aberration corrections are
C        applied.
C
C        Most our work consists of getting ready to call either of the
C        SPICELIB routines DNEARP or SURFPV. In order to make this
C        call, we'll need the velocity of the observer relative to the
C        target body's center in the target body-fixed frame. We must
C        evaluate the rotation state of the target at the correct
C        epoch, and account for the rate of change of light time, if
C        light time corrections are used. The algorithm we use depends
C        on the algorithm used in SUBPNT, since we're computing the
C        derivative with respect to time of the solution found by that
C        routine.
C
C        In this algorithm, we must take into account the fact that
C        SUBPNT performs light time and stellar aberration corrections
C        for the sub-observer point, not for the center of the target
C        body.
C
C        If light time and stellar aberration corrections are used,
C
C           - Find the aberration corrected sub-observer point and the
C             light time-corrected epoch TRGEPC associated with the
C             sub-observer point.
C
C           - Use TRGEPC to find the position of the target relative to
C             the solar system barycenter.
C
C           - Use TRGEPC to find the orientation of the target relative
C             to the J2000 reference frame.
C
C           - Find the light-time corrected position of the
C             sub-observer point; use this to compute the stellar
C             aberration offset that applies to the sub-observer point,
C             as well as the velocity of this offset.
C
C           - Find the corrected state of the target center as seen
C             from the observer, where the corrections are those
C             applicable to the sub-observer point.
C
C           - Negate the corrected target center state to obtain the
C             state of the observer relative to the target.
C
C           - Express the state of the observer relative to the target
C             in the target body fixed frame at TRGEPC.
C
C
C        Below, we'll use the convention that vectors expressed
C        relative to the body-fixed frame have names of the form
C
C           FX*
C
C        Note that SUBPNT will signal an error if FIXREF is not
C        actually centered on the target body.
C
         CALL SUBPNT ( METHOD, SVTARG, ET,     FIXREF,
     .                 ABCORR, SVOBS,  SPOINT, TRGEPC, SRFVEC )

C
C        Get J2000-relative states of observer and target with respect
C        to the solar system barycenter at their respective epochs of
C        participation.
C
         CALL SPKSSB ( OBSID, ET,     'J2000', SSBOBS )
         CALL SPKSSB ( TRGID, TRGEPC, 'J2000', SSBTG0 )

C
C        Get the uncorrected J2000 to body-fixed to state
C        transformation at TRGEPC.
C
         CALL SXFORM ( 'J2000', FIXREF, TRGEPC, XFORM )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZGFSSOB' )
            RETURN
         END IF

C
C        Initialize the state of the sub-observer point in the
C        body-fixed frame. At this point we don't know the
C        point's velocity; set it to zero.
C
         CALL MOVED  ( SPOINT, 3, FXPSTA    )
         CALL CLEARD (         3, FXPSTA(4) )

         IF ( USESTL ) THEN
C
C           We're going to need the acceleration of the observer
C           relative to the SSB. Compute this now.
C
            DO I = 1, 2
C
C              The epoch is ET -/+ TDELTA.
C
               T =  ET  + (2*I-3)*TDELTA

               CALL SPKSSB ( OBSID,  T,  'J2000', OBSSTA(1,I) )

            END DO

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'ZZGFSSOB' )
               RETURN
            END IF

C
C           Compute the observer's acceleration using a quadratic
C           approximation.
C
            CALL QDERIV ( 3, OBSSTA(4,1), OBSSTA(4,2), TDELTA, ACC )

         END IF

C
C        The rest of the algorithm is iterative. On the first
C        iteration, we don't have a good estimate of the velocity
C        of the sub-observer point relative to the body-fixed
C        frame. Since we're using this velocity as an input
C        to the aberration velocity computations, we
C        expect that treating this velocity as zero on the first
C        pass yields a reasonable estimate. On the second pass,
C        we'll use the velocity derived on the first pass.
C
         CALL CLEARD ( 3, FXPVEL )

C
C        We'll also estimate the rate of change of light time
C        as zero on the first pass.
C
         DLT = 0.D0

         DO I = 1, 2
C
C           Correct the target's velocity for the rate of
C           change of light time.
C
            IF ( XMIT ) THEN
               SCALE = 1.D0 + DLT
            ELSE
               SCALE = 1.D0 - DLT
            END IF

C
C           Scale the velocity portion of the target state to
C           correct the velocity for the rate of change of light
C           time.
C
            CALL MOVED ( SSBTG0, 3,         SSBTRG    )
            CALL VSCL  ( SCALE,  SSBTG0(4), SSBTRG(4) )

C
C           Get the state of the target with respect to the observer.
C
            CALL VSUBG ( SSBTRG, SSBOBS, 6, OBSTRG )

C
C           Correct the J2000 to body-fixed state transformation matrix
C           for the rate of change of light time.
C
            CALL ZZCORSXF ( XMIT, DLT, XFORM, CORXFM )

C
C           Invert CORXFM to obtain the corrected
C           body-fixed to J2000 state transformation.
C
            CALL INVSTM ( CORXFM, CORXFI )

C
C           Convert the sub-observer point state to the J2000 frame.
C
            CALL MXVG ( CORXFI, FXPSTA, 6, 6, PNTSTA )

C
C           Find the J2000-relative state of the sub-observer
C           point with respect to the target.
C
            CALL VADDG ( OBSTRG, PNTSTA, 6, OBSPNT )

            IF ( USESTL ) THEN
C
C              Now compute the stellar aberration correction
C              applicable to OBSPNT. We need the velocity of
C              this correction as well.
C
               CALL ZZSTELAB ( XMIT, ACC, SSBOBS(4), OBSPNT, SA, SAVEL )

               CALL MOVED ( SA,    3, SASTAT    )
               CALL MOVED ( SAVEL, 3, SASTAT(4) )
C
C              Adding the stellar aberration state to the target center
C              state gives us the state of the target center with
C              respect to the observer, corrected for the aberrations
C              applicable to the sub-observer point.

               CALL VADDG ( OBSTRG, SASTAT, 6, STEMP )

            ELSE
               CALL MOVED ( OBSTRG, 6, STEMP )
            END IF

C
C           Convert STEMP to the body-fixed reference frame.
C
            CALL MXVG ( CORXFM, STEMP, 6, 6, FXTSTA )

C
C           At long last, compute the state of the observer
C           with respect to the target in the body-fixed frame.
C
            CALL VMINUG ( FXTSTA, 6, FXOSTA )

C
C           Now we can obtain the surface velocity of the
C           sub-observer point.
C
            IF ( NEAR ) THEN
C
C              The sub-observer point method is "near point."
C
               CALL DNEARP ( FXOSTA, RADII(1), RADII(2), RADII(3),
     .                       FXPSTA, DALT,     FOUND              )

               IF ( .NOT. FOUND ) THEN

                  CALL SETMSG ( 'The sub-observer state could '
     .            //            'could not be computed because '
     .            //            'the velocity was not well '
     .            //            'defined.  DNEARP returned '
     .            //            '"not found."'                  )
                  CALL SIGERR ( 'SPICE(DEGENERATECASE)'         )
                  CALL CHKOUT ( 'ZZGFSSOB'                      )
                  RETURN

               END IF

            ELSE
C
C              The sub-observer point method is "surface intercept
C              point." The ray direction is simply the negative of the
C              observer's position relative to the target center.
C
               CALL VMINUG ( FXOSTA, 6, RAYSTA )

               CALL SURFPV ( FXOSTA,   RAYSTA,   RADII(1),
     .                       RADII(2), RADII(3), FXPSTA,   FOUND )

C
C              Although in general it's not an error for SURFPV to be
C              unable to compute an intercept state, it *is* an error
C              in this case, since the ray points toward the center of
C              the target.
C
               IF ( .NOT. FOUND ) THEN

                  CALL SETMSG ( 'The sub-observer state could '
     .            //            'could not be computed because '
     .            //            'the velocity was not well '
     .            //            'defined. SURFPV returned '
     .            //            '"not found."'                   )
                  CALL SIGERR ( 'SPICE(DEGENERATECASE)'          )
                  CALL CHKOUT ( 'ZZGFSSOB'                       )
                  RETURN

               END IF

            END IF

C
C           At this point we can update the surface point
C           velocity and light time derivative estimates.
C
C           In order to compute the light time rate, we'll
C           need the J2000-relative velocity of the sub-observer
C           point with respect to the observer. First convert
C           the sub-observer state to the J2000 frame, then
C           add the result to the state of the target center
C           with respect to the observer.
C
            CALL MXVG  ( CORXFI, FXPSTA, 6, 6, PNTSTA )
            CALL VADDG ( OBSTRG, PNTSTA, 6,    OBSPNT )

C
C           Now that we have an improved estimate of the
C           sub-observer state, we can estimate the rate of
C           change of light time as
C
C              range rate
C              ----------
C                  c
C
C
C           If we're correcting for stellar aberration, *ideally* we
C           should remove that correction now, since the light time
C           rate is based on light time between the observer and the
C           light-time corrected sub-observer point. But the error made
C           by including stellar aberration is too small to make it
C           worthwhile to make this adjustment.
C
            CALL VHAT ( OBSPNT, UPOS )

            DLT = VDOT ( OBSPNT(4), UPOS ) / CLIGHT()

C
C           With FXPVEL and DLT updated, we'll repeat our
C           computations.
C
         END DO

      ELSE
C
C        We should never get here.
C
         CALL SETMSG ( 'Aberration correction # was not '
     .   //            'recognized.'                      )
         CALL ERRCH  ( '#',  ABCORR                       )
         CALL SIGERR ( 'SPICE(NOTSUPPORTED)'              )
         CALL CHKOUT ( 'ZZGFSSOB'                         )
         RETURN

      END IF

C
C     Copy the computed state to the output argument STATE.
C
      CALL MOVED ( FXPSTA, 6, STATE )

      CALL CHKOUT  ( 'ZZGFSSOB' )
      RETURN
      END


MODULE params_model

USE common, ONLY: r_size, slen

IMPLICIT NONE

PUBLIC

!-----------------------------------------------------------------------
! General parameters
!-----------------------------------------------------------------------
!
  ! Now definable via namelist at runtime:

  ! HYCOM 1/12º global model grid dimensions:
  INTEGER :: glon=4500
  INTEGER :: glat=3298
  INTEGER :: glev=41

  ! HYCOM 1/12º local area model grid dimensions
  ! (updated at runtime by grid specification file)
  INTEGER :: nlon
  INTEGER :: nlat
  INTEGER :: nlev
  ! LAM grid index:
  INTEGER :: istart,iend
  INTEGER :: jstart,jend

  !STEVE: going with z-coordinate in the vertical for now:
  INTEGER,PARAMETER :: nv3d=4 ! u,v,t,s               !(OCEAN)(NCODA)
! INTEGER,PARAMETER :: nv3d=5 ! u,v,t,s,h             !(OCEAN)(MOM6)(HYCOM)
  INTEGER,PARAMETER :: nv4d=3 ! x,y,z                 !(OCEAN) STEVE: add t,x,y,z,id for DRIFTERS
! INTEGER,PARAMETER :: nv2d=3 ! ssh,sst,sss           !(OCEAN)
! INTEGER,PARAMETER :: nv2d=3 ! ssh,ubt,vbt           !(OCEAN) !(ALTIMETRY)(HYCOM)
  INTEGER,PARAMETER :: nv2d=1 ! ssh                   !(OCEAN) !(ALTIMETRY)(HYCOM)

  INTEGER,PARAMETER :: ilev_sfc=1

  ! Initialize via subroutine below:
  INTEGER,SAVE :: nij0           ! Number of gridpoints handled by myrank processor
  INTEGER,SAVE :: nlevall        ! Total number of variables and levels (3d + 2d)
  INTEGER,SAVE :: ngpv           ! Total number of gridpoints, including nij0*nlevall

  INTEGER,PARAMETER :: iv3d_u=1
  INTEGER,PARAMETER :: iv3d_v=2
  INTEGER,PARAMETER :: iv3d_t=3
  INTEGER,PARAMETER :: iv3d_s=4
  INTEGER,PARAMETER :: iv3d_h=5                !(NCODA)(n/a)

  INTEGER,PARAMETER :: iv2d_ssh=1              !(OCEAN) ! time averaged thickness of top model grid cell (m) plus patm/(grav*rho0)
  INTEGER,PARAMETER :: iv2d_ubt=2              !(OCEAN) ! Barotropic zonal velocity (HYCOM)
  INTEGER,PARAMETER :: iv2d_vbt=3              !(OCEAN) ! Barotropic meridional velocity (HYCOM)
  INTEGER,PARAMETER :: iv2d_sst=4              !(NCODA)(n/a)
  INTEGER,PARAMETER :: iv2d_sss=5              !(NCODA)(n/a)
  INTEGER,PARAMETER :: iv2d_eta=6              !(NCODA)(n/a)
  INTEGER,PARAMETER :: iv2d_mld=7              !(NCODA)(n/a)
  INTEGER,PARAMETER :: iv4d_x=1                !(NCODA)(n/a)
  INTEGER,PARAMETER :: iv4d_y=2                !(NCODA)(n/a)
  INTEGER,PARAMETER :: iv4d_z=3                !(NCODA)(n/a)

  !
  ! Elements (labels for each model variable)
  !
  CHARACTER(4) :: element(nv3d+nv2d+nv4d)
! element(iv3d_u) = 'U   '
! element(iv3d_v) = 'V   '
! element(iv3d_t) = 'T   '
! element(iv3d_s) = 'S   '               !(OCEAN)
! element(nv3d+iv2d_ssh) = 'SSH '        !(OCEAN)
! element(nv3d+iv2d_sst) = 'SST '        !(OCEAN)
! element(nv3d+iv2d_sss) = 'SSS '        !(OCEAN)
! if (DO_ALTIMETRY) then
!   element(nv3d+iv2d_eta) = 'eta '      !(OCEAN)
! endif
! if (DO_MLD) then
!   element(nv3d+iv2d_mld) = 'mld'       !(OCEAN)
! endif
! if (DO_DRIFTERS) then
!   element(nv3d+nv2d+iv4d_x) = 'X   '             !(OCEAN) (DRIFTERS)
!   element(nv3d+nv2d+iv4d_y) = 'Y   '             !(OCEAN) (DRIFTERS)
!   element(nv3d+nv2d+iv4d_z) = 'Z   '             !(OCEAN) (DRIFTERS)
! endif

  ! In place of GFDL grid_spec.nc data file (e.g. as used for MOM6), used to define the model grid
  CHARACTER(8)  :: gridfile_lon  = 'glon.dat'
  CHARACTER(8)  :: gridfile_lat  = 'glat.dat'
  CHARACTER(8)  :: gridfile_lev  = 'glev.dat'
  CHARACTER(8)  :: gridfile_kmt  = 'kmt.dat'

  CHARACTER(14)   :: SSHclm_file = 'aEtaCds9399.nc'  ! Used for MOM4p1 GODAS (HYCOM n/a)
  CHARACTER(slen) :: rsrt_tbase = 't.dat'
  CHARACTER(slen) :: rsrt_sbase = 's.dat'
  CHARACTER(slen) :: rsrt_ubase = 'u.dat'
  CHARACTER(slen) :: rsrt_vbase = 'v.dat'
  CHARACTER(slen) :: rsrt_sshbase  = 'ssh.dat'

  ! Bounds checking (for output by common_hycom.f90::write_restart)
  LOGICAL :: do_physlimit=.true.
  REAL(r_size) :: max_t = 50.0d0 ! degC
  REAL(r_size) :: min_t = -4.0d0 ! degC
  REAL(r_size) :: max_s = 50.0d0 ! psu
  REAL(r_size) :: min_s =  0.0d0 ! psu
  REAL(r_size) :: max_uv = 10.0 ! m/s
  REAL(r_size) :: min_uv =  -10.0d0 ! m/s
  REAL(r_size) :: max_h = 1000.0d0 !m
  REAL(r_size) :: min_h =  -1000.0d0 !m
  REAL(r_size) :: max_ssh = 100.0d0 !m
  REAL(r_size) :: min_ssh = -100.0d0 !m

  !STEVE: for filtering undef values from netcdf file
  REAL(r_size), PARAMETER :: ncundef = 1.267650600228229E+030 !1.0e18

  LOGICAL,SAVE :: params_model_initialized = .false.

  ! Write only the subgrid tile instead of updating the full global grid
  ! analysis file
  LOGICAL :: DO_WRITE_TILE = .true.
  INTEGER :: reclen_mult = 4

  !-----------------------------------------------------------------------------
  ! Not used for NRL NCODA-HYCOM version:
  !-----------------------------------------------------------------------------
  CHARACTER(slen) :: sample_file_a = 'hycom_sample.a'
  CHARACTER(slen) :: sample_file_b = 'hycom_sample.b'
  CHARACTER(slen) :: grid_file_a   = 'regional.grid.a'
  CHARACTER(slen) :: grid_file_b   = 'regional.grid.b' !(n/a)

  !For input/output of model binary files (converted form HYCOM ab-format):
  CHARACTER(8) :: base  = '.fsd.bin' ! (HYCOM)(All variables assembled in one binary file)
  CHARACTER(2) :: base_a  = '.a'     ! (HYCOM)(All variables assembled in one file)
  CHARACTER(2) :: base_b  = '.b'     ! (HYCOM)(All variables assembled in one file)

  !model input and output file direct/sequential
  INTEGER, PARAMETER :: hycom_io_access = 1  ! 0 == direct, 1 == sequential

CONTAINS

SUBROUTINE initialize_params_model

  IMPLICIT NONE

  if (params_model_initialized) then
    WRITE(6,*) "initialize_params_model:: already initialized, RETURNING..."
    RETURN
  endif

  nij0=nlon*nlat
  nlevall=nlev*nv3d+nv2d
  ngpv=nij0*nlevall

  params_model_initialized = .true.

END SUBROUTINE initialize_params_model

END MODULE params_model