eso-midas-testdata 17.02pl1.2-2build1 / usr / lib / eso-midas / 17FEB / test / prim / verify17.prg

! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS procedure verify17.prg  to verify MIDAS commands
!  K. Banse	Garching
!
!  test the problematic copy/table command
!  use as @@ verify17 ffffffff		with f = 1 or 0 (on/off)
!
! 130611		creation
! 130611		last modif
!
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/par p1 11111111111111 n "Enter control flags for entries: "
!
define/local loop/i/1/1 0
define/local rval/r/1/1 0. ? +lower
define/local ival/i/1/5 0 all +lower
define/local seconds/i/1/2 0,0 ? +lower
define/local rcorr/r/1/20 0. all +lower
define/local icorr/i/1/20 0 all +lower
define/local errsum/i/1/1 0 ? +lower
define/local secs/i/1/2 0,0 ? +lower
define/local myvals/i/1/6 0 all +lower
!
delete/temp                             !get rid of old temporary files
! 
write/key sizez/i/1/5 400,400,0,0,0
write/key dispyes/i/1/2 0,0
!
write/out +------------------------------------------+
write/out Start of procedure verify17.prg
write/out +------------------------------------------+
!
!
! if enabled, handle FITS working environment
!
set/midas newfil=?? >Null
if outputc(1:1) .eq. "F" then           !we're in true FITS environment
   inputi = m$len(mid$types)
   define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
   inputi = m$len(mid$types(9:))
   define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
   define/local workenv/c/1/4 FITS ? +lower
else
   define/local imatype/c/1/3 bdf ? +lower
   define/local tbltype/c/1/3 tbl ? +lower
   define/local workenv/c/1/5 Midas ? +lower
endif
! 
seconds(1) = m$secs()
set/format i1
do loop = 1 3
   if p1({loop}:{loop}) .eq. "1" @@ verify17,000{loop}
   if errsum .gt. 0 then
      write/out "We got problems with entry 000{loop} in verify17.prg!"
      return 1
   endif
enddo
! 
seconds(2) = m$secs()
mid$info(8) = seconds(2)-seconds(1)
!
write/out +------------------------------------------+
write/out procedure verify17.prg:
write/out Total time elapsed = {mid$info(8)} seconds.
write/out All tests o.k. - you deserve a coffee now...
write/out +------------------------------------------+
return 0
! 
!  here the different sub-procedures
!
entry 0001
!
reset/display
create/gra 3 600,400,0,380
create/display 7 512,512,616,300
dispyes(1) = 1                          !mark that we have display + graphic
dispyes(2) = 1
load/lut heat
display/lut
clear/chan overlay
!
entry 0002
!
write/out "test of copy/table"
write/out "------------------"
!
write/out > create/table bias 20 20 bias.dat bias_dec.fmt
create/table bias 20 20 bias.dat bias_dec.fmt

write/out > create/virtual bvirtual.tbl bias.tbl
create/virtual bvirtual.tbl bias.tbl
write/out > select/table -
            bvirtual.tbl :BINX.eq.1.AND.:BINY.eq.1.AND.:CONAD.LT.1.0
select/table bvirtual.tbl :BINX.eq.1.AND.:BINY.eq.1.AND.:CONAD.LT.1.0
write/out > copy/table bvirtual biassel
copy/table bvirtual biassel
write/out > read/table biassel
read/table biassel
write/out > show/table biassel
show/table biassel
if  outputi(1) .ne. 20 .or. outputi(2) .ne. 7 then
    errsum = errsum + 1
