← Back to branch summary

~ubuntu-branches/ubuntu/wily/eso-midas/wily-proposed

« back to all changes in this revision

Viewing changes to test/prim/verify99.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/verify99.prg
 
1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
!
 
3
!  MIDAS procedure verify99.prg  to verify MIDAS commands
 
4
!  K. Banse     000915  creation
 
5
!
 
6
!  use as @@ verify99 ffffff             with f = 1 or 0 (on/off)
 
7
! 
 
8
!  130503               last modif
 
9
!
 
10
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
11
!
 
12
define/par p1 11111111 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/8 00000000
 
21
define/local scale/i/1/1 1 ? +lower
 
22
define/local seconds/i/1/2 0 all +lower
 
23
define/local fcontr/i/1/2 0,0 ? +lower
 
24
!
 
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 verify99.prg
 
31
write/out +------------------------------------------+
 
32
!
 
33
! if enabled, handle FITS working environment
 
34
!
 
35
set/midas newfil=?? >Null
 
36
if outputc(1:1) .eq. "F" then
 
37
   write/out "in FITS work environment verify99.prg is skipped..."
 
38
   wait/secs 3
 
39
   return 0                             !no tests here in FITS workenv
 
40
endif
 
41
!
 
42
write/key ccc {p1}
 
43
set/format i1
 
44
do loop = 1 6                           !currently only 6 entries
 
45
   if ccc({loop}:{loop}) .eq. "1" @@ verify99,000{loop}
 
46
enddo
 
47
! 
 
48
seconds(2) = m$secs()
 
49
mid$info(8) = seconds(2)-seconds(1)
 
50
!
 
51
delete/temp                             !get rid of old temporary files
 
52
! 
 
53
write/out +------------------------------------------+
 
54
write/out procedure verify99.prg:
 
55
write/out Total time elapsed = {mid$info(8)} seconds.
 
56
if errsum .gt. 0 then
 
57
   write/out We got problems - check the MIDAS logfile !!!
 
58
   return 1
 
59
else
 
60
   write/out All tests o.k. - you deserve a coffee now...
 
61
   return 0
 
62
endif
 
63
write/out +------------------------------------------+
 
64
!
 
65
!  here the different sub-procedures
 
66
!
 
67
entry 0001
 
68
!
 
69
write/out test of CREATE/DISPLAY
 
70
write/out "----------------------"
 
71
!
 
72
reset/display  >Null
 
73
create/display 3 512,512,616,300
 
74
create/graphics 3 
 
75
dispyes(1) = 1                          !mark that we have display + graphic
 
76
dispyes(2) = 1
 
77
load/lut rainbow
 
78
!
 
79
entry 0002
 
80
write/out test of access to FITS extensions
 
81
write/out "---------------------------------"
 
82
! 
 
83
if aux_mode .eq. 1 then
 
84
   -delete lola.fits.*
 
85
   -delete FITZlola.*.*
 
86
   -copy tst0009.mt lola.fits
 
87
else
 
88
   -delete lola.fits FITZlola.*
 
89
   -copy tst0009.mt lola.fits
 
90
   $chmod +w lola.fits                  !make it writable
 
91
endif
 
92
! 
 
93
set/midas f_update=no
 
94
define/local fitzname/c/1/20 FITZlola.fits
 
95
! 
 
96
write/out > info/frame lola.fits extens
 
97
info/frame lola.fits extens
 
98
if outputi(19) .ne. 3 then
 
99
   write/out "we have a problem with info/frame..."
 
100
   errsum = errsum+1
 
101
   return
 
102
endif
 
103
if m$exist(fitzname) .ne. 0 goto FITZ
 
104
! 
 
105
write/out > indisk/mfits lola.fits lola
 
106
indisk/mfits lola.fits lola
 
107
! 
 
108
delete/descr lola0001.tbl history
 
109
read/descr lola0001.tbl *
 
110
rcorr(1) = outputi(1)
 
111
read/descr lola.fits[1] *
 
112
if m$exist(fitzname) .ne. 0 goto FITZ
 
113
if rcorr(1) .ne. outputi(1) then
 
