C Program reformats Voyager Saturn medium bandwidth data for use in quick-look
C and other processing.  Major functions are:
C         converts 8-bit samples in 5056-byte records to
C                 16-bit samples in 1024-byte records (standard PREP format)
C         corrects for missing/gained samples (optional)
C         generates PREP-style header for output file

C This program is the 1998/1999 equivalent of PREP80

C NB: This program only adjusts for missing/gained samples based on the sample
C     count at an even second.  The sample count was not reliable at other
C     times.  Because some files include pathological sample counts, the option
C     -s was added to allow processing without correcting for gained/lost samples.

C Usage
C -----
C           prep_11_6 labelfile tref [-s]
C  where
C                labelfile is the name of the PDS label file (must be in
C                              directory where program is run)
C                tref      is reference time for positioning samples
C                              (often taken to be 0. if no midnight crossing)
C                -s        enables missing/gained sample adjustment; if option
C                              is not included on command line, program ignores
C                              sample counts and processes data as though no
C                              samples were gained/lost

C Input/Output Files
C ------------------
C   There are two input files and two output files
C
C       Logical Unit  Description
C       ------------  -----------
C             31      input PDS label file (specified on command line)
C             32      input RSC-11-6 data file (name read from label file)
C             16      output log file (prep_11_6.log)
C             36      output PREP-format data file (name ydddhhmm.dPc
C                        constructed from inputs:
C                            ydddhhmm      same as input RSC-11-6 file
C                            d             first digit of DSN antenna number
C                            c             channel number + 1 from header

C Exits
C -----
C          0    normal return
C          1    usage problem; wrong number of arguments
C          2    error attempting to open labelfile
C          3    unable to find ^TABLE pointer at top of label file
C          4    unable to find START_TIME at top of label file
C          5    unable to find DSN_STATION_NUMBER at top of label file
C          6    unexpected frequency band in setting  ft
C          7    error attempting to open datafile
C         10    TREF is later than TNOM
C         20    error attempting to read input data record

C Output Header Record
C --------------------
C  The output header record is a mix of character, integer, and floating point
C  values.  Assignment of the first 280 bytes is as follows (remaining bytes
C  are undefined):
C
C    Word Number   Bytes   Mnemonic  Format          Description
C  (32-bit words)
C  -------------- ------- ---------- ------ ---------------------------------
C       01-03     001-012 date_exp  3i*4  date of experiment (YYYY-MM-DD)
C       04-06     013-024 time_exp  3i*4  time of experiment (hh:mm:ss)
C       07-11     025-044 filein    c*20  input file name
C         12      045-048 fea       i*4   DSN antenna number
C         13      049-052 band      c*4   frequency band (S or X)
C         14      053-056 poln      c*4   polarization (R or L)
C       15-16     057-064 ft        r*8   transmit frequency
C       17-20     065-080 program   c*16  program name (PREP_11_6)
C       21-24     081-096 version   c*16  program version
C       25-27     097-108 date_prep 3i*4  date of PREP_11_6 run (YYYY-MM-DD)
C       28-30     109-120 time_prep 3i*4  time of PREP_11_6 run (hh:mm:ss)
C       31-32     121-128 tref      r*8   reference time (sec from 0h)
C       33-34     129-136 tnom      r*8   nominal start time (sec from 0h)
C       35-36     137-144 tfirst    r*8   time of first record (sec from 0h)
C       37-38     145-152 tlast     r*8   time of last rec (sec from 0h)
C       39-40     153-160 dt        r*8   sample spacing (sec)
C         41      161-164 issmpr    i*4   record with 1st valid sample
C         42      165-168 issmps    i*4   index of 1st valid sample
C         43      169-172 iesmpr    i*4   record with last valid sample
C         44      173-176 iesmps    i*4   index of last valid sample
C         45      177-180 irecl     i*4   output record length (1024)
C         46      181-184 nbits     i*4   output bits per sample (16)
C       47-50     185-200 cc        4i*4  condition codes (not used)
C       51-70     201-280 comment   c*80  comment (optional)

      integer*4      channel_no    ! channel number from header + 1
      character*12   datafile      ! name of data file
      integer*4      date_prep(3)  ! date of program execution (DD-MM-YYYY)
      integer*4      ddd           ! most recent valid time tag (day)
      integer*4      dec_ratio     ! decimation ratio (from word 26, bits 14-16)
      character*1    dquote        ! ASCII double quote
      integer*4      dslip         ! slip adjustment (>0 more samples lost)
      real*8         dt            ! sample spacing (sec)
      character*1    equals        ! ASCII equals sign
      real*8         ft            ! transmit frequency (approx; Hz)
      integer*4      harray(42)    ! array of unpacked header values
      integer*4      hdata(256)    ! output header record
      integer*4      hh            ! most recent valid time tag (hour)
      integer*4      i             ! miscellaneous index
      integer*4      iarray(1264)  ! input array (one RSC-11-6 record)
      character*12   labelfile     ! name of PDS label file
      integer*4      ier           ! error return from library function
      integer*4      iesmpr        ! output record number of last valid sample
      integer*4      iesmps        ! index of last valid sample
      integer*4      iptr          ! pointer in input record
      integer*4      iptrb         ! input pointer with header offset
      integer*4      irec          ! input record number
      integer*4      islip         ! new sample slip count
      integer*4      islip0        ! current sample slip count
      integer*4      issmpr        ! output sample position (record)
      integer*4      issmps        ! output sample position (sample number)
      integer*4      i1            ! string pointer (start)
      integer*4      i2            ! string pointer (end)
      integer*4      mm            ! most recent valid time tag (minute)
      integer*4      msec          ! most recent valid time tag (microsec)
      integer*4      n             ! smaller of  nin  and  nout
      integer*4      narg          ! number of command line arguments
      integer*4      nin           ! number of input samples available
      integer*4      nout          ! number of output records slots open
      integer*4      odata(256)    ! output data record
      integer*4      optr          ! output sample pointer
      integer*4      orec          ! output record number
      character*12   outfile       ! name of file with 16-bit output samples
      character*16   program       ! program name
      real*8         samp          ! sample offset from tref
      integer*4      slipflag      ! 1 = handle slipped samples; 0 = ignore
      integer*4      spc           ! first digit of DSN antenna number
      integer*4      ss            ! most recent valid time tag (second)
      character*19   start_time    ! start time from PDS label
      character*80   string        ! miscellaneous string
      integer*4      tape          ! odr tape number
      real*8         tfirst        ! record #1 start time
      integer*4      time_prep(3)  ! time of program execution (hh:mm:ss)
      character*19   time_tag      ! most recent valid time tag
      real*8         tlast         ! last record start time
      real*8         tnom          ! nominal sample start time (secs)
      real*8         tref          ! reference time (secs)
      character*16   version       ! version of program
      integer*4      yyyy          ! year of experiment

      integer*4      iargc         ! function
      integer*4      slip          ! function
      integer*4      unlink        ! function

      equivalence  ( hdata(15), ft )
      equivalence  ( hdata(31), tref )
      equivalence  ( hdata(33), tnom )
      equivalence  ( hdata(35), tfirst )
      equivalence  ( hdata(37), tlast )
      equivalence  ( hdata(39), dt )
      equivalence  ( hdata(41), issmpr )
      equivalence  ( hdata(42), issmps )
      equivalence  ( hdata(43), iesmpr )
      equivalence  ( hdata(44), iesmps )


C Initializations

      call idate(date_prep)
      call itime(time_prep)

      dquote = char(34)
      equals = char(61)

      hdata(45) = 1024
      hdata(46) = 8

      program = "PREP_11_6       "
      version = "16-AUG-99       "

      ier = unlink('prep_11_6.log')

      open (unit = 16,
     *      file = 'prep_11_6.log',
     *      status = 'unknown')

      write(*,'("PROGRAM    ",a16,/,"VERSION    ",a16,/,
     *           "THIS RUN:   DATE   ",i4.4,2("-",i2.2),/,
     *           "            TIME   ",i4.2,2(":",i2.2))')
     *     program,version,(date_prep(4-i),i=1,3),time_prep

      write(16,'("PROGRAM    ",a16,/,"VERSION    ",a16,/,
     *           "THIS RUN:   DATE   ",i4.4,2("-",i2.2),/,
     *           "            TIME   ",i4.2,2(":",i2.2))')
     *     program,version,(date_prep(4-i),i=1,3),time_prep



C Get and process arguments; open label file

      narg = iargc()
      if ((narg .lt. 2) .or. (narg .gt. 3)) then
        write(*,'("USAGE:  prep_11_6  labelfile tref [-s]")')
        call exit (1)
      end if

      call getarg(1,labelfile)
      call getarg(2,string)
      read(string,*) tref

      slipflag = 0
      if (narg. eq. 3 ) then
        call getarg(3,string)
        if (string(01:02) .eq. '-s') then
          slipflag = 1
        else
          write(*,'("USAGE:  prep_11_6  labelfile tref [-s]")')
          call exit (1)
        end if
      end if

      open ( unit = 31,
     *       file = labelfile,
     *       err = 10,
     *       status = 'old')
      go to 12

 10   continue
      write(*,'("Error attempting to open ",a12)') labelfile
      call exit(2)

 12   continue


C Get data file name

      irec = 0
 20   continue
      irec = irec + 1
      read(31,'(a)') string
      if (string(01:10) .eq. "PRODUCT_ID") then
        i1 = index(string,dquote) + 1
        i2 = i1 + 11
        datafile(01:12) = string(i1:i2)
        go to 22
      else
        if (irec .le. 21) then
          go to 20
        else
          write(*,'("Unable to find PRODUCT_ID in first ",
     *              "21 lines of ",a12)') labelfile
          call exit(3)
        end if
      end if

 22   continue
      rewind (31)
C      write(*,*) datafile


C Get nominal start time

      irec = 0
 30   continue
      irec = irec + 1
      read(31,'(a)') string
      if (string(01:10) .eq. "START_TIME") then
        i1 = index(string,equals) + 2
        i2 = i1 + 18
        start_time(01:19) = string(i1:i2)
        read(start_time(01:04),'(i4)') yyyy
        go to 32
      else
        if (irec .le. 25) then
          go to 30
        else
          write(*,'("Unable to find START_TIME in first ",
     *              "25 lines of ",a12)') labelfile
          call exit(4)
        end if
      end if

  32  continue
      rewind (31)
      read(start_time,'(i4,5(1x,i2))') (hdata(i),i=1,6)
      tnom = 3.6d+03*hdata(4) + 6.0d+01*hdata(5) + 1.0d+00*hdata(6)
C      write(*,*) start_time,tnom


C Get DSN station number

      irec = 0
 40   continue
      irec = irec + 1
      read(31,'(a)') string
      if (string(01:18) .eq. "DSN_STATION_NUMBER") then
        i1 = index(string,equals) + 2
        i2 = i1 + 1
        read(string(i1:i2),'(i2)') hdata(12)
        spc = hdata(12)/10
        go to 42
      else
        if (irec .le. 25) then
          go to 40
        else
          write(*,'("Unable to find DSN_STATION_NUMBER in first ",
     *              "25 lines of ",a12)') labelfile
          call exit(5)
        end if
      end if

 42   continue
      rewind 31


C Open data file

 100  continue
      open ( unit = 32,
     *       file = datafile,
     *       err = 102,
     *       access = 'direct',
     *       form = 'unformatted',
     *       recl = 5056,
     *       status = 'old')
      go to 110

 102  continue
      write(*,'("Error attempting to open ",a12)') datafile
      call exit(7)

 110  continue


C Read enough records to get initial values from header
C Use tape number to set up the band, polarization,
C and channel_no.  XR 1, SR 2, XL 3, XR 4

      read(datafile(03:06),'(i4)') tape

      if ( ( (tape .ge. 6281) .and. (tape .le. 6291) ) .or.
     *     ( (tape .ge. 6325) .and. (tape .le. 6333) ) .or.
     *     ( (tape .ge. 6361) .and. (tape .le. 6365) ) .or.
     *     ( (tape .ge. 6589) .and. (tape .le. 6594) ) .or.
     *     ( (tape .ge. 6185) .and. (tape .le. 6196) ) .or.
     *     ( (tape .ge. 6001) .and. (tape .le. 6011) ) .or.
     *     ( (tape .ge. 6381) .and. (tape .le. 6391) ) .or.
     *     ( (tape .ge. 6469) .and. (tape .le. 6473) ) .or.
     *     ( (tape .ge. 6612) .and. (tape .le. 6616) ) .or.
     *     ( (tape .ge. 6089) .and. (tape .le. 6100) ) .or.
     *     ( (tape .ge. 6509) .and. (tape .le. 6513) ) .or.
     *     ( (tape .ge. 6549) .and. (tape .le. 6553) ) ) then
        hdata(13) = "S   "
        hdata(14) = "R   "
        ft = 2.296481035d+09
        channel_no = 2
      else if ( ( (tape .ge. 6197) .and. (tape .le. 6208) ) .or.
     *     ( (tape .ge. 6012) .and. (tape .le. 6022) ) .or.
     *     ( (tape .ge. 6392) .and. (tape .le. 6402) ) .or.
     *     ( (tape .ge. 6474) .and. (tape .le. 6478) ) .or.
     *     ( (tape .ge. 6617) .and. (tape .le. 6621) ) .or.
     *     ( (tape .ge. 6101) .and. (tape .le. 6112) ) .or.
     *     ( (tape .ge. 6514) .and. (tape .le. 6518) ) .or.
     *     ( (tape .ge. 6554) .and. (tape .le. 6558) ) ) then
        hdata(13) = "S  "
        hdata(14) = "L  "
        ft = 2.296481035d+09
        channel_no = 4
      else if ( ( (tape .ge. 6292) .and. (tape .le. 6324) ) .or.
     *     ( (tape .ge. 6334) .and. (tape .le. 6360) ) .or.
     *     ( (tape .ge. 6366) .and. (tape .le. 6380) ) .or.
     *     ( (tape .ge. 6595) .and. (tape .le. 6611) ) .or.
     *     ( (tape .ge. 6209) .and. (tape .le. 6244) ) .or.
     *     ( (tape .ge. 6023) .and. (tape .le. 6055) ) .or.
     *     ( (tape .ge. 6403) .and. (tape .le. 6435) ) .or.
     *     ( (tape .ge. 6479) .and. (tape .le. 6493) ) .or.
     *     ( (tape .ge. 6622) .and. (tape .le. 6636) ) .or.
     *     ( (tape .ge. 6113) .and. (tape .le. 6148) ) .or.
     *     ( (tape .ge. 6519) .and. (tape .le. 6553) ) .or.
     *     ( (tape .ge. 6559) .and. (tape .le. 6573) ) ) then
        hdata(13) = "X   "
        hdata(14) = "R   "
        ft = (11.0d+00/3.0d+00)*2.296481035d+09
        channel_no = 1
      else if ( ( (tape .ge. 6245) .and. (tape .le. 6280) ) .or.
     *     ( (tape .ge. 6056) .and. (tape .le. 6088) ) .or.
     *     ( (tape .ge. 6436) .and. (tape .le. 6468) ) .or.
     *     ( (tape .ge. 6494) .and. (tape .le. 6508) ) .or.
     *     ( (tape .ge. 6637) .and. (tape .le. 6651) ) .or.
     *     ( (tape .ge. 6149) .and. (tape .le. 6184) ) .or.
     *     ( (tape .ge. 6534) .and. (tape .le. 6548) ) .or.
     *     ( (tape .ge. 6574) .and. (tape .le. 6588) ) ) then
        hdata(13) = "X  "
        hdata(14) = "L  "
        ft = (11.0d+00/3.0d+00)*2.296481035d+09
        channel_no = 3
      else
        write(*,'("Unexpected tape number ",a4)') datafile(03:06)
        call exit(6)
      end if

      irec = 0
 120  continue
      irec = irec + 1
      read(32,rec=irec,err=900) iarray
      call get_hdr(iarray,harray)
      if ((harray(1) .eq. 1) .and. (harray(4).eq.1)) then
         dec_ratio  = 8 - harray(41)             ! DRA decimation ratio
         dt         = 1.0d+00*dec_ratio/3.0d+05  ! sample spacing (sec)
         islip0     = 0
         if (slipflag .eq. 1) then
           islip0     = slip(harray)             ! initial sample slip
         end if
         go to 130
      else
         write(*,'("*** First time tag and first sample count ",
     *             "NOT from first record ***")')
         go to 120
      end if

 130  continue

      samp = 3.0d+05*(tnom - tref)/dec_ratio    ! nominal samples since  tref

      if (samp. lt. 0.) then
        write(*,'("TREF is later than TNOM:",/,
     *            "  TREF = ",f15.6," sec",/,
     *            "  TNOM = ",f15.6," sec")') tref,tnom
        call exit(10)
      else
        orec   = 1                              ! output record count
        samp   = dmod(samp+0.5d+00,5.12d+02)
        optr   = int(samp)                      ! output sample pointer (0,1,2,...)
        tfirst = tnom - dt*optr                 ! record #1 start time
      end if

      optr = optr + islip0                      ! correct for initial sample slip
 132  continue
      if (optr .lt. 0) then
        optr   = optr + 512
        tfirst = tfirst - 512*dt
        go to 132
      end if
 134  continue
      if (optr .gt. 511) then
        optr   = optr - 512
        tfirst = tfirst + 512*dt
        go to 134
      end if

      issmpr = orec + 1                         ! start sample position (record)
      issmps = optr + 1                         ! start sample position (sample #)

      write(16,'(a19,"  INITIAL SAMPLE SLIP",i12)')
     *     start_time,islip0

C      write(*,*) orec,samp,optr,dt,tfirst,issmpr,issmps,islip0
      if (slipflag .eq. 0) then
        write(16,'("*** IGNORING SAMPLE SLIPS: INITIAL SLIP SET",
     *             " to 0 ***")')
      end if


C Rewind input file; initialize for bulk processing, open output file

      rewind 32
      irec = 0
      iptr = 0

      outfile(01:09) = datafile(01:09)
      write(outfile(10:12),'(i1,"P",i1)') spc,channel_no

      ier = unlink(outfile)

      open ( unit   = 36,
     *       file   = outfile,
     *       access = 'direct',
     *       form   = 'unformatted',
     *       recl   = 1024,
     *       status = 'unknown')

      go to 160


C Enter loop for bulk processing of data records

 140  continue

      if (iptr .lt. 5000) then
        go to 500                               ! all input samples transferred?
      else
        iptr = iptr - 5000
      end if

 160  continue                                  ! read in a new input record
      irec = irec + 1
      if (mod(irec,1000) .eq. 0)
     *     write(*,'("Reading input record ",i5)') irec
      read(32,rec=irec,err=900,end=910) iarray

      call get_hdr(iarray,harray)               ! get new header

      if (harray(1) .eq. 1) then                ! check and update time tag
        ddd = 100*harray(12) + 10*harray(13) + harray(14)
        hh = 10*harray(15) + harray(16)
        mm = 10*harray(17) + harray(18)
        ss = 10*harray(19) + harray(20)
        msec = harray(21)
        if (msec .gt. 500000) ss = ss + 1
        call dtcvt(yyyy,ddd,hh,mm,ss,time_tag)
      end if

      if ((harray(1) .eq. 1) .and. (harray(4) .eq. 1)) then  ! check and update sample count
        if (slipflag .eq. 1) then
          islip = slip(harray)
        else
          islip = 0
        end if
        if (islip .ne. islip0) then
          dslip = islip - islip0
          optr = optr + dslip                   ! simple case: adjust output pointer
          write(16,'(a19,"  Sample slip adjust:",i12)') time_tag,dslip
          islip0 = islip
          if (optr .ge. 512) go to 520
          if (optr .lt. 0) then                 ! hard case: adjust both
            iptr = iptr - optr
            optr = 0
            go to 140
          end if
        end if
      end if

 500  continue
      nout = 512 - optr                         ! number of output slots available
      nin = 5000 - iptr                         ! number of input samples waiting
      n = min0(nout,nin)                        ! pick the smaller

      iptrb = iptr + 56                         ! pointer includes header offset

      call xfer_11_6(iarray,iptrb,odata,optr,n) ! transfer  n  samples

      iptr = iptr + n                           ! update input pointer
      optr = optr + n                           ! update output pointer

 520  continue

      if (optr .ge. 512) then                   ! if output record is full,
        orec = orec + 1                         !    increment record counter
        write(36,rec=orec) odata                !    write the output record
        optr = optr - 512                       !    reset the sample pointer
        go to 520
      end if

      go to 140                                 ! go back for more

 900  continue
      write(*,'("Error attempting to read input record  irec =",i10)') irec
      call exit(20)

 910  continue
      irec = irec - 1
      write(*,'("EOF on input file after  irec = ",i6)') irec
      tlast = tfirst + 512*dt*(orec - 1)
      iesmpr = orec + 1
      iesmps = optr

      orec = orec + 1                           ! write last data record
      write(36,rec=orec) odata


C Assemble some final information into the header record; write it

      read(datafile,'(3a4)') (hdata(i),i=7,9)
      hdata(10) = "    "
      hdata(11) = "    "

      read(program,'(4a4)') (hdata(i),i=17,20)
      read(version,'(4a4)') (hdata(i),i=21,24)

      do i = 1,3
        hdata(i+27) = time_prep(i)
        hdata(28-i) = date_prep(i)
      end do

      do i = 51,70
        hdata(i) = "    "
      end do

      orec = 1
      write(36,rec=orec) hdata


C Write to the log file

      write(16,'("INPUT FILE                          ",a12,/,
     *           "DATA FROM                           DSS",i3,/,
     *           "FREQUENCY                           ",a1,"-BAND",/,
     *           "POLARIZATION                        ",a1,"CP")')
     *    datafile,hdata(12),hdata(13),hdata(14)

      write(16,'("REFERENCE START TIME FOR PROCESSING   TREF   =",
     *     0p1f13.6," SECS",/,
     *           "FIRST OUTPUT RECORD STARTS AT         TFIRST =",
     *     0p1f13.6, " SECS",/,
     *           "SAMPLE SPACING (PERIOD)               DT     =",
     *     0p1f13.6," SECS",/,
     *           "LAST OUTPUT RECORD STARTS AT          TLAST  =",
     *     0p1f13.6," SECS")')
     *          tref,tfirst,dt,tlast
      write(16,'("OUTPUT FILE                         ",a12,/,
     *           "OUTPUT RECORD SIZE         = ",i6," BYTES",/,
     *           "BITS PER SAMPLE            = ",i6,/,
     *           "FIRST VALID OUTPUT SAMPLE AT RECORD  ",i8,5x,
     *           " SAMPLE ",i5)')
     *          outfile,hdata(45),hdata(46),issmpr,issmps
      write(16,'("LAST VALID OUTPUT SAMPLE AT RECORD   ",i8,5x,
     *           " SAMPLE ",i5,/,
     *           "TOTAL NUMBER OF RECORDS READ       ",i8)')
     *           iesmpr,iesmps,irec

      stop
      end
