Dynamic_link: add demos using stdlibs / intrinsics
[scilab.git] / scilab / modules / dynamic_link / demos / call_fortran_stdlib.sce
1 //
2 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 // Copyright (C) 2009 - DIGITEO - Allan CORNET
4 // Copyright (C) 2018 - ESI Group - Clement DAVID
5 //
6 // This file is distributed under the same license as the Scilab package.
7 //
8
9 if haveacompiler() then
10
11     //           CALLING EXTERNAL FORTRAN SUBROUTINE
12
13     f1f = ["      subroutine barf(a,b,c)";
14     "      double precision  a,b,c";
15     "      c=exp(a*log(1+b))-1 ";
16     "      return";
17     "      end"];
18
19     i=["#include <stdlib.h>"
20     "#include <api_scilab.h>"
21     "#include <Scierror.h>"
22     "#include <localization.h>"
23     ""
24     "extern int C2F(barf)(double *x, double *y, double *z);"
25     ""
26     "int sci_barf(char *fname, void* pvApiCtx)"
27     "{"
28     "  SciErr sciErr;"
29     ""
30     "  int m1 = 0, n1 = 0;"
31     "  double *pdVarOne = NULL;"
32     "  int *piAddressVarOne = NULL;"
33     "  int m2 = 0, n2 = 0;"
34     "  double *pdVarTwo = NULL;"
35     "  int *piAddressVarTwo = NULL;"
36     "  double *pdblOut = NULL;"
37     ""
38     "  CheckInputArgument(pvApiCtx, 2, 2);"
39     "  CheckOutputArgument(pvApiCtx, 0, 1);"
40     ""
41     "  sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddressVarOne);"
42     "  if(sciErr.iErr)"
43     "  {"
44     "    printError(&sciErr, 0);"
45     "    return 0;"
46     "  }"
47     ""
48     "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarOne, &m1, &n1, &pdVarOne);"
49     "  if(sciErr.iErr)"
50     "  {"
51     "    printError(&sciErr, 0);"
52     "    return 0;"
53     "  }"
54     ""
55     "  sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddressVarTwo);"
56     "  if(sciErr.iErr)"
57     "  {"
58     "    printError(&sciErr, 0);"
59     "    return 0;"
60     "  }"
61     ""
62     "  sciErr = getMatrixOfDouble(pvApiCtx, piAddressVarTwo, &m2, &n2, &pdVarTwo);"
63     "  if(sciErr.iErr)"
64     "  {"
65     "    printError(&sciErr, 0);"
66     "    return 0;"
67     "  }"
68     ""
69     "  sciErr = allocMatrixOfDouble(pvApiCtx, nbInputArgument(pvApiCtx) + 1, 1, 1, &pdblOut);"
70     "  if (sciErr.iErr)"
71     "  {"
72     "    printError(&sciErr, 0);"
73     "    return 0;"
74     "  }"
75     ""
76     "  C2F(barf)(pdVarOne, pdVarTwo, pdblOut);"
77     ""
78     "  AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1;"
79     "  ReturnArguments(pvApiCtx);"
80     "  return 0;"
81     "}"]
82
83     mprintf("\n");
84     mprintf(gettext("Calling a Fortran subroutine from Scilab.\n"));
85
86     disp(f1f);
87
88     // we use TMPDIR for compilation
89
90     if ~c_link("barf") then
91         path = pwd();
92         chdir(TMPDIR);
93         mputl(f1f,"barf.f");
94         mputl(i,"sci_barf.c");
95
96         mprintf("\n");
97         mprintf(gettext("Calling ilib_for_link to build a Fortran subroutine.\n"));
98
99         lib_ = ilib_for_link(["barf"], "barf.f", [],"f");
100         link(lib_, "barf", "f");
101         ilib_build("gw_barf",["barf" "sci_barf"],"sci_barf.c",basename(lib_));
102         exec loader.sce ;
103         chdir(path)
104     end
105
106     //Z = X+Y by fortran subroutine
107     X = 5;
108     Y = 7;
109
110     mprintf("\n");
111     mprintf(gettext("Calling Fortran subroutine. Z = (1+Y)**X - 1"));
112     mprintf("\n");
113     mprintf(gettext("with X = %d"), X);
114     mprintf("\n");
115     mprintf(gettext("with Y = %d"), Y);
116     mprintf("\n");
117     mprintf("Z = barf(X, Y);");
118     mprintf("\n");
119     Z = barf(X, Y);
120     mprintf(gettext("Result Z = %d"), Z);
121     mprintf("\n");
122
123 end