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

! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS procedure verify14.prg  to verify MIDAS commands
!  K. Banse	031028	creation
!
!  use as @@ verify14 ffffffffff             with f = 1 or 0 (on/off)
!
!  130503		last modif
!
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/par p1 1111111111 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 ccc/c/1/10 0000000000
define/local secs/i/1/2 0,0 ? +lower
define/local myvals/i/1/2 0,0 ? +lower
!
delete/temp                             !get rid of old temporary files
! 
write/key sizez/i/1/5 600,600,0,0,0
write/key dispyes/i/1/2 0,0
!
write/out +------------------------------------------+
write/out Start of procedure verify14.prg
write/out +------------------------------------------+
!
seconds(1) = m$secs()
write/key ccc {p1}
set/format i1
do loop = 1 9
   if ccc({loop}:{loop}) .eq. "1" @@ verify14,000{loop}
   if errsum .gt. 0 then
      write/out "We got problems with entry 000{loop} in verify14.prg!"
      return 1
   endif
enddo
seconds(2) = m$secs()
mid$info(8) = seconds(2)-seconds(1)
!
write/out +------------------------------------------+
write/out procedure verify14.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 "----------------------------------------"
!
reset/display
!! 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
display/lut off
load/lut smooth
!
entry 0002
!
write/out test of REBIN/TT, SELECT/TABLE, ...
write/out "-----------------------------------"
!
! this is procedure w200mb.prg of Marc S.
! inserted into the verification setup by KB
! 
! it's quite an old procedure and worked happily until 98NOV
! then "fixes" of Midas screwed it up, only since 01FEB it's working again
! it's not the best example of a Midas procedure...
! - commands are abbreviated and the old syntax 'keyword' is used
! so it also serves as a test for backwards compatibility
! please, don't write your Midas procedures this way!!
! 
define/par P1 2000p C  "year and site:YYYYS"
define/local avein/R/1/1 0.0
define/local aveout/R/1/1 0.0
define/local avewhat/R/1/1 0.0
define/local rangemin/R/1/1 0.0
define/local rangemax/R/1/1 0.0
! 
inputi = m$exist("MID_TEST:phot2000p.tfits")
if inputi .ne. 1 then
   write/out > we need the FITS table `phot2000p.tfits' from the
   write/out > $MID_TEST directory for this verification
   write/out > please, get the latest data tar file from the ESO ftp server
   write/out > to bring your MID_TEST dir up to date ...
   write/out > verify14.prg skipped.
   nodemo = nodemo + 1
   $ echo "missing file: phot2000p.tfits in verify14.prg" >> ./missing-files
   return
endif
! 
set/format i1
write/out > "now, we read in a big FITS table, please, be patient"
display/long
! 
secs(1) = m$secs()
indisk/fits MID_TEST:phot2000p.tfits phot2000p.tbl
secs(2) = m$secs()
ival = secs(2)-secs(1)
write/out > indisk/fits of `phot2000p.tfits' took {ival} seconds ...
! 
show/table phot2000p.tbl
indisk/fits ws200mb2000p.tfits ws200mb2000p.tbl
show/table ws200mb2000p.tbl
!
crea/tab bias-5ms-11cm 2 1000 bias-5ms-11cm.asc
name/colu bias-5ms-11cm #1 :wfspeed "m/s"
name/colu bias-5ms-11cm #2 :bias "attenuation"
!
sele/tab  phot'P1' all
copy/tab phot'P1' mix'P1'
!
sele/tab  ws200mb'P1' all
compu/tab ws200mb'P1' :bin=0.25
compu/tab mix'P1' :bin=1./24./60.
rebin/tt mix'P1' :yearly99,:w200mb,:bin ws200mb'P1' -
         :yearly99,:jetspeed,:bin LIN 0.,1. LIN
sele/tab mix'P1' :w200mb.gt.0
stat/tab mix'P1' :w200mb
compute/key aveout = OUTPUTR(3)
stat/tab mix'P1' :yearly99
compute/key rangemin = OUTPUTR(1)
compute/key rangemax = OUTPUTR(2)
sele/tab ws200mb'P1' :yearly99.le. 'rangemax'.and. -
         :yearly99.ge. 'rangemin'
