← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to test/prim/verify12.prg

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/prim/verify12.prg
 
1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
!
 
3
!  MIDAS procedure verify12.prg  to verify MIDAS commands
 
4
!  K. Banse     020107, 020910, 031017, 080521, 091029
 
5
!
 
6
!  use as @@ verify12 ffffffffff             with f = 1 or 0 (on/off)
 
7
!
 
8
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
9
!
 
10
define/par p1 11111111111111 n "Enter control flags for entries: "
 
11
!
 
12
define/local loop/i/1/1 0
 
13
define/local rval/r/1/1 0. ? +lower
 
14
define/local ival/i/1/5 0 all +lower
 
15
define/local seconds/i/1/2 0,0 ? +lower
 
16
define/local rcorr/r/1/20 0. all +lower
 
17
define/local icorr/i/1/20 0 all +lower
 
18
define/local errsum/i/1/1 0 ? +lower
 
19
define/local secs/i/1/2 0,0 ? +lower
 
20
define/local myvals/i/1/6 0 all +lower
 
21
!
 
22
delete/temp                             !get rid of old temporary files
 
23
! 
 
24
write/key sizez/i/1/5 600,600,0,0,0
 
25
write/key dispyes/i/1/2 0,0
 
26
!
 
27
write/out +------------------------------------------+
 
28
write/out Start of procedure verify12.prg
 
29
write/out +------------------------------------------+
 
30
!
 
31
!
 
32
! if enabled, handle FITS working environment
 
33
!
 
34
set/midas newfil=?? >Null
 
35
if outputc(1:1) .eq. "F" then           !we're in true FITS environment
 
36
   inputi = m$len(mid$types)
 
37
   define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
 
38
   inputi = m$len(mid$types(9:))
 
39
   define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
 
40
   define/local workenv/c/1/4 FITS ? +lower
 
41
else
 
42
   define/local imatype/c/1/3 bdf ? +lower
 
43
   define/local tbltype/c/1/3 tbl ? +lower
 
44
   define/local workenv/c/1/5 Midas ? +lower
 
45
endif
 
46
! 
 
47
seconds(1) = m$secs()
 
48
set/format i1
 
49
do loop = 1 9
 
50
   if p1({loop}:{loop}) .eq. "1" @@ verify12,000{loop}
 
51
   if errsum .gt. 0 then
 
52
      write/out "We got problems with entry 000{loop} in verify12.prg!"
 
53
      return 1
 
54
   endif
 
55
enddo
 
56
! 
 
57
seconds(2) = m$secs()
 
58
mid$info(8) = seconds(2)-seconds(1)
 
59
!
 
60
write/out +------------------------------------------+
 
61
write/out procedure verify12.prg:
 
62
write/out Total time elapsed after first 9 tests = {mid$info(8)} seconds.
 
63
return 0
 
64
!
 
65
! because of the clear/contetx command we loose all local keywords,
 
66
! therefore entry 10, 11, ... execution comes here...
 
67
! 
 
68
if p1(10:10) .eq. "1" @@ verify12,00010
 
69
! 
 
70
write/out All tests o.k. - you deserve a coffee now...
 
71
write/out +------------------------------------------+
 
72
! 
 
73
!  here the different sub-procedures
 
74
!
 
75
entry 0001
 
76
!
 
77
write/out test of CREATE/DISPLAY + CREATE/GRAPHICS
 
78
write/out "----------------------------------------"
 
79
!
 
80
reset/display
 
81
create/display 7 512,512,616,300
 
82
dispyes(1) = 1                          !mark that we have display + graphic
 
83
dispyes(2) = 1
 
84
display/lut off
 
85
wait/secs 0.1
 
86
modify/disp ico
 
87
!
 
88
entry 0002
 
89
!
 
90
write/out  test of MODIFY/AREA
 
91
write/out "-------------------"
 
92
!
 
93
if workenv(1:1) .eq. "F" then
 
94
   -copy ccd.fits ccdin.fits
 
95
else
 
96
   indisk/fits ccd.fits ccdin.bdf
 
97
endif
 
98
create/table ccdintab * * ccdintab ccdintab
 
99
if dispyes(1) .eq. 1 then
 
100
   create/display 0 550,800,10,55
 
101
   clear/channel overlay
 
102
   load/image ccdin scale=2
 
