CMSCOPE changed

5 files changed, 280 insertions, 0 deletions

diff --git a/modules/linear_algebra/examples/intdgemm.c b/modules/linear_algebra/examples/intdgemm.c
new file mode 100755
index 000000000..d2036fc4d
--- /dev/null
+++ b/modules/linear_algebra/examples/intdgemm.c
@@ -0,0 +1,57 @@
+/*
+* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+* Copyright (C) INRIA
+* Copyright (C) DIGITEO - 2010 - Allan CORNET
+*
+* This file is released under the 3-clause BSD license. See COPYING-BSD.
+*/
+/* -------------------------------------------------------------------------- */
+/* WARNING:this gateway uses old scilab api and it does not work with Scilab 6*/
+/* see help api_scilab for more information. */
+/* -------------------------------------------------------------------------- */
+#include "stack-c.h"
+#include "Scierror.h"
+/* -------------------------------------------------------------------------- */
+/* Usage:  C = dgemm(alfa, A, B, betha, C) */
+/* -------------------------------------------------------------------------- */
+extern int C2F(dgemm)(char *, char *, int *, int *, int *,
+                      double *, double *, int *, double *, int *,
+                      double *, double *, int *);
+/* -------------------------------------------------------------------------- */
+int intdgemm(char* fname)
+{
+    int lalfa = 0, m1 = 0, n1 = 0, m = 0, n = 0, k = 0;
+    int mA = 0, nA = 0, lA = 0, mB = 0, nB = 0, lB = 0, m4 = 0, n4 = 0, lbeta = 0;
+    int mC = 0, nC = 0, lC = 0;
+
+    int minlhs = 1, minrhs = 5, maxlhs = 1, maxrhs = 5;
+
+    CheckRhs(minrhs, maxrhs) ;
+    CheckLhs(minlhs, maxlhs) ;
+
+    GetRhsVar(1, MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lalfa); /*      alpha */
+    CheckScalar(1, m1, n1);
+
+    GetRhsVar(2, MATRIX_OF_DOUBLE_DATATYPE, &mA, &nA, &lA);   /*      A     */
+    GetRhsVar(3, MATRIX_OF_DOUBLE_DATATYPE, &mB, &nB, &lB);   /*      B     */
+
+    GetRhsVar(4, MATRIX_OF_DOUBLE_DATATYPE, &m4, &n4, &lbeta); /*      beta */
+    CheckScalar(4, m4, n4);
+
+    GetRhsVar(5, MATRIX_OF_DOUBLE_DATATYPE, &mC, &nC, &lC);   /*      C     */
+
+    m = mA;
+    n = nB;
+    if (nA != mB || mA != mC || nB != nC )
+    {
+        Scierror(999, "%f: invalid matrix dims\n", fname);
+    }
+
+    k = nA;
+    C2F(dgemm)("n", "n", &m , &n , &k, stk(lalfa),
+               stk(lA), &mA , stk(lB), &mB , stk(lbeta) , stk(lC), &mC);
+    /*      Return C (#5) */
+    LhsVar(1) = 5;
+    return(0);
+}
+/* -------------------------------------------------------------------------- */
diff --git a/modules/linear_algebra/examples/intdsyev.c b/modules/linear_algebra/examples/intdsyev.c
new file mode 100755
index 000000000..8a56ee99b
--- /dev/null
+++ b/modules/linear_algebra/examples/intdsyev.c
@@ -0,0 +1,95 @@
+/*
+* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+* Copyright (C) INRIA
+* Copyright (C) DIGITEO - 2010 - Allan CORNET
+*
+* This file is released under the 3-clause BSD license. See COPYING-BSD.
+*/
+/* -------------------------------------------------------------------------- */
+/* WARNING:this gateway uses old scilab api and it does not work with Scilab 6*/
+/* see help api_scilab for more information. */
+/* -------------------------------------------------------------------------- */
+#include "sciprint.h"
+#include "Scierror.h"
+#include "stack-c.h"
+#include "machine.h"
+#include "core_math.h"
+/* -------------------------------------------------------------------------- */
+/* SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO ) */
+/* [w,U] = dsyev(A) */
+/* w = dsyev(A) */
+/* -------------------------------------------------------------------------- */
+extern int C2F(dsyev)();
+/* -------------------------------------------------------------------------- */
+int intdsyev(char* fname)
+{
+    int M = 0, N = 0, lA = 0;
+    int NLHS = 0;
+    int un = 1;
+    int WORK = 0, lWORK = 0, LWORKMIN = 0, LWORK = 0, INFO = 0;
+    int LDA = 0, lw = 0;
+    int A = 1, W = 2;
+
+    static int minlhs = 1, minrhs = 1, maxlhs = 2, maxrhs = 1;
+    CheckRhs(minrhs, maxrhs) ;
+    CheckLhs(minlhs, maxlhs) ;
+
+    /*--------------------A---------------------------*/
+    GetRhsVar(A, MATRIX_OF_DOUBLE_DATATYPE, &M, &N, &lA);
+    /*  To be done: Check A symmetric and Real*/
+    NLHS = Lhs;
+    switch ( NLHS )
+    {
+
+        case 2:
+            /*  [w,U]=dsyev(A)     */
+            CreateVar(W, MATRIX_OF_DOUBLE_DATATYPE, &N, &un, &lw);
+            WORK = 3;
+            LWORKMIN = Max(1, 3 * N - 1);
+            LWORK = LWORKMIN;
+            /* LWORK=C2F(maxvol)(&WORK, "d", 1L);   max memory currently available */
+            if (LWORK < LWORKMIN)
+            {
+                sciprint("not enough memory (use stacksize)");
+                SciError(9999);
+            };
+            CreateVar(3, MATRIX_OF_DOUBLE_DATATYPE, &LWORK, &un, &lWORK);
+            LDA = Max(1, N);
+            C2F(dsyev)("V", "L", &N, stk(lA), &LDA, stk(lw), stk(lWORK), &LWORK, &INFO);
+            if (INFO != 0)
+            {
+                C2F(errorinfo)("dsyev ", &INFO, 5L);
+            }
+            LhsVar(1) = A;
+            LhsVar(2) = W;
+            return 0;
+            break;
+
+        case 1:
+            /*   w=dsyev(A)    */
+            CreateVar(W, MATRIX_OF_DOUBLE_DATATYPE, &N, &un, &lw);
+            WORK = 3;
+            LWORKMIN = Max(1, 3 * N - 1);
+            LWORK = C2F(maxvol)(&WORK, "d", 1L); /* max memory currently available */
+            if (LWORK < LWORKMIN)
+            {
+                sciprint("not enough memory (use stacksize)");
+                SciError(9999);
+            };
+            CreateVar(3, MATRIX_OF_DOUBLE_DATATYPE, &LWORK, &un, &lWORK);
+            LDA = Max(1, N);
+            C2F(dsyev)("N", "L", &N, stk(lA), &LDA, stk(lw), stk(lWORK), &LWORK, &INFO);
+            if (INFO != 0)
+            {
+                C2F(errorinfo)("dsyev ", &INFO, 5L);
+            }
+            LhsVar(1) = W;
+            return 0;
+            break;
+
+        default:
+            return 0;
+    }
+    return(0);
+}
+/* -------------------------------------------------------------------------- */
diff --git a/modules/linear_algebra/examples/intzgemm.c b/modules/linear_algebra/examples/intzgemm.c
new file mode 100755
index 000000000..82ffce07e
--- /dev/null
+++ b/modules/linear_algebra/examples/intzgemm.c
@@ -0,0 +1,62 @@
+/*
+* Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+* Copyright (C) INRIA
+* Copyright (C) DIGITEO - 2010 - Allan CORNET
+*
+* This file is released under the 3-clause BSD license. See COPYING-BSD.
+*/
+/* -------------------------------------------------------------------------- */
+/* WARNING:this gateway uses old scilab api and it does not work with Scilab 6*/
+/* see help api_scilab for more information. */
+/* -------------------------------------------------------------------------- */
+#include "machine.h"
+#include "Scierror.h"
+#include "stack-c.h"
+/* -------------------------------------------------------------------------- */
+/*    Ex:  alfa = 1+%i;
+           betha = alfa;
+           A = rand(2,2) + %i * rand(2,2);
+           B = A;
+           C = A;
+   Usage:  C = zgemm(alfa, A, B, betha, C)
+*/
+/* -------------------------------------------------------------------------- */
+extern int C2F(zgemm)();
+/* -------------------------------------------------------------------------- */
+int intzgemm(char* fname)
+{
+    int lalfa = 0, m1 = 0, n1 = 0, m = 0, n = 0, k = 0;
+    int mA = 0, nA = 0, lA = 0, mB = 0, nB = 0, lB = 0;
+    int m4 = 0, n4 = 0, lbeta = 0, mC = 0, nC = 0, lC = 0;
+
+    int minlhs = 1, minrhs = 5, maxlhs = 1, maxrhs = 5;
+
+    CheckRhs(minrhs, maxrhs) ;
+    CheckLhs(minlhs, maxlhs) ;
+
+    GetRhsVar(1, MATRIX_OF_COMPLEX_DATATYPE, &m1, &n1, &lalfa); /*      alpha */
+    CheckScalar(1, m1, n1);
+
+    GetRhsVar(2, MATRIX_OF_COMPLEX_DATATYPE, &mA, &nA, &lA);   /*      A     */
+    GetRhsVar(3, MATRIX_OF_COMPLEX_DATATYPE, &mB, &nB, &lB);   /*      B     */
+
+    GetRhsVar(4, MATRIX_OF_COMPLEX_DATATYPE, &m4, &n4, &lbeta); /*      betha */
+    CheckScalar(4, m4, n4);
+
+    GetRhsVar(5, MATRIX_OF_COMPLEX_DATATYPE, &mC, &nC, &lC);   /*      C     */
+
+    m = mA;
+    n = nB;
+    if (nA != mB || mA != mC || nB != nC )
+    {
+        Scierror(999, "%f: invalid matrix dims\n", fname);
+    }
+
+    k = nA;
+    C2F(zgemm)("n", "n", &m , &n , &k, zstk(lalfa),
+               zstk(lA), &mA , zstk(lB), &mB , zstk(lbeta) , zstk(lC), &mC);
+    /*      Return C (#5) */
+    LhsVar(1) = 5;
+    return(0);
+}
+/* -------------------------------------------------------------------------- */
diff --git a/modules/linear_algebra/examples/lapackscilab.sce b/modules/linear_algebra/examples/lapackscilab.sce
new file mode 100755
index 000000000..11f7a1297
--- /dev/null
+++ b/modules/linear_algebra/examples/lapackscilab.sce
@@ -0,0 +1,56 @@
+//
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) DIGITEO - 2010 - Allan CORNET
+//
+// This file is released under the 3-clause BSD license. See COPYING-BSD.
+//
+
+//
+// A example to call some lapack routines
+// dgemm, zgemm, dsyev
+
+// WARNING:these gateways use old scilab api and it does not work with Scilab 6*/
+// see help api_scilab for more information.
+
+
+ilib_verbose(0);
+setenv("__USE_DEPRECATED_STACK_FUNCTIONS__","YES");
+
+curdir = pwd();
+file_path = get_file_path("lapackscilab.sce");
+chdir(file_path);
+
+files_functions = ["intdgemm.c";
+"intzgemm.c";
+"intdsyev.c"];
+
+table_functions = ["dgemm", "intdgemm";
+"zgemm", "intzgemm";
+"dsyev", "intdsyev"];
+
+ilib_build("lapackexample", table_functions, files_functions, []);
+exec loader.sce;
+
+Alfa = 2;
+Beta = 3;
+m = 3;
+n = 4;
+C = ones(m, n);
+k = 2;
+A = ones(m, k);
+B = ones(k, n);
+C1 = dgemm(Alfa, A, B, Beta, C);
+if norm(C1 - (Alfa * A * B + Beta * C)) > %eps then pause,end
+
+A = [1/2^10, 1/2^10; 2^10, 2^10];
+A = rand(3,3);
+if norm(max(real(dsyev(A))) - max(real(spec(A))) ) > %eps * 1e15 then pause,end
+
+alfa = 1 + %i;
+betha = alfa;
+A = rand(2,2) + %i * rand(2,2);
+B = A;
+C = A;
+C = zgemm(alfa, A, B, betha, C)
+
+cd(curdir);
\ No newline at end of file
diff --git a/modules/linear_algebra/examples/readme.txt b/modules/linear_algebra/examples/readme.txt
new file mode 100755
index 000000000..18f048d29
--- /dev/null
+++ b/modules/linear_algebra/examples/readme.txt
@@ -0,0 +1,10 @@
+Template (example) interface for a few Lapack routines.
+
+These gateways use old scilab api and it does not work with Scilab 6.
+See help api_scilab for more information.
+
+to test :
+
+  exec SCI/modules/linear_algebra/examples/lapackscilab.sce
+
+Allan CORNET - DIGITEO - 2010