program obsweighter5 c c This program determines weights for the orbit program using the new c scheme involving separation, method (mcode), and observer (ocode) c [ orbits.3 --> orbits.4 ] c c 040218 : set maximum value for wt1 for each method c : automatically reduce wt3 for HJ measures to 0.1 c : reduce wt3 for uncertain/estimated measures or measures with c theta determined from quadrant (i.e., "U" or "L" codes) from c 0.5 to 0.1 c 040322 : use new set of observer weights (observer.weight.2004) c : remove automatic HJ reduction, as is now incorporated in c observer.weight.2004 c : use four "generic" visual weights (VI1 - VI4) based on date c 110708 : added new method codes (EYE, PTG) to weighting c 120709 : modified for new WDS format c 170711 : scheme modified. Weight now determined by technique (as c listed below), separation (in rayleighs), Nnights, and c uncertain/estimated flags c c itech technique c 1 = A c 2 = C c 3 = E (mostly E2) c 4 = Eu c 5 = H (mostly Hf,Ht,Hw) c 6 = Hh c 7 = J c 8 = K c 9 = M (dates 1750-1829) c 10 = M (dates 1830-1849) c 11 = M (dates 1850-9999) c 12 = P (mostly Pa) c 13 = Po c 14 = S/I (tel 0.00 - 1.49m) c 15 = S/I (tel 1.50 - 2.49m) c 16 = S/I (tel 2.50 - 99.99m) c 17 = T c 18 = misc (other techniques) c real*8 c1(18),c2(18),c3(18),c4(18) dimension w2(18),rmax(18) character*100 title,data1,data2 character*9 adate character*6 atheta,atel character*7 arho character*3 ref1,method character*8 ref character*1 tcode,rflag,c95,c96,tflag,fflag,techflag character*2 techflag2 character*4 afilt c open(10,file='observer.weight.2017',status='UNKNOWN') open(11,file='orbits.3',status='UNKNOWN') open(12,file='orbits.4',status='UNKNOWN') c c read in technique weights and coefficients fror weight vs separation c ntech=18 do 100 n=1,ntech read(10,901) w2(n),c1(n),c2(n),c3(n),c4(n),rmax(n) 901 format(t3,f8.2,4f15.10,f5.0) if (c1(n) .lt. 0.) c1(n)=0. 100 continue c c read and write wds title and orbital elements lines c 200 read(11,907,end=999,err=999) title 907 format(a100) write(12,907) title read(11,907) title write(12,907) title c c read data and determine weight c 400 read(11,908,end=999,err=999) data1,wt,data2,date,tcode,theta, $ rflag,rho,method,filt,fflag,tel,tflag,enn,ref1, $ ref,c95,c96,techflag,techflag2,afilt,atel 908 format(a52,f6.2,a39,t7,f10.5,t19,a1,f7.3,t32,a1,f9.5,t50,a3, $ t63,f4.0,t71,a1,t73,f5.1,a1,f3.0,1x,a3,t83,a8,t95,2a1, $ t92,a1,t92,a2,t63,a4,t72,a6) if (date .eq. 0.0) go to 600 c c throw out erroneous or unresolved measures c if ((c95 .eq. 'X') .or. (c96 .eq. 'X')) go to 400 if ((c95 .eq. 'F') .or. (c96 .eq. 'F')) go to 400 c c determine rho in "Rayleighs" (i.e., multiples of Rayleigh limit) c The Rayleigh limit (in arcsec) = rral = filt (nm) / [4040. * tel (m)] c if (rflag .eq. 'D') rho=rho*3600. if (rflag .eq. 'M') rho=rho*60. if (rflag .eq. 'm') rho=rho/1000. c if (atel .eq. ' . ') tel=0.1 if (tflag .eq. 'k') tel=tel*1000. if (tflag .eq. 'M') tel=tel*1000000. c if (afilt .eq. ' ') filt= 550. if ((afilt .eq. ' ') .and. (fflag .eq. 'B')) filt= 450. if ((afilt .eq. ' ') .and. (fflag .eq. 'R')) filt= 700. if ((afilt .eq. ' ') .and. (fflag .eq. 'K')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Ci')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Cc')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Cp')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Cs')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'E2')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Ed')) filt= 820. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Hi')) filt=2200. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Hw')) filt=3300. if ((afilt .eq. ' ') .and. (techflag2 .eq. 'Kr')) filt=2200. if ((afilt .ne. ' ') .and. (fflag .eq. 'u')) filt=filt*1000. if ((afilt .ne. ' ') .and. (fflag .eq. 'm')) filt=filt*1.0e6 if ((afilt .ne. ' ') .and. (fflag .eq. 'c')) filt=filt*1.0e7 if ((afilt .ne. ' ') .and. (fflag .eq. 'M')) filt=filt*1.0e9 c rlim=filt/4040./tel rral=rho/rlim c c determine technique number c itech=18 if (techflag .eq. 'A') itech=1 if (techflag .eq. 'C') itech=2 if (techflag .eq. 'E') itech=3 if (techflag2 .eq. 'Eu') itech=4 if (techflag .eq. 'H') itech=5 if (techflag2 .eq. 'Hh') itech=6 if (techflag .eq. 'J') itech=7 if (techflag .eq. 'K') itech=8 if (techflag .eq. 'M') itech=9 if ((techflag .eq. 'M') .and. (idate .ge. 1830)) itech=10 if ((techflag .eq. 'M') .and. (idate .ge. 1850)) itech=11 if (techflag .eq. 'P') itech=12 if (techflag2 .eq. 'Po') itech=13 if (techflag .eq. 'S') itech=14 if ((techflag .eq. 'S') .and. (tel .ge. 1.49)) itech=15 if ((techflag .eq. 'S') .and. (tel .ge. 2.49)) itech=16 if (techflag .eq. 'I') itech=14 if ((techflag .eq. 'I') .and. (tel .ge. 1.49)) itech=15 if ((techflag .eq. 'I') .and. (tel .ge. 2.49)) itech=16 if (techflag .eq. 'T') itech=17 c if (enn .eq. 0.0) enn=1.0 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c determine weighting factor = sqrt(n) c wt4=sqrt(enn) c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c give half weight to measures flagged as uncertain or estimated. c Also, give half weight for speckle measures with separations c >3" (i.e., beyond isoplanatic patch) c wt3=1.0 if ((tcode .eq. ':') .or. (rflag .eq. 'L')) wt3=0.5 if (rflag .eq. ':') wt3=0.5 if ((techflag .eq. 'S') .and. (rho .gt. 3.0)) wt3=0.5 if ((techflag .eq. 'I') .and. (rho .gt. 3.0)) wt3=0.5 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c determine weight based on technique c wt2=w2(itech) c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c use fits to relative weight versus separation (in rayleighs) c appropriate to the technique to determine weighting factor wt1 c if (rral .le. rmax(itech)) wt1= c1(itech) + c2(itech)*rral $ + c3(itech)*rral**2 + c4(itech)*rral**3 if (rral .gt. rmax(itech)) wt1= 1.0 if (wt1 .lt. 0.0) wt1=0.0 if (wt1 .gt. 1.0) wt1=1.0 c ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c combine all factors to determine overall weight c wt=wt1*wt2*wt3*wt4 if ((wt .lt. 0.01) .and. (wt .ne. 0.0)) wt= 0.01 if (wt .gt. 999.99) wt=999.99 write(12,909) data1,wt,data2,wt1,wt2,wt3,wt4,itech,tel, $ techflag,techflag2,rral 909 format(a52,f6.2,a39,4f9.2,i4,f9.1,2x,a1,2x,a2,f9.2) go to 400 c 600 write(12,910) 910 format(95x,' ') go to 200 999 stop 'obsweighter program finished' end