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

! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS procedure verify2.prg  to verify MIDAS commands
!  K. Banse     950622, 980127, 991111, 000119
!
! 130503		last modif
! 
!  use as @@ verify2 ffffffff ffffffffff	with f = 1 or 0 (on/off)
!
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/par p1 1111111111 n "Enter control flags for entries: "
define/par p2 1111111111 n "Enter control flags for entries: "
! 
define/local loop/i/1/1 0
define/local test/c/1/1 ? ? +lower
define/local rval/r/1/1 0. ? +lower
define/local ival/i/1/5 0 all +lower
define/local cfunc/c/1/16 " " 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 ccc/c/1/15 0000000000000
! 
delete/temp                             !get rid of old temporary files
! 
write/key dispyes/i/1/2 0,0
!
write/out +------------------------------------------+
write/out Start of procedure verify2.prg
write/out +------------------------------------------+
!
seconds(1) = m$secs()
! 
! 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
! 
write/key ccc/c/1/8 {p1}
set/format i1
do loop = 1 8
   if ccc({loop}:{loop}) .eq. "1" @@ verify2,000{loop}  !<<<<<<<<<<<
   if errsum .gt. 0 then
      write/out "We got problems with entry 000{loop} in verify2.prg!"
      return 1
   endif
enddo
write/key ccc/c/1/8 {p2}
do loop = 1 4
   if ccc({loop}:{loop}) .eq. "1" @@ verify2,001{loop}
   if errsum .gt. 0 then
      write/out "We got problems with entry 001{loop} in verify2.prg!"
      return 1
   endif
enddo
seconds(2) = m$secs()
mid$info(8) = seconds(2)-seconds(1)
! 
write/out +------------------------------------------+
write/out procedure verify2.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
!
write/out test of CREATE/DISPLAY + CREATE/GRAPHICS
write/out "----------------------------------------"
!
create/display 7 512,512,616,300
create/gra 3 600,400,0,380
dispyes(1) = 1                          !mark that we have display + graphic
dispyes(2) = 1
load/lut heat
display/lut
clear/channel overlay
!
entry 0002
! 
write/out test of building elongated Gaussian images
write/out "------------------------------------------"
! 
set/format f12.6
create/image &a 2,100,100 0.,0.,1.,1. gauss 50,8,50,8
write/descr &a.{imatype} this_is_a_very_long_long_descriptor_name0001/c/1/8 -
            pipeline
write/dhelp &a.{imatype} this_is_a_very_long_long_descriptor_name0001 -
            "help text for this horrible descriptor"
rebin/linear &a.{imatype} &b 0.3,1 0.,0. + NO
rebin/rotate &b.{imatype} &c 33.3 + NO
extract/image &d = &c.{imatype}[@100,@82:@230,@190]
! 
rotate/clock &d.{imatype} &e 
write/descr &d.{imatype} step 1,1
write/descr &e.{imatype} step 1,1
! 
create/image veria 2,256,256
write/descr veria.{imatype} -
            this_is_a_very_long_long_descriptor_name0001/c/1/8 pipeline
write/dhelp veria.{imatype} this_is_a_very_long_long_descriptor_name0001 -
            "help text for this horrible descriptor"
