C Program

      double precision   const(11)     !body parameters
      integer*4          day           !2-digit day
      integer*4          doy           !3-digit day-of-year
      double precision   etmutc        !ET minus UTC
      character*80       infile        !binary CRS file name (from command line)
      integer*4          gredat1       !vigesimal gregorian date (part 1)
      integer*4          gredat2       !vigesimal gregorian date (part 2)
      integer*4          hh            !2-digit hour
      integer*4          i             !miscellaneous index
      integer*2          iarray2(189)
      integer*2          iarrayx(063)
      integer*2          iarrayy(063)
      integer*2          iarrayz(063)
      integer*4          iarray4(095)
      integer*4          ierr          !status return from stat
      integer*4          irec          !state vector block count
      integer*4          iword         !adjusted word pointer
      integer*4          iword0        !first word pointer
      integer*4          iwordn        !last word pointer
      integer*4          ibyte
      double precision   juldat        !Julian date
      integer*4          jword0        !word pointer
      integer*4          mm            !2-digit minute
      integer*4          mode          !mode for doy_mmdd
      integer*4          mon           !2-digit month
      integer*4          n
      character*6        name(10)      !names of up to 10 bodies
      integer*4          narg          !number of command line arguments
      integer*4          nbodl         !number of bodies in the file
      integer*4          nrec          !number of state vector sets
      integer*4          nwrds         !number of words in univac record
      integer*4          pgm_status    !program exit status (normal = 0)
      integer*4          scid          !spacecraft ID number
      double precision   sp1950        !seconds since 1950
      real*4             ss            !2-digit seconds plus 4 decimal places
      integer*4          statb(13)     !file status array
      double precision   state(10,6)   !position/velocity vecotr for 10 bodies
      integer*4          status        !return status from doy_mmdd
      character*72       string
      integer*4          yyyy          !4-digit year

      integer*4          iargc         !library function
      integer*4          stat          !library function
      character*1        uni2ascii     !character function
      double precision   uni2ieee_dp   !double precision function
      integer*4          uni2ieee_int  !integer function

      equivalence      ( iarray2(001), iarray4(1) , iarrayx(1) )
      equivalence      ( iarray2(064), iarrayy(1) )
      equivalence      ( iarray2(127), iarrayz(1) )


C Initializations

      pgm_status = 0
      do i = 1,11
         const(i) = 0.0
      end do


C Get and process command line arguments

      narg = iargc()
      if (narg .ne. 1) then
        write(*,'("USAGE: crs2asc infile")')
        pgm_status = 1
        go to 99
      end if

      call getarg(1,infile)

      write(*,'("Begin program CRS2ASC -- ",
     *          "Converts Univac binary CRS file to ASCII",/,
     *          "Program by Dick Simpson - Version of 28 July 1998",/,
     *          "Input file: ",(a),/,
     *          "Output file: crs2asc.out")') infile(01:50)

      ierr = stat(infile,statb)
      nrec = (statb(8) - 126)/378 - 1


C Open input binary data file and output ASCII data file

      open ( unit = 31,
     *       file = infile,
     *       access = 'direct',
     *       form = 'unformatted',
     *       recl = 126,
     *       status = 'old')

      open ( unit = 32,
     *       file = 'crs2asc.out',
     *       status = 'unknown')


C First Univac record

      read (31,rec=1) iarrayx
      read (31,rec=2) iarrayy
      read (31,rec=3) iarrayz


C      write(*,'(10z5.4)') iarray2

      iword = 1
      nwrds = uni2ieee_int(iarray4, iword)
      write(*,'("NWRDS = ",i10)') nwrds

      do jword0 = 1,62,12
        if (jword0 .eq. 1) then
          iword0 = 2
        else
          iword0 = jword0
        end if
        iwordn = jword0 + 11
        if (iwordn .eq. 72) iwordn = 62

        do iword = iword0,iwordn
          do ibyte = 0,5
            n = mod(6*(iword-iword0)+ibyte,72)+1
            string(n:n) = uni2ascii(iarray4,iword,ibyte)
          end do
        end do
        write(*,'(a)') string(01:6*(iwordn-iword0))
      end do


