← Back to branch summary

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

« back to all changes in this revision

Viewing changes to test/prim/verify7.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/verify7.prg
 
1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
!
 
3
!  MIDAS procedure verify7.prg  to verify MIDAS commands
 
4
!  K. Banse     930628  creation
 
5
!
 
6
!  use as @@ verify7 fffffff             with f = 1 or 0 (on/off)
 
7
!
 
8
!  130503               last modif
 
9
! 
 
10
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
11
!
 
12
define/par p1 111111111111 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/12 0000000000
 
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
write/key sizez/i/1/5 600,600,0,0,0
 
26
write/key dispyes/i/1/2 0,0
 
27
! 
 
28
write/out +------------------------------------------+
 
29
write/out Start of procedure verify7.prg
 
30
write/out +------------------------------------------+
 
31
!
 
32
seconds(1) = m$secs()
 
33
!
 
34
! if enabled, handle FITS working environment
 
35
!
 
36
set/midas newfil=?? >Null
 
37
if outputc(1:1) .eq. "F" then           !we're in true FITS environment
 
38
   inputi = m$len(mid$types)
 
39
   define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
 
40
   inputi = m$len(mid$types(9:))
 
41
   define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
 
42
   define/local workenv/c/1/4 FITS ? +lower
 
43
else
 
44
   define/local imatype/c/1/3 bdf ? +lower
 
45
   define/local tbltype/c/1/3 tbl ? +lower
 
46
   define/local workenv/c/1/5 Midas ? +lower
 
47
endif
 
48
!
 
49
set/midas f_update=??
 
50
define/local save_out/c/1/20 {outputc}
 
51
set/midas f_update=yes
 
52
!
 
53
write/key ccc {p1}
 
54
set/format i1
 
55
do loop = 1 11          
 
56
   if ccc({loop}:{loop}) .eq. "1" @@ verify7,000{loop}
 
57
   if errsum .gt. 0 then
 
58
      write/out "We got problems with entry 000{loop} in verify7.prg!"
 
59
      return 1
 
60
   endif
 
61
enddo
 
62
! 
 
63
set/midas f_update={save_out}
 
64
! 
 
65
seconds(2) = m$secs()
 
66
mid$info(8) = seconds(2)-seconds(1)
 
67
!
 
68
write/out +------------------------------------------+
 
69
write/out procedure verify7.prg:
 
70
write/out Total time elapsed = {mid$info(8)} seconds.
 
71
write/out All tests o.k. - you deserve a coffee now...
 
72
write/out +------------------------------------------+
 
73
return 0
 
74
!
 
75
!  here the different sub-procedures
 
76
!
 
77
entry 0001
 
78
!
 
79
write/out test of CREATE/DISPLAY + CREATE/GRAPHICS
 
80
write/out "----------------------------------------"
 
81
!
 
82
reset/display
 
83
create/display 0 4,4,0,0 ? no
 
84
mid$info(4) = dazdevr(12)-525
 
85
mid$info(5) = dazdevr(13)-560
 
86
modify/display icon
 
87
create/display 7 512,512,{mid$info(4)},{mid$info(5)}
 
88
mid$info(4) = mid$info(4) - 608
 
89
mid$info(5) = dazdevr(13)-420
 
90
create/gra 3 600,400,{mid$info(4)},{mid$info(5)}
 
91
dispyes(1) = 1                          !mark that we have display + graphic
 
92
dispyes(2) = 1
 
93
display/lut off
 
94
load/lut rainbow3
 
95
!
 
96
entry 0002
 
97
!
 
98
write/out test of CREATE/IMA
 
99
write/out "------------------"
 
100
!
 
101
@@ creamask                     !create image arti.bdf
 
102
if {arti,npix(1)} .gt. 50 then
 
103
   scale = 1
 
104
else
 
105
   scale = 2
 
106
endif
 
107
! 
 
108
rebin/linear arti &z .25,.25
 
109
! 
 
110
write/out > resample/image &z &zz half_step
 
111
resample/image &z &zz half_step
 
112
statist/image &zz p5=wf >Null
 
