program rdtycho
c
c read binary tycho catalog
c written 21-july-1997 aah
c
      integer*4 i4(4)
      integer*2 i2(16)
      integer*1 id,ie,if,ig,ih,ii,ij,ik
      equivalence (id,i2(9)),(ie,i2(10)),(if,i2(11)),
     $  (ig,i2(12)),(ih,i2(13)),(ii,i2(14)),
     $  (ij,i2(15)),(ik,i2(16))
c
      open (unit=1,file='tycho.cat',status='old',
     $  access='direct',carriagecontrol='none',
     $  form='unformatted',recl=10,recordtype='fixed')
100   continue
        print *,'Enter tycho number, minus=end:'
        read (5,*) i
        print *,'Requested tycho record number = ',i
        if (i.lt.0) stop
        read (1,rec=i) i4,(i2(j),j=1,8),id,ie,
     $    if,ig,ih,ii,ij,ik
        call unpack(i4,i2)
        goto 100
      stop
      end

      subroutine unpack (i4,i2)
      real*8 ra,dec
      real*4 pi,ualpha,udelta,raerr,decerr,uaerr,pierr
      real*4 uderr,bt,sigbt,vt,sigvt,vtscat,vtmax,vtmin
      integer tyc1,tyc2,tyc3,itycho,hip,ira,idec,i,iy
      integer ivtscat,ivtmax,ivtmin,ipi
      integer ibterr,ivterr,iuaerr,iuderr,iraerr,idecerr
      integer ipierr
      integer*4 i4(4)
      integer*2 i2(16)
      character aflag*1,gflag*1,tflag*1
c
      iy = i2(16)
      ra = dfloat(i4(2))/3600000.
      dec = dfloat(i4(3))/3600000.
      hip = i4(4)
      tyc1 = i4(1)/100000
      tyc2 = i4(1) - tyc1*100000
      if (tyc2.lt.20000) then
        tyc3 = 1
      elseif (tyc2.lt.40000) then
        tyc2 = tyc2 - 20000
        tyc3 = 2
      elseif (tyc2.lt.60000) then
        tyc2 = tyc2 - 40000
        tyc3 = 3
      else
        tyc2 = tyc2 - 60000
        tyc3 = 4
      endif
      decerr = i2(10)/10.
      raerr = i2(9) /10.
      uderr = i2(13)/10.
      uaerr = i2(12)/10.
      sigvt = i2(15)/1000.
      sigbt = i2(14)/1000.
      pierr = i2(11)/10.
      pi = i2(1)/100.
      vtmax = i2(7)/1000.
      vtmin = i2(8)/1000.
      vtscat = i2(6)/1000.
      ualpha = i2(2)/10.
      udelta = i2(3)/10.
      vt = i2(5)/1000.
      bt = i2(4)/1000.
      aflag = ' '
      gflag = ' '
      tflag = ' '
      if (btest(iy,0)) aflag = 'X'
      if (btest(iy,1)) gflag = 'X'
      if (btest(iy,2)) tflag = 'X'
      write (6,900) tyc1,tyc2,tyc3,ra,dec,aflag,pi,
     $  ualpha,udelta,raerr,decerr,pierr,uaerr,uderr,hip,bt,
     $  sigbt,vt,sigvt,vtscat,vtmax,vtmin,gflag,tflag
900   format (2x,i4,i6,i2,37x,2(f12.8,1x),a1,1x,
     $  f7.2,1x,2(f8.2,1x),5(f6.2,1x),70x,i6,1x,
     $  2(f6.3,1x,f5.3,1x),30x,f5.3,1x,2(f5.2,1x),
     $  2(a1,1x))
      return
      end