eso-midas-testdata 17.02pl1.2-2build1 / usr / lib / eso-midas / 17FEB / test / prim / verify3.prg

! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  MIDAS procedure verify3.prg  to verify MIDAS command COMPUTE/KEYWORD
!  K. Banse     ESO - DMD	Garching
!  
!  091029		last modif
! 
!  use as @@ verify3 ffffffffffffffffff		with f = 1 or 0 (on/off)
!
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/par p1 111111111111 n "Enter control flags for entries: "
! 
define/local loop/i/1/1 0
define/local dval/d/1/5 0. all +lower
define/local rval/r/1/5 0. all +lower
define/local ival/i/1/5 0 all +lower
define/local seconds/i/1/2 0,0 +lower
define/local cfunc/c/1/10 " " all +lower
define/local ccc/c/1/12 "0" all
define/local errsum/i/1/1 0 ? +lower
! 
seconds(1) = m$secs()
!
! if enabled, handle FITS working environment
!
set/midas newfil=?? >Null
if outputc(1:1) .eq. "F" then           !we're in true FITS environment
   inputi = m$len(mid$types)
   define/local imatype/c/1/{inputi} {mid$types(1:8)} ? +lower
   inputi = m$len(mid$types(9:))
   define/local tbltype/c/1/{inputi} {mid$types(9:)} ? +lower
   define/local workenv/c/1/4 FITS ? +lower
   define/local workvar/i/1/4 5,8,0,0 ? +lower
else					!using good old Midas data format
   define/local imatype/c/1/3 bdf ? +lower
   define/local tbltype/c/1/3 tbl ? +lower
   define/local workenv/c/1/5 Midas ? +lower
   define/local workvar/i/1/4 15,4096,0,0 ? +lower
endif
! 
write/out +------------------------------------------+
write/out Start of procedure verify3.prg
write/out +------------------------------------------+
!
write/key ccc {p1}
set/format i1
do loop = 1 12
   if ccc({loop}:{loop}) .eq. "1" @@ verify3,000{loop}
   if errsum .gt. 0 then
      write/out "We got problems with entry 000{loop} in verify3.prg!"
      return 1
   endif
enddo
seconds(2) = m$secs()
mid$info(8) = seconds(2)-seconds(1)
!
! 
write/out +------------------------------------------+
write/out procedure verify3.prg:
write/out Total time elapsed = {mid$info(8)} seconds.
write/out All tests o.k. - you deserve a coffee now...
write/out +------------------------------------------+
return 0
! 
!  here the different sub-procedures
! 
entry 0001
! --------
! 
write/out test of CREATE/IMA 
write/out "------------------"
! 
crea/ima veria 2,256,256 ? poly 1
write/descr veria this_is_a_very_long_descriptor_name0099/r/1/5 -
            -1.234,2.345,-3.456,4.567,-5.678