113
write/keyw rcorr 0.0,1.0,2.087141e-01,3.674280e-01,1.40988,3.21806
 
114
@@ kcompare rcorr outputr 1,6 0.001
 
115
write/keyw rcorr/r/13/14 3.000105e-01,2.087141e-01
 
116
@@ kcompare rcorr outputr 13,14 0.001
 
117
write/out > filter/smooth &zz &zzz 3,3,0.
 
118
filter/smooth &zz &zzz 3,3,0.
 
119
write/out > resample/image &zzz &b double_step
 
120
resample/image &zzz &x double_step
 
121
! 
 
122
! filter again on small image
 
123
write/out > filter/smooth &z &zz 2,2,0.
 
124
filter/smooth &z &zz 2,2,0.
 
125
write/out > compute/image &d = &zz-&x 
 
126
compute/image &d = &zz-&x 
 
127
write/out > statist/image &d >Null
 
128
statist/image &d >Null
 
129
write/keyw rcorr -9.562504e-02,9.562498e-02,6.882602e-06,1.633776e-02,-1.56138E-02,6.4243
 
130
@@ kcompare rcorr outputr 1,6 0.00001
 
131
rename/image &zz &b                     !that's smoother
 
132
compute/image &b = &b * 0.999999        !to avoid rounding errors for different
 
133
                                        !machine architectures
 
134
!
 
135
if dispyes(1) .eq. 1 then
 
136
   load/ima &b.{imatype} scale={scale}
 
137
endif
 
138
!
 
139
entry 0003
 
140
!
 
141
write/out test of REPLACE/IMA
 
142
write/out "-------------------"
 
143
!
 
144
create/ima &a 2,{&b,npix(1)},{&b,npix(2)} ? poly 0.,0.7
 
145
write/out > replace/ima &b veria 0.09,>=&a,0.
 
146
replace/ima &b veria 0.09,>=&a,0.
 
147
write/keyw icorr/i/15/1  20566
 
148
@@ kcompare icorr outputi 15,15
 
149
! 
 
150
write/out > find/min veria
 
151
find/min veria
 
152
write/keyw rcorr 0.0,259.0
 
153
@@ kcompare rcorr outputr 1,2 0.001
 
154
write/keyw icorr 1,1,371,64
 
155
@@ kcompare icorr outputi 1,4
 
156
! 
 
157
write/out > find/pixel veria 0.0,5.9 out all werio 221
 
158
find/pixel veria 0.0,5.9 out all werio 221
 
159
write/keyw icorr 20236
 
160
@@ kcompare icorr outputi 1,1
 
161
show/table werio
 
162
write/out > copy/dk werio.{tbltype} tblcontr inputi
 
163
copy/dk werio.{tbltype} tblcontr inputi
 
164
write/key icorr 9,248,3,221,0,0,0,1,15,221
 
165
@@ kcompare icorr inputi 1,10
 
166
! 
 
167
write/out > find/pixel veria 0.0,0.1 out
 
168
find/pixel veria 0.0,0.1 out 
 
169
rcorr(1) = 4.9
 
170
@@ kcompare rcorr outputr 1,1 0.001
 
171
write/keyw icorr 8,30
 
172
@@ kcompare icorr outputi 1,2
 
173
rval = outputr(1)-0.2
 
174
!
 
175
if dispyes(1) .eq. 1 then
 
176
   load/ima veria.{imatype} scale={scale} cuts={rval},{veria,lhcuts(4)}
 
177
endif
 
178
-delete werio.tbl
 
179
!
 
180
entry 0004
 
181
!
 
182
write/out test of APPLY/EDGE
 
183
write/out "------------------"
 
184
!
 
185
write/out > apply/edge veria &e 0.1
 
186
apply/edge veria &e 0.1
 
187
! 
 
188
if dispyes(1) .eq. 1 then
 
189
   load/ima &e.{imatype} scale={scale} cuts=0.,1.
 
190
endif
 
191
!
 
192
inputr = 0.2+{veria,lhcuts(4)}
 
193
write/out > replace/ima veria &b &e/0.09,>={inputr}
 
