program sedrblock
c
c This routine reblocks binary FTP'd Voyager SEDR files written in 
c IBM System 370 format to restore the original record structure.
c
c Navigation and pointing vector blocks are separated into individual
c records.  Null pointing vector blocks are eliminated.
c
c Conversion of binary data to the VMS representation is performed by
c a separate routine to be called after reblocking.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c The SEDR file consists of a series of logical records.  Each logical
c record contains one navigation block and all pointing vector blocks
c associated with it.  Each pointing vector block consists of 126 bytes.
c Navigation blocks associated with the Jupiter, Uranus and Neptune
c encounters have lengths of 252 bytes.  All other navigation blocks
c are 126 bytes in length.
c
c A navigation block may be followed by on one more pointing vector
c records.  Word 101 of a pointing vector block contains a flag
c indicating the occurance of another pointing vector block.  This
c flag may have a value of either zero or one.  A null (zero) value 
c denotes the last pointing vector block of the logical record.  A 
c value of one indicates another pointing vector block follows.  If
c word 101 contains a value other than zero or one, it may be assumed
c that this is a navigation block.  The last pointing vector block of 
c a logical record may be followed by a zero filled logical block 
c (126 bytes).
c
c Notes:
c
c Data recovery operations on the mission's legacy IBM system introduced
c 126 byte block(s) of null data between both navigation and pointing
c vector blocks.  The reblocking algorithm removes this fill data.
c
c This program assumes input of a 512 byte fixed length record binary
c file on a DEC VMS platform.  Adjustments will be necessary to run
c this program on a different platform.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Written by Sandy Kramer, HSTX, code 692, NASA GSFC, 09/11/96
c
      parameter (lrecl=512)
      character chdr(45)*4,dsn1*50,dsn2*50
      integer*4 ihdr(45),pvlen,time(6)
      logical*1 navrec,fill
      logical*4 lrec(128),lnav(252),lpv(126),lhdr(45)
c
      equivalence ( lpv(1), lnav(1) )
c
      include '($iodef)'  ! VMS i/o conversion routines
c
c open spanned binary input file of IBM 370 format data
c
      write(6,*) '   Enter dsn'
      read(5,'(a)') dsn1
      write(6,*) dsn1
      open(10,file=dsn1,form='unformatted',status='old',
     &     convert='ibm',readonly)
c
c read header record and first 83 words of navigation record 1
c
      read(10,end=900) chdr(1),chdr(2),ihdr(3),chdr(4),chdr(5),ihdr(6),
     &                 ihdr(7),chdr(8),chdr(9),ihdr(10),ihdr(11),
     &                 (chdr(i),i=12,27),(ihdr(i),i=28,45),
     &                 (lnav(i),i=1,83)
c
      istat = lib$tra_ebc_asc(chdr(1),chdr(1))  ! EBCDIC to ASCII
      istat = lib$tra_ebc_asc(chdr(2),chdr(2))  ! EBCDIC to ASCII
      istat = lib$tra_ebc_asc(chdr(4),chdr(4))  ! EBCDIC to ASCII
      istat = lib$tra_ebc_asc(chdr(5),chdr(5))  ! EBCDIC to ASCII
      istat = lib$tra_ebc_asc(chdr(8),chdr(8))  ! EBCDIC to ASCII
      istat = lib$tra_ebc_asc(chdr(9),chdr(9))  ! EBCDIC to ASCII
      do i = 12,27
       istat = lib$tra_ebc_asc(chdr(i),chdr(i)) ! EBCDIC to ASCII
      end do
c
c display header record with character and integer conversion to VAX
c
      write(6,*) chdr(1),chdr(2),ihdr(3),chdr(4),chdr(5),ihdr(6),
     &           ihdr(7),chdr(8),chdr(9),ihdr(10),ihdr(11),
     &           (chdr(i),i=12,27),(ihdr(i),i=28,45)  ! header rec