103
   load/lut rainbow
 
104
   draw/rect ccdintab >Null
 
105
endif
 
106
modify/area ccdin,ccdintab ccdout
 
107
if dispyes(1) .eq. 1 then
 
108
   create/display 1 550,800,565,55
 
109
   load/image ccdout scale=2
 
110
   draw/rect ccdintab >Null
 
111
   draw/arrow 191.,312.,173.,321. f ? yellow >Null
 
112
   label/display "cleaned area" 302.,178.,f ov yellow 1
 
113
endif
 
114
modify/column ccdout ccdout v @53
 
115
if dispyes(1) .eq. 1 then
 
116
   load/ima ccdout
 
117
   draw/arrow 86.,250.,67.,231. f ? yellow >Null
 
118
   label/display "cleaned column" 258.,81.,f ov yellow 1 
 
119
endif
 
120
!
 
121
if aux_mode(1) .eq. 1 then
 
122
   -delete ccdi*.{imatype}.*
 
123
   -delete ccdint*.{tbltype}.*
 
124
else
 
125
   -delete ccdi*.{imatype}
 
126
   -delete ccdint*.{tbltype}
 
127
endif
 
128
!
 
129
entry 0003
 
130
!
 
131
write/out  test of VIMOS data files
 
132
write/out "-------------------------"
 
133
!
 
134
delete/temp
 
135
define/param p1 vimos.fits c "Enter name of FITS file (with type):"
 
136
if dispyes(1) .eq. 1 then
 
137
   delete/display 0
 
138
   delete/display 1
 
139
   modify/display window
 
140
endif
 
141
! 
 
142
set/format i1
 
143
!
 
144
write/out > get an overview of FITS file {p1}:
 
145
write/out > via: info/frame {p1} extens
 
146
! 
 
147
info/frame {p1} extens
 
148
define/local auxi/i/1/1 0
 
149
! 
 
150
set/midas dscalloc=0,0
 
151
secs(1) = m$secs()
 
152
display/long
 
153
READ/DESCR {p1} 
 
154
secs(2) = m$secs()
 
155
auxi = auxi+1
 
156
myvals({auxi}) = secs(2)-secs(1)
 
157
!
 
158
write/out > with the default settings for the descr. directory
 
159
write/out > READ/DESCR {p1} took {myvals({auxi})} seconds
 
160
!
 
161
write/out > 
 
162
write/out > extension[1] of FITS file {p1} has more than 3000 descriptors
 
163
outputi(2) = 1600
 
164
outputi(3) = 6000
 
165
set/midas dscalloc={outputi(2)},{outputi(3)}
 
166
write/out > so let's already allocate space for a big descr. directory
 
167
write/out > SET/MIDAS dscalloc={outputi(2)},{outputi(3)}
 
168
secs(1) = m$secs()
 
169
display/long
 
170
READ/DESCR {p1} 
 
171
secs(2) = m$secs()
 
172
auxi = auxi+1
 
173
myvals({auxi}) = secs(2)-secs(1)
 
174
write/out > now READ/DESCR {p1} took {myvals({auxi})} seconds
 
175
if myvals(1) .gt. 0 then
 
176
   outputr = (myvals(1)-myvals({auxi}))/myvals(1)
 
177
   outputi = outputr*100
 
178
   write/out > which is a {outputi} % saving
 
179
endif
 
180
write/out
 
181
write/out > actually for this command we don't need any ESO.xyz descriptors
 
182
write/out > so, let's ignore them via
 
183
write/out > SET/MIDAS eso-desc=no
 
184
SET/MIDAS eso-desc=no
 
185
secs(1) = m$secs()
 
186
READ/DESCR {p1} 
 
187
secs(2) = m$secs()
 
188
auxi = auxi+1
 
189
myvals({auxi}) = secs(2)-secs(1)
 
190
write/out > now READ/DESCR {p1} took {myvals({auxi})} seconds
 
191
SET/MIDAS eso-desc=yes
 
192
! 
 
193
if workenv(1:1) .eq. "F" return
 
194
! 
 
195
write/out 
 
196
write/out > Convert all extensions of {p1} to internal Midas format
 
197
write/out > via: indisk/mfits vimos.fits mvim
 
198
indisk/mfits vimos.fits mvim
 
199
!
 
200
if dispyes(2) .eq. 1 then
 