insert/image &a.{imatype} veria.{imatype} @120,@33
insert/image &d.{imatype} veria.{imatype} @10,@10
insert/image &e.{imatype} veria.{imatype} @120,@120
!
if dispyes(1) .eq. 1 load/ima veria.{imatype} cuts=0.0,0.002
! 
create/table verit 4 10 null
create/column verit.{tbltype} :XSTART "World Coords" E12.5 R*4
create/column verit.{tbltype} :XEND "World Coords" E12.5 R*4
create/column verit.{tbltype} :YSTART "World Coords" E12.5 R*4
create/column verit.{tbltype} :YEND "World Coords" E12.5 R*4
verit.{tbltype},:xstart,@1 = 37.
verit.{tbltype},:ystart,@1 = 28.
verit.{tbltype},:xend,@1 = 110.
verit.{tbltype},:yend,@1 = 95.
verit.{tbltype},:xstart,@2 = 124.
verit.{tbltype},:ystart,@2 = 126.
verit.{tbltype},:xend,@2 = 214.
verit.{tbltype},:yend,@2 = 236.
verit.{tbltype},:xstart,@3 = 142.
verit.{tbltype},:ystart,@3 = 56.
verit.{tbltype},:xend,@3 = 196.
verit.{tbltype},:yend,@3 = 106
! 
if dispyes(1) .ne. 1 return
! 
define/local i/i/1/1 0
define/local tbnam/c/1/40 verit.{tbltype}
do i = 1 3
   write/keyw ival -
   {{tbnam},:xstart,@{i}},{{tbnam},:ystart,@{i}},{{tbnam},:xend,@{i}},{{tbnam},:yend,@{i}} F
   draw/rect @{ival}},@{ival(2)},@{ival(3)},@{ival(4)} F
   plot/perspec veria.{imatype} [@{ival}},@{ival(2)}:@{ival(3)},@{ival(4)}]
