	program noorbpluck
c
c	modification of Gary's program to pluck out data
c	from WDS catalogue for orbit grade tests
c	version 120709: reads data from new-format WDS files
c
      	implicit none

	character*160 info
	character*37 filename
	character*10 radc
      	character*7 wdsid,inid
      	character*5 comp,incomp
      	character*2 hr
      	character*1 fhr,blank,wdsid1
      	real*8 min
c
      	open (15,file='noorb.1')
      	open (30,file='noorb.2')
c
	blank=' '
50     	read(15,'(a2,f3.1,t11,a7,a5)',
     $     end=999) hr,min,inid,incomp
c
10      if (min .lt. 30.0) fhr='0'
        if (min .ge. 30.0) fhr='5'
        filename='/home/wih/WDS/wds'//hr//fhr//'.data'
        open (20,file=filename)
20      read (20,'(a10,a7,a5,t1,a130)',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,'(a130)') info
        write(30,901)
  901   format('NO ')
30        read (20,'(bz,a10,a1,a5,t1,a130)',end=10) 
     $     radc,wdsid1,comp,info
          if (wdsid1 .ne. ' ') then
	     write(30,'(129x,a1)') blank
  	    close(20)
            go to 50
          endif
          write(30,'(a130)') info
          go to 30
        endif
        go to 20

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

