← Back to branch summary

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

« back to all changes in this revision

Viewing changes to test/prim/verify8.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/verify8.prg
 
1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
!
 
3
!  MIDAS procedure verify8.prg  to verify MIDAS commands
 
4
!  K. Banse     950906  creation
 
5
!
 
6
!  use as @@ verify8 ffffffff             with f = 1 or 0 (on/off)
 
7
!
 
8
! 130503                last modif
 
9
! 
 
10
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
11
!
 
12
define/par p1 111111111 n "Enter control flags for entries: "
 
13
!
 
14
define/local loop/i/1/1 0
 
15
define/local rval/r/1/1 0. ? +lower
 
16
define/local ival/i/1/5 0 all +lower
 
17
define/local rcorr/r/1/20 0. all +lower
 
18
define/local icorr/i/1/20 0 all +lower
 
19
define/local errsum/i/1/1 0 ? +lower
 
20
define/local ccc/c/1/9 000000000
 
21
define/local scale/i/1/1 1 ? +lower
 
22
define/local seconds/i/1/2 0,0? +lower
 
23
!
 
24
delete/temp                             !get rid of old temporary files
 
25
seconds(1) = m$secs()
 
26
write/key sizez/i/1/5 600,600,0,0,0
 
27
write/key dispyes/i/1/2 0,0
 
28
! 
 
29
write/out +------------------------------------------+
 
30
write/out Start of procedure verify8.prg
 
31
write/out +------------------------------------------+
 
32
!
 
33
set/midas f_update=??
 
34
define/local save_out/c/1/20 {outputc}
 
35
set/midas f_update=yes
 
36
! 
 
37
! if enabled, handle FITS working environment
 
38
!
 
39
set/midas newfil=?? >Null
 
40
if outputc(1:1) .eq. "F" then           !we're in true FITS environment
 
41
   inputi = m$len(mid$types)
 
42
   define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
 
43
   inputi = m$len(mid$types(9:))
 
44
   define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
 
45
   define/local workenv/c/1/4 FITS ? +lower
 
46
else
 
47
   define/local imatype/c/1/3 bdf ? +lower
 
48
   define/local tbltype/c/1/3 tbl ? +lower
 
49
   define/local workenv/c/1/5 Midas ? +lower
 
50
endif
 
51
! 
 
52
write/key ccc {p1}
 
53
set/format i1
 
54
do loop = 1 9
 
55
   if ccc({loop}:{loop}) .eq. "1" @@ verify8,000{loop}
 
56
   if errsum .gt. 0 then
 
57
      write/out "We got problems with entry 000{loop} in verify8.prg!"
 
58
      return 1
 
59
   endif
 
60
enddo
 
61
! 
 
62
set/midas f_update={save_out}
 
63
! 
 
64
seconds(2) = m$secs()
 
65
mid$info(8) = seconds(2)-seconds(1)
 
66
!
 
67
write/out +------------------------------------------+
 
68
write/out procedure verify8.prg:
 
69
write/out Total time elapsed = {mid$info(8)} seconds.
 
70
write/out All tests o.k. - you deserve a coffee now...
 
71
write/out +------------------------------------------+
 
72
return 0
 
73
!
 
74
!  here the different sub-procedures
 
75
!
 
76
entry 0001
 
77
!
 
78
write/out test of CREATE/DISPLAY 
 
79
write/out "----------------------"
 
80
!
 
81
reset/display  >Null
 
82
create/display 7 700,512,400,300  >Null
 
83
dispyes(1) = 1                          !mark that we have display + graphic
 
84
dispyes(2) = 1
 
85
display/lut off
 
86
load/lut rainbow3
 
87
!
 
88
entry 0002
 
89
!
 
90
write/out test of constructing an image
 
91
write/out "----------------------------"
 
92
!
 
93
@@ creamask                     !create image arti.bdf
 
94
! 
 
95
rebin/linear arti &z .1,.25
 
96
filter/smooth &z &b 2,2,0. >Null
 
97
!
 
