! @(#)residual.prg 17.1.1.1 (ES0-DMD) 01/25/02 17:13:37 ! @(#)residual.prg 17.1.1.1 (ESO-SDAG) 01/25/02 17:13:37 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++ !.COPYRIGHT (C) 1994 European Southern Observatory !.IDENT: residual.prg !.AUTHOR: O.R. Hainaut !.KEYWORDS: POS1, astrometry !.PURPOSE: POS1 astrometric package ! plots the xy residual of the standard stars, and ask !.USE: @c pos1 standard mes plate_epoch cat_epoch sch/lsb tol ! 1 2 3 4 5 6 ! x_terms,yterms std ! 7 8 !.Version: Sat Sep 17 19:16:43 1994 !----------------------------------------------------- defi/par p1 ppm ? "Standard file " defi/par p2 N ? "Plot?" defi/loc i/i/1/1 0 defi/loc iw/i/1/1 0 defi/loc w/r/1/2 0.,0. defi/loc w1/r/1/1 0. if p2 .eq. "N" .or. p2 .eq. "n" goto delete !--plot the std stars sel/tab {p1} :std .eq. 1 set/grap color=1 stype=2 frame=square plot/tab {p1} :r_a :dec set/grap color=2 stype=1 stat/tab {p1} :xerr outputr(1) = -outputr(1) if outputr(1) .ge. outputr(2) then w1 = outputr(1) else w1 = outputr(2) endif stat/tab {p1} :yerr outputr(1) = -outputr(1) if outputr(1) .ge. w1 w1 = outputr(1) if outputr(2) .ge. w1 w1 = outputr(2) stat/tab {p1} :r_a w = m$abs(outputr(2)-outputr(1)) !--draw the residuals ! I'm sure that a MIDAS guru could make this 10 times nicer and 100x faster do i = 1 5 comp/tab {p1} wx = :r_a + :xerr*{w}/100./{w1}*{i} comp/tab {p1} wy = :dec + :yerr*{w}/250./{w1}*{i} sel/tab {p1} :std .eq. 1 over/tab {p1} :wx :wy enddo set/grap color=1 stype=2 !--label the stars ! same remark... stat/tab {p1} :r_a w1 = (outputr(2)-outputr(1))/50. iw = {{p1}.tbl,TBLCONTR(4)} set/form i1 do i = 1 {iw} if {{p1}.tbl,:std,@{i}} .eq. 1 then w(1) = {{p1}.tbl,:R_a,@{i}}-w1 w(2) = {{p1}.tbl,:dec,@{i}}-w1 label/grap {i} {w(1)},{w(2)} endif enddo set/form !-- Delete/undelete stars delete: inqu/key i "Star to be deleted/restored? (0 to exit)" if i .le. 0 return if i .gt. {{p1}.tbl,tblcontr(4)} then write/out "*error* {i}: no such star (hint: you have to enter the" write/out " sequencial number of the star, not its identifier" goto delete endif if {{p1}.tbl,:std,@{i}} .eq. 2 then writ/tab {p1} :std @{i} 1 else writ/tab {p1} :std @{i} 2 endif goto delete