CMSCOPE changed

9 files changed, 166 insertions, 0 deletions

diff --git a/modules/special_functions/macros/buildmacros.bat b/modules/special_functions/macros/buildmacros.bat
new file mode 100755
index 000000000..a73ca67f8
--- /dev/null
+++ b/modules/special_functions/macros/buildmacros.bat
@@ -0,0 +1,11 @@
+
+rem Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+rem Copyright (C) 2008 - INRIA
+rem
+rem This file must be used under the terms of the CeCILL.
+rem This source file is licensed as described in the file COPYING, which
+rem you should have received as part of this distribution.  The terms
+rem are also available at
+rem http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
+
+@..\..\..\bin\scilex -nwni -ns -e exec('buildmacros.sce');quit;
diff --git a/modules/special_functions/macros/buildmacros.sce b/modules/special_functions/macros/buildmacros.sce
new file mode 100755
index 000000000..50989a440
--- /dev/null
+++ b/modules/special_functions/macros/buildmacros.sce
@@ -0,0 +1,15 @@
+
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2005-2008 - INRIA - Allan CORNET <allan.cornet@inria.fr>
+//
+// This file must be used under the terms of the CeCILL.
+// This source file is licensed as described in the file COPYING, which
+// you should have received as part of this distribution.  The terms
+// are also available at
+// http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
+
+if (isdef("genlib") == %f) then
+    exec(SCI+"/modules/functions/scripts/buildmacros/loadgenlib.sce");
+end
+
+genlib("special_functionslib","SCI/modules/special_functions/macros",%f,%t);
diff --git a/modules/special_functions/macros/calerf.bin b/modules/special_functions/macros/calerf.bin
new file mode 100755
index 000000000..b0d6e8d30
--- /dev/null
+++ b/modules/special_functions/macros/calerf.bin
diff --git a/modules/special_functions/macros/calerf.sci b/modules/special_functions/macros/calerf.sci
new file mode 100755
index 000000000..214541992
--- /dev/null
+++ b/modules/special_functions/macros/calerf.sci
@@ -0,0 +1,45 @@
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2012 - Steven G. Johnson <stevenj@alum.mit.edu>
+//
+// This file must be used under the terms of the CeCILL.
+// This source file is licensed as described in the file COPYING, which
+// you should have received as part of this distribution.  The terms
+// are also available at
+// http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
+
+function y=calerf(x,flag)
+
+    //calerf  -  computes error functions
+    //%Syntax
+    // y = calerf(x,flag).
+    //%Parameters
+    // x : real (or complex) vector
+    // flag : integer indicator (0, 1, or 2)
+    // y : real (or complex) vector (of same size)
+    //%Description
+    // calerf computes the error functions erf, erfc, or erfcx,
+    // depending on the value of the flag parameter.  (It is
+    // included for backward compatibility with older Scilab
+    // versions; there is no longer any reason to call this directly.)
+    //%See also
+    // erf erfc erfcx erfi dawson
+    //!
+
+    rhs = argn(2);
+
+    // check the number of input arguments
+    if rhs<>2 then
+        error(msprintf(gettext("%s: Wrong number of input argument(s): %d expected.\n"),"calerf",2));
+    end
+
+    if flag==0 then
+        y=erf(x);
+    elseif flag==1 then
+        y=erfc(x);
+    elseif flag==2 then
+        y=erfcx(x);
+    else
+        error(msprintf(gettext("%s: Wrong value for argument #%d: 0, 1 or 2 expected.\n"),"calerf",2));
+    end
+
+endfunction
diff --git a/modules/special_functions/macros/cleanmacros.bat b/modules/special_functions/macros/cleanmacros.bat
new file mode 100755
index 000000000..4ad1bbae2
--- /dev/null
+++ b/modules/special_functions/macros/cleanmacros.bat
@@ -0,0 +1,13 @@
+
+rem Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+rem Copyright (C) 2008 - INRIA
+rem
+rem This file must be used under the terms of the CeCILL.
+rem This source file is licensed as described in the file COPYING, which
+rem you should have received as part of this distribution.  The terms
+rem are also available at
+rem http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
+
+@del *.bin 2>NUL
+@del lib 2>NUL
+@del names 2>NUL
diff --git a/modules/special_functions/macros/erfinv.bin b/modules/special_functions/macros/erfinv.bin
new file mode 100755
index 000000000..cd9f6c460
--- /dev/null
+++ b/modules/special_functions/macros/erfinv.bin
diff --git a/modules/special_functions/macros/erfinv.sci b/modules/special_functions/macros/erfinv.sci
new file mode 100755
index 000000000..b75df4d2a
--- /dev/null
+++ b/modules/special_functions/macros/erfinv.sci
@@ -0,0 +1,80 @@
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) INRIA
+//
+// This file must be used under the terms of the CeCILL.
+// This source file is licensed as described in the file COPYING, which
+// you should have received as part of this distribution.  The terms
+// are also available at
+// http://www.cecill.info/licences/Licence_CeCILL_V2.1-en.txt
+//
+//
+function x=erfinv(y)
+    //   X = erfinv(Y) is the inverse error function for each element of Y.
+    //   The inverse error function satisfies y = erf(x), for -1 <= y <= 1
+    //   and -inf <= x <= inf.
+    //   uses rational aproximation of erfinv on ]-1 -0.7[ [-0.7 0.7]  ]0.7 1[
+    //   to obtain first aproximation then two newtion steps are used to
+    //   refine the solution of the equation y-erf(x)=0
+    //   coefficients of rational approximation are determined by solving non linear
+    //   linear least square problems given tabulated values of x and erf(x).
+
+    if ~isreal(y) then error(msprintf(gettext("%s: Wrong type for input argument #%d: Real expected.\n"),"erfinv",1));end;
+    x = zeros(y)
+
+
+    // Central range. -0.7 <= y <= 0.7
+    //coefficient of the rational approximation of erfinv on this range
+    a = [0.88622692374517353,-1.6601283962374516,0.92661860147244357,-0.14110320437680104];
+    b = [-2.13505380615258078,1.46060340345661088,-0.33198239813321595,0.01197270616590528];
+    //       a1*y + a2*y^3 + a3*y^5 + a4*y^7
+    //  x= --------------------------------------
+    //     1 + b1*y^2 + b2*y^4 + b3*y^6 + b4*y^8
+    y0 = 0.7;
+    k =find(abs(y)<=y0);
+    if k<>[] then
+        z = y(k) .* y(k);
+        x(k) = y(k) .* (((a(4)*z+a(3)) .* z+a(2)) .* z+a(1)) ./ ((((b(4)*z+b(3)) .* z+b(2)) .* z+b(1)) .* z+1);
+    end
+
+    // Near end points of range.
+    // Coefficients in rational approximations.
+
+    c = [-1.994216456587148,-1.87267416351196,3.60874665878559364,1.82365845766309853];
+    d = [3.74146294065960872,1.81848952562894617];
+
+
+    // 0.7 < y < 1
+    //       a1 + a2*z + a3*z^2 + a4*z^3
+    //  x= ------------------------------ ; z = sqrt(-log(1-y)/2)
+    //         1 + b1*z + b2*z^2
+
+    k = find((y0<y)&(y<1));
+    if k<>[] then
+        z = sqrt(-log((1-y(k))/2));
+        x(k) = (((c(4)*z+c(3)) .* z+c(2)) .* z+c(1)) ./ ((d(2)*z+d(1)) .* z+1);
+    end
+
+    // -1 < y < 0.7
+    //      - a1 - a2*z - a3*z^2 - a4*z^3
+    //  x= ------------------------------ ; z = sqrt(-log(1+y)/2)
+    //         1 + b1*z + b2*z^2
+
+    k = find((-y0>y)&(y>-1));
+    if k<>[] then
+        z = sqrt(-log((1+y(k))/2));
+        x(k) = -(((c(4)*z+c(3)) .* z+c(2)) .* z+c(1)) ./ ((d(2)*z+d(1)) .* z+1);
+    end
+
+    // Two steps of Newton-Raphson correction to obtain full accuracy.
+    // Without these steps, erfinv(y) would be about 3 times
+    // faster to compute, but accurate to only about 6 digits.
+
+    x = x-(erf(x)-y) ./ (2/sqrt(%pi)*exp(-x.^2));
+    x = x-(erf(x)-y) ./ (2/sqrt(%pi)*exp(-x.^2));
+
+    // Exceptional cases.
+    x(find(y==-1))=-%inf;
+    x(find(y==1))=%inf;
+    x(find(abs(y)>1|isnan(x)))=%nan;
+
+endfunction
diff --git a/modules/special_functions/macros/lib b/modules/special_functions/macros/lib
new file mode 100755
index 000000000..4ab57c90e
--- /dev/null
+++ b/modules/special_functions/macros/lib
diff --git a/modules/special_functions/macros/names b/modules/special_functions/macros/names
new file mode 100755
index 000000000..1a959d957
--- /dev/null
+++ b/modules/special_functions/macros/names
@@ -0,0 +1,2 @@
+calerf
+erfinv