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

« back to all changes in this revision

Viewing changes to test/prim/verify3.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:
 
1
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2
!
 
3
!  MIDAS procedure verify3.prg  to verify MIDAS command COMPUTE/KEYWORD
 
4
!  K. Banse     ESO - DMD       Garching
 
5
!  
 
6
!  091029               last modif
 
7
 
8
!  use as @@ verify3 ffffffffffffffffff         with f = 1 or 0 (on/off)
 
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 dval/d/1/5 0. all +lower
 
16
define/local rval/r/1/5 0. all +lower
 
17
define/local ival/i/1/5 0 all +lower
 
18
define/local seconds/i/1/2 0,0 +lower
 
19
define/local cfunc/c/1/10 " " all +lower
 
20
define/local ccc/c/1/12 "0" all
 
21
define/local errsum/i/1/1 0 ? +lower
 
22
 
23
seconds(1) = m$secs()
 
24
!
 
25
! if enabled, handle FITS working environment
 
26
!
 
27
set/midas newfil=?? >Null
 
28
if outputc(1:1) .eq. "F" then           !we're in true FITS environment
 
29
   inputi = m$len(mid$types)
 
30
   define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
 
31
   inputi = m$len(mid$types(9:))
 
32
   define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
 
33
   define/local workenv/c/1/4 FITS ? +lower
 
34
   define/local workvar/i/1/4 5,8,0,0 ? +lower
 
35
else                                    !using good old Midas data format
 
36
   define/local imatype/c/1/3 bdf ? +lower
 
37
   define/local tbltype/c/1/3 tbl ? +lower
 
38
   define/local workenv/c/1/5 Midas ? +lower
 
39
   define/local workvar/i/1/4 15,4096,0,0 ? +lower
 
40
endif
 
41
 
42
write/out +------------------------------------------+
 
43
write/out Start of procedure verify3.prg
 
44
write/out +------------------------------------------+
 
45
!
 
46
write/key ccc {p1}
 
47
set/format i1
 
48
do loop = 1 12
 
49
   if ccc({loop}:{loop}) .eq. "1" @@ verify3,000{loop}
 
50
   if errsum .gt. 0 then
 
51
      write/out "We got problems with entry 000{loop} in verify3.prg!"
 
52
      return 1
 
53
   endif
 
54
enddo
 
55
seconds(2) = m$secs()
 
56
mid$info(8) = seconds(2)-seconds(1)
 
57
!
 
58
 
59
write/out +------------------------------------------+
 
60
write/out procedure verify3.prg:
 
61
write/out Total time elapsed = {mid$info(8)} seconds.
 
62
write/out All tests o.k. - you deserve a coffee now...
 
63
write/out +------------------------------------------+
 
64
return 0
 
65
 
66
!  here the different sub-procedures
 
67
 
68
entry 0001
 
69
! --------
 
70
 
71
write/out test of CREATE/IMA 
 
72
write/out "------------------"
 
73
 
74
crea/ima veria 2,256,256 ? poly 1
 
75
write/descr veria this_is_a_very_long_descriptor_name0099/r/1/5 -
 
76
            -1.234,2.345,-3.456,4.567,-5.678
 
77
read/descr veria
 
78
 
79
entry 0002
 
80
! --------
 
81
 
82
write/out test of the different functions of COMPUTE/KEYWORD
 
83
write/out "--------------------------------------------------"
 
84
 
85
-dir veria.{imatype}
 
86
write/key cfunc m$exist
 
87
write/out ival = {cfunc}("veria.{imatype}")
 
88
ival = {cfunc}("veria.{imatype}")
 
89
write/out ival = {ival}
 
90
if ival .ne. 1 @@ verify3,error
 
91
in_a = "veria.{imatype}"
 
92
write/out in_a = {in_a}
 
93
write/out ival = {cfunc}(in_a)
 
94
ival = {cfunc}(in_a)
 
95
write/out ival = {ival}
 
96
if ival .ne. 1 @@ verify3,error
 
97
cfunc = "m$existd"
 
98
write/out ival = {cfunc}(in_a,"NPIX")
 
99
ival = {cfunc}(in_a,"NPIX")
 
100
write/out ival = {ival}
 
101
if ival .ne. 1 @@ verify3,error
 
102
write/out ival = {cfunc}(in_a,"this_is_a_very_long_descriptor_name0099")
 
103
ival = {cfunc}(in_a,"this_is_a_very_long_descriptor_name0099")
 
104
write/out ival = {ival}
 
105
if ival .ne. 1 @@ verify3,error
 
106
write/out ival = {cfunc}(in_a,"CLOCHARD")
 