98
if dispyes(2) .eq. 1 then
 
99
   load/ima &b 
 
100
endif
 
101
!
 
102
create/ima &a 2,{&b,npix(1)},{&b,npix(2)} ? poly 0.,0.7
 
103
replace/ima &b veria 0.09,>=&a,0. >Null
 
104
! 
 
105
find/min veria >Null
 
106
find/pixel veria 0.0,0.1 out >Null
 
107
rval = outputr(1)-0.2
 
108
!
 
109
if dispyes(2) .eq. 1 then
 
110
   load/ima veria cuts={rval},{veria,lhcuts(4)}
 
111
endif
 
112
!
 
113
apply/edge veria &e 0.1 >Null
 
114
! 
 
115
if dispyes(2) .eq. 1 then
 
116
   load/ima &e cuts=0.,1.
 
117
endif
 
118
!
 
119
inputr = 0.2+{veria,lhcuts(4)}
 
120
replace/ima veria &b &e/0.09,>={inputr} >Null
 
121
! 
 
122
find/min &b >Null
 
123
if dispyes(2) .eq. 1 then
 
124
   load/ima &b cuts={rval},{&b,lhcuts(4)}
 
125
endif
 
126
!
 
127
crea/ima &z 2,2047,172 
 
128
!
 
129
write/descr &b step 1.,1.
 
130
inputi(1) = {&z,npix(1)}/2-{&b,npix(1)}/2
 
131
insert/ima &b &z @{inputi}
 
132
! 
 
133
write/image &z <,<,2047 {&b,lhcuts(4)} all
 
134
write/image &z <,>,2047 {&b,lhcuts(4)} all
 
135
create/image &c 2,1,172 ? ? {&b,lhcuts(4)}
 
136
insert/image &c &z <,<
 
137
insert/image &c &z >,<
 
138
!
 
139
if dispyes(1) .eq. 1 then
 
140
   load/ima &z cuts={rval},{&b,lhcuts(4)}
 
141
endif
 
142
! 
 
143
read/descr &z *
 
144
!
 
145
entry 0003
 
146
write/out test of LOAD/IMAGE with scaling
 
147
write/out "-------------------------------"
 
148
!
 
149
if dispyes(1) .ne. 1 return
 
150
! 
 
151
define/local loop/i/1/2 0,0
 
152
set/format i1
 
153
! 
 
154
do loop = 1 4
 
155
   write/out > load/image &z.{imatype} scale=-{loop},1 center=c
 
156
   load/image &z.{imatype} scale=-{loop},1 center=c
 
157
enddo
 
158
do loop = 2 5
 
159
   write/out > load/image &z.{imatype} scale=-{loop},{loop} center=c
 
160
   load/image &z.{imatype} scale=-{loop},{loop} center=c
 
161
enddo
 
162
do loop = 4 7
 
163
   write/out > load/image &z.{imatype} scale={loop},-{loop} center=c
 
164
   load/image &z.{imatype} scale={loop},-{loop} center=c
 
165
enddo
 
166
do loop = 3 6
 
167
   write/out > load/image &z.{imatype} scale=-{loop},-{loop} center=c
 
168
   load/image &z.{imatype} scale=-{loop},-{loop} center=c
 
169
enddo
 
170
!
 
171
write/out > load/image &z.{imatype} scale=-4,1 center=c
 
172
load/image &z.{imatype} scale=-4,1 center=c
 
173
wait/sec 1
 
174
write/out > load/image &z.{imatype} scale=-4,1,a center=c
 
175
load/image &z.{imatype} scale=-4,1,a center=c
 
176
wait/sec 1
 
177
write/out > load/image &z.{imatype} scale=-4,1,min center=c
 
178
load/image &z.{imatype} scale=-4,1,min center=c
 
179
wait/sec 1
 
180
write/out > load/image &z.{imatype} scale=-4,1,max center=c
 
181
load/image &z.{imatype} scale=-4,1,max center=c
 
182
! 
 
183
write/image &z <,<,2047 0 all
 