read/descr veria
! 
entry 0002
! --------
! 
write/out test of the different functions of COMPUTE/KEYWORD
write/out "--------------------------------------------------"
! 
-dir veria.{imatype}
write/key cfunc m$exist
write/out ival = {cfunc}("veria.{imatype}")
ival = {cfunc}("veria.{imatype}")
write/out ival = {ival}
if ival .ne. 1 @@ verify3,error
in_a = "veria.{imatype}"
write/out in_a = {in_a}
write/out ival = {cfunc}(in_a)
ival = {cfunc}(in_a)
write/out ival = {ival}
if ival .ne. 1 @@ verify3,error
cfunc = "m$existd"
write/out ival = {cfunc}(in_a,"NPIX")
ival = {cfunc}(in_a,"NPIX")
write/out ival = {ival}
if ival .ne. 1 @@ verify3,error
write/out ival = {cfunc}(in_a,"this_is_a_very_long_descriptor_name0099")
ival = {cfunc}(in_a,"this_is_a_very_long_descriptor_name0099")
write/out ival = {ival}
if ival .ne. 1 @@ verify3,error
write/out ival = {cfunc}(in_a,"CLOCHARD")
ival = {cfunc}(in_a,"CLOCHARD")
write/out ival = {ival}
if ival .ne. 0 @@ verify3,error
write/out ival = {cfunc}("CLOCHARD","NPIX")
ival = {cfunc}("CLOCHARD","NPIX")
write/out ival = {ival}
if ival .ne. 0 @@ verify3,error
cfunc = "m$symbol"
write/out inputc = {cfunc}("DAZUNIT")
inputc = {cfunc}("DAZUNIT")
write/out inputc = {inputc}
if inputc(1:2) .ne. mid$sess(11:12) @@ verify3,error
! 
cfunc  = "m$len   "
write/key in_a s all
in_a(21:21) = " "
write/out in_a = {in_a(1:44)}
write/out ival = {cfunc}(in_a)
ival = {cfunc}(in_a)
write/out ival = {ival}
if ival .ne. 20 @@ verify3,error
! 
entry 0003
! --------
! 
write/out testing M$INDEX, M$TIME, M$ISODATE 
write/out "----------------------------------"
! 
write/key cfunc m$index
write/key in_a x all
in_a(21:) = "Midas test1 "
write/out in_a = {in_a}
write/out ival = {cfunc}(in_a,"t1")
ival = {cfunc}(in_a,"t1")
write/out ival = {ival}
if ival .ne. 30 @@ verify3,error
write/key out_a " " all
write/key out_a t1
write/out ival = {cfunc}(in_a,out_a)
write/out ival = {ival}
ival = {cfunc}(in_a,out_a)
if ival .ne. 30 @@ verify3,error
! 
cfunc = "m$time  "
outputc = {cfunc}()
write/out outputc = {cfunc}() 
write/out yields: {outputc(1:40)}
inputc = {cfunc}(1)
write/out outputc = {cfunc}(1)
write/out yields: {inputc(1:12)} (today)
in_a = {cfunc}(-1)
write/out outputc = {cfunc}(-1)
write/out yields: {in_a(1:12)} (yesterday)
if aux_mode .eq. 2 then			!only for Unix
   if inputc(9:10) .ne. outputc(5:6) @@ verify3,error
   if inputc(1:4) .ne. in_a(1:4) @@ verify3,error
endif
cfunc = "m$isodate"
write/out outputc = {cfunc}() 
outputc = {cfunc}()
write/out yields: {outputc(1:40)}
if aux_mode .eq. 2 then			!only for Unix
   if inputc(1:10) .ne. outputc(1:10) @@ verify3,error
endif
! 
cfunc = "m$secs   "
write/out ival = {cfunc}()
ival = {cfunc}()
write/out yields: {ival}
!
entry 0004
! --------
!
write/out testing M$ABS, M$NINT, M$TSTNO 
write/out "------------------------------"
! 
cfunc = "m$abs    "
write/key inputi/i/10/3 123456,0,-123456
write/out inputi(10,11,12) = {inputi(10)},{inputi(11)},{inputi(12)}
write/out ival = {cfunc}(inputi(10))
ival = {cfunc}(inputi(10))
write/out ival = {ival}
if ival .ne. inputi(10) @@ verify3,error
write/out ival = {cfunc}(inputi(11))
ival = {cfunc}(inputi(11))
write/out ival = {ival}
if ival .ne. inputi(11) @@ verify3,error
write/out ival = {cfunc}(inputi(12))
ival = {cfunc}(inputi(12))
write/out ival = {ival}
if ival .eq. inputi(12) @@ verify3,error
!
write/key inputr/r/10/3 12345.6,0,-12345.6
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
write/out rval = {cfunc}(inputr(10))
rval = {cfunc}(inputr(10))
write/out rval = {rval}
if rval .ne. inputr(10) @@ verify3,error
write/out rval = {cfunc}(inputr(11))
rval = {cfunc}(inputr(11))
write/out rval = {rval}
if rval .ne. inputr(11) @@ verify3,error
write/out rval = {cfunc}(inputr(12))
rval = {cfunc}(inputr(12))
write/out rval = {rval}
if rval .eq. inputr(12) @@ verify3,error
!
write/key inputd/d/10/3 12345.6d1,0,-12345.6
write/out inputd(10,11,12) = {inputd(10)},{inputd(11)},{inputd(12)}
write/out dval = {cfunc}(inputd(10))
dval = {cfunc}(inputd(10))
write/out dval = {dval}
if dval .ne. inputd(10) @@ verify3,error
write/out dval = {cfunc}(inputd(11))
dval = {cfunc}(inputd(11))
write/out dval = {dval}
if dval .ne. inputd(11) @@ verify3,error
write/out dval = {cfunc}(inputd(12))
dval = {cfunc}(inputd(12))
write/out dval = {dval}
if dval .eq. inputd(12) @@ verify3,error
! 
cfunc = "m$nint  "
write/key inputr/r/10/3 66.6,0,-77.7
write/key inputi/i/10/3 67,0,-78
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
write/out ival = {cfunc}(inputr(10))
ival = {cfunc}(inputr(10))
write/out ival = {ival}
if ival .ne. inputi(10) @@ verify3,error
write/out rval = {cfunc}(inputr(11))
ival = {cfunc}(inputr(11))
write/out ival = {ival}
if ival .ne. inputi(11) @@ verify3,error
write/out rval = {cfunc}(inputr(12))
ival = {cfunc}(inputr(12))
write/out ival = {ival}
if ival .ne. inputi(12) @@ verify3,error
write/key d/r/1/1 21.4
write/out rval = {cfunc}(d-0.5)
rval = {cfunc}(d-0.5)
if rval .lt. 20.99 .or. rval .gt. 21.01 then
   @@ verify3,error