114
   write/out "we have a problem with read/descr ..."
 
115
   errsum = errsum+1
 
116
   return
 
117
endif
 
118
! 
 
119
write/out > statistics/image lola0002
 
120
statistics/image lola0002
 
121
do inputi = 1 7
 
122
   icorr({inputi}) = outputi({inputi})
 
123
enddo
 
124
do inputi = 1 12
 
125
   rcorr({inputi}) = outputr({inputi})
 
126
enddo
 
127
write/out > statistics/image lola.fits[2]
 
128
statistics/image lola.fits[2]
 
129
if m$exist(fitzname) .ne. 0 goto FITZ
 
130
@@ kcompare icorr outputi 1,7
 
131
@@ kcompare rcorr outputr 1,12 0.005
 
132
! 
 
133
write/out > read/descr lola.fits[0] *
 
134
read/descr lola.fits[0] *
 
135
if m$exist(fitzname) .ne. 0 goto FITZ
 
136
! 
 
137
write/descr lola0000 klaus/c/1/8 Klaus          ! update primary header
 
138
read/desc lola0000 *
 
139
rcorr(1) = outputi(1)
 
140
write/out > outdisk/sfits lola0000.bdf,lola0001.tbl,lola0002.bdf lolanew.fits
 
141
outdisk/sfits lola0000.bdf,lola0001.tbl,lola0002.bdf lolanew.fits
 
142
write/out > read/descr lolanew.fits[0] *
 
143
read/descr lolanew.fits[0] *
 
144
outputi(1) = outputi(1) - 1
 
145
if rcorr(1) .ne. outputi(1) then
 
146
   write/out "we have a problem with read/descr ..."
 
147
   errsum = errsum+1
 
148
   return
 
149
endif
 
150
! 
 
151
write/keyw icorr/i/1/8 8,53,0,0,15,56,0,53
 
152
write/out > show/tab lolanew.fits[1]
 
153
show/tab lolanew.fits[1]
 
154
@@ kcompare icorr outputi 1,8
 
155
! 
 
156
if dispyes(1) .eq. 1 then
 
157
   load/image lolanew.fits[2] scale=5,1
 
158
   set/grap ltype=1 colour=4
 
159
   plot/tab lolanew.fits[1] ? #2
 
160
endif
 
161
return
 
162
! 
 
163
FITZ:
 
164
write/out FITZ file exists ...
 
165
errsum = errsum+1
 
166
!
 
167
entry 0003
 
168
write/out more tests of the same 
 
169
write/out "----------------------"
 
170
! 
 
171
write/out > indisk/mfits tst0012.mt toto
 
172
indisk/mfits tst0012.mt toto
 
173
! 
 
174
write/out > create a table without any filled row
 
175
create/table middummtab 3 8 null                !create an empty table
 
176
create/column middummtab :x
 
177
create/column middummtab :y
 
178
create/column middummtab :z
 
179
create/column middummtab :w C*4
 
180
! 
 
