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