endif
!
cfunc = "m$tstno "
write/key inputc/c/1/10 123456.78
write/out inputc = {inputc}
write/out ival = {cfunc}(inputc)
ival = {cfunc}(inputc)
write/out ival = {ival}
if ival .ne. 1 @@ verify3,error
write/key inputc keyword-test
write/out inputc = {inputc}
write/out ival = {cfunc}(inputc)
ival = {cfunc}(inputc)
write/out ival = {ival}
if ival .ne. 0 @@ verify3,error
!
entry 0005
! --------
! 
write/out testing M$LOG10, M$LN, M$SQRT, M$SIN, M$COS, M$TAN
write/out "--------------------------------------------------"
! 
@a matconst			!define the math constants
set/format f12.6
! 
cfunc = "m$log10  "
write/out rval = {cfunc}(123.456)
rval = {cfunc}(123.456)
write/out rval = {rval}
rval(2) = 2.09151-rval
if rval(2) .gt. 0.00001 goto math_error
rval(3) = m$log(123.456)			!old form of LOG10
rval(2) = rval(3)-rval
if rval(2) .gt.  0.00001 then
   write/out "problems with backwards compatibility of M$LOG ..."
   @@ verify3,error
endif
! 
cfunc = "m$ln  "
write/out rval = {cfunc}(123.456)
rval = {cfunc}(123.456)
write/out rval = {rval}
rval(2) = 4.81588-rval
if rval(2) .gt. 0.00001 goto math_error
! 
cfunc = "m$sqrt  "
write/out rval = {cfunc}(2.0)
rval = {cfunc}(2.0)
write/out rval = {rval}
rval(2) = matconst(5)-rval
if rval(2) .gt. 0.00001 goto math_error
! 
cfunc = "**      "
inputr = 3.0
write/out inputr = {inputr}
write/out rval = 270. *(inputr**(-3))
rval = 270. *(inputr**(-3))
write/out rval = {rval}
if rval .lt. 9.9999 .or. rval .gt. 10.001 goto math_error
! 
cfunc = "m$sin   "
write/key inputr/r/10/3 45.,90.,-45.
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
write/out rval(2) = {cfunc}(inputr(10))
rval(2) = {cfunc}(inputr(10))
write/out rval(2) = {rval(2)}
if rval(2) .lt. 0.70710 .or. rval(2) .gt. 0.70711 goto math_error
write/out rval(3) = {cfunc}(inputr(11))
rval(3) = {cfunc}(inputr(11))
write/out rval(3) = {rval(3)}
if rval(3) .lt. 0.99999 .or. rval(3) .gt. 1.00001 goto math_error
write/out rval(4) = {cfunc}(inputr(12))
rval(4) = {cfunc}(inputr(12))
write/out rval(4) = {rval(4)}
if rval(4) .lt. -0.70711 .or. rval(4) .gt. -0.70710 goto math_error
! 
cfunc = "m$cos   "
write/out rval = {cfunc}(inputr(10))
rval = {cfunc}(inputr(10))
write/out rval = {rval}
outputr = rval(2)
if rval .ne. outputr goto math_error
write/out rval = {cfunc}(inputr(11))
rval = {cfunc}(inputr(11))
write/out rval = {rval}
rval = rval+1.					!rval should be = 0.0
if rval .lt. 0.99999 .or. rval .gt. 1.00001 goto math_error
write/out rval = {cfunc}(inputr(12))
rval = {cfunc}(inputr(12))
write/out rval = {rval}
outputr = -rval(4)
if rval .ne. outputr goto math_error
!
cfunc = "m$tan   "
write/key inputr/r/10/3 45.,66.,-45.
write/out inputr(10,11,12) = {inputr(10)},{inputr(11)},{inputr(12)}
write/out rval = {cfunc}(inputr(10))
rval = {cfunc}(inputr(10))
write/out rval(2) = {cfunc}(inputr(10))
rval(2) = {cfunc}(inputr(10))
write/out rval(2) = {rval(2)}
if rval(2) .lt. 0.99999 .or. rval(2) .gt. 1.00001 goto math_error
write/out rval(3) = {cfunc}(inputr(11))
rval(3) = {cfunc}(inputr(11))
write/out rval(3) = {rval(3)}
if rval(3) .lt. 2.24603 .or. rval(3) .gt. 2.24605  goto math_error
write/out rval(4) = {cfunc}(inputr(12))
rval(4) = {cfunc}(inputr(12))
write/out rval(4) = {rval(4)}
if rval(4) .gt. -0.99999 .or. rval(4) .lt. -1.00001 goto math_error
return
! 
math_error:
@@ verify3,error
! 
entry 0006
! --------
! 
write/out testing M$UPPER
write/out "---------------"
! 
write/key cfunc m$upper
in_a = "veria.bdf"
write/out in_a = {in_a}
write/out out_a = {cfunc}(in_a)
out_a = {cfunc}(in_a)
write/out out_a = {out_a}
if out_a .ne. "VERIA.BDF" @@ verify3,error
write/key cfunc m$lower
write/out out_b = {cfunc}(out_a)
out_b = {cfunc}(out_a)
write/out out_b = {out_b}
if out_b .ne. in_a @@ verify3,error
! 
entry 0007
! --------
! 
set/format i1 ,g15.10                              !change double format
cfunc = "comp/key"
read/descr veria npix
write/out add descr. NPIX(1), NPIX(2) of frame `veria.bdf'
write/out "compute/key ival = \{veria,npix(1)\} + \{veria,npix(2)\}"
compute/key ival = {veria,npix(1)} + {veria,npix(2)}
write/out ival = {ival}
if ival .ne. 512 @@ verify3,error
! 
outputd(15) = 4.1595076632E+02
write/out "new descr. CALCULO is set to" -
 "{ival}/10*sqrt(66.0), should be {outputd(15)}"
write/out write/descr veria calculo/d/1/1 0.0
write/descr veria calculo/d/1/1 0.0
write/out "veria,calculo = ival/10*m$sqrt(66.0)"
veria,calculo = ival/10*m$sqrt(66.0)
write/out veria,calculo = {veria,calculo}
outputd = outputd(15) - {veria,calculo}
if outputd .lt. -0.000001 .or. outputd .gt. 0.000001 @@ verify3,error
veria,calculo = ival/10.0*m$sqrt(66.0)
outputd = outputd(15) - {veria,calculo}
if outputd .lt. -0.000001 .or. outputd .gt. 0.000001 @@ verify3,error
write/out > compute/dima {ival}/10*sqrt(66.0)
compute/dima {ival}/10*sqrt(66.0)
outputd = outputd(15)-outputd
if outputd .lt. -0.00001 .or. outputd .gt. 0.00001 @@ verify3,error
! 
veria,this_is_a_very_long_descriptor_name0099(3) = 99.666
rval = {veria,this_is_a_very_long_descriptor_name0099(3)} - 1.555
if rval .lt. 98.1109 .or. rval .gt. 98.11101 then
   write/out rval = {rval}
   @@ verify3,error
endif
! 
entry 0008
! --------
! 
write/out testing immediate commands
write/out "--------------------------"
! 
cfunc = "immediate command"
write/out "set 1. pixel of frame `veria' to 20. + pixel at x=20,y=20," -
should be  = 21.0
write/out "veria[<,<] = 20. + \{veria[@20,@20]\}"
veria[<,<] = 20. + {veria[@20,@20]}
read/ima veria >Null			!outputr(1 - 20) get the values also
if outputr(1) .ne. 21.0 @@ verify3,error
!
write/out "also set the 2. pixel to root(17.34556) - 1.1, should be 3.0648"
write/out "veria[@2,<] = m$sqrt(inputr(3)) - 1.1"
inputr(3) = 17.34556
write/out inputr(3) = {inputr(3)}
veria[@2,<] = m$sqrt(inputr(3)) - 1.1
write/out veria[@2,<] = {veria[@2,<]}
outputr(1) = 3.0648-{veria[@2,<]}
if outputr(1) .lt. -0.00001 .or. outputr(1) .gt. 0.00001 @@ verify3,error
!
cfunc = "m$system"
if aux_mode .lt. 2 return		!not implemented yet for VMS
! 
inputi = 99
write/out "check return status from `ls' Unix command"
inputi = m$system("ls veri*.prg")	!we know that these files exist...
if inputi .ne. 0 @@ verify3,error
! 
entry 0009
! --------
!
write/out test of big expression in COMPUTE/KEY
write/out "-------------------------------------"
!
cfunc = "comp/key"
def/loc a/d/1/1 8220.
def/loc b/d/1/1 15.
def/loc c/d/1/1 -1.46095E-01
def/loc d/d/1/1 1.51853E-02
def/loc res/r/1/1 0.
!
set/format g15.8
write/out "comp/key res =  8220. + 15. * ( -1.46095E-01" -
          " / (-2. * 1.51853E-02)) - 15."
