program wdspluck4 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 update 210823: add components Ca,Cb (R.Matson) 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,wdsid1 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' c filename='/data/WDS/wds'//hr//fhr//'.data' c filename='/media/4C1B-71FC/WDS/wds'//hr//fhr//'.data' c filename='/home/wih/WDS/wds'//hr//fhr//'.data' c filename='/home/wds/wds/wds'//hr//fhr//'.data' filename='/data/wds/wds/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. 'AB ') .and. (comp .ne.'AB ')) go to 20 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. 'Ca,Cb') .and. (comp .ne.'Ca,Cb')) go to 20 if ((incomp .eq. 'Da,Dc') .and. (comp .ne.'Da,Dc')) 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,'(2x,a13,1x,a10,1x,a8,1x,a8,1x,a13,1x,a8,1x,a8,2x, $ a8)') pp,aa,xii,xnn,tt,ee,xoo,ref c30 read (20,'(bz,a10,a1,a5,1x,f9.4,t1,a130)',end=10) c $ radc,wdsid1,comp,date,info 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 c if (date .lt. indate) write(30,'(a130)') info write(30,'(a130)') info go to 30 endif go to 20 111 stop 'input identification not found' 999 stop 'WDS extraction program finished' end