107
ival = {cfunc}(in_a,"CLOCHARD")
 
108
write/out ival = {ival}
 
109
if ival .ne. 0 @@ verify3,error
 
110
write/out ival = {cfunc}("CLOCHARD","NPIX")
 
111
ival = {cfunc}("CLOCHARD","NPIX")
 
112
write/out ival = {ival}
 
113
if ival .ne. 0 @@ verify3,error
 
114
cfunc = "m$symbol"
 
115
write/out inputc = {cfunc}("DAZUNIT")
 
116
inputc = {cfunc}("DAZUNIT")
 
117
write/out inputc = {inputc}
 
118
if inputc(1:2) .ne. mid$sess(11:12) @@ verify3,error
 
119
 
120
cfunc  = "m$len   "
 
121
write/key in_a s all
 
122
in_a(21:21) = " "
 
123
write/out in_a = {in_a(1:44)}
 
124
write/out ival = {cfunc}(in_a)
 
125
ival = {cfunc}(in_a)
 
126
write/out ival = {ival}
 
127
if ival .ne. 20 @@ verify3,error
 
128
 
129
entry 0003
 
130
! --------
 
131
 
132
write/out testing M$INDEX, M$TIME, M$ISODATE 
 
133
write/out "----------------------------------"
 
134
 
135
write/key cfunc m$index
 
136
write/key in_a x all
 
137
in_a(21:) = "Midas test1 "
 
138
write/out in_a = {in_a}
 
139
write/out ival = {cfunc}(in_a,"t1")
 
140
ival = {cfunc}(in_a,"t1")
 
141
write/out ival = {ival}
 
142
if ival .ne. 30 @@ verify3,error
 
143
write/key out_a " " all
 
144
write/key out_a t1
 
145
write/out ival = {cfunc}(in_a,out_a)
 
146
write/out ival = {ival}
 
147
ival = {cfunc}(in_a,out_a)
 
148
if ival .ne. 30 @@ verify3,error
 
149
 
150
cfunc = "m$time  "
 
151
outputc = {cfunc}()
 
152
write/out outputc = {cfunc}() 
 
153
write/out yields: {outputc(1:40)}
 
154
inputc = {cfunc}(1)
 
155
write/out outputc = {cfunc}(1)
 
156
write/out yields: {inputc(1:12)} (today)
 
157
in_a = {cfunc}(-1)
 
158
write/out outputc = {cfunc}(-1)
 
159
write/out yields: {in_a(1:12)} (yesterday)
 
160
if aux_mode .eq. 2 then                 !only for Unix
 
161
   if inputc(9:10) .ne. outputc(5:6) @@ verify3,error
 
162
   if inputc(1:4) .ne. in_a(1:4) @@ verify3,error
 
163
endif
 
164
cfunc = "m$isodate"
 
165
write/out outputc = {cfunc}() 
 
166
outputc = {cfunc}()
 
167
write/out yields: {outputc(1:40)}
 
168
if aux_mode .eq. 2 then                 !only for Unix
 
169
   if inputc(1:10) .ne. outputc(1:10) @@ verify3,error
 
170
endif
 
171
 
172
cfunc = "m$secs   "
 
173
write/out ival = {cfunc}()
 
174
ival = {cfunc}()
 
175
write/out yields: {ival}
 
176
!
 
177
entry 0004
 
178
! --------
 
179
!
 
180
write/out testing M$ABS, M$NINT, M$TSTNO 
 
181
write/out "------------------------------"
 
182
 
183
cfunc = "m$abs    "
 
184
write/key inputi/i/10/3 123456,0,-123456
 
185
write/out inputi(10,11,12) = {inputi(10)},{inputi(11)},{inputi(12)}
 
186
write/out ival = {cfunc}(inputi(10))
 
187
ival = {cfunc}(inputi(10))
 
188
write/out ival = {ival}
 
189
if ival .ne. inputi(10) @@ verify3,error
 
190
write/out ival = {cfunc}(inputi(11))
 
191
ival = {cfunc}(inputi(11))
 
192
write/out ival = {ival}
 
193
if ival .ne. inputi(11) @@ verify3,error
 
194
write/out ival = {cfunc}(inputi(12))
 
195
ival = {cfunc}(inputi(12))
 
196
write/out ival = {ival}
 
197
if ival .eq. inputi(12) @@ verify3,error
 
198
!
 
199
write/key inputr/r/10/3 12345.6,0,-12345.6
 
200
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
 
201
write/out rval = {cfunc}(inputr(10))
 
202
rval = {cfunc}(inputr(10))
 