enddo
! 
entry 0003
! 
write/out test of CENTER/GAUSS
write/out "--------------------"
! 
write/out center/gauss veria.{imatype},verit.{tbltype} verit1
center/gauss veria.{imatype},verit.{tbltype} verit1
! 
copy/tk verit1.{tbltype} :xcen,:ycen,:xsig,:ysig,:xfwhm,:yfwhm @1 outputr/r/1/6 
write/keyw rcorr 77.869,62.058,22.994,15.209,54.146,35.815
@@ kcompare rcorr outputr 1,6 0.01
copy/tk verit1.{tbltype} :xerr,:yerr @1 outputr/r/1/2 
write/keyw rcorr 8.6998e-03,3.5970e-02
@@ kcompare rcorr outputr 1,2 0.00001
! 
copy/tk verit1.{tbltype} :xcen,:ycen,:xsig,:ysig,:xfwhm,:yfwhm @2 outputr/r/1/6 
write/keyw rcorr -
1.7284e+02,1.7999e+02,1.5829e+01,2.2708e+01,3.7275e+01,5.3473e+01
@@ kcompare rcorr outputr 1,6 0.01
copy/tk verit1.{tbltype} :xerr,:yerr @2 outputr/r/1/2 
write/keyw rcorr 1.9590e-02,1.2412e-02
@@ kcompare rcorr outputr 1,2 0.00001
! 
copy/tk verit1.{tbltype} :xcen,:ycen,:xsig,:ysig,:xfwhm,:yfwhm @3 outputr/r/1/6 
write/keyw rcorr -
1.6900e+02,8.2000e+01,7.9948e+00,7.9948e+00,1.8826e+01,1.8826e+01
@@ kcompare rcorr outputr 1,6 0.01
copy/tk verit1.{tbltype} :xerr,:yerr @3 outputr/r/1/2 
write/keyw rcorr 1.0031e-06,1.0442e-06
@@ kcompare rcorr outputr 1,2 0.00001
! 
entry 0004
! 
write/out test of CENTER/MOMENT
write/out "---------------------"
! 
write/out center/moment veria.{imatype},verit.{tbltype} verit2
center/moment veria.{imatype},verit.{tbltype} verit2
! 
copy/tk verit2.{tbltype} :xcen,:ycen,:xsig,:ysig,:xfwhm,:yfwhm @1 outputr/r/1/6
write/keyw rcorr -
7.7426e+01,6.2438e+01,1.5933e+01,1.1429e+01,3.7520e+01,2.6912e+01
@@ kcompare rcorr outputr 1,6 0.01
copy/tk verit2.{tbltype} :xerr,:yerr @1 outputr/r/1/2
write/keyw rcorr 3.2150e-01,2.3061e-01 
@@ kcompare rcorr outputr 1,2 0.00001
!
copy/tk verit2.{tbltype} :xcen,:ycen,:xsig,:ysig,:xfwhm,:yfwhm @2 outputr/r/1/6
write/keyw rcorr -
1.7287e+02,1.7999e+02,1.4023e+01,1.9724e+01,3.3022e+01,4.6447e+01 
@@ kcompare rcorr outputr 1,6 0.01
copy/tk verit2.{tbltype} :xerr,:yerr @2 outputr/r/1/2
write/keyw rcorr 2.0512e-01,2.8850e-01
@@ kcompare rcorr outputr 1,2 0.00001
! 
copy/tk verit2.{tbltype} :xcen,:ycen,:xsig,:ysig,:xfwhm,:yfwhm @3 outputr/r/1/6
write/keyw rcorr -
1.6900e+02,8.1993e+01,7.8475e+00,7.8362e+00,1.8479e+01,1.8453e+01 
@@ kcompare rcorr outputr 1,6 0.01
copy/tk verit2.{tbltype} :xerr,:yerr @3 outputr/r/1/2
write/keyw rcorr 1.6916e-01,1.6892e-01 
@@ kcompare rcorr outputr 1,2 0.00001
! 
entry 0005
! 
write/out test of CENTER/IQE
write/out "------------------"
!
write/out center/iqe veria.{imatype},verit.{tbltype} verit3
center/iqe veria.{imatype},verit.{tbltype} verit3
! 
copy/tk verit3.{tbltype} :xcen,:ycen,:ax_maj,:ax_min,:angle @1 outputr/r/1/5
write/keyw rcorr 7.8032e+01,6.2868e+01,5.9702e+01,1.7432e+01,3.3238e+01
@@ kcompare rcorr outputr 1,5 0.1
!
copy/tk verit3.{tbltype} :xcen,:ycen,:ax_maj,:ax_min,:angle @2 outputr/r/1/5
write/keyw rcorr 1.7284e+02,1.8002e+02,6.2632e+01,1.8753e+01,1.2329e+02
@@ kcompare rcorr outputr 1,5 0.1
! 
copy/tk verit3.{tbltype} :xcen,:ycen,:ax_maj,:ax_min,:angle @3 outputr/r/1/5
write/keyw rcorr 1.6900e+02,8.20007e+01,1.84393e+01,1.84366e+01,9.00293e+01
@@ kcompare rcorr outputr 1,5 0.1
! 
entry 0006
!
write/out test of MAGNITUDE/CIRCLE
write/out "------------------------"
!
write/out > magnitude/circle veria.{imatype},verit.{tbltype} verit1 ? ? 0
magnitude/circle veria.{imatype},verit.{tbltype} verit1 ? ? 0
!
copy/tk verit1.{tbltype} :xcen,:ycen,:magnitude,:mag_sigma,:flux @1 outputr/r/1/5
write/keyw rcorr -
77.0854,62.279,2.8773,0.09626,0.0706
@@ kcompare rcorr outputr 1,5 0.01
!
copy/tk verit1.{tbltype} :xcen,:ycen,:magnitude,:mag_sigma,:flux @2 outputr/r/1/5
write/keyw rcorr -
172.795,180.06,2.7725,0.0953,0.07780
@@ kcompare rcorr outputr 1,5 0.01
!
copy/tk verit1.{tbltype} :xcen,:ycen,:magnitude,:mag_sigma,:flux @3 outputr/r/1/5
write/keyw rcorr -
1.6900e+02,8.2000e+01,2.2605,0.02485,0.1247
@@ kcompare rcorr outputr 1,5 0.01
! 
! compare result from table row no. 2 with explicit input
write/out > magnitude/circle veria,169.0,181.0 p5=1
magni/circ veria,169.0,181.0 p5=1
write/keyw rcorr -
0.,0.,0.,0.,172.795,180.06,2.7725,0.0953,0.07780
@@ kcompare rcorr outputr 5,5 0.01
! 
entry 0007
!
write/out test of SET/FORMAT 
write/out "------------------"
!
outputd = 1.0102030405
define/local loop/i/1/1 0
!
write/keyw outputi 35,450,3,12345
write/keyw outputr 12.345,1.234,1234.567,0.123
write/keyw outputd 123.456,1234.567,12.345,12345.678
!
write/out "we want to display: | int_key | real_key | double_key |"
write/out "set/format i1 f10.3"
set/format i1 f10.3
write/out
do loop = 1 4
   write/out " | {outputi({loop})} | {outputr({loop})} | {outputd({loop})} |"
