1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
3
! MIDAS procedure verify1.prg to verify MIDAS commands
4
! K. Banse 931104, 970521, 981008, 990729
8
! use as @@ verify1 ffffffff with f = 1 or 0 (on/off)
10
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
12
define/par p1 11111111 n "Enter control flags for entries: "
14
define/local loop/i/1/1 0
15
define/local test/c/1/1 ? ? +lower
16
define/local rval/r/1/1 0. ? +lower
17
define/local ival/i/1/5 0 all +lower
18
define/local cfunc/c/1/16 " " all +lower
19
define/local seconds/i/1/2 0,0? +lower
20
define/local rcorr/r/1/20 0. all +lower
21
define/local icorr/i/1/20 0 all +lower
22
define/local errsum/i/1/1 0 ? +lower
23
define/local ccc/c/1/8 00000000
24
define/local aname/c/1/80 " " all +lower
25
define/local bname/c/1/80 " " all +lower
26
define/local cname/c/1/80 " " all +lower
28
delete/temp !get rid of old temporary files
30
write/out +------------------------------------------+
31
write/out start of procedure verify1.prg
32
write/out +------------------------------------------+
34
write/key dispyes/i/1/2 0,0
38
! if enabled, handle FITS working environment
40
set/midas newfil=?? >Null
41
if outputc(1:1) .eq. "F" then !we're in true FITS environment
42
inputi = m$len(mid$types)
43
define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
44
inputi = m$len(mid$types(9:))
45
define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
46
define/local workenv/c/1/4 FITS ? +lower
48
define/local imatype/c/1/3 bdf ? +lower
49
define/local tbltype/c/1/3 tbl ? +lower
50
define/local workenv/c/1/5 Midas ? +lower
53
if aux_mode(1) .eq. 1 then !VMS
54
write/keyw aname veria_s
55
write/keyw bname veria_v
58
write/keyw aname veria_somewhat_longer_file
59
write/keyw bname veria_very_very_much_longer_than_usual_file
60
write/keyw cname for_all_the_weri_images
66
if ccc({loop}:{loop}) .eq. "1" @@ verify1,000{loop}
68
write/out "We got problems with entry 000{loop} in verify1.prg!"
73
mid$info(8) = seconds(2)-seconds(1)
75
write/out +------------------------------------------+
76
write/out procedure verify1.prg:
77
write/out Total time elapsed = {mid$info(8)} seconds.
78
write/out All tests o.k. - you deserve a coffee now...
79
write/out +------------------------------------------+
82
! here the different sub-procedures
86
write/out test of CREATE/ICAT
87
write/out "-------------------"
89
define/local ojo/i/1/1 0
90
in_a = m$upper(mid$sys(1:20))
91
inputi = m$index(in_a,"VMS")
92
if aux_mode(1) .eq. 1 then !VMS
95
in_a = "AUX_MODE(1) = 1 indicates a VMS system"
100
in_a = "AUX_MODE(1) != 1 indicates a Unix/Linux system"
104
write/out Ojo: "Mismatch between keywords AUX_MODE and MID$SYS ...!"
105
write/out " " {in_a(1:>)}
106
write/out " " however, MID$SYS says: {mid$sys(1:20)}
107
write/out " " to fix that problem
108
write/out " " "execute the `setup' option in the Midas configuration"-
115
delete/image veria* noconf
117
write/out First, we create 4 images:
118
write/out {aname}_name_1, {aname}_name_2
119
write/out {aname}_name_3,
120
write/out {bname}_name_4
121
create/ima {aname}_name_1 2,256,256 ? radius_law 200,40,15,70
122
write/descr {aname}_name_1.{imatype} -
123
this_is_a_very_long_long_descriptor_name0001/c/1/8 pipeline
124
write/dhelp {aname}_name_1.{imatype} -
125
this_is_a_very_long_long_descriptor_name0001 -
126
"help text for this horrible descriptor"
127
create/ima {aname}_name_2 2,256,256 ? radius_law 200,40,25,70
128
write/descr {aname}_name_2.{imatype} -
129
this_is_a_very_long_long_descriptor_name0002/c/1/8 pipeline
130
write/dhelp {aname}_name_2.{imatype} -
131
this_is_a_very_long_long_descriptor_name0002 -
132
"help text for this horrible descriptor"
133
create/ima {aname}_name_3 2,256,256 ? radius_law 200,40,35,70
134
write/descr {aname}_name_3.{imatype} -
135
this_is_a_very_long_long_descriptor_name0003/c/1/8 pipeline
136
write/dhelp {aname}_name_3.{imatype} -
137
this_is_a_very_long_long_descriptor_name0003 -
138
"help text for this horrible descriptor"
139
create/ima {bname}_name_4 -
140
2,256,256 ? radius_law 200,40,45,70
141
write/descr {bname}_name_4.{imatype} -
142
this_is_a_very_long_long_descriptor_name0004/c/1/8 pipeline
143
write/dhelp {bname}_name_4.{imatype} -
144
this_is_a_very_long_long_descriptor_name0004 -
145
"help text for this horrible descriptor"
146
write/out "Now we create an image catalog `vericat.cat' for them via:"
147
write/out create/icat vericat veria*.{imatype}
148
create/icat vericat veria*.{imatype}
149
write/out And display the contents fo the catalog via:
150
write/out read/icat vericat
153
delete/ima weria*.{imatype} noconf
154
write/out "Now we create 4 more images weria1,2,3,4"
155
modify/column {aname}_name_1.{imatype} weria1 v @101 >Null
156
modify/column {aname}_name_2.{imatype} weria2 v @101 >Null
157
modify/column {aname}_name_3.{imatype} weria3 v @101 >Null
158
modify/column {bname}_name_4.{imatype} weria4 v @101 >Null
159
write/out And a catalog `{cname}_catalog.cat' for them
160
create/icat {cname}_catalog weria*.{imatype}
161
read/icat {cname}_catalog
162
-copy {cname}_catalog.cat weriax.cat
163
cfunc = "use entry #"
164
read/descr #3_weriax.cat
169
write/out test of ADD, SUBTRACT, SEARCH and SORT/ICAT
170
write/out "-------------------------------------------"
173
write/out Add all entries in {cname}_catalog.cat to vericat.cat via:
174
write/out add/icat vericat {cname}_catalog.cat
175
add/icat vericat {cname}_catalog.cat
176
show/icat vericat >Null
177
if outputi .ne. 8 @@ verify1,error
180
cfunc = "SUBTR/ICAT "
181
write/out "Subtract the entry for image `{aname}_name_2.{imatype} from vericat.cat via:"
182
write/out subtract/icat vericat {aname}_name_2.{imatype}
183
subtract/icat vericat {aname}_name_2.{imatype}
184
show/icat vericat >Null
185
if outputi .ne. 7 @@ verify1,error
188
write/out "And subtract all entries for images with a `3' in their names via:"
189
write/out subtract/icat vericat *3*
190
subtract/icat vericat *3*
191
show/icat vericat >Null
192
if outputi .ne. 5 @@ verify1,error
195
write/out Finally, subtract entry no. 8 via
196
write/out subtract/icat vericat #8
197
subtract/icat vericat #8
198
show/icat vericat >Null
199
if outputi .ne. 4 @@ verify1,error
203
"We change the IDENT descr. of image weria2.{imatype} and update the catalog."
204
write/desc weria2.{imatype} ident " " all
205
write/desc weria2.{imatype} ident "Test of search"
206
add/icat vericat weria2.{imatype} >Null
209
write/out And search for the image via the command:
210
write/out search/icat vericat Test
211
search/icat vericat Test
212
if out_a .ne. "weria2.{imatype}" @@ verify1,error
213
write/out "Now we sort the catalog according to the IDENT field via:"
214
write/out sort/icat vericat
218
write/out "Now we make the catalog the `active' image catalog via:"
219
write/out set/icat vericat
221
write/out Now we create a new image via:
222
write/out create/image straightx 1,9000 ? sequence -360,360
223
create/image straightx 1,9000 ? sequence -360,360
224
write/out and another one via:
225
write/out compute/image diff = -
226
{bname}_name_4.{imatype} - {aname}_name_2.{imatype}
227
compute/image diff = -
228
{bname}_name_4.{imatype} - {aname}_name_2.{imatype}
229
write/out "These frames should be added automatically to the catalog"
231
show/icat vericat >Null
232
if outputi .ne. 6 @@ verify1,error
236
write/out "We will compute a new image by subtracting two existing images"
237
write/out "these images will be accessed by sequence numbers and by their names"
239
write/out The new image middumma is given by
240
write/out compute/image &a = #4 - #3
241
write/out and will be compared to middummb
242
write/out compute/image &b = weria2.{imatype} - weria1.{imatype}
243
compute/image &a = #4 - #3
244
compute/image &b = weria2.{imatype} - weria1.{imatype}
245
write/out Now subtract these images
246
write/out compute/image &c = middumma.{imatype} - middummb.{imatype}
247
compute/image &c = middumma.{imatype} - middummb.{imatype}
249
if outputr(4) .ne. 0 @@ verify1,error
253
write/out Finally, we `deactivate' the catalog via:
254
write/out clear/icat vericat
257
! finally loop many times to catch open files
258
define/local count/i/1/2 150,0
259
create/image klaus 1,100
261
write/out test of add/icat in a long ({count(1)}) loop ...
262
do count(2) = 1 count(1)
263
! write/out "loop no." {count(2)}
264
crea/icat aaa NULL >Null
265
crea/icat bbb kla*.{imatype} >Null
266
open/file TEST w inputi
267
close/file {inputi(1)}
268
add/icat aaa bbb.cat >Null
269
open/file TEST w inputi
270
close/file {inputi(1)}
272
if count(2) .ne. count(1) then
278
write/out test of AVERAGE/IMAGE
279
write/out "----------------------"
281
write/out avera/ima weriares1 = {cname}_catalog.cat
282
avera/ima weriares1 = {cname}_catalog.cat
283
statist/ima weriares1 >Null
284
write/key rcorr 3.24023E-03,2.07653E+01,1.00440E-01,3.17890E-01
285
write/key rcorr/r/5/3 2.13603E+01,8.71274E+02,6.58243E+03
286
write/key icorr 65536,0256,0001,0128,0128
287
@@ kcompare rcorr outputr 1,6 0.01
288
@@ kcompare rcorr outputr 7,7 0.1
289
@@ kcompare icorr outputi 1,5
290
avera/ima weriares2 = weria1,weria2,weria3,weria4
291
compute/pix &a = weriares1-weriares2
293
write/key rcorr 0.,0.
294
@@ kcompare rcorr outputr 1,2 0.0001
295
write/out avera/ima weriares2 = {cname}_catalog.cat ? ? min
296
avera/ima weriares2 = {cname}_catalog.cat ? ? min
297
statist/ima weriares2 >Null
298
write/key rcorr 2.81103E-03,1.74128E+01,7.06025E-02,2.57701E-01
299
write/key rcorr/r/5/3 2.41263E+01,1.05318E+03,4.62701E+03
300
write/key icorr 65536,0256,0001,0128,0128
301
@@ kcompare rcorr outputr 1,6 0.01
302
@@ kcompare rcorr outputr 7,7 0.1
303
@@ kcompare icorr outputi 1,5
304
write/out avera/ima weriares3 = {cname}_catalog.cat ? ? max
305
avera/ima weriares3 = {cname}_catalog.cat ? ? max
306
statist/ima weriares3 >Null
307
write/key rcorr 3.96110E-03,2.35756E+01,1.33625E-01,3.81238E-01
308
write/key rcorr/r/5/3 1.88921E+01,7.02512E+02,8.75722E+03
309
write/key icorr 65536,0256,0001,0128,0128
310
@@ kcompare rcorr outputr 1,6 0.01
311
@@ kcompare rcorr outputr 7,7 0.1
312
@@ kcompare icorr outputi 1,5
313
write/out avera/ima weriares4 = {cname}_catalog.cat ? ? median
314
avera/ima weriares4 = {cname}_catalog.cat ? ? median
315
stat/ima weriares4 >Null
316
write/key rcorr 2.91881E-03,1.97706E+01,8.78078E-02,2.96087E-01
317
write/key rcorr/r/5/3 2.25164E+01,9.52958E+02,5.75457E+03
318
write/key icorr 65536,0256,0001,0128,0128
319
@@ kcompare rcorr outputr 1,6 0.01
320
@@ kcompare rcorr outputr 7,7 0.1
321
@@ kcompare icorr outputi 1,5
325
write/out test of COMPUTE/WEIGHTS
326
write/out "-----------------------"
328
write/out compute/weights {cname}_catalog.cat @140,@100,@178,@155
329
compute/weights {cname}_catalog.cat @140,@100,@178,@155
330
write/key outputr {weria2,weight}
331
write/key rcorr 0.9491076
332
@@ kcompare rcorr outputr 1,1 0.0001
333
rcorr(1) = {weria2,weight}
334
compute/weights weria1,weria2,weria3,weria4 @140,@100,@178,@155 >Null
335
outputr(1) = {weria2,weight}
336
@@ kcompare rcorr outputr 1,1 0.0001
340
write/out test of file access within the monitor
341
write/out "--------------------------------------"
344
write/descr weria1 remarks/c*68/1/3 KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK all
345
copy/ii weria4 weria5
346
write/descr weria5 kuki/c/1/4 LOLE
350
inputi = m$existd("weria{inputi(10)}","kuki")
351
if inputi .ne. 0 then
352
write/out "we got {inputi} for" m$existd("weria{inputi(10)}","kuki")
356
inputi = m$existd("weria5","kuki")
357
if inputi .ne. 1 then
358
write/out "test1 for" m$existd("weria5,"kuki")
362
cfunc = "use of FRAMACC"
363
write/descr weria1 kuki/c/1/4 LOLA
364
write/descr weria2 kuki/c/1/4 LOLB
365
write/descr weria3 kuki/c/1/4 LOLC
366
write/descr weria4 kuki/c/1/4 LOLD
367
define/local tchar/c/1/5 ABCDE
370
inputi = m$existd("weria{inputi(10)}","kuki")
371
if inputi .ne. 1 then
372
write/out test2 for m$existd("weria{inputi(10)}","kuki")
375
inputc(1:1) = "{weria{inputi(10)},kuki(4:4)}"
376
if inputc(1:1) .ne. tchar({inputi(10)}:{inputi(10)}) then
377
write/out "test3 for weria{inputi(10)}
383
if workenv(1:1) .eq. "M" then
384
weria{inputi(10)},naxis = 1
385
copy/it weria{inputi(10)} veria{inputi(10)}.{tbltype}
386
weria{inputi(10)},naxis = 2
388
extract/image wweria = weria{inputi(10)}[<,<:>,<]
389
copy/it wweria veria{inputi(10)}.{tbltype}
392
inputi = m$existd("veria{inputi(10)}.{tbltype}","kuki")
393
if inputi .ne. 0 then
394
write/out test4 for m$existd("veria{inputi(10)}.{tbltype}","kuki")
399
write/descr veria1.{tbltype} kuki/c/1/4 LOLA
400
write/descr veria2.{tbltype} kuki/c/1/5 abcBd
401
write/descr veria3.{tbltype} kuki/c/1/6 LOLCxx
402
write/descr veria4.{tbltype} kuki/c/1/4 LOLD
403
write/descr veria5.{tbltype} kuki/c/1/10 "LOLE "
406
inputc(1:1) = "{veria{inputi(10)}.{tbltype},kuki(4:4)}"
407
if inputc(1:1) .ne. tchar({inputi(10)}:{inputi(10)}) then
408
write/out "test5 for veria{inputi(10)}.{tbltype}
413
write/descr weria1 kiki/i/1/4 1,2,3,4
414
write/descr weria2 kiki/i/1/4 1,2,3,4
415
write/descr weria3 kiki/i/1/4 1,2,3,4
416
write/descr weria4 kiki/i/1/4 1,2,3,4
417
write/descr weria5 kiki/i/1/4 1,2,3,4
418
write/descr veria1.{tbltype} kiki/i/1/4 11,12,13,14
419
write/descr veria2.{tbltype} kiki/i/1/5 11,12,13,14,15
420
write/descr veria3.{tbltype} kiki/i/1/6 11,12,13,14,15,16
421
write/descr veria4.{tbltype} kiki/i/1/4 11,12,13,14
422
write/descr veria5.{tbltype} kiki/i/1/10 11,12,13,14,0,0,0,0,0,0
425
inputi(1) = m$value(weria{inputi(10)},kiki(4))
426
if inputi(1) .ne. 4 then
427
write/out "test6 for weria{inputi(10)}
430
inputi(1) = m$value(veria{inputi(10)}.{tbltype},kiki(4))
431
if inputi(1) .ne. 14 then
432
write/out "test7 for veria{inputi(10)}.{tbltype}
435
weria{inputi(10)}[@10,@10] = 99.9
436
veria{inputi(10)}.{tbltype},#1,@256 = 88.8
439
read/image weria{inputi(10)} @10,@10,1
442
read/image weria{inputi(10)} @10,@10,1 h | write/keyw outputr
443
@@ kcompare rcorr outputr 1,1 0.0001
445
copy/tk veria{inputi(10)} #1 @256 outputr
446
@@ kcompare rcorr outputr 1,1 0.0001
451
write/out test of DELETE/ICAT
452
write/out "-------------------"
454
write/out "Delete all frames with entries in catalog vericat.cat via:"
455
write/out delete/icat vericat noconf
456
delete/icat vericat noconf
457
if aux_mode(1) .lt. 2 then !VMS
458
-delete vericat.cat.*
459
-delete {cname}_catalog.cat.*
462
-delete {cname}_catalog.cat
464
delete/ima weria* noconf
465
delete/ima veria* noconf
466
delete/tab veria* noconf
471
write/out ********* redo catalog creation + FRAMACC tests *********
483
write/out do @@ verify1,0006
484
write/out "-------------------"
491
write/out ######## problems with {cfunc} ########
added
removed
test/prim/verify1.prg