194
replace/ima veria &b &e/0.09,>={inputr}
 
195
! 
 
196
find/min &b
 
197
if dispyes(1) .eq. 1 then
 
198
   load/ima &b.{imatype} scale={scale} cuts={rval},{&b,lhcuts(4)}
 
199
endif
 
200
!
 
201
! save this image for interactive usage
 
202
compute/image ia.{imatype} = &b.{imatype}
 
203
read/descr ia.{imatype}
 
204
! 
 
205
entry 0005
 
206
!
 
207
write/out test of EXTRACT, INSERT, FLIP/IMAGE
 
208
write/out "-----------------------------------"
 
209
!
 
210
write/out > extra/image &f = &b[<,@26:>,@150]
 
211
extra/image &f = &b[<,@26:>,@150]
 
212
!
 
213
crea/ima &t 2,512,256 ? poly 50.,-0.05,-0.1
 
214
crea/ima &u 2,512,256 
 
215
write/descr &f step 1.,1.               !avoid a warning mesage in `insert'
 
216
insert/ima &f &u @67,<
 
217
replace/ima &u &s <,0=&t
 
218
create/ima &x 2,512,512
 
219
create/ima &y 2,512,512
 
220
insert/ima &s &x <,@257
 
221
insert/ima &s &y <,@257
 
222
flip/image &x y
 
223
compute/pix veria = &x+&y
 
224
write/ima veria <,@256,1024 250. all
 
225
!
 
226
write/descr veria -
 
227
            this_is_a_very_long_long_descriptor_name0001/c/1/8 pipeline
 
228
write/dhelp veria this_is_a_very_long_long_descriptor_name0001 -
 
229
            "help text for this horrible descriptor"
 
230
!
 
231
if dispyes(2) .eq. 1 then
 
232
   load/ima veria.{imatype} scale={scale} cuts={rval},{&b,lhcuts(4)}
 
233
endif
 
234
!
 
235
entry 0006
 
236
write/out test of COPY/...
 
237
write/out "----------------"
 
238
!
 
239
!
 
240
write/out "create imageZ via: extra/ima &z = veria[<,@100:@100,@100]"
 
241
extract/ima &z = veria[<,@100:@100,@100]
 
242
write/out copy: -
 
243
"imageZ -> descrZ -> keyZ -> descrY -> imageY -> keyY"
 
244
copy/id &z &z zzz
 
245
write/key testz/i/1/100 -1 all
 
246
copy/dk &z zzz testz
 
247
copy/kd testz &z yyy 
 
248
copy/dima &z yyy &y
 
249
write/key testy/i/1/100 -1 all
 
250
copy/ik &y testy
 
251
write/out -
 
252
"finally, compare the contents of keyZ and keyY (no message, if o.k.)"
 
253
@@ kcompare testz testy 1,100
 
254
! 
 
255
define/local longer_test/c/1/10 x all
 
256
copy/dk &z this_is_a_very_long_long_descriptor_name0001/c/2/4 longer_test
 
257
if longer_test .ne. "ipelxxxxxx" then
 
258
   write/out key `longer_test': "{longer_test} - should be: ipelxxxxxx"
 
259
   errsum = errsum+1
 
260
endif
 
261
!
 
262
entry 0007
 
263
! 
 
264
entry 0008
 
265
write/out test of LOAD/IMAGE cube
 
266
write/out "-------------------"
 
267
!
 
268
if dispyes(1) .ne. 1 return
 
269
!
 
270
define/local xs/i/1/2 0,190
 
271
define/local ys/i/1/2 0,190
 
272
define/local loop/i/1/1 0
 
273
define/local angle/r/1/1 45.0
 
274
! 
 
275
create/image &a 3,380,380,9
 
276
! 
 
277
write/out "rotate image in steps of 45 degrees" and store as planes of a cube
 
278
xs = -(m$value(&b,npix(1))/2-xs(2))
 
279
ys = -(m$value(&b,npix(2))/2-ys(2))
 
280
insert/image &b &a @{xs},@{ys},< >Null
 
281
insert/image &b &a @{xs},@{ys},> >Null
 
