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