203
write/out rval = {rval}
 
204
if rval .ne. inputr(10) @@ verify3,error
 
205
write/out rval = {cfunc}(inputr(11))
 
206
rval = {cfunc}(inputr(11))
 
207
write/out rval = {rval}
 
208
if rval .ne. inputr(11) @@ verify3,error
 
209
write/out rval = {cfunc}(inputr(12))
 
210
rval = {cfunc}(inputr(12))
 
211
write/out rval = {rval}
 
212
if rval .eq. inputr(12) @@ verify3,error
 
213
!
 
214
write/key inputd/d/10/3 12345.6d1,0,-12345.6
 
215
write/out inputd(10,11,12) = {inputd(10)},{inputd(11)},{inputd(12)}
 
216
write/out dval = {cfunc}(inputd(10))
 
217
dval = {cfunc}(inputd(10))
 
218
write/out dval = {dval}
 
219
if dval .ne. inputd(10) @@ verify3,error
 
220
write/out dval = {cfunc}(inputd(11))
 
221
dval = {cfunc}(inputd(11))
 
222
write/out dval = {dval}
 
223
if dval .ne. inputd(11) @@ verify3,error
 
224
write/out dval = {cfunc}(inputd(12))
 
225
dval = {cfunc}(inputd(12))
 
226
write/out dval = {dval}
 
227
if dval .eq. inputd(12) @@ verify3,error
 
228
 
229
cfunc = "m$nint  "
 
230
write/key inputr/r/10/3 66.6,0,-77.7
 
231
write/key inputi/i/10/3 67,0,-78
 
232
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
 
233
write/out ival = {cfunc}(inputr(10))
 
234
ival = {cfunc}(inputr(10))
 
235
write/out ival = {ival}
 
236
if ival .ne. inputi(10) @@ verify3,error
 
237
write/out rval = {cfunc}(inputr(11))
 
238
ival = {cfunc}(inputr(11))
 
239
write/out ival = {ival}
 
240
if ival .ne. inputi(11) @@ verify3,error
 
241
write/out rval = {cfunc}(inputr(12))
 
242
ival = {cfunc}(inputr(12))
 
243
write/out ival = {ival}
 
244
if ival .ne. inputi(12) @@ verify3,error
 
245
write/key d/r/1/1 21.4
 
246
write/out rval = {cfunc}(d-0.5)
 
247
rval = {cfunc}(d-0.5)
 
248
if rval .lt. 20.99 .or. rval .gt. 21.01 then
 
249
   @@ verify3,error
 
250
endif
 
251
!
 
252
cfunc = "m$tstno "
 
253
write/key inputc/c/1/10 123456.78
 
254
write/out inputc = {inputc}
 
255
write/out ival = {cfunc}(inputc)
 
256
ival = {cfunc}(inputc)
 
257
write/out ival = {ival}
 
258
if ival .ne. 1 @@ verify3,error
 
259
write/key inputc keyword-test
 
260
write/out inputc = {inputc}
 
261
write/out ival = {cfunc}(inputc)
 
262
ival = {cfunc}(inputc)
 
263
write/out ival = {ival}
 
264
if ival .ne. 0 @@ verify3,error
 
265
!
 
266
entry 0005
 
267
! --------
 
268
 
269
write/out testing M$LOG10, M$LN, M$SQRT, M$SIN, M$COS, M$TAN
 
270
write/out "--------------------------------------------------"
 
271
 
272
@a matconst                     !define the math constants
 
273
set/format f12.6
 
274
 
275
cfunc = "m$log10  "
 
276
write/out rval = {cfunc}(123.456)
 
277
rval = {cfunc}(123.456)
 
278
write/out rval = {rval}
 
279
rval(2) = 2.09151-rval
 
280
if rval(2) .gt. 0.00001 goto math_error
 
281
rval(3) = m$log(123.456)                        !old form of LOG10
 
282
rval(2) = rval(3)-rval
 
283
if rval(2) .gt.  0.00001 then
 
284
   write/out "problems with backwards compatibility of M$LOG ..."
 
285
   @@ verify3,error
 
286
endif
 
287
 
288
cfunc = "m$ln  "
 
289
write/out rval = {cfunc}(123.456)
 
290
rval = {cfunc}(123.456)
 
291
write/out rval = {rval}
 
292
rval(2) = 4.81588-rval
 
293
if rval(2) .gt. 0.00001 goto math_error
 
294
 
295
cfunc = "m$sqrt  "
 
296
write/out rval = {cfunc}(2.0)
 
297
rval = {cfunc}(2.0)
 