c
c determine navigation record length 126 or 252 words (504 or 1008 bytes) 
c from header info.
c
      if ( chdr(14).eq.'LAUN' .or.
     &     chdr(14).eq.'CRUI' .or.
     &     chdr(14).eq.'SATU' .or.
     &     chdr(14).eq.'XCRU' ) then
       navlen = 126
      else if ( chdr(14).eq.'JUPI' .or.
     &          chdr(14).eq.'URAN' .or.
     &          chdr(14).eq.'NEPT' ) then
       navlen = 252
      else
       write(6,*)
       write(6,*) 'Invalid SEDR type!'
       write(6,*)
       stop
      end if
      write(6,*)
      write(6,*) 'SEDR NAV data block id: ',chdr(14),chdr(15)
c
c all pointing vector records are 126 words (504 bytes) in length.
c
      pvlen = 126
      close(10)
c
c open output file of variable length IBM 370 binary records
c
      write(6,*) '   Enter dsn'
      read(5,'(a)') dsn2
      write(6,*) dsn2
      open(11,file=dsn2,form='unformatted',status='new',
     &     recordtype='variable',recl=8191)
c
c open spanned binary input file of IBM 370 format data without conversion 
c
      open(10,file=dsn1,form='unformatted',status='old',readonly)
      read(10,end=900) (lhdr(i),i=1,45),(lnav(i),i=1,83)  
c
c output header record
c
      write(11) (lhdr(i),i=1,45)
c
c read spanned navigation and pointing vector records
c
      iword = 84
      navrec = .true.
      fill = .false.
   10 continue
       read(10,end=900) (lrec(i),i=1,128)
       do i = 1,128

        if ( navrec ) then  ! NAV rec

   20    continue
         if ( iword.le.navlen ) then
          lnav(iword) = lrec(i)  ! load navigation record array
          iword = iword + 1
         else               ! write navigation record array
          nextpv = i4(lnav(101)) ! confirm not a PV record
          iyear = i4(lnav(1))    ! check year is valid
          if ( iyear.ne.0 ) then
           call vmstime(lnav,time)
           write(6,887) nextpv,time
           write(11) (lnav(j),j=1,navlen)
           navrec = .false.
          else
c           write(6,*) 'Null NAV record!'
           navrec = .false.
          end if
          lpv(1) = lrec(i) ! load first pv word
          iword = 2
         end if

        else                ! PV rec

   50    continue
         if ( iword.le.pvlen ) then

          lpv(iword) = lrec(i)  ! load pointing vector array
          iword = iword + 1

         else

          nextpv = i4(lpv(101)) ! PV continuation bit
          if ( nextpv.ne.0 .and. nextpv.ne.1 ) then
           navrec = .true.
           goto 20
          end if
          iyear = i4(lpv(1))    ! check year of current record
          if ( iyear.ne.0 ) then
           call vmstime(lpv,time)         
           write(6,888) nextpv,time
           write(11) (lpv(j),j=1,pvlen)  ! write pointing vector array
          else
c           write(6,*) 'Null PV record!'
           iword = 1
           goto 50
          end if

          if ( nextpv.eq.0 ) then  ! next block is nav
           navrec = .true.
           lnav(1) = lrec(i)
          else if ( nextpv.eq.1 ) then  ! another pv block follows
           navrec = .false.
           lpv(1) = lrec(i)
          else
           write(6,*) 'PV continuation bit error!'
           stop
          end if
          iword = 2

         end if
        end if
       end do
      goto 10
c
  900 continue
      stop
  800 format(1x,i4,1x,i3.3,3(1x,i2.2),1x,i3.3,1x,e10.4)
  887 format(1x,'NAV info: ',i11,3x,6i5)
  888 format(1x,'PV info: ',i11,3x,6i5)
      end
      function i4(in)
c
c This function will perform the necessary bit manipulation on
c integer*4 data that was originally IBM 370 binary format and
c is being translated to DEC binary format.
c
      integer*4 in,i4
      i4 = ishftc(in,8,16)
      i4 = ishftc(i4,16,32)
      i4 = ishftc(i4,8,16)
      return
      end
      subroutine vmstime(lnav,time)
c
c Convert IBM integer time tag to VMS integer format.
c
      integer*4 time(6)
      logical*4 lnav(126)
      time(1) = i4(lnav(1))
      time(2) = i4(lnav(2))
      time(3) = i4(lnav(3))
      time(4) = i4(lnav(4))
      time(5) = i4(lnav(5))
      time(6) = i4(lnav(6))
      return
      end