comp/key res = 'a' - 0.5 * 'b' * ('c' / 'd') - 'b'
write/out result = 'res'
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
comp/key res = 'a' + 'b' * ('c' / (-2. * 'd')) - 'b'
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
comp/key res =  8220. + 15. * ( -1.46095E-01 / (-2. * 1.51853E-02)) - 15.
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
comp/key res = 'a'-0.5*'b' * ('c'/'d')-'b'
if res .gt. 8277.15626 .or. res .lt. 8277.15624 goto math_error
write/out "and compare it with the calculator option of COMPUTE/IMAGE"
write/out -
"compute/ima 8220. + 15. * ( -1.46095E-01 / (-2. * 1.51853E-02)) - 15."
compute/ima 8220. + 15. * ( -1.46095E-01 / (-2. * 1.51853E-02)) - 15.
return
!
math_error:
write/out result should be = 8277.15625      ...
@@ verify3,error
!
entry 00010
! ---------
!
write/key cfunc m$value
write/out test of the M$VALUE function
veria[@10,@5] = 77.7
write/out "veria[<,<] = 2.212 +m$value(veria[@10,@5])"
veria[<,<] = 2.212 + m$value(veria[@10,@5])
read/ima veria >Null			!outputr(1 - 20) get the values also
if outputr(1) .lt. 79.91199 .or. outputr(1) .gt. 79.91201 then
   @@ verify3,error