C Second Univac record

      read (31,rec=4) iarrayx

      iword = 1
      nbodl = uni2ieee_int(iarray4, iword)
      write(*,'("NBODL = ",i10)') nbodl

      do iword = 2,nbodl+1
        do ibyte = 0,5
          n = ibyte + 1
          name(iword-1)(n:n) = uni2ascii(iarray4,iword,ibyte)
        end do
        write(*,'(a)') name(iword-1)(01:06)
      end do


C Third through Nth Univac record

      do irec = 1,nrec

        read (31,rec=3*irec+2) iarrayx
        read (31,rec=3*irec+3) iarrayy
        read (31,rec=3*irec+4) iarrayz


C        write(*,'(10z5.4)') iarray2

        iword = 1

        nwrds = uni2ieee_int(iarray4, iword)
C        write(*,'("NWRDS = ",i10)') nwrds

        iword = 2
        sp1950 = uni2ieee_dp(iarray4, iword)
C        write(*,'("SP1950 = ",1p1e26.18)') sp1950

        iword = 4
        juldat = uni2ieee_dp(iarray4, iword)
C        write(*,'("JULDAT = ",1p1e26.18)') juldat

        iword = 6
        gredat1 = uni2ieee_int(iarray4, iword)
C        write(*,'("GREDAT1 = ",i10)') gredat1

        yyyy = gredat1/1000000
        mon = (gredat1 - 1000000*yyyy)/10000
        day =  gredat1 - 1000000*yyyy - 10000*mon
C        write(*,'(3x,i4.4,2("-",i2.2))') yyyy,mon,day

        iword = 7
        gredat2 = uni2ieee_int(iarray4, iword)
C        write(*,'("GREDAT2 = ",i10)') gredat2

        hh = gredat2/100000000
        mm = (gredat2 - 100000000*hh)/1000000
        ss = 0.0001*dfloat(gredat2 - 100000000*hh - 1000000*mm)
C        write(*,'(3x,2(i2.2,":"),f7.4)') hh,mm,ss

        iword = 8
        etmutc = uni2ieee_dp(iarray4, iword)
C        write(*,'("ETMUTC = ",1p1e26.18)') etmutc

        mode = -1
        call doy_mmdd(mode,yyyy,doy,mon,day,status)
        if (status .ne. 0) then
          write (*,'("error return from doy_mmdd = ",i5)') status
          pgm_status = 1
          go to 99
        end if

        if (irec .eq. 1) then            !write first 2 output records

          if      (yyyy .eq. 1980 .and. doy .eq. 317) then
            scid = 31
          else if (yyyy .eq. 1980 .and. doy .eq. 318) then
            scid = 31
          else if (yyyy .eq. 1981 .and. doy .eq. 238) then
            scid = 32
          else if (yyyy .eq. 1986 .and. doy .eq. 024) then
            scid = 32
          else
            write(*,'("Cannot get SCID for ",i4.4,2("-",i2.2),
     *            "T",2(i2.2,":"),f7.4,10x,"DOY = ",i3.3)')
     *            yyyy,mon,day,hh,mm,ss,doy
            pgm_status = 1
            go to 99
          end if

          if (yyyy .eq. 1986 .and. doy .eq. 297) then
            write(32,'(3i10,2x,"07/28/98  T860507   UNK     ")')
     *       nrec,scid,nbodl
          else
            write(32,'(3i10,2x,"07/28/98  UNK       UNK     ")')
     *       nrec,scid,nbodl
          end if
          write(32,'("SPACECRAFT CENTERED EME50 COORDINATES",e26.18)')
     *       etmutc
          do n = 1,nbodl
            write(32,'(16x,a6,e26.18,2e16.8,/,5e16.8,/,3e26.18)')
     *          name(n),const
          end do
        end if

        do n = 1,nbodl
          do i = 1,6
            iword = 11 + 12*(n-1) + 2*(i-1)
            state(n,i) = uni2ieee_dp(iarray4,iword)
c          write(*,'(3i4,1p1e28.18)') n,i,iword,state(n,i)
          end do
        end do

        write(32,'(i4.4,i4.3,2i3.2,f8.4,e26.18)')
     *     yyyy,doy,hh,mm,ss,sp1950
        write(32,'(1p3e26.18)') ((state(n,i),i=1,6),n=1,nbodl)

        end do


C Exit

 99   continue

      call exit(pgm_status)

      stop
      end