181
write/out > and store it as an extension in a FITS file via `outdisk/sfits'
 
182
outdisk/sfits -
 
183
lola0000.bdf,lola0001.tbl,lola0002.bdf,middummtab.tbl,toto0002 lolanew.fits
 
184
write/out > list extensions of that FITS file (lolanew.fits)
 
185
write/out > info/frame lolanew.fits ext
 
186
info/frame lolanew.fits ext
 
187
if outputi(19) .ne. 5 then
 
188
   write/out "we have a problem with outdisk/sfits or info/frame ..."
 
189
   errsum = errsum+1
 
190
   return
 
191
endif
 
192
icorr(1) = outputi(19)
 
193
indisk/mfits lolanew.fits midd noy
 
194
if mid$info(4) .ne. icorr(1) then
 
195
   write/out "we have a problem with outdisk/sfits or info/frame ..."
 
196
   errsum = errsum+1
 
197
   return
 
198
endif
 
199
! 
 
200
write/out > build a FITS file with the first two FITS headers empty (NAXIS=0) 
 
201
outdisk/sfits -
 
202
lola0000,lola0000,lola0001.tbl,lola0002,middummtab.tbl,toto0002 lolanew.fits
 
203
write/out > info/frame lolanew.fits ext
 
204
info/frame lolanew.fits ext
 
205
write/out > get 2nd empty header: indisk/mfits lolanew.fits[1] lolab
 
206
indisk/mfits lolanew.fits[1] lolab
 
207
read/descr lolab0001.bdf *
 
208
if outputi(1) .ne. 10 then
 
209
   write/out "we have a problem with extraction of 2nd empty FITS header...
 
210
   errsum = errsum+1
 
211
   return
 
212
endif
 
213
write/out > pull out all extensions: indisk/mfits lolanew.fits
 
214
indisk/mfits lolanew.fits lola
 
215
if mid$info(4) .ne. 6 then
 
216
   write/out "we have a problem with indisk/mfits ..."
 
217
   errsum = errsum+1
 
218
   return
 
219
endif
 
220
!
 
221
entry 0004
 
222
write/out tests of COMPUTE/SIGNATURE
 
223
write/out "--------------------------"
 
224
! 
 
225
!
 
226
-copy tst0001.mt md5image.fits
 
227
! 
 
228
! the file md5tableima.fits has a primary (empty) header,
 
229
! followed by a table and an image extension
 
230
! this file gave problems on different systems
 
231
! i.e. the MD5 signature was different on e.g. a Sun and an Intel/Pentium 
 
232
! apparently copying via binary ftp does not preserve exactly
 
233
! all data...
 
234
! so we do the tests on that file just for info
 
235
! 
 
236
-copy tst0009.mt md5tableima.fits
 
237
-copy in3d.mt    md5table.fits
 
238
! 
 
239
if aux_mode .lt. 2 then
 
240
   $ SET PROT=W:RWE md5*.fits
 
241
else
 
242
   $ chmod +w md5*.fits
 
243
endif
 
244
! 
 
245
indisk/fits md5image.fits md5ima.bdf
 
246
indisk/fits md5table.fits md5tab.tbl
 
247
define/local md5/c*32/1/3 " " all
 
248
md5(1) = "28cd15ee1d98b891592419fb36ed9dae"
 
249
md5(2) = "7e529c63d8ab10d79db1d01352de1ca9"
 
250
md5(3) = "64a2cd1cccc3b5d452e31113006f6686"
 
251
! 
 
252
write/out > 
 
253
write/out > get the MD5 signature for FITS files
 
254
write/out > compute/signature md5image.fits
 
255
compute/signature md5image.fits
 
256
if outputc .ne. md5(1) then
 
257
   write/out bad signature with md5image.fits
 
258
   errsum = errsum+1
 
259
   return
 
260
endif
 
261
! 
 
262
write/out > compute/signature md5tableima.fits calc
 
263
compute/signature md5tableima.fits 
 
264
if outputc .ne. md5(2) then
 
265
   write/out just for info: different signature with md5tableima.fits
 
266
endif
 
267
! 
 
268
write/out > compute/signature md5table.fits
 
269
compute/signature md5table.fits
 
270
if outputc .ne. md5(3) then
 
271
   write/out bad signature with md5table.fits
 
272
   errsum = errsum+1
 
273
   return
 
274
endif
 
275
! 
 
276
write/out > 
 
277
write/out > get the MD5 signature for corresponding Midas files
 
278
write/out > compute/signature md5ima.bdf
 
279
compute/signature md5ima.bdf
 
280
if outputc .ne. md5(1) then
 
281
   write/out bad signature with md5ima.bdf
 
282
   errsum = errsum+1
 
283
   return
 
284
endif
 
285
write/out > compute/signature md5tab.tbl
 
286
compute/signature md5tab.tbl
 
287
if outputc .ne. md5(3) then
 
288
   write/out bad signature with md5tab.tbl
 
289
   errsum = errsum+1
 
290
   return
 
291
endif
 
292
! 
 
293
! now we compare values in calculate mode 
 
294
! 
 
295
write/out > 
 
296
write/out > now just compare the signatures
 
297
write/out > compute/signature md5image.fits calc
 
298
compute/signature md5image.fits calc
 
299
if outputc .ne. md5(1) then
 
300
   write/out bad signature with md5image.fits
 
301
   errsum = errsum+1
 
302
   return
 
303
endif
 
304
! 
 
305
write/out > compute/signature md5tableima.fits calc
 
306
compute/signature md5tableima.fits calc
 
307
if outputc .ne. md5(2) then
 
308
   write/out just for info: different signature with md5tableima.fits
 
309
endif
 
310
! 
 
311
write/out > compute/signature md5table.fits calc
 
312
compute/signature md5table.fits calc
 
313
if outputc .ne. md5(3) then
 
314
   write/out bad signature with md5table.fits
 
315
   errsum = errsum+1
 
316
   return
 
317
endif
 
318
!
 
319
write/out > compute/signature md5ima.bdf calc
 
320
compute/signature md5ima.bdf calc
 
321
if outputc .ne. md5(1) then
 
322
   write/out bad signature with md5ima.bdf
 
323
   errsum = errsum+1
 
324
   return
 
325
endif
 
326
! 
 
327
write/out > compute/signature md5tab.tbl calc
 
328
compute/signature md5tab.tbl calc
 
329
if outputc .ne. md5(3) then
 
330
   write/out bad signature with md5tab.tbl
 
331
   errsum = errsum+1
 
332
   return
 
333
endif
 
334
! 
 
335
! now we create FITS files with the MD5 signature from Midas files
 
336
! 
 
337
write/out > 
 
338
write/out > now we create FITS files from the Midas files
 
339
write/out > and put DATAMD5 always into the primary header
 
340
write/out > compute/signature md5ima.bdf ? md55ima.fits
 
341
compute/signature md5ima.bdf ? md55ima.fits
 
342
read/descr md55ima.fits[0] datamd5 
 
343
inputc = m$value(md55ima.fits[0],datamd5) 
 
344
if inputc .ne. md5(1) then
 
345
   write/out bad signature in primary header of md55ima.fits
 
346
   errsum = errsum+1
 
347
   return
 
348
endif
 
349
! 
 
350
write/out > compute/signature md5tab.tbl ? md55tab.tfits
 
351
compute/signature md5tab.tbl ? md55tab.tfits
 
352
read/descr md55tab.tfits[0] datamd5 f
 
353
inputc = m$value(md55tab.tfits[0],datamd5) 
 
354
if inputc .ne. md5(3) then
 
355
   write/out bad signature in primary header of md55tab.tfits
 
356
   errsum = errsum+1
 
357
   return
 
358
endif
 
359
! 
 
360
entry 0005
 
361
write/out tests of incorrect FITS headers
 
362
write/out "-------------------------------"
 
363
! 
 
364
inputc = m$symbol("MID_TEST")
 
365
inputi = m$exist("{inputc}/NACO.fits")
 
366
if inputi .eq. 0 then                   !no NACO.fits in demo-data directory
 
367
   nodemo = nodemo + 1
 
368
   $ echo "missing file: NACO.fits in verify99.prg" >> ./missing-files
 
369
   return
 
370
endif
 
371
! 
 
372
-copy {inputc}/NACO.fits NACO.fits
 
373
write/out > info/frame NACO.fits ext
 
374
info/frame NACO.fits ext
 
375
if outputi(19) .ne. 3 then
 
376
   write/out problems with bad FITS headers
 
377
   errsum = errsum+1
 
378
   return
 
379
endif
 
380
write/out > indisk/mfits NACO.fits
 
381
indisk/mfits NACO.fits
 
382
if mid$info(4) .ne. 3 then
 
383
   write/out problems with bad FITS headers
 
384
   errsum = errsum+1
 
385
   return
 
386
endif
 
387
! 
 
388
entry 0006
 
389
!                                       delete the temp files
 
390
if aux_mode(1) .ne. 2 then
 
391
   -delete lola*.*.*
 
392
   -delete toto*.*.*
 
393
   -delete md5*.*.*
 
394
else
 
395
   -delete lola*.*
 
396
   -delete toto*.*
 
397
   -delete md5*.*
 
398
endif
 
399
 
 
400
 
 
401
 
 
402
 
 
403
 
 
404
 
 
405
 
 
406