fort function does not exist in version 6. A gateway has been created. 17/17017/2
Adeline CARNIS [Mon, 10 Aug 2015 15:39:40 +0000 (17:39 +0200)]
Change-Id: I73e2b469ae0f2972137f00f20d5bf992267cf39f

scilab/modules/differential_equations/demos/n_pendulum/Maple/sci_np.c [new file with mode: 0644]
scilab/modules/differential_equations/demos/n_pendulum/n_pendulum.sci
scilab/modules/differential_equations/demos/wheel/Maple/sci_wheelg.c [new file with mode: 0644]
scilab/modules/differential_equations/demos/wheel/wheel2.dem.sce
scilab/modules/differential_equations/demos/wheel/wheel_show.sci

diff --git a/scilab/modules/differential_equations/demos/n_pendulum/Maple/sci_np.c b/scilab/modules/differential_equations/demos/n_pendulum/Maple/sci_np.c
new file mode 100644 (file)
index 0000000..7800bb9
--- /dev/null
@@ -0,0 +1,32 @@
+#include "api_scilab.h"
+#include "Scierror.h"
+#include "sci_malloc.h"
+#include <localization.h>
+
+extern int F2C(np)(int *a);
+
+int sci_np(char *fname, void* pvApiCtx)
+{
+    SciErr sciErr;
+
+    int m_out = 1, n_out = 1;
+    int iOut = 0;
+
+    CheckInputArgument(pvApiCtx, 0, 0);
+    CheckOutputArgument(pvApiCtx, 0, 1);
+
+    F2C(np)(&iOut);
+
+    sciErr = createMatrixOfInteger32(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m_out, n_out, &iOut);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+    AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
+
+    return 0;
+}
+
+
+
index 8a0d333..697883e 100644 (file)
@@ -19,41 +19,19 @@ function demo_pendulum()
             cdpath = pwd();
             chdir(TMPDIR);
             fcode = mgetl(path+"dlslv.f");mputl(fcode,"dlslv.f");
-            fcode = mgetl(path+"ener.f");mputl(fcode,"ener.f");
             fcode = mgetl(path+"np.f");mputl(fcode,"np.f");
             fcode = mgetl(path+"npend.f");mputl(fcode,"npend.f");
-            files = ["npend.f","np.f","ener.f","dlslv.f" ];
+            fcode = mgetl(path+"sci_np.c");mputl(fcode, "sci_np.c");
+            files = ["npend.f","np.f","dlslv.f"];
             ilib_verbose(0);
-            ilib_for_link(["npend";"np";"ener"],files,[],"f");
+            lib = ilib_for_link(["npend";"np"], ["dlslv.f", "npend.f", "np.f"], [],"f");
+            link(lib, "npend", "f");
+            ilib_build("gw",["np","sci_np"],"sci_np.c",basename(lib));
             exec("loader.sce",-1);
             chdir(cdpath);
         end
     endfunction
 
-
-    function [n]=np()
-        // Return the size  of the Fortran pendulum
-        n=1;
-        n=fort("np",n,1,"i","sort",1);
-    endfunction
-
-
-    function [ydot]=npend ( t, th)
-        // Fortran version
-        //    data r  / 1.0, 1.0, 1.0, 1.0 /
-        //    data m  / 1.0, 1.0, 1.0, 1.0 /
-        //    data j  / 0.3, 0.3, 0.3, 0.3 /
-        ydot=ones(6,1)
-        ydot=fort("npend",3,1,"i",t,2,"d",th,3,"d",ydot,4,"d","sort",4);
-    endfunction
-
-
-    function [E]=ener( th)
-        E=0.0;
-        E=fort("ener",th,1,"d",E,2,"d","sort",2);
-    endfunction
-
-
     function draw_chain_from_angles(a,r,job)
         // a the angles , a(i,j) is the angle of node i a time t(j)
         // r the segments half length
@@ -151,5 +129,3 @@ function demo_pendulum()
     end
 
 endfunction