184
write/image &z <,>,2047 0 all
 
185
! 
 
186
write/out > load/image &z.{imatype} scale=-2,2 center=c
 
187
load/image &z.{imatype} scale=-2,2 center=c
 
188
write/out > load/image &z.{imatype} scale=-6,-2 dirs=up,ov center=c
 
189
load/image &z.{imatype}  scale=-6,-2 dirs=up,ov center=c
 
190
! 
 
191
write/out finally let's display a vertical LUT with labels
 
192
write/out @a vertlut
 
193
@a vertlut
 
194
! 
 
195
rename/image &z veria.bdf
 
196
!
 
197
entry 0004
 
198
write/out test of LOAD/IMAGE with different planes (video)
 
199
write/out "------------------------------------------------"
 
200
!
 
201
if dispyes(1) .ne. 1 .or. workenv(1:1) .eq. "F" return
 
202
!
 
203
write/out > build a cube with 4 planes from a Rosat image
 
204
write/out > create/image &cub 3,256,256,4
 
205
create/image &cub 3,256,256,4
 
206
! 
 
207
compute/image &p = rosat.mt
 
208
write/descr &p step 1.,1.
 
209
write/descr &p start 100.,100.
 
210
compute/image &r = &p * 1.5
 
211
compute/image &s = &p * 2.
 
212
insert/image &p &cub <,<,@1
 
213
insert/image &p &cub <,<,@2
 
214
insert/image &r &cub <,<,@3
 
215
insert/image &s &cub <,<,@4
 
216
clear/chan overlay
 
217
write/out > load/image &cub,2..4,1 scale=2 cuts=3.,8.
 
218
load/image &cub,2..4,1 scale=2 cuts=3.,8.
 
219
! 
 
220
if applic(1:1) .ne. "t" then            !test, if load/image command went o.k.
 
221
   errsum = errsum+1
 
222
   return
 
223
endif 
 
224
! 
 
225
entry 0005
 
226
write/out some more table tests
 
227
write/out "---------------------"
 
228
! 
 
229
define/local mm/i/1/1 0
 
230
! 
 
231
create/table test 15  1000
 
232
write/descr  test.{tbltype}  PIXEL/R/1/1 1.
 
233
create/column test :X F10.2  R*4
 
234
create/column test :Y F10.2  R*4
 
235
create/column test :PEAK E12.3  R*4
 
236
create/column test :IDENT F15.7  R*8
 
237
DELETE/DESCR test.{tbltype} PIXEL
 
238
create/column test :R1 F10.6 R*8
 
239
create/column test :R2 F10.6 R*8
 
240
create/column test :R3 F10.6 R*8
 
241
create/column test :R4 F10.6 R*8
 
242
create/column test :R5 F10.6 R*8
 
243
mm = m$existd("test.{tbltype}","tlabl009")
 
244
if mm .ne. 1 then
 
245
   errsum = errsum+1
 
246
   return
 
247
endif 
 
248
create/column test :R6 F10.6 R*8
 
249
create/column test :R7 F10.6 R*8
 
250
create/column test :R8 F10.6 R*8
 
251
create/column test :R9 F10.6 R*8
 
252
create/column test :R10 F10.6 R*8
 
253
create/column test :R11 F10.6 R*8
 
254
mm = m$existd("test.{tbltype}","tlabl006")
 
255
if mm .ne. 1 then
 
256
   errsum = errsum+1
 
257
   return
 
258
endif 
 
259
! 
 
260
test.{tbltype},x,@1 = 1.234
 
261
test.{tbltype},y,@1 = 2.345
 
262
read/table test
 
263
! 
 
264
if workenv(1:1) .eq. "F" then
 
265
   -copy test.{tbltype} testtab.mt
 
266
else
 
267
   outdisk/fits test.{tbltype} testtab.mt
 
268
endif
 
269
! 
 
270
entry 0006
 
271
!
 
272
if aux_mode(1) .eq. 1 return                    !not implemented yet for VMS
 
273
! 
 