stat/tab ws200mb'P1' :jetspeed
compute/key avein = OUTPUTR(3)
compu/tab mix'P1' :w200mb = :w200mb * 'avein' / 'aveout' / 10.
name/colu mix'P1' :w200mb "velocity,m/s"
sele/tab ws200mb'P1' all
!
compu/tab mix'P1' :wfspeed=:w200mb+0.001*MOD(:w200mb,:scint)
sort/tab mix'P1' :wfspeed
project/tab mix'P1' test :yearly99,:filfwhm,:filscintz,:filisopla,:w200mb
!
compu/tab test :w400mb=0.5*:w200mb
name/colu test :w400mb "half w200mb, m/s"
rebin/tt test :w200mb,:bias0 bias-5ms-11cm :wfspeed,:bias lin 0,1 lin
try2000-1:
compu/tab test :bias0=abs(:bias0)
sele/tab test :w200mb.ge.30.0.and.:w200mb.le.30.01
stat/tab test :bias0
compute/key aveout = OUTPUTR(3)
sele/tab test all
sele/tab  bias-5ms-11cm :wfspeed.eq.30
stat/tab bias-5ms-11cm :bias
compute/key avein = OUTPUTR(3)
sele/tab  bias-5ms-11cm all
compu/tab test :bias200mb=:bias0* 'avein' / 'aveout'
compu/tab test :filscintzc=:filscintz/:bias200mb
name/colu test :filscintzc "10mn ave,zenith@0.5mu"
compu/tab test :filisoplac=:filisopla*(:bias200mb)**(3./5.)
name/colu test :filisoplac "10mn ave,arcsec@0.5mu"
compu/tab test :hbarc=6.52/:filfwhm/:filisoplac
name/colu test :hbarc "altitude, km above site"
compu/tab test :tau0c=0.98*0.31*5E-07/:filfwhm/:w200mb/5E-6
name/colu test :tau0c "AO time constant, second"
!
! now for half the velocity
rebin/tt test :w400mb,:bias0 bias-5ms-11cm :wfspeed,:bias lin 0,1 lin
compu/tab test :bias0=abs(:bias0)
sele/tab test :w400mb.ge.16.0.and.:w400mb.le.16.01
stat/tab test :bias0
compute/key aveout = OUTPUTR(3)
sele/tab test all
sele/tab  bias-5ms-11cm :wfspeed.eq.16
stat/tab bias-5ms-11cm :bias
compute/key avein = OUTPUTR(3)
sele/tab  bias-5ms-11cm all
compu/tab test :bias400mb=:bias0* 'avein' / 'aveout'
compu/tab test :filscintzcc=:filscintz/:bias400mb
name/colu test :filscintzcc "10mn ave,zenith@0.5mu"
compu/tab test :filisoplacc=:filisopla*(:bias400mb)**(3./5.)
name/colu test :filisoplacc "10mn ave,arcsec@0.5mu"
compu/tab test :hbarcc=6.52/:filfwhm/:filisoplacc
name/colu test :hbarcc "altitude, km above site"
compu/tab test :tau0cc=0.98*0.31*5E-07/:filfwhm/:w400mb/5E-6
name/colu test :tau0cc "AO time constant, second"
compu/tab test :tau0ms=0.98*0.31*5E-07/:filfwhm/5E-6
compu/tab test :tau0ms=1000.*:tau0ms*5./2./MAX(14,:w200mb)
name/colu test :tau0ms "AO Time Cst, ms"
!
-rename test.tbl mix'P1'.tbl
sort/tab  mix'P1' :yearly99
compu/tab mix'P1' :time=24.*(:yearly99-int(:yearly99-0.5))
name/colu  mix'P1' :time "U.T"
write/out w200mb.prg successfully terminated...
!
if aux_mode(1) .eq. 1 then
   -delete phot*.tbl.*
   -delete phot*.tfits.*
   -delete vimos200mb20*.*.*
   -delete mix*.tbl.*
else
   -delete phot*.tbl
   -delete phot*.tfits
   -delete vimos200mb20*.*
   -delete mix*.tbl.*
endif
! 
entry 0003
!
write/out  test of memory leaks  
write/out "--------------------"
!
set/format i1
write/out > while this loop is running 50 times, 
write/out > check the memory usage (via ps, top, ...)
! 
do ival = 1 50
   write/out mem_loop no. {ival}
   @@ verify14,memory timmi2.fits