enddo
write/out
write/out "set/format j8 t10.3"
set/format J8 T10.3
write/out
!
do loop = 1 4
   write/out " | {outputi({loop})} | {outputr({loop})} | {outputd({loop})} |"
enddo
! 
entry 0008
!
write/out test of REBIN/LINEAR
write/out "--------------------"
!
write/out > create/image &a 2,1002,997 ? radius_law 300.,5.5,0.9,44.4
create/image &a 2,1002,997 ? radius_law 300.,5.5,0.9,44.4
write/out > compute/image &a.{imatype} = exp(&a.{imatype})
compute/image &a.{imatype} = exp(&a.{imatype})
write/out > rebin/linear &a.{imatype} &b 3,3
rebin/linear &a.{imatype} &b 3,3
!
copy/dkey &b.{imatype} npix inputi
write/keyw icorr 334,332
@@ kcompare icorr inputi 1,2
! 
write/out > rebin/linear &b.{imatype} &c 1.,1.
rebin/linear &b.{imatype} &c 1.,1.
!
copy/dkey &c.{imatype} npix inputi
write/keyw icorr 1002,996
@@ kcompare icorr inputi 1,2
! 
if dispyes(1) .eq. 1 then
   clear/chan over
   load/ima &a.{imatype} cuts=1.0,1.001
   load/ima &b.{imatype} cuts=1.0,1.001
   load/ima &c.{imatype} cuts=1.0,1.001
endif
!
entry 0011
!
write/out test of Contexts
write/out "----------------"
!
if workenv(1:1) .eq. "F" return		!context "long" not ready for FITS yet
! 
write/out > set/context long
set/context long
write/out > show/context
show/context
! 
write/out -
> "clear last context and enable context `verify'" in current directory
clear/context
show/context
clear/context -a
!
entry 0012
!
write/out  test of COMPUTE/AIRMASS, /UT, /ST 
write/out "---------------------------------"
!
set/midas f_update=no			!keep old settings
write/out > compute/airmass tst0002.mt
compute/airmass tst0002.mt
write/keyw rcorr 1.29466
@@ kcompare rcorr outputr 1,1 0.0001
! 
set/midas f_update=yes
if workenv(1:1) .eq. "F" then
   compute/image &n = nttexample.mt
   return
endif
! 
write/out > indisk/fits nttexample.mt &n
indisk/fits nttexample.mt &n >Null
write/out > compute/airmass &n -10.,43.,55.35 29.,15.,25.8
compute/airmass &n -10.,43.,55.35 29.,15.,25.8
write/keyw rcorr 1.90774
@@ kcompare rcorr outputr 1,1 0.0001
!
write/out > compute/airmass &n
compute/airmass &n
write/keyw rcorr 1.98103
@@ kcompare rcorr outputr 1,1 0.0001
!
write/out > compute/st &n -70.,43.,55.35,0,0
compute/st &n -70.,43.,55.35,0,0
write/keyw rcorr 11.,33.,46.4735
@@ kcompare rcorr outputr 1,3 0.0001
!
write/out > compute/ut &n -70.,43.,55.35,0,0
compute/ut &n -70.,43.,55.35,0,0
write/keyw rcorr 9.,37.,4.24117
@@ kcompare rcorr outputr 1,3 0.0001
!
set/format ,g24.14
write/out > compute/ut 0.,0.,0. {"middummn.{imatype}",o_time(6)}
compute/ut 0.,0.,0. {"middummn.{imatype}",o_time(6)}
@@ kcompare rcorr outputr 1,3 0.0001
! 
if mid$sys(1:5) .eq. "PC/Cy" then
   define/local im_a/c/1/96 FORS.1999-01-27T05c43c50.495.fits