298
write/out rval = {rval}
 
299
rval(2) = matconst(5)-rval
 
300
if rval(2) .gt. 0.00001 goto math_error
 
301
 
302
cfunc = "**      "
 
303
inputr = 3.0
 
304
write/out inputr = {inputr}
 
305
write/out rval = 270. *(inputr**(-3))
 
306
rval = 270. *(inputr**(-3))
 
307
write/out rval = {rval}
 
308
if rval .lt. 9.9999 .or. rval .gt. 10.001 goto math_error
 
309
 
310
cfunc = "m$sin   "
 
311
write/key inputr/r/10/3 45.,90.,-45.
 
312
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
 
313
write/out rval(2) = {cfunc}(inputr(10))
 
314
rval(2) = {cfunc}(inputr(10))
 
315
write/out rval(2) = {rval(2)}
 
316
if rval(2) .lt. 0.70710 .or. rval(2) .gt. 0.70711 goto math_error
 
317
write/out rval(3) = {cfunc}(inputr(11))
 
318
rval(3) = {cfunc}(inputr(11))
 
319
write/out rval(3) = {rval(3)}
 
320
if rval(3) .lt. 0.99999 .or. rval(3) .gt. 1.00001 goto math_error
 
321
write/out rval(4) = {cfunc}(inputr(12))
 
322
rval(4) = {cfunc}(inputr(12))
 
323
write/out rval(4) = {rval(4)}
 
324
if rval(4) .lt. -0.70711 .or. rval(4) .gt. -0.70710 goto math_error
 
325
 
326
cfunc = "m$cos   "
 
327
write/out rval = {cfunc}(inputr(10))
 
328
rval = {cfunc}(inputr(10))
 
329
write/out rval = {rval}
 
330
outputr = rval(2)
 
331
if rval .ne. outputr goto math_error
 
332
write/out rval = {cfunc}(inputr(11))
 
333
rval = {cfunc}(inputr(11))
 
334
write/out rval = {rval}
 
335
rval = rval+1.                                  !rval should be = 0.0
 
336
if rval .lt. 0.99999 .or. rval .gt. 1.00001 goto math_error
 
337
write/out rval = {cfunc}(inputr(12))
 
338
rval = {cfunc}(inputr(12))
 
339
write/out rval = {rval}
 
340
outputr = -rval(4)
 
341
if rval .ne. outputr goto math_error
 
342
!
 
343
cfunc = "m$tan   "
 
344
write/key inputr/r/10/3 45.,66.,-45.
 
345
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
 
346
write/out rval = {cfunc}(inputr(10))
 
347
rval = {cfunc}(inputr(10))
 
348
write/out rval(2) = {cfunc}(inputr(10))
 
349
rval(2) = {cfunc}(inputr(10))
 
350
write/out rval(2) = {rval(2)}
 
351
if rval(2) .lt. 0.99999 .or. rval(2) .gt. 1.00001 goto math_error
 
352
write/out rval(3) = {cfunc}(inputr(11))
 
353
rval(3) = {cfunc}(inputr(11))
 
354
write/out rval(3) = {rval(3)}
 
355
if rval(3) .lt. 2.24603 .or. rval(3) .gt. 2.24605  goto math_error
 
356
write/out rval(4) = {cfunc}(inputr(12))
 
357
rval(4) = {cfunc}(inputr(12))
 
358
write/out rval(4) = {rval(4)}
 
359
if rval(4) .gt. -0.99999 .or. rval(4) .lt. -1.00001 goto math_error
 
360
return
 
361
 
362
math_error:
 
363
@@ verify3,error
 
364
 
365
entry 0006
 
366
! --------
 
367
 
368
write/out testing M$UPPER
 
369
write/out "---------------"
 
370
 
371
write/key cfunc m$upper
 
372
in_a = "veria.bdf"
 
373
write/out in_a = {in_a}
 
374
write/out out_a = {cfunc}(in_a)
 
375
out_a = {cfunc}(in_a)
 
376
write/out out_a = {out_a}
 
377
if out_a .ne. "VERIA.BDF" @@ verify3,error
 
378
write/key cfunc m$lower
 
379
write/out out_b = {cfunc}(out_a)
 
380
out_b = {cfunc}(out_a)
 
381
write/out out_b = {out_b}
 
382
if out_b .ne. in_a @@ verify3,error
 
383
 
384
entry 0007
 
385
! --------
 
386
 
387
set/format i1 ,g15.10                              !change double format
 
388
cfunc = "comp/key"
 
389
read/descr veria npix
 
