#1512

- Added API call solveLinearSystem (same functionality to be used in the backend later)


git-svn-id: https://openmodelica.org/svn/OpenModelica/trunk@8928 f25d12d1-65f4-0310-ae8a-bbce733d8d8e

Author: sjoelund

Compiler/FrontEnd/ModelicaBuiltin.mo

@@ -1311,5 +1311,15 @@ function uriToFilename "Handles modelica:// and file:// URI's. The result is an
 external "builtin";
 end uriToFilename;
 
+function solveLinearSystem
+  "Solve A*X = B
+  Returns info>0: Singular for element i. info<0: Bad input."
+  input Real[size(B,1),size(B,1)] A;
+  input Real[:] B;
+  output Real[size(B,1)] X;
+  output Integer info;
+external "builtin";
+end solveLinearSystem;
+
 end Scripting;
 end OpenModelica;

Compiler/FrontEnd/ValuesUtil.mo

@@ -1117,6 +1117,20 @@ algorithm
   end matchcontinue;
 end valueReals;
 
+public function arrayValueReals "function: valueReals
+
+  Return the real value of a Value. If the value is an integer,
+  it is cast to a real.
+"
+  input Value inValue;
+  output list<Real> outReal;
+protected
+  list<Values.Value> vals;
+algorithm
+  Values.ARRAY(valueLst=vals) := inValue;
+  outReal := valueReals(vals);
+end arrayValueReals;
+
 public function valueNeg "function: valueNeg
   author: PA
 

Compiler/Makefile.common

@@ -18,7 +18,7 @@ AST = $(top_builddir)/Parser/libomparse_rml.a $(top_builddir)/Parser/libantlr3.a
 RTOBJ   = \
 $(srcdir)/runtime/runtime.a \
 $(srcdir)/../c_runtime/libc_runtime.a \
-$(srcdir)/modpar/libmodpar.a 
+$(srcdir)/modpar/libmodpar.a
 
 FRONTEND_DIR=$(srcdir)/FrontEnd
 BACKEND_DIR=$(srcdir)/BackEnd

Compiler/Script/CevalScript.mo

@@ -671,7 +671,7 @@ algorithm
       AbsynDep.Depends aDep;
       Absyn.ComponentRef crefCName;
       list<tuple<String,Values.Value>> resultValues;
-      list<Real> timeStamps;
+      list<Real> timeStamps,realVals;
       list<DAE.Exp> expLst;
       list<tuple<String,list<String>>> deps;
       Absyn.CodeNode codeNode;
@@ -1848,6 +1848,12 @@ algorithm
 
     case (cache,env,"uriToFilename",_,st,msg)
       then (cache,Values.STRING(""),st);
+        
+    case (cache,env,"solveLinearSystem",{Values.ARRAY(valueLst=vals),v},st,msg)
+      equation
+        (realVals,i) = System.solveLinearSystem(Util.listMap(vals,ValuesUtil.arrayValueReals),ValuesUtil.arrayValueReals(v));
+        v = ValuesUtil.makeArray(Util.listMap(realVals,ValuesUtil.makeReal));
+      then (cache,Values.TUPLE({v,Values.INTEGER(i)}),st);
 
  end matchcontinue;
 end cevalInteractiveFunctions2;

Compiler/Util/System.mo

@@ -801,7 +801,17 @@ end openModelicaPlatform;
 public function getGCStatus
   output Integer used;
   output Integer allocated;
-  external "C" System_getGCStatus(used,allocated);
+  external "C" System_getGCStatus(used,allocated) annotation(Library = "omcruntime");
 end getGCStatus;
 
+public function solveLinearSystem
+  "Solves A*X = B. Fails and sets error buffer on failure.
+  Returns info>0: Singular for element i. info<0: Bad input."
+  input list<list<Real>> A;
+  input list<Real> B;
+  output list<Real> X;
+  output Integer info;
+  external "C" info=SystemImpl__solveLinearSystem(A,B,X) annotation(Library = "omcruntime");
+end solveLinearSystem;
+
 end System;

Compiler/omc_debug/Makefile.in