else
   define/local im_a/c/1/96 FORS.1999-01-27T05:43:50.495.fits
endif
inputi = m$exist("MID_TEST:{im_a}")
if inputi .ne. 1 then
   nodemo = nodemo + 1
   $ echo "missing file: {im_a} in verify2.prg" >> ./missing-files
   return
endif
! 
write/out > indisk/fits MID_TEST:{im_a} &n 
indisk/fits MID_TEST:{im_a} &n >Null
write/out > compute/airmass &n -10.,43.,55.35 29.,15.,25.8
compute/airmass &n -10.,43.,55.35 29.,15.,25.8 
write/keyw rcorr 3.81811
@@ kcompare rcorr outputr 1,1 0.0001
!
write/out > compute/airmass &n
compute/airmass &n
write/keyw rcorr 1.00940
@@ kcompare rcorr outputr 1,1 0.0001
! 
write/out > compute/st &n -70.,43.,55.35,0,0
compute/st &n -70.,43.,55.35,0,0
write/keyw rcorr 9.,25.,11.2145
@@ kcompare rcorr outputr 1,3 0.0001
! 
write/out > compute/ut &n -70.,43.,55.35,0,0
compute/ut &n -70.,43.,55.35,0,0
write/keyw rcorr 5.,43.,50.4956
@@ kcompare rcorr outputr 1,3 0.0001
! 
set/format ,g24.14
write/out > compute/ut 0.,0.,0. {"middummn.{imatype}",o_time(6)} 
compute/ut 0.,0.,0. {"middummn.{imatype}",o_time(6)} 
write/keyw rcorr 7.,28.,50.0484
@@ kcompare rcorr outputr 1,3 0.0001
!
entry 0013
!
write/out test of writing descriptors with different data types
write/out "-----------------------------------------------------"
!
write/out > write/descr &n ddesc/d/1/4 1.123456,2.34567,3.45678,4.56789
write/descr &n ddesc/d/1/4 1.123456,2.34567,3.45678,4.56789
write/out > write/descr &n rdesc/r/1/4 1.123456,2.34567,3.45678,4.56789
write/descr &n rdesc/r/1/4 1.123456,2.34567,3.45678,4.56789
write/out > write/descr &n ddesc/r/3/2 -12.2,-13.3
write/descr &n ddesc/r/3/2 -12.2,-13.3
write/out > write/descr &n rdesc/d/3/2 -123.456789,-987.654321
write/descr &n rdesc/d/3/2 -123.456789,-987.654321
write/out 
read/descr &n ddesc,rdesc
!
entry 0014
!
write/out test of filling char. keywords
write/out "------------------------------"
! 
write/keyw inputc -
"CATALOG_TYPE    ASCII           # "NONE","ASCII","ASCII_ HEAD","FITS_1.0"               "
inputi(1) = m$strlen(inputc)
! 
write/keyw outputc -
"CATALOG_TYPE    ASCII           # "NONE","ASCII","ASCII_ HEAD","FITS_1.0""
inputi(2) = m$strlen(outputc)
! 
if inputi(1) .ne. 73 .or. inputi(1) .ne. inputi(2) then
   errsum = errsum + 1
   return
endif
if inputc(73:73) .ne. """ .or. inputc(73:73) .ne. outputc(73:73) then
   errsum = errsum + 1
   return
endif