390
write/out add descr. NPIX(1), NPIX(2) of frame `veria.bdf'
 
391
write/out "compute/key ival = \{veria,npix(1)\} + \{veria,npix(2)\}"
 
392
compute/key ival = {veria,npix(1)} + {veria,npix(2)}
 
393
write/out ival = {ival}
 
394
if ival .ne. 512 @@ verify3,error
 
395
 
396
outputd(15) = 4.1595076632E+02
 
397
write/out "new descr. CALCULO is set to" -
 
398
 "{ival}/10*sqrt(66.0), should be {outputd(15)}"
 
399
write/out write/descr veria calculo/d/1/1 0.0
 
400
write/descr veria calculo/d/1/1 0.0
 
401
write/out "veria,calculo = ival/10*m$sqrt(66.0)"
 
402
veria,calculo = ival/10*m$sqrt(66.0)
 
403
write/out veria,calculo = {veria,calculo}
 
404
outputd = outputd(15) - {veria,calculo}
 
405
if outputd .lt. -0.000001 .or. outputd .gt. 0.000001 @@ verify3,error
 
406
veria,calculo = ival/10.0*m$sqrt(66.0)
 
407
outputd = outputd(15) - {veria,calculo}
 
408
if outputd .lt. -0.000001 .or. outputd .gt. 0.000001 @@ verify3,error
 
409
write/out > compute/dima {ival}/10*sqrt(66.0)
 
410
compute/dima {ival}/10*sqrt(66.0)
 
411
outputd = outputd(15)-outputd
 
412
if outputd .lt. -0.00001 .or. outputd .gt. 0.00001 @@ verify3,error
 
413
 
414
veria,this_is_a_very_long_descriptor_name0099(3) = 99.666
 
415
rval = {veria,this_is_a_very_long_descriptor_name0099(3)} - 1.555
 
416
if rval .lt. 98.1109 .or. rval .gt. 98.11101 then
 
417
   write/out rval = {rval}
 
418
   @@ verify3,error
 
419
endif
 
420
 
421
entry 0008
 
422
! --------
 
423
 
424
write/out testing immediate commands
 
425
write/out "--------------------------"
 
426
 
427
cfunc = "immediate command"
 
428
write/out "set 1. pixel of frame `veria' to 20. + pixel at x=20,y=20," -
 
429
should be  = 21.0
 
430
write/out "veria[<,<] = 20. + \{veria[@20,@20]\}"
 
431
veria[<,<] = 20. + {veria[@20,@20]}
 
432
read/ima veria >Null                    !outputr(1 - 20) get the values also
 
433
if outputr(1) .ne. 21.0 @@ verify3,error
 
434
!
 
435
write/out "also set the 2. pixel to root(17.34556) - 1.1, should be 3.0648"
 
436
write/out "veria[@2,<] = m$sqrt(inputr(3)) - 1.1"
 
437
inputr(3) = 17.34556
 
438
write/out inputr(3) = {inputr(3)}
 
439
veria[@2,<] = m$sqrt(inputr(3)) - 1.1
 
440
write/out veria[@2,<] = {veria[@2,<]}
 
441
outputr(1) = 3.0648-{veria[@2,<]}
 
442
if outputr(1) .lt. -0.00001 .or. outputr(1) .gt. 0.00001 @@ verify3,error
 
443
!
 
444
cfunc = "m$system"
 
445
if aux_mode .lt. 2 return               !not implemented yet for VMS
 
446
 
447
inputi = 99
 
448
write/out "check return status from `ls' Unix command"
 
449
inputi = m$system("ls veri*.prg")       !we know that these files exist...
 
450
if inputi .ne. 0 @@ verify3,error
 
451
 
452
entry 0009
 
453
! --------
 
454
!
 
455
write/out test of big expression in COMPUTE/KEY
 
456
write/out "-------------------------------------"
 
457
!
 
458
cfunc = "comp/key"
 
459
def/loc a/d/1/1 8220.
 
460
def/loc b/d/1/1 15.
 
461
def/loc c/d/1/1 -1.46095E-01
 
462
def/loc d/d/1/1 1.51853E-02
 
463
def/loc res/r/1/1 0.
 
464
!
 
465
set/format g15.8
 
466
write/out "comp/key res =  8220. + 15. * ( -1.46095E-01" -
 
467
          " / (-2. * 1.51853E-02)) - 15."
 
468
comp/key res = 'a' - 0.5 * 'b' * ('c' / 'd') - 'b'
 
469
write/out result = 'res'
 
470
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
 
471
comp/key res = 'a' + 'b' * ('c' / (-2. * 'd')) - 'b'
 
472
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
 
