c2345678911234567892123456789312345678941234567895123456789612345678971234567898
      program gaialist
c
c   Program to take a direct access, binary pointer file (eg. nseq or pix2fits)
c   and output a "tab" formatted catalogue text file for utilities such as 
c   GAIA/skycat.
c
c  Compilation: alpha% f77 gaialist.f -L/star/lib `sla_link` -o gaialist 
c                 sun% f77 gaialist.f `sla_link` -o gaialist -xl
c
      implicit none
      integer i,j,point,buff(32)
      character ifile*80,iamfile*80,ofile*80,tab*1,sign*1
      parameter (tab=char(9))
      double precision ra,dc
      integer ihmsf(4),idmsf(4)
      real mag
      logical swap
      parameter (swap=.false.)
c      parameter (swap=.true.)

      write (*,*) 'IAM file:'
      read (*,'(a)') iamfile
      write (*,*) 'Index of pointers:'
      read (*,'(a)') ifile
      write (*,*) 'Name of output TAB formatted text file:'
      read (*,'(a)') ofile

c  Test data:
c      iamfile='/disk1/nch/UKR444/iam.srtrd'
c      ifile='/disk1/nch/scratch/test.fits.idx'
c      iamfile='/net/cosaxp1/disk1/nch/UKR444/iam.srtrd'
c      ifile='/net/cosaxp1/disk1/nch/scratch/test.fits.idx'
c      ofile='try5.txt'
 
      open (unit=2,file=iamfile,status='old',access='direct',
     :form='unformatted',recl=32,readonly)
      open (unit=3,file=ifile,status='old',access='direct',
     :form='unformatted',recl=1,readonly)
      open (unit=1,file=ofile,status='new')

c  Write some header information:
      write (1,'(a)') ' TAB formatted file written using gaialist'
      write (1,*)
      write (1,'(a,a)') '   IAM file:',iamfile
      write (1,'(a,a)') '   Index file:',ifile
      write (1,*)
      write (1,'(a)') '# Config entry for catalogue:'
      write (1,'(a)') 'serv_type: local'
      write (1,'(a)') 'symbol: mag circle (-19-$mag)/10.'
      write (1,'(a)') '# End config entry'
      write (1,*)
      write (1,'(a)') 
     :'id'//tab//'ra'//tab//'dec'//tab//'mag'//tab//'area'//tab//
     :'A_I'//tab//'B_I'//tab//'THETA_I'//tab//'CLASS'//tab//'BLEND'//
     :tab//'QUALITY'//tab
      write (1,'(a)') 
     :'--'//tab//'--'//tab//'---'//tab//'---'//tab//'----'//tab//
     :'---'//tab//'---'//tab//'-------'//tab//'-----'//tab//'-----'//
     :tab//'-------'//tab

      i=1
10    read (3,rec=i,err=20) point
      if (point.eq.0) then
       write (*,*) 'Image number: ',i
       write (*,*) 'Zero pointer - no parameters output.'
       write (*,*)
       i=i+1
       goto 10
      endif
      read (2,rec=point) buff
      if (swap) call swbyte4(buff,32)
      ra=dble(buff(1))/1.0d8
      dc=dble(buff(2))/1.0d8
      mag=real(buff(9))/1000.
      call sla_dr2tf(3,ra,sign,ihmsf)
      call sla_dr2af(2,dc,sign,idmsf)
      write (1,15) i,tab,(ihmsf(j),j=1,4),tab,sign,(idmsf(j),j=1,4),
     :tab,mag,tab,buff(7),tab,buff(16),tab,buff(17),tab,buff(18),tab,
     :buff(19),tab,buff(29),tab,buff(30),tab
15    format(i8.8,a1,3i3,'.',i3.3,a1,a1,i2.2,2i3,'.',i2.2,a1,f6.2,a1
     :,7(i8,a1))
      i=i+1
      goto 10
20    close (2)
      close (3)
      close (1)

      end

      include 'swbyte4.f'