282
! 
 
283
set/format i1 f4.1
 
284
do loop = 2 8
 
285
   write/out > rebin/rotate &b &u {angle}
 
286
   rebin/rotate &b &u {angle}
 
287
   xs = -(m$value(&u,npix(1))/2-xs(2))
 
288
   ys = -(m$value(&u,npix(2))/2-ys(2))
 
289
   if xs .eq. 0 xs = 1
 
290
   write/out > insert/image &u &a @{xs},@{ys},@{loop}
 
291
   insert/image &u &a @{xs},@{ys},@{loop} >Null
 
292
   angle = angle+45.0
 
293
enddo
 
294
! 
 
295
create/display 7 512,512,616,300
 
296
load/lut rainbow4
 
297
write/out > load/image &a,all
 
298
load/image &a.{imatype},all
 
299
! 
 
300
entry 0009
 
301
write/out test of very long command lines
 
302
write/out "-------------------------------"
 
303
!
 
304
write/out aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccccccccccccccccccccccccccccc ddddddddddddddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff ggggggggggggggggggggggggggggggggggggggg 99.9
 
305
@@ verify7,testlong aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaazzzzzzzzzz bbbbbbbbbbbbbbbbbbbbbbbbbbbzzzzzzzzzzzzzzzzz ccccccccccccccccccccccccccccccccccccccccczz dddddddddddddddddddddddddddddddddddddddddddddddddddzz eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeezzzzzzzzzzzzzzz fffffffffffffffffffffffffffffffffffffffffffffffzz ggggggggggggggggggggggggggggggggggggggggggzz
 
306
write/out mid$errmess(42:43) should be = `gz'
 
307
write/out {mid$errmess(42:43)}
 
308
! 
 
309
entry testlong
 
310
define/param p1 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
 
311
define/param p2 bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
 
312
define/param p3 ccccccccccccccccccccccccccccccccccccccccccc
 
313
define/param p4 ddddddddddddddddddddddddddddddddddddddddddddd
 
314
define/param p5 eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
 
315
define/param p6 ffffffffffffffffffffffffffffffffffffffffffffffffffffff
 
316
define/param p7 gggggggggggggggggggggggggggggggggggggggggggggggggggggggggg
 
317
define/param p8 zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz
 
318
write/keyw in_a {p1}
 
319
write/keyw in_b {p2}
 
320
write/keyw out_a {p3}
 
321
write/keyw out_b {p4}
 
322
write/keyw inputc {p5}
 
323
write/keyw outputc {p6}
 
324
write/keyw mid$errmess {p7}
 
325
read/keyw in_a,in_b,out_a,out_b,inputc,outputc,mid$errmess
 
326
write/out 
 
327
!
 
328
entry 00010
 
329
write/out test of WCS handling via CD matrix
 
330
write/out "---------------------------------"
 
331
!
 
332
if mid$sys(1:5) .ne. "PC/Cy" then
 
333
   define/local tmpname/c/1/48 "r.VIMOS.2004-07-13T08:27:31.790_0000.fits "
 
334
else
 
335
   define/local tmpname/c/1/48 "r.VIMOS.2004-07-13T08c27c31.790_0000.fits "
 
336
endif
 
337
inputi = m$exist("MID_TEST:{tmpname}")
 
338
if inputi .ne. 1 then
 
339
  write/out > we need the FITS file `{tmpname}' 
 
340
  write/out > from the $MID_TEST directory for this verification
 
341
  write/out > please, get the latest demo_data tar file from the ESO ftp server
 
342
  write/out > to bring your MID_TEST dir up to date ...
 
343
  write/out > test skipped.
 
344
  nodemo = nodemo + 1
 
345
  $ echo "missing file: {tmpname} in verify7.prg" >> ./missing-files
 
346
  return
 
347
endif
 
348
! 
 
349
indisk/fits MID_TEST:{tmpname} vimos2004
 
350
read/desc vimos2004
 
351
inputd(1) = m$value(vimos2004.bdf,step(2))
 
352
read/desc vimos2004 rotang_from_cd-matrix
 