enddo
! 
entry memory
!
! this is a procedure from M. Sperl from Vienna
! used in the context of the TIMMI2 data pipeline
! 
!check input parameter
DEFINE/MAXPAR 1
DEFINE/PARAMETER P1 ? I "Frame to process"
DEFINE/LOCAL BDFIN/C/1/200 "{P1}" ? +lower_levels
!common defines
DEFINE/LOCAL MAJOR/I/1/1       {{BDFIN},ESO.OBS.MAJOR}          ? +lower_levels
DEFINE/LOCAL MINOR/I/1/1       {{BDFIN},ESO.OBS.MINOR}          ? +lower_levels
DEFINE/LOCAL FINISH/I/1/1      {{BDFIN},ESO.PRO.REDU.FINISH}    ? +lower_levels
DEFINE/LOCAL NAXIS/I/1/1       {{BDFIN},NAXIS}                  ? +lower_levels
DEFINE/LOCAL PARMSET/C/1/200   "{{BDFIN},ESO.PRO.REDU.PPARSET}" ? +lower_levels
!define PATHs
DEFINE/LOCAL BASENAME/C/1/200  "x"                              ? +lower_levels
if aux_mode(1) .eq. 1 then
   $ dir
else
   $ basename {P1} .fits | WRITE/KEYWORD BASENAME
endif
!redefine BDFIN copy if necessary
BDFIN = "{BASENAME}_in.bdf"
INDISK/FITS {P1} {BDFIN} NO >Null
!define BDFOUT
DEFINE/LOCAL BDFOUT/C/1/200 "{BDFIN}" ? +lower_levels
! 
entry 0004
!
write/out
write/out  test of CREATE/TABLE
write/out "--------------------"
!
define/local fc/i/1/2 0,0
!
! create the format file for the command (berti.fmt)
! 
open/file berti.fmt w fc
write/file {fc} FS = "\t,"
write/keyw outputc "DEFINE/FIELD R    :RA"
write/file {fc},key  outputc
write/file {fc} "DEFINE/FIELD R    :DEC"
write/file {fc} "DEFINE/FIELD C*13 :NAME"
close/file {fc}
! 
write/out
write/out > data file rudi.dat:
-type rudi.dat
write/out
! 
write/out
write/out > format file berti.fmt:
-type berti.fmt
write/out
! 
write/out > create/table waldi 3 3 rudi berti
create/table waldi 3 3 rudi berti
write/out
show/table waldi
write/out
read/table waldi
! 
entry 0005
!
write/out
write/out  test of SELECT/TABLE for FITS tables
write/out "------------------------------------"
!
set/midas f_update=yes
$cp ws200mb2000p.tfits klaus.tfits
show/table klaus.tfits
write/keyw icorr          8,1472,0,0,11,1472,0,1472
@@ kcompare icorr outputi 1,8
! 
select/table klaus.tfits :yearly.lt.250.0
icorr(1) = 1008
if outputi(1) .ne. icorr(1) then	!check no. of sels (should be = 1008)
   write/out -
   "we should have {icorr(1)} selected rows, but got {outputi(1)} selections...
   write/out
   errsum = errsum + 1
   return
