scilab/modules/differential_equations/tests/unit_tests/intg.dia.ref

   1 // =============================================================================
   2 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   3 // Copyright (C) 2007-2008 - INRIA
   4 //
   5 //  This file is distributed under the same license as the Scilab package.
   6 // =============================================================================
   7 //
   8 // <-- CLI SHELL MODE -->
   9 //
  10 // <-- ENGLISH IMPOSED -->
  11 ilib_verbose(0);
  12 // Function written in the Scilab language
  13 function y = f(x), y = x*sin(30*x)/sqrt(1-((x/(2*%pi))^2)), endfunction
  14 exact = -2.5432596188;
  15 I = intg(0, 2*%pi, f);
  16 if abs(exact-I) > 1e-9 then bugmes();quit;end
  17 // Function with an argument written in the Scilab language
  18 function y = f1(x, w), y = x*sin(w*x)/sqrt(1-((x/(2*%pi))^2)), endfunction
  19 I = intg(0, 2*%pi, list(f1, 30));
  20 if abs(exact-I) > 1e-9 then bugmes();quit;end
  21 // Function written in Fortran (a Fortran compiler is required)
  22 // define a Fortran function
  23 cd TMPDIR;
  24 F=["      double precision function ffun(x)"
  25 "      double precision x, pi"
  26 "      pi = 3.14159265358979312d+0"
  27 "      ffun = x*sin(30.0d+0*x)/sqrt(1.0d+0-(x/(2.0d+0*pi))**2)"
  28 "      return"
  29 "      end"];
  30 mputl(F, fullfile(TMPDIR, "ffun.f"));
  31 // compile the function
  32 l = ilib_for_link("ffun", "ffun.f", [], "f");
  33 // add the function to the working environment
  34 link(l, "ffun", "f");
  35 // integrate the function
  36 I = intg(0, 2*%pi, "ffun");
  37 abs(exact-I);
  38 if abs(exact-I) > 1e-9 then bugmes();quit;end
  39 // Function written in C (a C compiler is required)
  40 // define a C function
  41 C=["#include <math.h>"
  42 "double cfun(double *x)"
  43 "{"
  44 "  double y, pi = 3.14159265358979312;"
  45 "  y = *x/(2.0e0*pi);"
  46 "  return *x*sin(30.0e0**x)/sqrt(1.0e0-y*y);"
  47 "}"];
  48 mputl(C, fullfile(TMPDIR, "cfun.c"));
  49 // compile the function
  50 l = ilib_for_link("cfun", "cfun.c", [], "c");
  51 // add the function to the working environment
  52 link(l, "cfun", "c");
  53 // integrate the function
  54 I = intg(0, 2*%pi, "cfun");
  55 if abs(exact-I) > 1e-9 then bugmes();quit;end
  56 // Test third output argument
  57 [i, err, ierr] = intg(0, 1, f);
  58 if abs(ierr) <> 0 then bugmes();quit;end
  59 prot = funcprot();
  60 funcprot(0);
  61 function y = f(x), y = cos(x); endfunction
  62 funcprot(prot);
  63 [i, err, ierr] = intg(0, %pi, f);
  64 Warning: Round-off error detected, the requested tolerance (or default) cannot be achieved. Try using bigger tolerances.
  65 if abs(ierr) <> 2 then bugmes();quit;end
  66 // IEEE compatibility
  67 // Error 264: "Wrong value for argument #i: Must not contain NaN or Inf."
  68 if execstr("I = intg(%inf, 0, f)", "errcatch")    <> 264 then bugmes();quit;end
  69 if execstr("I = intg(-%inf, 0, f)", "errcatch")   <> 264 then bugmes();quit;end
  70 if execstr("I = intg(%nan, 0, f)", "errcatch")    <> 264 then bugmes();quit;end
  71 if execstr("I = intg(0, %inf, f)", "errcatch")    <> 264 then bugmes();quit;end
  72 if execstr("I = intg(0, -%inf, f)", "errcatch")   <> 264 then bugmes();quit;end
  73 if execstr("I = intg(0, %nan, f)", "errcatch")    <> 264 then bugmes();quit;end
  74 if execstr("I = intg(%nan, %nan, f)", "errcatch") <> 264 then bugmes();quit;end