	program extract
c
c	modification of Gary's program to pluck out data
c	from WDS catalogue for rectilinear systems
c
      	implicit none

	character*100 data
	character*80 info,elements
	character*25 filename
	character*10 radc
      	character*8 ref
      	character*7 wdsid,inid
      	character*5 comp,incomp
      	character*2 hr
      	character*1 fhr,blank
      	real*8 min,date,indate
      	integer*4 igrade
c
      	open (150,file='linear.1')
      	open (300,file='linear.2')
c
	blank=' '
50     	read(150,'(a100,t1,a2,f3.1,t11,a7,a5)',end=999) 
     $     data,hr,min,inid,incomp
	write(6,901) data
  901	format(a100)
	indate=9999.
c
10      if (min .lt. 30.0) fhr='0'
        if (min .ge. 30.0) fhr='5'
        filename='/data/wih/WDS/wds'//hr//fhr//'.data'
        open (200,file=filename)
20      read (200,'(a10,a7,a5,t1,a80)',end=10) radc,wdsid,comp,info
25      continue
        if (wdsid .eq. inid) then
	  if ((incomp .eq. 'AC   ') .and. (comp .ne.'AC   ')) go to 20 
	  if ((incomp .eq. 'AB-C ') .and. (comp .ne.'AB-C ')) go to 20 
	  if ((incomp .eq. 'AD   ') .and. (comp .ne.'AD   ')) go to 20 
	  if ((incomp .eq. 'BC   ') .and. (comp .ne.'BC   ')) go to 20 
	  if ((incomp .eq. 'CD   ') .and. (comp .ne.'CD   ')) go to 20 
	  if ((incomp .eq. 'Aa   ') .and. (comp .ne.'Aa   ')) go to 20 
c	  write(300,'(a80)') info
	  write(300,901) data
30        read (200,'(bz,a10,a7,a5,1x,f9.4,t1,a80)',end=10) 
     $     radc,wdsid,comp,date,info
          if (wdsid .ne. ' ') then
	     write(300,'(80x,a1)') blank
  	    close(200)
            go to 50
          endif
          if (date .lt. indate) write(300,'(a80)') info
          go to 30
        endif
        go to 20

111   stop 'input identification not found'
999   stop 'WDS extraction program finished'
      end