201
   load/image mvim0001 scale=-4 cuts=185,900
 
202
endif
 
203
! 
 
204
write/out
 
205
read/descr mvim0001 eso.ins.slit400.x f >middu.dat+term
 
206
open/file ./middu.dat read inputi
 
207
if inputi(1) .lt. 1 then
 
208
   write/out > could not open ./middu.dat ...
 
209
   errsum = errsum + 1
 
210
   return
 
211
endif
 
212
read/file {inputi} inputc
 
213
write/keyw inputc " " all
 
214
read/file {inputi} inputc
 
215
close/file {inputi}
 
216
inputi = m$index(inputc,"(x co-ordinate")
 
217
if inputi .lt. 10 then
 
218
   write/out > could not read the help text for descr ESO.INS.SLIT400.X ...
 
219
   errsum = errsum + 1
 
220
   return
 
221
endif
 
222
! 
 
223
write/out 
 
224
write/out > STATISTICS/IMAGE mvim0001
 
225
statistics/image mvim0001
 
226
write/key rcorr  1.93596E+02,6.09617E+03,2.29753E+02,2.17852E+02
 
227
write/key rcorr/r/5/3 1.54960E+01,2.74223E+02,1.93892784E+08
 
228
write/key icorr  843920,2,955,533,484
 
229
@@ kcompare rcorr outputr 1,4 0.01
 
230
@@ kcompare rcorr outputr 5,6 0.3
 
231
@@ kcompare rcorr outputr 7,7 0.5
 
232
@@ kcompare icorr outputi 1,5
 
233
write/out > 
 
234
write/out > STATISTICS/IMAGE mvim0002
 
235
statistics/image mvim0002
 
236
write/key rcorr 209.233,11597.9,3.03998E+02,1.13098E+02
 
237
write/key rcorr/r/5/3 1.95013E+01,1.26267E+03,2.56549968E+08
 
238
write/key icorr  843920,879,953,521,329
 
239
@@ kcompare rcorr outputr 1,4 0.02
 
240
@@ kcompare rcorr outputr 5,6 0.3
 
241
@@ kcompare rcorr outputr 7,7 0.5
 
242
@@ kcompare icorr outputi 1,5
 
243
! 
 
244
write/out >  
 
245
write/out > one can access FITS extensions directly in a Midas command, e.g.:
 
246
write/out > STATISTICS/IMAGE {p1}[2]
 
247
write/out > should be the same as:
 
248
write/out > STATISTICS/IMAGE mvim0002
 
249
statistics/image {p1}[2]
 
250
write/key rcorr 209.233,11597.9,3.03998E+02,1.13098E+02
 
251
write/key rcorr/r/5/3 1.95013E+01,1.26267E+03,2.56549968E+08
 
252
write/key icorr  843920,879,953,521,329
 
253
@@ kcompare rcorr outputr 1,4 0.02
 
254
@@ kcompare rcorr outputr 5,6 0.3
 
255
@@ kcompare rcorr outputr 7,7 0.5
 
256
@@ kcompare icorr outputi 1,5
 
257
! 
 
258
write/out >  
 
259
write/out > now some number crunching: "COMPUTE/IMAGE vv = mvim0001 + 123.456"
 
260
secs(1) = m$secs()
 
261
compute/image vv = mvim0001 + 123.456
 
262
secs(2) = m$secs()
 
263
myvals(1) = secs(2)-secs(1)
 
264
write/out > COMPUTE/IMAGE took {myvals(1)} seconds
 
265
write/out > "but most of the time was spent copying the more than" -
 
266
            3000 descriptors...
 
267
write/out > let's turn off the descriptor copying, via: SET/MIDAS dsccopy=no
 
268
write/out > COMPUTE/IMAGE vv = mvim0001 + 123.456
 
269
set/midas dsccopy=no
 
270
secs(1) = m$secs()
 
271
compute/image vv = mvim0001 + 123.456
 
272
secs(2) = m$secs()
 
273
myvals(2) = secs(2)-secs(1)
 
274
write/out > now the COMPUTE/IMAGE took {myvals(2)} seconds
 
275
set/midas dsccopy=yes                   !needed for other verifications
 
276
! 
 
277
write/out >  
 
278
write/out > "now rebuild the Vimos FITS file and add image `vv.bdf' as" -
 