endif
create/table veria
create/column veria :veria
veria,:veria,@4 = 77.7
write/out "inputr(12) = m$value(veria[<,<]) - m$value(veria,:veria,@4)"
inputr(12) = m$value(veria[<,<]) - m$value(veria,:veria,@4)
if inputr(12) .lt. 2.21199 .or. inputr(12) .gt. 2.21201 then
   @@ verify3,error
endif
inputi = m$tnull(veria,:veria,@1)		!should be NULL
if inputi .ne. 1 then
   @@ verify3,error
endif

write/descr veria new/d/1/1 2.0
write/out -
"inputr(11) = 4.0*m$value(veria,new)-m$sqrt(m$value(veria,:veria,4))"
inputr(11) = -
4.0*m$value(veria,new) - m$sqrt( m$value(veria,:veria,4) )
if inputr(11) .gt. -0.814759 .or. inputr(11) .lt. -0.814761 then
   @@ verify3,error
endif
! 
write/keyw inputd/d/1/10 -0.0099d0 all
write/descr veria klaus/i/1/1 {veria,npix(1)}
if aux_mode .eq. 1 then				!VMS
   -copy veria.{imatype} test_this_file_name.{imatype}
   write/out -
   "inputd(10) = m$value(veria,klaus) - m$value(test_this_file_name,npix(1))"
   inputd(10) = m$value(veria,klaus) - m$value(test_this_file_name,npix(1))
   if m$abs(inputd(10)) .gt. 0.000001 then 
      @@ verify3,error
   endif
   ! 
   write/keyw inputd/d/1/10 -0.0099d0 all
   copy/dd veria npix/i/2/1 veria klaussi/i/1/1
   write/out inputd(10) = -