353
inputd(2) = m$value(vimos2004.bdf,rotang_from_cd-matrix(1))
 
354
write/keyw outputd 0.5694400E-04,1.5707963267500 
 
355
@@ kcompare outputd inputd 1,2 0.00001
 
356
!
 
357
write/out
 
358
write/out > wcstest.mt -> middummk.bdf 
 
359
write/out > modify descr. step of middummk.bdf 
 
360
write/out > middummk.bdf -> lola.fits -> middummz.bdf
 
361
write/out > compare step of middummk.bdf and middummz.bdf
 
362
define/local mymode/i/1/1 {mid$mode(6)}
 
363
define/local dwork/d/1/2 0.,0. ? +lower
 
364
! 
 
365
mid$mode(6) = 0
 
366
@@ verify7,do_it
 
367
@@ kcompare rcorr outputd 1,2 0.000001
 
368
mid$mode(6) = 1
 
369
@@ verify7,do_it                        !should give WRONG results
 
370
@@ kcompare rcorr dwork 1,2 0.000001
 
371
mid$mode(6) = 2
 
372
@@ verify7,do_it
 
373
@@ kcompare rcorr outputd 1,2 0.000001
 
374
! 
 
375
mid$mode(6) = mymode                    !reset to value before 
 
376
! 
 
377
entry do_it
 
378
set/format i1
 
379
write/out 
 
380
indisk/fits wcstest.mt middummk
 
381
dwork(1) = m$value(middummk,step(1))    !save original step size
 
382
dwork(2) = m$value(middummk,step(2))
 
383
write/keyw outputd/d/1/2 -0.55250E-03,0.55250E-03
 
384
copy/kd outputd/d/1/2 middummk step/d/1/2
 
385
write/out modify step from: {dwork(1)},{dwork(2)} to: {outputd(1)},{outputd(2)}
 
386
outdisk/fits middummk lola.fits >Null
 
387
indisk/fits lola.fits middummz >Null
 
388
write/out for MID$MODE(6) = {MID$MODE(6)} we get:
 
389
read/descr middummk step
 
390
read/descr middummz step
 
391
rcorr(1) = m$value(middummz,step(1))
 
392
rcorr(2) = m$value(middummz,step(2))
 
393
!
 
394
entry 00011
 
395
write/out test of FIND/PXPOS
 
396
write/out "------------------"
 
397
!
 
398
indisk/fits ccd.fits pxpos
 
399
find/pxpos pxpos postab med,5 y         !get 11 pixel positions
 
400
if outputi .ne. 11 then
 
401
   write/out we should have got 11 pixel positions
 
402
   errsum = errsum+1
 
403
endif
 
404
! sort table in ascending order of pixel positions
 
405
sort/table postab :y_pix,:x_pix
 
406
copy/ti postab oldx :x_pix
 
407
copy/ti postab oldy :y_pix
 
408
do inputi = 1 11                        !set column :value to 99999.0
 
409
   postab,:value,@{inputi} = 99999.0
 
410
enddo
 
411
copy/ii pxpos ccd
 
412
write/image ccd postab,table            !store 99999.0 into the pixel pos.
 
413
!
 
414
! find back the positions of these 11 max values
 
415
find/pxpos ccd newtab max,10 y
 
416
if outputi .ne. 11 then
 
417
   write/out we should have got 11 pixel positions
 
418
   errsum = errsum+1
 
419
endif
 
420
! sort table in ascending order of pixel positions
 
421
sort/table newtab :y_pix,:x_pix
 
422
copy/ti newtab newx :x_pix
 
423
copy/ti newtab newy :y_pix
 
424
! 
 
425
! check result positions 
 
426
! for images to be equal, we had to sort the tables...
 
427
rcorr(1) = 0.0
 
428
rcorr(2) = 0.0
 
429
compute/image &d = newx - oldx
 
430
find/minmax &d
 
431
@@ kcompare rcorr outputr 1,2 0.00001
 
432
compute/image &d = newy - oldy
 
433
find/minmax &d
 
434
@@ kcompare rcorr outputr 1,2 0.00001
 
435
 
 
436