endif
!
!
! OJO
!
! 
select/table bias ALL			!also reset descr. SELIDX
!
! continue work with tables created above
!
set/midas f_update=yes
write/out > compute/table  hear.tfits :new_wave = :wave/2.1
compute/table  hear.tfits :new_wave = :wave/2.1
write/out > copy/ti hear.tfits hear_ima :new_wave
copy/ti hear.tfits hear_ima :new_wave
outputr(1) = m$value("hear.tfits",:new_wave,@150)
rcorr(1) = m$value(hear_ima[@150]) 
write/out > show/table hear.tfits
show/table hear.tfits
outputr(2) = outputi(8)
rcorr(2) = m$value(hear_ima,npix(1))
@@ kcompare rcorr outputr 1,2 0.01
! 
!! bias.tbl has char. columns => problems with 32bit Scientific Linux 6.4 
!! with gcc 4.4.7 
!! on 64bit systems no problem encountered up to now (2013)
! 
copy/table bias newbie			!!OJO
! 
delete/column newbie #1,#20
write/out > show/table newbie
show/table newbie
write/out > copy/ti newbie newbie_ima
copy/ti newbie newbie_ima
read/imag newbie_ima <,<,22
write/out > copy/ti newbie test_ima #11
copy/ti newbie test_ima #11
write/out > read/image test_ima
read/image test_ima
write/out > read/image newbie_ima <,@11
read/image newbie_ima <,@11
write/out > comp/ima &d = newbie_ima@11 - test_ima
comp/ima &d = newbie_ima@11 - test_ima
write/out > find/minmax &d
find/minmax &d
write/keyw rcorr/r/1/2 0.,0.
@@ kcompare rcorr outputr 1,2 0.0001
! 
entry 0003
!
write/out 
write/out test of TBERDC (center/gauss)
write/out "---------------------------"
! 
if dispyes(1) .eq. 1 reset/display
! 
! the following test procedure was kindly contributed by Cees Bassa
! from the Jodrell Bank Center for Astrophysics, Manchester (July 2010)
! 
! Read image and reset wcs
indisk/fits ISAAC.2006-04-13T06:32:38.944.fits isaac
write/desc isaac start/d/1/2 1.,1.
write/desc isaac step/d/1/2 1.,1.
write/desc isaac cunit/c/1/60 " "

! Create display and load image
if dispyes(1) .eq. 1 then
   create/disp 0 520,520
   load/lut heat
   load isaac scale=-2 cuts=F,1sigma
endif

! Load astrometric standards and position estimates
$echo "define/field 01 12 R F12.6 :xcen" >in.fmt
$echo "define/field 13 25 R F12.6 :ycen" >>in.fmt
$echo "define/field 26 34 R F12.6 :rx" >>in.fmt
$echo "define/field 35 43 R F12.6 :ry" >>in.fmt
$echo "end" >>in.fmt

create/tab astrometry * * astrometry.dat in.fmt

! Load standards
if dispyes(1) .eq. 1 then
   load/tab astrometry :xcen :ycen ? 1 4 4
endif

! Create IDENT column
crea/col astrometry :no I*4 I4
comp/tab astrometry :no = seq
crea/col astrometry :ident C*8 A8
comp/tab astrometry :ident = CONCAT("ID",TOCHAR(:no))

! Create center/gauss search boxes
comp/tab astrometry :xstart = :xcen-10.
comp/tab astrometry :xend = :xcen+10.
comp/tab astrometry :ystart = :ycen-10.
comp/tab astrometry :yend = :ycen+10.

! Run center/gauss
center/gauss isaac,astrometry astrometry

! Offset positions to image center
comp/tab astrometry :x_off = :xcen-512.0
comp/tab astrometry :y_off = :ycen-512.0

! Copy astrometry table because align/ima wants them different
 
!! astrometry.tbl has char. columns => problems with 32bit systems possible
!! see also entry 0013 of verify13.prg

copy/tab astrometry temp		!!!OJO

! Load fitted positions
if dispyes(1) .eq. 1 then
   load/tab astrometry :xcen :ycen ? 1 2 5
endif

! Align image
align/ima astrometry,:x_off,:y_off temp,:rx,:ry f ? y

! Plot residuals
if dispyes(1) .eq. 1 then
   create/gra
   plot/tab astrometry :xresidual :yresidual ? 1
endif

! Residual statistics
stat/tab astrometry :xresidual
write/key rcorr/r/1/4 -1.5899,0.467388,5.19838e-07,0.250642  
@@ kcompare rcorr outputr 1,2 0.0001  4,4 0.0001
! 
stat/tab astrometry :yresidual
write/key rcorr/r/1/4  -0.986995,0.577721,-4.47603e-07,0.223052 
@@ kcompare rcorr outputr 1,2 0.0001  4,4 0.0001
!