"m$sqrt(m$value(test_this_file_name,npix(2))) - m$sqrt(m$value(veria,klaussi))"
   inputd(10) = -
m$sqrt(m$value(test_this_file_name,npix(2))) - m$sqrt(m$value(veria,klaussi))
else
   -copy veria.{imatype} test_this_file+name.{imatype}
   write/out -
   "inputd(10) = m$value(veria,klaus) - m$value(test_this_file+name,npix(1))"
   inputd(10) = m$value(veria,klaus) - m$value(test_this_file+name,npix(1))
   if m$abs(inputd(10)) .gt. 0.000001 then 
      @@ verify3,error
   endif
   ! 
   write/keyw inputd/d/1/10 -0.0099d0 all
   copy/dd veria npix/i/2/1 veria klaussi/i/1/1
   write/out inputd(10) = -
"m$sqrt(m$value(test_this_file+name,npix(2))) - m$sqrt(m$value(veria,klaussi))"
   inputd(10) = -
m$sqrt(m$value(test_this_file+name,npix(2))) - m$sqrt(m$value(veria,klaussi))
endif
if m$abs(inputd(10)) .gt. 0.000001 then 
   @@ verify3,error
endif
! 
write/out -
"inputr(12) = m$abs(4.0*m$value(veria,new)-m$sqrt(m$value(veria,:veria,4)))"
inputr(12) = -
m$abs(4.0*m$value(veria,new) - m$sqrt( m$value(veria,:veria,4)))
if inputr(12) .lt. 0.814759 .or. inputr(12) .gt. 0.814761 then
   @@ verify3,error
endif
! 
inputc = "{veria,ident}"
outputc = m$value(veria,ident)
if inputc .ne. outputc @@ verify3,error
! 
write/out rval = m$value(veria,this_is_a_very_long_descriptor_name0099(2))
rval = m$value(veria,this_is_a_very_long_descriptor_name0099(2))
if rval .lt. 2.34499 .or. rval .gt. 2.34501 then
   write/out rval = {rval}
   @@ verify3,error
endif
inputr(1) = 0.0
outputr(13) = 99.9
inputr = m$value(outputr(13))
if inputr .lt. 99.899 .or. inputr .gt. 99.901 then
   write/out inputr = {inputr}
   @@ verify3,error
endif
! 
write/out check of "M$FILTYP, M$VALUE, M$FTSET in a loop (200 iterations)"
write/keyw in_a veria
write/keyw in_b veria
do inputi = 1 200
   if m$filtyp(in_a,".{imatype}") .eq. 1 then
      outputi(1) = m$value({in_a},npix(1))
   else
      outputi(1) = m$value({in_a},tblcontr(1))
   endif
!
   if m$ftset(in_b) .eq. 0 then			!we need explicit file type
      in_b = in_b // ".{tbltype}"
   endif
   if m$filtyp(in_b," ") .eq. 1 then
      outputi(2) = m$value({in_b},npix(1))
   else
      outputi(2) = m$value({in_b},tblcontr(1))
      rval = m$value({in_b},:veria,@4)
   endif
enddo
if outputi .ne. 256 .or. outputi(2) .ne. workvar(1) then
   set/format i1
   write/out outputi(1,2) = -
   "{outputi(1)},{outputi(2)} (instead of 256,{workvar(1)})"
   @@ verify3,error
endif
if rval .lt. 77.699 .or. rval .gt. 77.701 then
   write/out rval = {rval} (instead of 77.7)
   @@ verify3,error
endif
!
entry 00011
! ---------
!
cfunc = "IF expr." 
write/out test of IF statements involving expressions
write/out "-------------------------------------------"
write/key outputr/r/3/2 0.55,0.049
if outputr(4) .lt. .05 .and. 0.5 .gt. m$abs(outputr(3)-.1) then
   wait/secs 0
else
   write/out test1 failed
   @@ verify3,error
endif
if outputr(4) .lt. .05 .and. m$abs(-1.+outputr(3)) .lt. 0.5 then
   wait/secs 0
else
   write/out test2 failed
   @@ verify3,error
