/usr/lib/eso-midas/17FEB/test/prim/verify14.prg is in eso-midas-testdata 17.02pl1.2-2build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 | ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! 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
|