274
write/out test of handling FITS images
 
275
write/out "----------------------------"
 
276
!
 
277
set/midas newfile=midas                 !ensure Midas format for new files
 
278
$rm -f flatf.fits
 
279
$cp nttexample.mt flatf.fits            !get the data file
 
280
$ chmod +w flatf.fits
 
281
if workenv(1:1) .eq. "F" then
 
282
  set/midas newfile=fits
 
283
  write/descr testtab.mt ident/c/1/72 "this is the identification... "
 
284
  return                !we already work with FITS files...
 
285
endif
 
286
! 
 
287
indisk/fits flatf.fits middummz.bdf     !the Midas reference frame
 
288
! 
 
289
read/descr flatf.fits
 
290
write/out > write/descr flatf.fits start/d/2/1 1.12345
 
291
write/descr flatf.fits start/d/2/1 1.12345
 
292
write/out > and now start(2) of flatf.fits:
 
293
write/out {flatf.fits,start(2)}
 
294
outputr(1) = 1.12345
 
295
rcorr(1) = m$value(flatf.fits,start(2))
 
296
@@ kcompare rcorr outputr 1,1 0.00005
 
297
! 
 
298
write/image flatf.fits @100,@200,2 11.,12.
 
299
write/out > write/image flatf.fits @100,@200,2 11.,12.
 
300
write/image &z @100,@200,2 11.,12.
 
301
@a diffima flatf.fits &z 0.0001
 
302
if outputi(10) .ne. 0 then
 
303
   errsum = errsum+1
 
304
   write/out ######## problem (a) with entry 0006
 
305
   return
 
306
endif
 
307
write/out > compute/image &r = flatf.fits+21.22
 
308
compute/image &r = flatf.fits+21.22
 
309
compute/image &b = &z+21.22
 
310
@a diffima &r &b 0.0001
 
311
if outputi(10) .ne. 0 then
 
312
   errsum = errsum+1
 
313
   write/out ######## problem (b) with entry 0006
 
314
   return
 
315
endif
 
316
!
 
317
if dispyes(2) .eq. 1 then
 
318
   clear/chan ov
 
319
   load/ima flatf.fits cuts=f,3sigma
 
320
endif
 
321
!
 
322
-copy flatf.fits a_VLT_instrument_like_very_long_name_ident1.fits
 
323
-copy flatf.fits a_VLT_instrument_like_very_long_name_ident2.fits
 
324
-copy flatf.fits a_VLT_instrument_like_very_long_name_ident3.fits
 
325
write/out > copy FITS file flatf.fits to the files:
 
326
write/out "     " -
 
327
 a_VLT_instrument_like_very_long_name_ident1.fits  and
 
328
write/out "     " -
 
329
 a_VLT_instrument_like_very_long_name_ident2.fits  and
 
330
write/out "     " -
 
331
 a_VLT_instrument_like_very_long_name_ident3.fits 
 
332
write/out > -
 
333
compute/image &m = (a_VLT_instrument_like_very_long_name_ident1.fits + 
 
334
write/out "     " -
 
335
       (a_VLT_instrument_like_very_long_name_ident2.fits*1.03)) + 
 
336
write/out "     " -
 
337
       (a_VLT_instrument_like_very_long_name_ident3.fits/4.4)
 
338
compute/image &m = (a_VLT_instrument_like_very_long_name_ident1.fits + -
 
339
      (a_VLT_instrument_like_very_long_name_ident2.fits*1.03)) + -
 
340
      (a_VLT_instrument_like_very_long_name_ident3.fits/4.4)
 
341
compute/image &n = &z + (&z*1.03) + (&z/4.4)
 
342
@a diffima &m &n 0.0001
 
343
if outputi(10) .ne. 0 then
 
344
   errsum = errsum+1
 
345
   write/out ######## problem (c) with entry 0006
 
346
   return
 
347
endif
 
348
compute/image &m = (a_VLT_instrument_like_very_long_name_ident1.fits + -
 
349
      (a_VLT_instrument_like_very_long_name_ident2.fits*1.03)) + -
 