endif
write/key outputr/r/3/2 0.6,0.049
if outputr(4) .lt. .05 .and. 0.5 .gt. m$abs(outputr(3)-.1) then
   write/out test4 failed
   @@ verify3,error
endif
write/key outputr/r/3/2 1.51,4.0
if m$abs(1.+outputr(3)-m$sqrt(outputr(4))) .lt. 0.5 then
   write/out test5 failed
   @@ verify3,error
endif
!
entry 00012
! ---------
!
cfunc = "compute/keyw"
write/out more tests of keyword processing 
write/out "--------------------------------"
!
cfunc = "m$strcmp()"
inputi(1) = 0
in_b = "MYFILE"
inputi(1) = m$strcmp(m$lower(in_b),in_b)
write/out here  m$strcmp(m$lower(in_b),in_b) = {inputi}
if inputi .eq. 0 then
   write/out m$strcmp(m$lower(in_b),in_b) is 0 ...
   @@ verify3,error
endif
if m$strcmp(in_b,"MYFILE") .ne. 0 then
   write/out m$strcmp(in_b,"MYFILE") is not 0 ...
   @@ verify3,error
endif
! 
write/keyw klaus/c/1/100 " " all
klaus = "aaaaaaaaa1aaaaaaaaa2aaaaaaaaa3aaaaaaaaa4aaaaaaaaa5aaaaaaaaa6aaaaaaaaa7bbbbbbbbb8bbbcdef8"
klaus(90:100) = "x123456789K"
if klaus(81:100) .ne. "bbbcdef8 x123456789K" then
   write/out klaus(81:100) = {klaus(81:100)} (instead of "bbbcdef8 x123456789K")
   @@ verify3,error
endif
! 
inputi = m$len(klaus)			!should be 89
inputi(2) = m$strlen(klaus)		!should be 100
cfunc = "m$len()"
if inputi(1) .ne. 88 then
   write/out m$len(klaus) = {inputi(1)} instead of 88
   @@ verify3,error
endif
cfunc = "m$strlen()"
if inputi(2) .ne. 100 then
   write/out m$strlen(klaus) = {inputi(2)} instead of 100
   @@ verify3,error
endif
cfunc = "m$ftset()"
if aux_mode(1) .eq. 1 then
   klaus(1:) = "MIDASHOME:[98NOV.prim.general.src]genova.typefile "
else
   klaus(1:) = "/midas/98NOV/prim/general/src/genova.typefile "
endif
if m$ftset(klaus) .ne. 1  then
   write/out m$ftset("{klaus}") is not 1
   @@ verify3,error
endif
! 
cfunc = "compute/keyw"
define/local markus/d/1/12 0.123456789 all
markus(10) = inputi(1) + markus(10)
markus(11) = inputi(2) + markus(11)
markus(1) = (m$exp(markus(2))+m$sin(markus(3))*12345.6789 + markus(10) + markus(11))/-123.456789 + markus(12)
markus(5) = markus(1) - -1.6259801521866
markus(12) = matconst(1)**m$sqrt(m$abs(m$exp(m$sin(m$cos(markus(4)+ m$ftset(klaus)))))) -
+0.33*m$len("123 567") + 0.34678		!expression with 1 cont. line
if m$abs(markus(5)) .gt. 1.e-11 .or. m$nint(markus(12)) .ne. 5 then
   write/out keyword markus(5) is {markus(5)} instead of 0.0
   write/out or
   write/out keyword markus(12) is {markus(12)} instead of 5.0
   @@ verify3,error
endif
! 
define/local mchar/c/1/3 000
write/keyw holger/c/1/500 Ax all
set/format i1
do inputi(2) = 1 10
   do inputi = 1 500
      write/keyw mchar {inputi}
      holger({inputi}:{inputi}) = mchar(1:1)
   enddo
enddo
if holger(56:56) .ne. "5" then
   write/out keyword holger(56:56) is {holger(56:56)} instead of 5
   @@ verify3,error
endif
! 
klaus = holger(1:90)//"abcdefghijk"
if klaus(89:93) .ne. "89abc" then
   write/out keyword klaus(89:93) is {klaus(89:93)} instead of 89abc
   @@ verify3,error
endif
! 
entry error
! ---------
! 
write/out ######## problems with {cfunc} ########
errsum = errsum+1