endif
! 
show/table klaus.tfits
write/keyw icorr          8,1472,0,0,11,1472,0,1008
@@ kcompare icorr outputi 1,8
statistics/table klaus.tfits :yearly
write/keyw rcorr  1.0,249.0,123.313,73.0003  
@@ kcompare rcorr outputr 1,3 0.001
@@ kcompare rcorr outputr 4,4 0.0001
! 
entry 0006
!
write/out
write/out  test of INDISK/MFITS + copying of FITS header
write/out "---------------------------------------------"
!
set/midas work=midas
indisk/mfits tst0011.mt
write/descr toto0000 klaus/c/1/10 "klaus "
outdisk/sfits toto0000,toto0001,toto0002.tbl middummo.fits
! 
write/keyw nodsc/i/1/20 0 all
indisk/mfits middummo.fits nocop p6=?
show/descr nocop0000.bdf >Null
nodsc(1) = outputi(1)
show/descr nocop0001.bdf >Null
nodsc(2) = outputi(1)
show/descr nocop0002.tbl >Null
nodsc(3) = outputi(1)
! 
indisk/mfits middummo.fits sicop p6=copy,*
show/descr sicop0000.bdf >Null
nodsc(4) = outputi(1)
show/descr sicop0001.bdf >Null
nodsc(5) = outputi(1)
show/descr sicop0002.tbl >Null
nodsc(6) = outputi(1)
! 
indisk/mfits middummo.fits sicop p6=copy,2
show/descr sicop0000.bdf >Null
nodsc(10) = outputi(1)
show/descr sicop0001.bdf >Null
nodsc(11) = outputi(1)
show/descr sicop0002.tbl >Null
nodsc(12) = outputi(1)
! 
indisk/mfits middummo.fits sicop p6=copy,1
show/descr sicop0000.bdf >Null
nodsc(13) = outputi(1)
show/descr sicop0001.bdf >Null
nodsc(14) = outputi(1)
show/descr sicop0002.tbl >Null
nodsc(15) = outputi(1)
! 
read/keyw nodsc
write/keyw icorr 10,17,21,10,18,22,0,0,0,10,17,22,10,18,21
@@ kcompare icorr nodsc 1,15
! 
entry 0007
!
write/out
write/out  test of command creation with blank qualifier
write/out "---------------------------------------------"
!
in_a = m$symbol("MIDASHOME")			! use keyword for safety
in_b = m$symbol("MIDVERS")
!
write/out > create/comm select @@ kcompare.prg
create/comm select @@ kcompare.prg
write/out > show/com select
show/com select
write/out > show/code select
show/code select
! 
entry 0008
!
write/out
write/out  test of direct table access for big tables
write/out "------------------------------------------"
!
create/tab biggy 2 330000 null			! 330 000 rows
creat/col biggy :col1 " "  I2 I*4
creat/col biggy :col2 " "  I5 I*4
creat/col biggy :col3 " "  I5 I*4
creat/col biggy :col4 " "  I5 I*4
creat/col biggy :col5 " "  I5 I*4
creat/col biggy :col6 " "  A22 C*22
creat/col biggy :col7 " "  A22 C*22
creat/col biggy :col8 " "  A22 C*22
creat/col biggy :col9 " "  A22 C*22
creat/col biggy :col10 " "  A22 C*22
creat/col biggy :col11 " "  A22 C*22
creat/col biggy :col12 " "  A22 C*22
comp/tab  biggy :col1 = 33
biggy,:col1,@8000 = 22
read/tab biggy :col1 @8000
inputi(12) = m$value(biggy,:col1,@8000)
if inputi(12) .ne. 22 then
   write/out 'Should be: 22 => internal table access did'nt work!!"
   write/out
   errsum = errsum + 1
   return
endif
write/tab biggy :col1 @8001 44
read/tab biggy :col1 @8000..8001
inputi(12) = m$value(biggy,:col1,@8001)
if inputi(12) .ne. 44 then
   write/out 'Should be: 44 => internal table access did'nt work!!"
   write/out
   errsum = errsum + 1
   return
endif
! 
entry 0009
!
write/out
write/out  test of Echelle command REGRESSION/ROBUST
write/out "-----------------------------------------"
!
set/context echelle
! 
indisk/fits thar5s.fit thar5s
indisk/fits bachesORDE.fit bachesORDE
indisk/fits bachesLINE.fit bachesLINE
indisk/fits MID_HOME:contrib/baches/demo/thar.fit thar.tbl

! do we use the display?
if dispyes(1) .eq. 1 .and.  dispyes(2) .eq. 1 then
   create/display 0 1000,600,0,25
   cuts/imag thar5s =sigma
   load/lut heat
   display/echelle thar5s
endif

initialize/echelle baches

! initialize/echelle sets keyword WLCVISU to YES
! which leads to display and graph window creation...
! so we have to sync that with dispyes keyword

if dispyes(1) .eq. 0 wlcvisu = "NO   "

set/eche WLCREG = ROBUST
identify/echelle

! icorr(1) = 1536
! @@ kcompare icorr outputi 1,1
! rcorr(3) = 133227.
! @@ kcompare rcorr outputr 3,3 0.5