350
      (a_VLT_instrument_like_very_long_name_ident3.fits/4.4)
 
351
! 
 
352
entry 0007
 
353
!
 
354
if aux_mode(1) .eq. 1 return                    !not implemented yet for VMS
 
355
! 
 
356
if workenv(1:1) .eq. "F" return         !we already work with FITS files...
 
357
! 
 
358
write/out test of creating FITS images automatically
 
359
write/out "------------------------------------------"
 
360
!
 
361
replace/image flatf.fits &b <,300=0.0 >Null
 
362
compute/image &y = (444.4+&b)/12.
 
363
! 
 
364
write/out > -rename flatf.fits flatf.fitz
 
365
-rename flatf.fits flatf.fitz
 
366
write/out > set/midas newfiles=fits,fitz
 
367
set/midas newfiles=fits,fitz
 
368
! 
 
369
write/out > replace/image flatf.fitz &a <,300=0.0
 
370
replace/image flatf.fitz &a <,300=0.0 >Null
 
371
@a diffima middumma.fitz &b.bdf 0.0001
 
372
if outputi(10) .ne. 0 then
 
373
   errsum = errsum+1
 
374
   write/out ######## problem (a) with entry 0007
 
375
   goto setback
 
376
endif
 
377
! 
 
378
write/out > compute/image &t = (444.4+middumma.fitz)/12.
 
379
compute/image &t = (444.4+middumma.fitz)/12.
 
380
@a diffima middummt.fitz &y.bdf 0.0001
 
381
if outputi(10) .ne. 0 then
 
382
   errsum = errsum+1
 
383
   write/out ######## problem (b) with entry 0007
 
384
   goto setback
 
385
endif
 
386
! 
 
387
rename/ima middumma.fitz lola.fitz
 
388
rename/ima middummt.fitz kuki.fitz
 
389
write/out > create/icat kukiwu *.fitz ESO.DET.EXP.TYPE
 
390
create/icat kukiwu *.fitz ESO.DET.EXP.TYPE
 
391
write/out > show/icat kukiwu
 
392
show/icat kukiwu
 
393
write/out > read/icat kukiwu
 
394
read/icat kukiwu
 
395
write/out > read/descr #3_kukiwu
 
396
read/descr #3_kukiwu
 
397
setback:
 
398
set/midas newfile=midas                 !go back to Midas format for new files
 
399
!
 
400
-delete flatf.fitz lola.fitz kuki.fitz kukiwu.cat 
 
401
-delete a_VLT_instrument_like_very_long_name_ident1.fits
 
402
-delete a_VLT_instrument_like_very_long_name_ident2.fits
 
403
-delete a_VLT_instrument_like_very_long_name_ident3.fits
 
404
! 
 
405
entry 0008
 
406
!
 
407
if aux_mode(1) .eq. 1 return                    !not implemented yet for VMS
 
408
! 
 
409
write/out some tests of handling FITS tables
 
410
write/out "----------------------------------"
 
411
! 
 
412
write/out > write/table testtab.mt :R6 @1 66.66
 
413
write/table testtab.mt :R6 @1 66.66
 
414
write/out > testtab.mt,:r7,@1 = 77.77
 
415
testtab.mt,:r7,@1 = 77.77
 
416
write/out > read/table testtab.mt
 
417
read/table testtab.mt
 
418
write/out > show/table testtab.mt
 
419
show/table testtab.mt
 
420
inputr = m$value(testtab.mt,:r7,1)
 
421
write/key rcorr 77.77
 
422
@@ kcompare rcorr inputr 1,1 0.001
 
423
read/descr testtab.mt ident
 
424
write/descr testtab.mt ident kukiwuki
 
425
copy/dk testtab.mt ident out_a
 
426
if out_a .ne. "kukiwuki" then   errsum = errsum+1
 
427
   write/out ######## problem with entry 0008
 
428
   return
 
429
endif
 
430
!
 
431
delete/table test noconf
 
