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 // <-- CLI SHELL MODE -->
   8 // <-- ENGLISH IMPOSED -->
   9 // Run with test_run('differential_equations','intg',['no_check_error_output'])
  10 // Function written in the Scilab language
  11 function y = f(x), y = x*sin(30*x)/sqrt(1-((x/(2*%pi))^2)), endfunction
  12 exact = -2.5432596188;
  13 I = intg(0, 2*%pi, f);
  14 if abs(exact-I) > 1e-9 then bugmes();quit;end
  15 // Function with an argument written in the Scilab language
  16 function y = f1(x, w), y = x*sin(w*x)/sqrt(1-((x/(2*%pi))^2)), endfunction
  17 I = intg(0, 2*%pi, list(f1, 30));
  18 if abs(exact-I) > 1e-9 then bugmes();quit;end
  19 // Function written in Fortran (a Fortran compiler is required)
  20 // define a Fortran function
  21 cd TMPDIR;
  22 F=['      double precision function ffun(x)'
  23    '      double precision x, pi'
  24    '      pi = 3.14159265358979312d+0'
  25    '      ffun = x*sin(30.0d+0*x)/sqrt(1.0d+0-(x/(2.0d+0*pi))**2)'
  26    '      return'
  27    '      end'];
  28 mputl(F, fullfile(TMPDIR, 'ffun.f'));
  29 // compile the function
  30 l = ilib_for_link('ffun', fullfile(TMPDIR, 'ffun.f'), [], 'f');
  31    Generate a loader file
  32    Generate a Makefile
  33    ilib_gen_Make: Copy compilation files (Makefile*, libtool...) to TMPDIR
  34    ilib_gen_Make: Copy TMPDIR/ffun.f to TMPDIR
  35    ilib_gen_Make: Modification of the Makefile in TMPDIR.
  36    Running the Makefile
  37    Generate a cleaner file
  38 // add the function to the working environment
  39 link(l, 'ffun', 'f');
  40 Shared archive loaded.
  41 Link done.
  42 // integrate the function
  43 I = intg(0, 2*%pi, 'ffun');
  44 abs(exact-I);
  45 if abs(exact-I) > 1e-9 then bugmes();quit;end
  46 // Function written in C (a C compiler is required)
  47 // define a C function
  48 C=['#include <math.h>'
  49    'double cfun(double *x)'
  50    '{'
  51    '  double y, pi = 3.14159265358979312;'
  52    '  y = *x/(2.0e0*pi);'
  53    '  return *x*sin(30.0e0**x)/sqrt(1.0e0-y*y);'
  54    '}'];
  55 mputl(C, fullfile(TMPDIR, 'cfun.c'));
  56 // compile the function
  57 l = ilib_for_link('cfun', fullfile(TMPDIR, 'cfun.c'), [], 'c');
  58    Generate a loader file
  59    Generate a Makefile
  60    ilib_gen_Make: Copy compilation files (Makefile*, libtool...) to TMPDIR
  61    ilib_gen_Make: Copy TMPDIR/cfun.c to TMPDIR
  62    ilib_gen_Make: Modification of the Makefile in TMPDIR.
  63    Running the Makefile
  64    Generate a cleaner file
  65 // add the function to the working environment
  66 link(l, 'cfun', 'c');
  67 Shared archive loaded.
  68 Link done.
  69 // integrate the function
  70 I = intg(0, 2*%pi, 'cfun');
  71 if abs(exact-I) > 1e-9 then bugmes();quit;end
  72 // Test third output argument
  73 [i, err, ierr] = intg(0, 1, f);
  74 if abs(ierr) <> 0 then bugmes();quit;end
  75 function y = f(x), y = cos(x); endfunction
  76 Warning : redefining function: f                       . Use funcprot(0) to avoid this message
  77
  78 [i, err, ierr] = intg(0, %pi, f);
  79 Warning: Round-off error detected, the requested tolerance (or default) cannot be achieved. Try using bigger tolerances.
  80 if abs(ierr) <> 2 then bugmes();quit;end
  81 // IEEE compatibility
  82 // Error 264: "Wrong value for argument #i: Must not contain NaN or Inf."
  83 if execstr("I = intg(%inf, 0, f)", 'errcatch')    <> 264 then bugmes();quit;end
  84 if execstr("I = intg(-%inf, 0, f)", 'errcatch')   <> 264 then bugmes();quit;end
  85 if execstr("I = intg(%nan, 0, f)", 'errcatch')    <> 264 then bugmes();quit;end
  86 if execstr("I = intg(0, %inf, f)", 'errcatch')    <> 264 then bugmes();quit;end
  87 if execstr("I = intg(0, -%inf, f)", 'errcatch')   <> 264 then bugmes();quit;end
  88 if execstr("I = intg(0, %nan, f)", 'errcatch')    <> 264 then bugmes();quit;end
  89 if execstr("I = intg(%nan, %nan, f)", 'errcatch') <> 264 then bugmes();quit;end