-
-
diff --git a/scilab/modules/differential_equations/demos/wheel/Maple/sci_wheelg.c b/scilab/modules/differential_equations/demos/wheel/Maple/sci_wheelg.c
new file mode 100644 (file)
index 0000000..1ac481f
--- /dev/null
@@ -0,0 +1,151 @@
+#include "api_scilab.h"
+#include "Scierror.h"
+#include "sci_malloc.h"
+#include <localization.h>
+#include "sciprint.h"
+
+extern int F2C(wheelg)(int *n, int *k, double *uf, double *vf, double *wf, double *xx);
+
+int sci_wheelg(char *fname, void* pvApiCtx)
+{
+    SciErr sciErr;
+
+    int *piAddressVarOne = NULL;
+    int m1 = 0, n1 = 0;
+    int *piN = NULL;
+
+    int *piAddressVarTwo = NULL;
+    int m2 = 0, n2 = 0;
+    int *piK = NULL;
+
+    int *piAddressVarThree = NULL;
+    int m3 = 0, n3 = 0;
+    double *pdUF = NULL;
+
+    int *piAddressVarFour = NULL;
+    int m4 = 0, n4 = 0;
+    double *pdVF = NULL;
+
+    int *piAddressVarFive = NULL;
+    int m5 = 0, n5 = 0;
+    double *pdWF = NULL;
+
+    int *piAddressVarSix = NULL;
+    int m6 = 0, n6 = 0;
+    double *pdXX = NULL;
+
+    CheckInputArgument(pvApiCtx, 1, 6);
+    CheckOutputArgument(pvApiCtx, 0, 3);
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddressVarOne, &m1, &n1, &piN);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getMatrixOfDoubleAsInteger(pvApiCtx, piAddressVarTwo, &m2, &n2, &piK);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddressVarThree);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarThree, &m3, &n3, &pdUF);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 4, &piAddressVarFour);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarFour, &m4, &n4, &pdVF);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 5, &piAddressVarFive);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarFive, &m5, &n5, &pdWF);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getVarAddressFromPosition(pvApiCtx, 6, &piAddressVarSix);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarSix, &m6, &n6, &pdXX);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    F2C(wheelg)(piN, piK, pdUF, pdVF, pdWF, pdXX);
+
+    sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, m3, n3, pdUF);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+    sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 2, m4, n4, pdVF);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+
+    sciErr = createMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 3, m5, n5, pdWF);
+    if (sciErr.iErr)
+    {
+        printError(&sciErr, 0);
+        return 0;
+    }
+    AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;
+    AssignOutputVariable(pvApiCtx, 2) = nbInputArgument(pvApiCtx) + 2;
+    AssignOutputVariable(pvApiCtx, 3) = nbInputArgument(pvApiCtx) + 3;
+
+    ReturnArguments(pvApiCtx);
+    return 0;
+}
index 36a118b..4464153 100644 (file)
@@ -22,7 +22,6 @@ function demo_wheel2()
 
     mode(0);
     wheel_build_and_load();
-    wheelg = wheelgf;
     tmin   = 0.0;
     tmax   = 15;
     nn     = 300;
@@ -72,4 +71,4 @@ function demo_wheel2()
 endfunction
 
 demo_wheel2();
-clear demo_wheel2;
\ No newline at end of file
+clear demo_wheel2;
index 20daa62..2f78c72 100644 (file)
@@ -19,7 +19,6 @@ function []=wheel_show(xx,t,p)
     // xx= [theta,phi,psi,teta,phi,psi,x,y]
 
 
-
     [lhs,rhs]=argn(0)
     if rhs <= 2 , p=%pi/3;end
     if rhs <= 2 , t=%pi/3;end
@@ -125,18 +124,6 @@ function []=wheel_show(xx,t,p)
 
 endfunction
 
-
-function [xxu,yyu,zzu]=wheelgf(n,t,xu,yu,zu,xx)
-    [xxu,yyu,zzu]=fort("wheelg",n,1,"i",t,2,"i",xu,3,"d",yu,4,"d",zu,5,"d",xx,6,"d","sort",3,4,5);
-endfunction
-
-
-function [y]=test_wheel(n,t,x)
-    y   = x;
-    [y] = fort("wheel",n,1,"i",t,2,"d",x,3,"d",y,4,"d","sort",4);
-endfunction
-
-
 function [xxu,yyu,zzu]=wheelgs(n,t,xu,yu,zu,xx)
 
     // slower version without dynamic link
@@ -169,16 +156,18 @@ function []=wheel_build_and_load()
         my_cur_path = pwd();
         chdir(TMPDIR);
         path  = SCI+"/modules/differential_equations/demos/wheel/Maple";
-        fcode = mgetl(path+"/dlslv.f");  mputl(fcode,"dlslv.f");
+        fcode = mgetl(path+"/dlslv.f");mputl(fcode,"dlslv.f");
         fcode = mgetl(path+"/wheel.f");  mputl(fcode,"wheel.f");
         fcode = mgetl(path+"/wheelg.f"); mputl(fcode,"wheelg.f");
+        fcode = mgetl(path+"/sci_wheelg.c");mputl(fcode, "sci_wheelg.c");
         files = ["wheel.f","wheelg.f","dlslv.f" ];
         ilib_verbose(0);
-        ilib_for_link(["wheel";"wheelg"],files,[],"f");
+        lib_ = ilib_for_link(["wheel";"wheelg"], files, [],"f");
+        link(lib_, "wheel", "f");
+        ilib_build("gw_wheel",["wheelg","sci_wheelg"],"sci_wheelg.c",basename(lib_));
         exec("loader.sce",-1);
         chdir(my_cur_path);
     end
-
 endfunction