	program wdspluck3
c
c	modification of Gary's program to pluck out data
c	from WDS catalogue for orbit grade tests
c
      	implicit none

	character*278 orbit
	character*160 info
	character*37 filename
        character*20 pp,aa,xii,xnn,tt,ee,xoo
	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
c
      	open (15,file='orbits.1')
      	open (30,file='orbits.2')
c
	blank=' '
50     	read(15,'(t20,a2,f3.1,t31,a7,a5,t81,a13,t106,a10,t126,a8,t144,
     $     a8,t163,a13,t188,a8,t206,a8,t255,f4.0,t252,a8,t1,a278)',
     $     end=999) hr,min,inid,incomp,pp,aa,xii,xnn,tt,ee,xoo,
     $     indate,ref,orbit
	write(6,901) orbit
  901	format(a258)
	indate=9999.
c
10      if (min .lt. 30.0) fhr='0'
        if (min .ge. 30.0) fhr='5'
        filename='/data/WDS/wds'//hr//fhr//'.data'
        open (20,file=filename)
20      read (20,'(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. 'AE   ') .and. (comp .ne.'AE   ')) go to 20 
	  if ((incomp .eq. 'AF   ') .and. (comp .ne.'AF   ')) go to 20 
	  if ((incomp .eq. 'AG   ') .and. (comp .ne.'AG   ')) go to 20 
	  if ((incomp .eq. 'BC   ') .and. (comp .ne.'BC   ')) go to 20 
	  if ((incomp .eq. 'BD   ') .and. (comp .ne.'BD   ')) go to 20 
	  if ((incomp .eq. 'CD   ') .and. (comp .ne.'CD   ')) go to 20 
	  if ((incomp .eq. 'CE   ') .and. (comp .ne.'CE   ')) go to 20 
	  if ((incomp .eq. 'Aa,Ab') .and. (comp .ne.'Aa,Ab')) go to 20 
	  if ((incomp .eq. 'Ba,Bb') .and. (comp .ne.'Ba,Bb')) go to 20 
	  if ((incomp .eq. 'Aa1,2') .and. (comp .ne.'Aa1,2')) go to 20 
	  if ((incomp .eq. 'Ab1,2') .and. (comp .ne.'Ab1,2')) go to 20 
	  write(30,'(a80)') info
	  write(30,'(2x,a13,1x,a10,1x,a8,1x,a8,1x,a13,1x,a8,1x,a8,2x,
     $     a8)') pp,aa,xii,xnn,tt,ee,xoo,ref
30        read (20,'(bz,a10,a7,a5,1x,f9.4,t1,a80)',end=10) 
     $     radc,wdsid,comp,date,info
          if (wdsid .ne. ' ') then
	     write(30,'(80x,a1)') blank
  	    close(20)
            go to 50
          endif
          if (date .lt. indate) write(30,'(a80)') info
          go to 30
        endif
        go to 20

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