279
            third extension 
 
280
write/out > OUTDISK/SFITS mvim0000.bdf,mvim0001.bdf,mvim0002.bdf,vv.bdf -
 
281
            newVIMOS.fits
 
282
! 
 
283
-delete newVIMOS.fits
 
284
OUTDISK/SFITS mvim0000.bdf,mvim0001.bdf,mvim0002.bdf,vv.bdf newVIMOS.fits
 
285
if m$exist("newVIMOS.fits") .ne. 1 then
 
286
   write/out > problems with building new FITS file (OUTDISK/SFITS)"
 
287
   errsum = errsum + 1
 
288
   return
 
289
endif
 
290
! 
 
291
set/midas dscalloc=0,0
 
292
write/out
 
293
read/key myvals
 
294
!
 
295
entry 0004
 
296
!
 
297
write/out  test of CONVERT/DESCR_MATRIX
 
298
write/out "-----------------------------"
 
299
! 
 
300
if workenv(1:1) .eq. "F" return
 
301
! 
 
302
set/format i1
 
303
show/descr mvim0001 >Null
 
304
myvals(1) = outputi                             !save total
 
305
! 
 
306
write/out >
 
307
write/out > get rid of that ESO.INS.SLIT descriptor matrix via
 
308
write/out > -
 
309
CONVERT/DESCR_MATRIX mvim0001 slittab ds-t eso.ins.slit type,id,x,y,dimx,dimy 1
 
310
CONVERT/DESCR mvim0001 slittab ds-t eso.ins.slit type,id,x,y,dimx,dimy 1
 
311
! 
 
312
write/out > now, let's time again the COMPUTE statement
 
313
secs(1) = m$secs()
 
314
compute/image vv = mvim0001 + 123.456
 
315
secs(2) = m$secs()
 
316
myvals(2) = secs(2)-secs(1)
 
317
write/out > COMPUTE/IMAGE took {myvals(2)} seconds
 
318
! 
 
319
write/out > CONVERT/DESCR mvim0001 slittab t-ds 
 
320
CONVERT/DESCR mvim0001 slittab t-ds 
 
321
show/descr mvim0001 >Null
 
322
if outputi .ne. myvals(1) then
 
323
   write/out descr total was {myvals(1)}, is now {outputi}
 
324
endif
 
325
! 
 
326
delete/temp
 
327
if aux_mode(1) .eq. 1 then
 
328
   -delete mvim0*.{imatype}.*
 
329
   -delete vv.bdf.*
 
330
else
 
331
   -delete mvim0*.{imatype}
 
332
   -delete vv.bdf
 
333
endif
 
334
!
 
335
entry 0005
 
336
! 
 
337
if workenv(1:1) .eq. "F" return
 
338
!
 
339
select/table slittab seq.lt.30
 
340
copy/table slittab middumm
 
341
! 
 
342
execute/table middumm compute/image [:x] -2 >blabla.dat
 
343
execute/table middumm compute/image [:dimy] + 0.1 >blublu.dat
 
344
execute/table middumm compute/image [:id] + 0 >bloblo.dat
 
345
! 
 
346
write/keyword in_a <blabla.dat
 
347
write/keyword in_b <blublu.dat
 
348
if in_a .eq. in_b then
 
349
   write/out > in_a = {in_a}
 
350
   write/out > in_b = {in_b}
 
351
   write/out > they should be different...
 
352
   errsum = errsum + 1
 
353
   return
 
354
endif
 
355
! 
 
356
define/local fca/i/1/2 0,0
 
357
define/local fcb/i/1/2 0,0
 
358
open/file blabla.dat read fca
 
359
open/file blublu.dat read fcb 
 
360
if fca(1) .lt. 0 .or. fcb(1) .lt. 0 then
 
361
   errsum = errsum + 1
 
362
   return
 
363
endif
 
364
read/file {fca} inputc
 
365
read/file {fcb} outputc
 
366
if fca(2) .lt. 0 .or. fcb(2) .lt. 0 then
 
367
   errsum = errsum + 1
 
368
   return
 
369
endif
 
370
if inputc(1:{fca(2)}) .eq. outputc(1:{fca(2)}) then
 
371
   errsum = errsum + 1
 
372
   return
 
373
endif
 
374
close/file {fca(1)}
 
375
close/file {fcb(1)}
 