473
comp/key res =  8220. + 15. * ( -1.46095E-01 / (-2. * 1.51853E-02)) - 15.
 
474
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
 
475
comp/key res = 'a'-0.5*'b' * ('c'/'d')-'b'
 
476
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
 
477
write/out "and compare it with the calculator option of COMPUTE/IMAGE"
 
478
write/out -
 
479
"compute/ima 8220. + 15. * ( -1.46095E-01 / (-2. * 1.51853E-02)) - 15."
 
480
compute/ima 8220. + 15. * ( -1.46095E-01 / (-2. * 1.51853E-02)) - 15.
 
481
return
 
482
!
 
483
math_error:
 
484
write/out result should be = 8277.15625      ...
 
485
@@ verify3,error
 
486
!
 
487
entry 00010
 
488
! ---------
 
489
!
 
490
write/key cfunc m$value
 
491
write/out test of the M$VALUE function
 
492
veria[@10,@5] = 77.7
 
493
write/out "veria[<,<] = 2.212 +m$value(veria[@10,@5])"
 
494
veria[<,<] = 2.212 + m$value(veria[@10,@5])
 
495
read/ima veria >Null                    !outputr(1 - 20) get the values also
 
496
if outputr(1) .lt. 79.91199 .or. outputr(1) .gt. 79.91201 then
 
497
   @@ verify3,error
 
498
endif
 
499
create/table veria
 
500
create/column veria :veria
 
501
veria,:veria,@4 = 77.7
 
502
write/out "inputr(12) = m$value(veria[<,<]) - m$value(veria,:veria,@4)"
 
503
inputr(12) = m$value(veria[<,<]) - m$value(veria,:veria,@4)
 
504
if inputr(12) .lt. 2.21199 .or. inputr(12) .gt. 2.21201 then
 
505
   @@ verify3,error
 
506
endif
 
507
inputi = m$tnull(veria,:veria,@1)               !should be NULL
 
508
if inputi .ne. 1 then
 
509
   @@ verify3,error
 
510
endif
 
511
 
 
512
write/descr veria new/d/1/1 2.0
 
513
write/out -
 
514
"inputr(11) = 4.0*m$value(veria,new)-m$sqrt(m$value(veria,:veria,4))"
 
515
inputr(11) = -
 
516
4.0*m$value(veria,new) - m$sqrt( m$value(veria,:veria,4) )
 
517
if inputr(11) .gt. -0.814759 .or. inputr(11) .lt. -0.814761 then
 
518
   @@ verify3,error
 
519
endif
 
520
 
521
write/keyw inputd/d/1/10 -0.0099d0 all
 
522
write/descr veria klaus/i/1/1 {veria,npix(1)}
 
523
if aux_mode .eq. 1 then                         !VMS
 
524
   -copy veria.{imatype} test_this_file_name.{imatype}
 
525
   write/out -
 
526
   "inputd(10) = m$value(veria,klaus) - m$value(test_this_file_name,npix(1))"
 
527
   inputd(10) = m$value(veria,klaus) - m$value(test_this_file_name,npix(1))
 
528
   if m$abs(inputd(10)) .gt. 0.000001 then 
 
529
      @@ verify3,error
 
530
   endif
 
531
   ! 
 
532
   write/keyw inputd/d/1/10 -0.0099d0 all
 
533
   copy/dd veria npix/i/2/1 veria klaussi/i/1/1
 
534
   write/out inputd(10) = -
 
535
"m$sqrt(m$value(test_this_file_name,npix(2))) - m$sqrt(m$value(veria,klaussi))"
 
536
   inputd(10) = -
 
537
m$sqrt(m$value(test_this_file_name,npix(2))) - m$sqrt(m$value(veria,klaussi))
 
538
else
 
539
   -copy veria.{imatype} test_this_file+name.{imatype}
 
540
   write/out -
 
541
   "inputd(10) = m$value(veria,klaus) - m$value(test_this_file+name,npix(1))"
 
542
   inputd(10) = m$value(veria,klaus) - m$value(test_this_file+name,npix(1))
 
543
   if m$abs(inputd(10)) .gt. 0.000001 then 
 
544
      @@ verify3,error
 
545
   endif
 
546
   ! 
 
547
   write/keyw inputd/d/1/10 -0.0099d0 all
 
548
   copy/dd veria npix/i/2/1 veria klaussi/i/1/1
 
549
   write/out inputd(10) = -
 
550
"m$sqrt(m$value(test_this_file+name,npix(2))) - m$sqrt(m$value(veria,klaussi))"
 
551
   inputd(10) = -
 