432
!
 
433
entry 0009
 
434
!
 
435
if mid$sys(1:5) .eq. "PC/Cy" then
 
436
   define/local im_a/c/1/96 FORS.1999-01-27T05c43c50.495.fits
 
437
else
 
438
   define/local im_a/c/1/96 FORS.1999-01-27T05:43:50.495.fits
 
439
endif
 
440
 
 
441
inputi = m$exist("MID_TEST:{im_a}")
 
442
if inputi .ne. 1 then
 
443
   nodemo = nodemo + 1
 
444
   $ echo "missing file: {im_a} in verify8.prg" >> ./missing-files
 
445
   return
 
446
endif
 
447
! 
 
448
write/out  some tests with a FORS1 image
 
449
write/out "-----------------------------"
 
450
! 
 
451
-copy MID_TEST:{im_a} {im_a}
 
452
! 
 
453
define/local cv/r/1/2 280,8300
 
454
if dispyes(1) .eq. 1 then
 
455
   load/lut rainbow4
 
456
   load/ima {im_a} cuts={cv(1)},{cv(2)}
 
457
endif
 
458
write/out > extract/image &ll = {im_a} [<,<:@1040,@1024]        !lower left
 
459
extract/image &ll = {im_a} [<,<:@1040,@1024]    !lower left
 
460
write/out > extract/image &lr = {im_a} [@1041,<:>,@1024]
 
461
extract/image &lr = {im_a} [@1041,<:>,@1024]
 
462
write/out > extract/image &ul = {im_a} [<,@1025:@1040,>]        !upper left
 
463
extract/image &ul = {im_a} [<,@1025:@1040,>]    !upper left
 
464
write/out > extract/image &ur = {im_a} [@1041,@1025:>,>]
 
465
extract/image &ur = {im_a} [@1041,@1025:>,>]
 
466
! 
 
467
define/local minim/r/1/4 0. all
 
468
define/local fact/r/1/1 0. 
 
469
! 
 
470
statist/image &ll [151.034,-27.3490:151.029,-27.3458]
 
471
minim(1) = outputr(3)
 
472
statist/image &lr [151.011,-27.3500:151.007,-27.3468]
 
473
minim(2) = outputr(3)
 
474
statist/image &ul [151.035,-27.3347:151.030,-27.3315]
 
475
minim(3) = outputr(3)
 
476
statist/image &ur [151.009,-27.3307:151.005,-27.3274]
 
477
minim(4) = outputr(3)
 
478
! 
 
479
fact = minim(1) / minim(2)
 
480
write/out > compute/imag &lr1 = &lr * {fact}
 
481
compute/imag &lr1 = &lr * {fact}
 
482
fact = minim(1) / minim(3)
 
483
write/out > compute/imag &ul1 = &ul * {fact}
 
484
compute/imag &ul1 = &ul * {fact}
 
485
fact = minim(1) / minim(4)
 
486
write/out > compute/imag &ur1 = &ur * {fact}
 
487
compute/imag &ur1 = &ur * {fact}
 
488
! 
 
489
write/out > compute/image &new = "{im_a}" * 0.0
 
490
compute/image &new = "{im_a}" * 0.0
 
491
write/out > insert/image &ll &new
 
492
insert/image &ll &new
 
493
write/out > insert/image &lr1 &new
 
494
insert/image &lr1 &new
 
495
write/out > insert/image &ul1 &new
 
496
insert/image &ul1 &new
 
497
write/out > insert/image &ur1 &new
 
498
insert/image &ur1 &new
 
499
if dispyes(1) .eq. 1 then
 
500
   load/ima &new cuts={cv(1)},{cv(2)}
 
501
endif
 
502
statist/image &new
 
503
write/keyw rcorr  194,76675.3,2839.6,1019.6,51.3063,3266.62
 
504
@@ kcompare rcorr outputr 1,6 0.1
 
505
write/keyw icorr  4259840,11,363,1723,47
 
506
@@ kcompare icorr outputi 1,5
 
507
 
 
508