376
! 
 
377
open/file blublu.dat read fca
 
378
open/file bloblo.dat read fcb 
 
379
if fca(1) .lt. 0 .or. fcb(1) .lt. 0 then
 
380
   errsum = errsum + 1
 
381
   return
 
382
endif
 
383
read/file {fca} inputc
 
384
read/file {fcb} outputc
 
385
if fca(2) .lt. 0 .or. fcb(2) .lt. 0 then
 
386
   errsum = errsum + 1
 
387
   return
 
388
endif
 
389
if inputc(1:{fca(2)}) .eq. outputc(1:{fca(2)}) then
 
390
   errsum = errsum + 1
 
391
   return
 
392
endif
 
393
close/file {fca(1)}
 
394
close/file {fcb(1)}
 
395
! 
 
396
if aux_mode(1) .eq. 1 then
 
397
   -delete slittab.tbl.*
 
398
   -delete middumm.tbl.*
 
399
else
 
400
   -delete slittab.tbl
 
401
   -delete middumm.tbl
 
402
endif
 
403
! 
 
404
entry 0006
 
405
! 
 
406
entry dscfill
 
407
define/local klus/i/1/1 0
 
408
! 
 
409
do klus = 1 10
 
410
   write/descr {p1} eso.ins.desc.txt{klus}/c/1/20 "Na bitte, Brigitte "
 
411
   write/dhelp {p1} eso.ins.desc.txt{klus} "Just a text string..."
 
412
   write/descr {p1} eso.ins.desc.ix{klus}/i/1/2 {klus},{klus}
 
413
   write/dhelp {p1} eso.ins.desc.ix{klus} "Two integer values..."
 
414
   write/descr {p1} eso.ins.desc.rx{klus}/r/1/2 {klus}.1,{klus}.2
 
415
   write/dhelp {p1} eso.ins.desc.rx{klus} "Two real values..."
 
416
   write/descr {p1} eso.ins.desc.dx{klus}/d/1/3 {klus}.7,{klus}.8,{klus}.9
 
417
   write/dhelp {p1} eso.ins.desc.dx{klus} "Three double values..."
 
418
enddo
 
419
! 
 
420
entry 0007
 
421
!
 
422
if dispyes(1) .eq. 1 then
 
423
   crea/disp 0
 
424
   wait/secs 0.2
 
425
   dele/disp all
 
426
   wait/secs 1                  !for slow machines...
 
427
   crea/disp 1
 
428
endif
 
429
! 
 
430
entry 0008
 
431
!
 
432
entry 0009
 
433
!
 
434
entry 00010
 
435
!
 
436
write/out  test of creating/deleting commands (via context)
 
437
write/out "------------------------------------------------"
 
438
!
 
439
set/context rbs
 
440
start/pipeline
 
441
write/keyw klaussi/i/1/1 0
 
442
define/local maindir/c/1/120 " " all
 
443
maindir = m$symbol("MID_HOME")
 
444
if aux_mode .eq. 1 then
 
445
   write/keyw veridir/c/1/120 {maindir}.test.prim]
 
446
else
 
447
   write/keyw veridir/c/1/120 {maindir}/test/prim/
 
448
endif
 
449
! 
 
450
do klaussi = 1 5
 
451
   write/out
 
452
   write/out >>>>>>> loop no. {klaussi} <<<<<<<<
 
453
   write/out
 
454
   clear/context -total
 
455
   set/context rbs
 
456
   set/context verify {veridir}                 !removes all local keywords
 
457
   !
 
458
   set/context cloud 
 
459
   write/out "show currently enabled contexts"
 
460
   write/out
 
461
   show/context
 
462
   wait/secs 1
 
463
   !
 
464
   clear/cont verify 
 
465
   clear/CONTEXT cloud
 
466
   clear/CONTEXT rbs
 
467
enddo
 
468
! 
 
469
ididev(18) = 11
 
470
mid$disp = "I_ImageDisplay "
 
471
! 
 
472
if dispyes(1) .eq. 1 then
 
473
   load tst0010.mt[2] scale=3,2
 
474
   load/lut rainbow3 ? d
 
475
   load tst0010.mt[2]
 
476
   clear/chan 
 
477
   load/lut aips0 ? d
 
478
   load tst0010.mt[2]
 
479
endif
 
480
!
 
481