552
m$sqrt(m$value(test_this_file+name,npix(2))) - m$sqrt(m$value(veria,klaussi))
 
553
endif
 
554
if m$abs(inputd(10)) .gt. 0.000001 then 
 
555
   @@ verify3,error
 
556
endif
 
557
 
558
write/out -
 
559
"inputr(12) = m$abs(4.0*m$value(veria,new)-m$sqrt(m$value(veria,:veria,4)))"
 
560
inputr(12) = -
 
561
m$abs(4.0*m$value(veria,new) - m$sqrt( m$value(veria,:veria,4)))
 
562
if inputr(12) .lt. 0.814759 .or. inputr(12) .gt. 0.814761 then
 
563
   @@ verify3,error
 
564
endif
 
565
 
566
inputc = "{veria,ident}"
 
567
outputc = m$value(veria,ident)
 
568
if inputc .ne. outputc @@ verify3,error
 
569
 
570
write/out rval = m$value(veria,this_is_a_very_long_descriptor_name0099(2))
 
571
rval = m$value(veria,this_is_a_very_long_descriptor_name0099(2))
 
572
if rval .lt. 2.34499 .or. rval .gt. 2.34501 then
 
573
   write/out rval = {rval}
 
574
   @@ verify3,error
 
575
endif
 
576
inputr(1) = 0.0
 
577
outputr(13) = 99.9
 
578
inputr = m$value(outputr(13))
 
579
if inputr .lt. 99.899 .or. inputr .gt. 99.901 then
 
580
   write/out inputr = {inputr}
 
581
   @@ verify3,error
 
582
endif
 
583
 
584
write/out check of "M$FILTYP, M$VALUE, M$FTSET in a loop (200 iterations)"
 
585
write/keyw in_a veria
 
586
write/keyw in_b veria
 
587
do inputi = 1 200
 
588
   if m$filtyp(in_a,".{imatype}") .eq. 1 then
 
589
      outputi(1) = m$value({in_a},npix(1))
 
590
   else
 
591
      outputi(1) = m$value({in_a},tblcontr(1))
 
592
   endif
 
593
!
 
594
   if m$ftset(in_b) .eq. 0 then                 !we need explicit file type
 
595
      in_b = in_b // ".{tbltype}"
 
596
   endif
 
597
   if m$filtyp(in_b," ") .eq. 1 then
 
598
      outputi(2) = m$value({in_b},npix(1))
 
599
   else
 
600
      outputi(2) = m$value({in_b},tblcontr(1))
 
601
      rval = m$value({in_b},:veria,@4)
 
602
   endif
 
603
enddo
 
604
if outputi .ne. 256 .or. outputi(2) .ne. workvar(1) then
 
605
   set/format i1
 
606
   write/out outputi(1,2) = -
 
607
   "{outputi(1)},{outputi(2)} (instead of 256,{workvar(1)})"
 
608
   @@ verify3,error
 
609
endif
 
610
if rval .lt. 77.699 .or. rval .gt. 77.701 then
 
611
   write/out rval = {rval} (instead of 77.7)
 
612
   @@ verify3,error
 
613
endif
 
614
!
 
615
entry 00011
 
616
! ---------
 
617
!
 
618
cfunc = "IF expr." 
 
619
write/out test of IF statements involving expressions
 
620
write/out "-------------------------------------------"
 
621
write/key outputr/r/3/2 0.55,0.049
 
622
if outputr(4) .lt. .05 .and. 0.5 .gt. m$abs(outputr(3)-.1) then
 
623
   wait/secs 0
 
624
else
 
625
   write/out test1 failed
 
626
   @@ verify3,error
 
627
endif
 
628
if outputr(4) .lt. .05 .and. m$abs(-1.+outputr(3)) .lt. 0.5 then
 
629
   wait/secs 0
 
630
else
 
631
   write/out test2 failed
 
632
   @@ verify3,error
 
633
endif
 
634
write/key outputr/r/3/2 0.6,0.049
 
635
if outputr(4) .lt. .05 .and. 0.5 .gt. m$abs(outputr(3)-.1) then
 
636
   write/out test4 failed
 
637
   @@ verify3,error
 
638
endif
 
639
write/key outputr/r/3/2 1.51,4.0
 
640
if m$abs(1.+outputr(3)-m$sqrt(outputr(4))) .lt. 0.5 then
 
641
   write/out test5 failed
 
642
   @@ verify3,error
 
643
endif
 
644
!
 
645
entry 00012
 
646
! ---------
 
647
!
 
648
cfunc = "compute/keyw"
 
649
write/out more tests of keyword processing 
 