@@ -32,7 +32,7 @@ endif
 
 LDFLAGS = @LDFLAGS@ -lm -L$(RMLHOME)/lib/plain -lrml_g -lpthread \
   $(LIBSOCKET) $(CORBALIBS) $(LIBLPSOLVE55) \
-  -L../../build/lib/omc @LIBSENDDATA_LDFLAGS@  $(SQLITE3)
+  -L../../build/lib/omc @LIBSENDDATA_LDFLAGS@ -llapack $(SQLITE3)
 
 PROG = omcd
 RMLC	= @rmlc_bin@ -g -Wc,-O1 #-Wr,-East,-Ecps,-Efol

Compiler/omc_profiler/Makefile.in

@@ -29,7 +29,7 @@ endif
 
 LDFLAGS = @LDFLAGS@ -lm -L$(RMLHOME)/lib/plain -lrml_p \
   $(LIBSOCKET) $(CORBALIBS) $(LIBLPSOLVE55) \
-  -L../../build/lib/omc @LIBSENDDATA_LDFLAGS@ $(SQLITE3)
+  -L../../build/lib/omc @LIBSENDDATA_LDFLAGS@ -llapack $(SQLITE3)
 
 PROG = omcp
 RMLC	= @rmlc_bin@ -p

Compiler/omc_release/Makefile.in

@@ -29,7 +29,7 @@ endif
 
 LDFLAGS = @LDFLAGS@ -lm -L$(RMLHOME)/lib/plain -lrml \
   $(LIBSOCKET) $(CORBALIBS) $(LIBLPSOLVE55) \
-  -L../../build/lib/omc @LIBSENDDATA_LDFLAGS@ $(SQLITE3)
+  -L../../build/lib/omc @LIBSENDDATA_LDFLAGS@ -llapack $(SQLITE3)
 
 PROG = omc
 RMLC	= @rmlc_bin@

Compiler/runtime/System_rml.c

@@ -2012,3 +2012,14 @@ RML_BEGIN_LABEL(System__getGCStatus)
   RML_TAILCALLK(rmlSC);
 }
 RML_END_LABEL
+
+
+RML_BEGIN_LABEL(System__solveLinearSystem)
+{
+  void *res;
+  rmlA1 = mk_icon(SystemImpl__solveLinearSystem(rmlA0,rmlA1,&res));
+  rmlA0 = res;
+  RML_TAILCALLK(rmlSC);
+}
+RML_END_LABEL
+

Compiler/runtime/systemimpl.c

@@ -1318,6 +1318,48 @@ static int SystemImpl__uriToClassAndPath(const char *uri, const char **scheme, c
   return 1;
 }
 
+int SystemImpl__solveLinearSystem(void *lA, void *lB, void **res)
+{
+  int sz = 0,i,j;
+  void *tmp = lB;
+  double *A,*B;
+  integer *ipiv;
+  integer info = 0,nrhs=1,lda,ldb;
+  while (RML_NILHDR != RML_GETHDR(tmp)) {
+    sz++;
+    tmp = RML_CDR(tmp);
+  }
+  A = (double*) malloc(sz*sz*sizeof(double));
+  assert(A != NULL);
+  B = (double*) malloc(sz*sizeof(double));
+  assert(B != NULL);
+  for (i=0; i<sz; i++) {
+    tmp = RML_CAR(lA);
+    for (j=0; j<sz; j++) {
+      A[j*sz+i] = rml_prim_get_real(RML_CAR(tmp));
+      tmp = RML_CDR(tmp);
+    }
+    B[i] = rml_prim_get_real(RML_CAR(lB));
+    lA = RML_CDR(lA);
+    lB = RML_CDR(lB);
+  }
+  ipiv = (integer*) calloc(sz,sizeof(integer));
+  assert(ipiv != 0);
+  lda = sz;
+  ldb = sz;
+  dgesv_(&sz,&nrhs,A,&lda,ipiv,B,&ldb,&info);
+
+  tmp = mk_nil();
+  while (sz--) {
+    tmp = mk_cons(mk_rcon(B[sz]),tmp);
+  }
+  free(A);
+  free(B);
+  free(ipiv);
+  *res = tmp;
+  return info;
+}
+
 #ifdef __cplusplus
 }
 #endif