650
write/out "--------------------------------"
 
651
!
 
652
cfunc = "m$strcmp()"
 
653
inputi(1) = 0
 
654
in_b = "MYFILE"
 
655
inputi(1) = m$strcmp(m$lower(in_b),in_b)
 
656
write/out here  m$strcmp(m$lower(in_b),in_b) = {inputi}
 
657
if inputi .eq. 0 then
 
658
   write/out m$strcmp(m$lower(in_b),in_b) is 0 ...
 
659
   @@ verify3,error
 
660
endif
 
661
if m$strcmp(in_b,"MYFILE") .ne. 0 then
 
662
   write/out m$strcmp(in_b,"MYFILE") is not 0 ...
 
663
   @@ verify3,error
 
664
endif
 
665
 
666
write/keyw klaus/c/1/100 " " all
 
667
klaus = "aaaaaaaaa1aaaaaaaaa2aaaaaaaaa3aaaaaaaaa4aaaaaaaaa5aaaaaaaaa6aaaaaaaaa7bbbbbbbbb8bbbcdef8"
 
668
klaus(90:100) = "x123456789K"
 
669
if klaus(81:100) .ne. "bbbcdef8 x123456789K" then
 
670
   write/out klaus(81:100) = {klaus(81:100)} (instead of "bbbcdef8 x123456789K")
 
671
   @@ verify3,error
 
672
endif
 
673
 
674
inputi = m$len(klaus)                   !should be 89
 
675
inputi(2) = m$strlen(klaus)             !should be 100
 
676
cfunc = "m$len()"
 
677
if inputi(1) .ne. 88 then
 
678
   write/out m$len(klaus) = {inputi(1)} instead of 88
 
679
   @@ verify3,error
 
680
endif
 
681
cfunc = "m$strlen()"
 
682
if inputi(2) .ne. 100 then
 
683
   write/out m$strlen(klaus) = {inputi(2)} instead of 100
 
684
   @@ verify3,error
 
685
endif
 
686
cfunc = "m$ftset()"
 
687
if aux_mode(1) .eq. 1 then
 
688
   klaus(1:) = "MIDASHOME:[98NOV.prim.general.src]genova.typefile "
 
689
else
 
690
   klaus(1:) = "/midas/98NOV/prim/general/src/genova.typefile "
 
691
endif
 
692
if m$ftset(klaus) .ne. 1  then
 
693
   write/out m$ftset("{klaus}") is not 1
 
694
   @@ verify3,error
 
695
endif
 
696
 
697
cfunc = "compute/keyw"
 
698
define/local markus/d/1/12 0.123456789 all
 
699
markus(10) = inputi(1) + markus(10)
 
700
markus(11) = inputi(2) + markus(11)
 
701
markus(1) = (m$exp(markus(2))+m$sin(markus(3))*12345.6789 + markus(10) + markus(11))/-123.456789 + markus(12)
 
702
markus(5) = markus(1) - -1.6259801521866
 
703
markus(12) = matconst(1)**m$sqrt(m$abs(m$exp(m$sin(m$cos(markus(4)+ m$ftset(klaus)))))) -
 
704
+0.33*m$len("123 567") + 0.34678                !expression with 1 cont. line
 
705
if m$abs(markus(5)) .gt. 1.e-11 .or. m$nint(markus(12)) .ne. 5 then
 
706
   write/out keyword markus(5) is {markus(5)} instead of 0.0
 
707
   write/out or
 
708
   write/out keyword markus(12) is {markus(12)} instead of 5.0
 
709
   @@ verify3,error
 
710
endif
 
711
 
712
define/local mchar/c/1/3 000
 
713
write/keyw holger/c/1/500 Ax all
 
714
set/format i1
 
715
do inputi(2) = 1 10
 
716
   do inputi = 1 500
 
717
      write/keyw mchar {inputi}
 
718
      holger({inputi}:{inputi}) = mchar(1:1)
 
719
   enddo
 
720
enddo
 
721
if holger(56:56) .ne. "5" then
 
722
   write/out keyword holger(56:56) is {holger(56:56)} instead of 5
 
723
   @@ verify3,error
 
724
endif
 
725
 
726
klaus = holger(1:90)//"abcdefghijk"
 
727
if klaus(89:93) .ne. "89abc" then
 
728
   write/out keyword klaus(89:93) is {klaus(89:93)} instead of 89abc
 
729
   @@ verify3,error
 
730
endif
 
731
 
732
entry error
 
733
! ---------
 
734
 
735
write/out ######## problems with {cfunc} ########
 
736
errsum = errsum+1
 
737