* Bug 15246 fixed: missing blkslv() + blkslvi() for chsolve() and chfact() 74/19374/6
Samuel GOUGEON [Mon, 14 Aug 2017 18:44:06 +0000 (20:44 +0200)]
 * http://bugzilla.scilab.org/15246

   blkslvi() builtin has been removed from Scilab 6.0.0 (the only
   occurence out of blkslv() is is in modules\sparse\includes\gw_sparse.h).
   This removal breaks blkslv() and so chsolve() and chfact() public functions.

Change-Id: I55f011c32d0b198c371df863164c4ad7e72f00a3

15 files changed:
scilab/CHANGES.md
scilab/modules/helptools/data/configuration/scilab_macros.txt
scilab/modules/sparse/Makefile.am
scilab/modules/sparse/Makefile.in
scilab/modules/sparse/includes/sparse_gw.hxx
scilab/modules/sparse/macros/blkslv.sci [new file with mode: 0644]
scilab/modules/sparse/macros/chfact.sci
scilab/modules/sparse/sci_gateway/cpp/sci_blkslvi.cpp [new file with mode: 0644]
scilab/modules/sparse/sci_gateway/cpp/sparse_f_Import.def
scilab/modules/sparse/sci_gateway/cpp/sparse_gw.cpp
scilab/modules/sparse/sci_gateway/cpp/sparse_gw.vcxproj
scilab/modules/sparse/sci_gateway/cpp/sparse_gw.vcxproj.filters
scilab/modules/sparse/src/fortran/blkslv.f [new file with mode: 0644]
scilab/modules/sparse/src/fortran/sparse_f.vfproj
scilab/modules/sparse/tests/nonreg_tests/bug_15246.tst [new file with mode: 0644]

index ec51b58..2acd497 100644 (file)
@@ -461,6 +461,7 @@ the [development mailing list](dev@lists.scilab.org) for a particular toolbox.
 * [#15236](http://bugzilla.scilab.org/show_bug.cgi?id=15236): The `isglobal` help page was inaccurate. Examples were erroneous.
 * [#15239](http://bugzilla.scilab.org/show_bug.cgi?id=15239): The console properties `.tag` and `.userdata` were not displayed nor documented.
 * [#15243](http://bugzilla.scilab.org/show_bug.cgi?id=15243): `grand(nr, nc, "uin", vmin)` crashed Scilab.
+* [#15246](http://bugzilla.scilab.org/show_bug.cgi?id=15246): `chsolve` called a `blkslv` missing function.
 * [#15249](http://bugzilla.scilab.org/show_bug.cgi?id=15249): `findobj("toto")` yielded an error instead of returning [].
 * [#15260](http://bugzilla.scilab.org/show_bug.cgi?id=15260): `sci2exp` was broken for cells, structures, and all types of hypermatrix.
 * [#15261](http://bugzilla.scilab.org/show_bug.cgi?id=15261): Insertion in struct felt with wrong default value.
index 7582cc7..bde5062 100644 (file)
@@ -20,6 +20,7 @@ SPARSE_FORTRAN_SOURCES = \
     src/fortran/ordmmd.f \
        src/fortran/blkfc1.f \
        src/fortran/blkfct.f \
+       src/fortran/blkslv.f \
        src/fortran/inpnv.f \
        src/fortran/symfct.f
        
@@ -44,7 +45,8 @@ GATEWAY_CPP_SOURCES = \
        sci_gateway/cpp/sci_symfcti.cpp \
        sci_gateway/cpp/sci_bfinit.cpp \
        sci_gateway/cpp/sci_inpnv.cpp \
-       sci_gateway/cpp/sci_blkfc1i.cpp
+       sci_gateway/cpp/sci_blkfc1i.cpp \
+       sci_gateway/cpp/sci_blkslvi.cpp
        
 libscisparse_la_CPPFLAGS = \
     -I$(srcdir)/src/c/ \
index 59be7fe..cc6425a 100644 (file)
@@ -177,8 +177,9 @@ am__objects_1 = src/c/libscisparse_algo_la-spUtils.lo \
 am__objects_2 = src/fortran/isort1.lo src/fortran/spt.lo \
        src/fortran/sz2ptr.lo src/fortran/spreshape.lo \
        src/fortran/ordmmd.lo src/fortran/blkfc1.lo \
-       src/fortran/blkfct.lo src/fortran/inpnv.lo \
-       src/fortran/symfct.lo
+       src/fortran/blkfct.lo src/fortran/blkslv.lo \
+       src/fortran/inpnv.lo src/fortran/symfct.lo
+
 am_libscisparse_algo_la_OBJECTS = $(am__objects_1) $(am__objects_2)
 libscisparse_algo_la_OBJECTS = $(am_libscisparse_algo_la_OBJECTS)
 AM_V_lt = $(am__v_lt_@AM_V@)
@@ -208,7 +209,8 @@ am__objects_3 = sci_gateway/cpp/libscisparse_la-sparse_gw.lo \
        sci_gateway/cpp/libscisparse_la-sci_symfcti.lo \
        sci_gateway/cpp/libscisparse_la-sci_bfinit.lo \
        sci_gateway/cpp/libscisparse_la-sci_inpnv.lo \
-       sci_gateway/cpp/libscisparse_la-sci_blkfc1i.lo
+       sci_gateway/cpp/libscisparse_la-sci_blkfc1i.lo \
+       sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo
 am_libscisparse_la_OBJECTS = $(am__objects_3)
 libscisparse_la_OBJECTS = $(am_libscisparse_la_OBJECTS)
 @MAINTAINER_MODE_FALSE@am_libscisparse_la_rpath =
@@ -618,6 +620,7 @@ SPARSE_FORTRAN_SOURCES = \
     src/fortran/ordmmd.f \
        src/fortran/blkfc1.f \
        src/fortran/blkfct.f \
+       src/fortran/blkslv.f \
        src/fortran/inpnv.f \
        src/fortran/symfct.f
 
@@ -642,7 +645,8 @@ GATEWAY_CPP_SOURCES = \
        sci_gateway/cpp/sci_symfcti.cpp \
        sci_gateway/cpp/sci_bfinit.cpp \
        sci_gateway/cpp/sci_inpnv.cpp \
-       sci_gateway/cpp/sci_blkfc1i.cpp
+       sci_gateway/cpp/sci_blkfc1i.cpp \
+       sci_gateway/cpp/sci_blkslvi.cpp
 
 libscisparse_la_CPPFLAGS = \
     -I$(srcdir)/src/c/ \
@@ -890,6 +894,8 @@ src/fortran/blkfc1.lo: src/fortran/$(am__dirstamp) \
        src/fortran/$(DEPDIR)/$(am__dirstamp)
 src/fortran/blkfct.lo: src/fortran/$(am__dirstamp) \
        src/fortran/$(DEPDIR)/$(am__dirstamp)
+src/fortran/blkslv.lo: src/fortran/$(am__dirstamp) \
+       src/fortran/$(DEPDIR)/$(am__dirstamp)
 src/fortran/inpnv.lo: src/fortran/$(am__dirstamp) \
        src/fortran/$(DEPDIR)/$(am__dirstamp)
 src/fortran/symfct.lo: src/fortran/$(am__dirstamp) \
@@ -966,6 +972,9 @@ sci_gateway/cpp/libscisparse_la-sci_inpnv.lo:  \
 sci_gateway/cpp/libscisparse_la-sci_blkfc1i.lo:  \
        sci_gateway/cpp/$(am__dirstamp) \
        sci_gateway/cpp/$(DEPDIR)/$(am__dirstamp)
+sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo:  \
+       sci_gateway/cpp/$(am__dirstamp) \
+       sci_gateway/cpp/$(DEPDIR)/$(am__dirstamp)
 
 libscisparse.la: $(libscisparse_la_OBJECTS) $(libscisparse_la_DEPENDENCIES) $(EXTRA_libscisparse_la_DEPENDENCIES) 
        $(AM_V_CXXLD)$(CXXLINK) $(am_libscisparse_la_rpath) $(libscisparse_la_OBJECTS) $(libscisparse_la_LIBADD) $(LIBS)
@@ -985,6 +994,7 @@ distclean-compile:
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_adj2sp.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_bfinit.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_blkfc1i.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_blkslvi.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_full.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_inpnv.Plo@am__quote@
 @AMDEP_TRUE@@am__include@ @am__quote@sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_ludel.Plo@am__quote@
@@ -1255,6 +1265,13 @@ sci_gateway/cpp/libscisparse_la-sci_blkfc1i.lo: sci_gateway/cpp/sci_blkfc1i.cpp
 @AMDEP_TRUE@@am__fastdepCXX_FALSE@     DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
 @am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libscisparse_la_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o sci_gateway/cpp/libscisparse_la-sci_blkfc1i.lo `test -f 'sci_gateway/cpp/sci_blkfc1i.cpp' || echo '$(srcdir)/'`sci_gateway/cpp/sci_blkfc1i.cpp
 
+sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo: sci_gateway/cpp/sci_blkslvi.cpp
+@am__fastdepCXX_TRUE@  $(AM_V_CXX)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libscisparse_la_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -MT sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo -MD -MP -MF sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_blkslvi.Tpo -c -o sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo `test -f 'sci_gateway/cpp/sci_blkslvi.cpp' || echo '$(srcdir)/'`sci_gateway/cpp/sci_blkslvi.cpp
+@am__fastdepCXX_TRUE@  $(AM_V_at)$(am__mv) sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_blkslvi.Tpo sci_gateway/cpp/$(DEPDIR)/libscisparse_la-sci_blkslvi.Plo
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@     $(AM_V_CXX)source='sci_gateway/cpp/sci_blkslvi.cpp' object='sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCXX_FALSE@     DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libscisparse_la_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS) -c -o sci_gateway/cpp/libscisparse_la-sci_blkslvi.lo `test -f 'sci_gateway/cpp/sci_blkslvi.cpp' || echo '$(srcdir)/'`sci_gateway/cpp/sci_blkslvi.cpp
+
 .f.o:
        $(AM_V_F77)$(F77COMPILE) -c -o $@ $<
 
index 3ffe9e7..de0a079 100644 (file)
@@ -55,5 +55,6 @@ CPP_GATEWAY_PROTOTYPE(sci_symfcti);
 CPP_GATEWAY_PROTOTYPE(sci_bfinit);
 CPP_GATEWAY_PROTOTYPE(sci_inpnv);
 CPP_GATEWAY_PROTOTYPE(sci_blkfc1i);
+CPP_GATEWAY_PROTOTYPE(sci_blkslvi);
 
 #endif /* !__SPARSE_GW_HXX__ */
diff --git a/scilab/modules/sparse/macros/blkslv.sci b/scilab/modules/sparse/macros/blkslv.sci
new file mode 100644 (file)
index 0000000..b155dac
--- /dev/null
@@ -0,0 +1,22 @@
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) ????-2008 - INRIA
+//
+// Copyright (C) 2012 - 2016 - Scilab Enterprises
+//
+// This file is hereby licensed under the terms of the GNU GPL v2.0,
+// pursuant to article 5.3.4 of the CeCILL v.2.1.
+// This file was originally licensed under the terms of the CeCILL v2.1,
+// and continues to be available under such terms.
+// For more information, see the COPYING file which you should have received
+// along with this program.
+
+function rhs = blkslv(spcho,rhs)
+    // Private utility shared by chfact() and chsolve()
+    //
+    //[xlnz,nnzl,xsuper,xlindx,lindx,snode,split,tmpsiz,perm,invp,lnz]=spcho(2:12);
+    xsuper = spcho("xsuper");
+    nsuper = size(xsuper,1)-1;
+    neqns = size(rhs,1);
+    rhs = blkslvi(nsuper,xsuper,spcho("xlindx"),spcho("lindx"),spcho("xlnz"),...
+    spcho("lnz"),rhs);
+endfunction
index 02b12f3..efd05b9 100644 (file)
@@ -10,7 +10,7 @@
 // For more information, see the COPYING file which you should have received
 // along with this program.
 
-function spcho=chfact(A)
+function spcho = chfact(A)
     //cholesky factors, returned in a tlist
     //spcho  = {xlnz, nnzl, xsuper, xlindx, lindx, snode,
     //          split, tmpsiz, perm, invp, lnz}.
@@ -37,6 +37,7 @@ function spcho=chfact(A)
 endfunction
 
 function [spcho]= blkfc1(spcho,level)
+    // Private utility called only by chfact()
     //retrieves Fortran variables (see sfinit.f,bfinit.f,symfct.f )
     //[xlnz,nnzl,xsuper,xlindx,lindx,snode,split,tmpsiz,perm,invp,lnz]=spcho(2:12);
     xsuper=spcho("xsuper");
@@ -69,18 +70,8 @@ function [spcho]= blkfc1(spcho,level)
     spcho("lnz")=lnz;
 endfunction
 
-function rhs=blkslv(spcho,rhs)
-    //
-    //[xlnz,nnzl,xsuper,xlindx,lindx,snode,split,tmpsiz,perm,invp,lnz]=spcho(2:12);
-    xsuper=spcho("xsuper");
-    nsuper=size(xsuper,1)-1;
-    neqns =size(rhs,1);
-    rhs=blkslvi(nsuper,xsuper,spcho("xlindx"),spcho("lindx"),spcho("xlnz"),...
-    spcho("lnz"),rhs);
-endfunction
-
 function [spcho]=inpnv(xadjf,adjf,anzf,spcho)
-    //
+    // Private utility called only by chfact()
     //[xlnz,nnzl,xsuper,xlindx,lindx,snode,split,tmpsiz,perm,invp,lnz]=spcho(2:12);
     //
     xsuper=spcho("xsuper");
@@ -97,7 +88,7 @@ function [spcho]=inpnv(xadjf,adjf,anzf,spcho)
 endfunction
 
 function [spcho] = symfct(xadj,adjncy,perm,invp,cachsz,neqns)
-    //
+    // Private utility called only by chfact()
     // sfinit - input
     //
     nnza=size(adjncy,1);
diff --git a/scilab/modules/sparse/sci_gateway/cpp/sci_blkslvi.cpp b/scilab/modules/sparse/sci_gateway/cpp/sci_blkslvi.cpp
new file mode 100644 (file)
index 0000000..9006521
--- /dev/null
@@ -0,0 +1,136 @@
+/*
+*  Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+*  Copyright (C) 2017 - Scilab Enterprises - Adeline CARNIS
+*
+ * Copyright (C) 2012 - 2016 - Scilab Enterprises
+ *
+ * This file is hereby licensed under the terms of the GNU GPL v2.0,
+ * pursuant to article 5.3.4 of the CeCILL v.2.1.
+ * This file was originally licensed under the terms of the CeCILL v2.1,
+ * and continues to be available under such terms.
+ * For more information, see the COPYING file which you should have received
+ * along with this program.
+*
+*/
+
+#include <iostream>
+#include "sparse_gw.hxx"
+#include "function.hxx"
+#include "sparse.hxx"
+
+extern "C"
+{
+#include "charEncoding.h"
+#include "Scierror.h"
+#include "localization.h"
+}
+
+extern "C" int  C2F(blkslv)(int* nsuper, int* xsuper, int* xlindx, int* lindx, int* xlnz,
+                            double* lnz, double* rhs);
+
+using namespace types;
+
+Function::ReturnValue sci_blkslvi(typed_list &in, int _iRetCount, typed_list &out)
+{
+    if (in.size() != 7)
+    {
+        Scierror(999, _("%s: Wrong number of input argument(s): %d expected.\n"), "blkslvi", 15);
+        return Function::Error;
+    }
+
+    if (_iRetCount != 1)
+    {
+        Scierror(999, _("%s: Wrong number of output arguments: %d expected.\n"), "blkslvi", 1);
+        return Function::Error;
+    }
+
+
+    //get argument #1
+    if (in[0]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 1);
+        return Function::Error;
+    }
+
+    Double* pdbl1 = in[0]->getAs<Double>();
+    pdbl1->convertToInteger();
+    int* nsuper = (int*)pdbl1->get();
+
+    //get argument #2
+    if (in[1]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 2);
+        return Function::Error;
+    }
+
+    Double* pdbl2 = in[1]->getAs<Double>();
+    pdbl2->convertToInteger();
+    int* xsuper = (int*)pdbl2->get();
+
+    //get argument #3
+    if (in[2]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 3);
+        return Function::Error;
+    }
+
+    Double* pdbl3 = in[2]->getAs<Double>();
+    pdbl3->convertToInteger();
+    int* xlindx = (int*)pdbl3->get();
+
+    //get argument #4
+    if (in[3]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 4);
+        return Function::Error;
+    }
+
+    Double* pdbl4 = in[3]->getAs<Double>();
+    pdbl4->convertToInteger();
+    int* lindx = (int*)pdbl4->get();
+
+    //get argument #5
+    if (in[4]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 5);
+        return Function::Error;
+    }
+
+    Double* pdbl5 = in[4]->getAs<Double>();
+    pdbl5->convertToInteger();
+    int* xlnz = (int*)pdbl5->get();
+
+    //get argument #6
+    if (in[5]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 6);
+        return Function::Error;
+    }
+
+    Double* pdbl6 = in[5]->getAs<Double>();
+    double* lnz = pdbl6->get();
+
+    //get argument #7
+    if (in[6]->isDouble() == false)
+    {
+        Scierror(999, _("%s: Wrong type for input argument #%d: A matrix of integer value expected.\n"), "blkslvi", 7);
+        return Function::Error;
+    }
+
+    Double* pdbl7 = in[6]->getAs<Double>();
+    double* rhs = pdbl7->get();
+
+
+    C2F(blkslv)(nsuper, xsuper, xlindx, lindx, xlnz, lnz, rhs);
+
+    pdbl1->convertFromInteger();
+    pdbl2->convertFromInteger();
+    pdbl3->convertFromInteger();
+    pdbl4->convertFromInteger();
+    pdbl5->convertFromInteger();
+
+    out.push_back(pdbl7);
+
+    return Function::OK;
+}
+
index fa89e08..793f707 100644 (file)
@@ -39,5 +39,6 @@ int SparseModule::Load()
     symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"bfinit", &sci_bfinit, MODULE_NAME));
     symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"inpnvi", &sci_inpnv, MODULE_NAME));
     symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"blkfc1i", &sci_blkfc1i, MODULE_NAME));
+    symbol::Context::getInstance()->addFunction(types::Function::createFunction(L"blkslvi", &sci_blkslvi, MODULE_NAME));
     return 1;
 }
index 590b403..511af7a 100644 (file)
     <ClCompile Include="sci_adj2sp.cpp" />
     <ClCompile Include="sci_bfinit.cpp" />
     <ClCompile Include="sci_blkfc1i.cpp" />
+    <ClCompile Include="sci_blkslvi.cpp" />
     <ClCompile Include="sci_full.cpp" />
     <ClCompile Include="sci_inpnv.cpp" />
     <ClCompile Include="sci_ludel.cpp" />
index cd60c83..dcff405 100644 (file)
@@ -80,6 +80,9 @@
     <ClCompile Include="sci_blkfc1i.cpp">
       <Filter>Source Files</Filter>
     </ClCompile>
+    <ClCompile Include="sci_blkslvi.cpp">
+      <Filter>Source Files</Filter>
+    </ClCompile>
   </ItemGroup>
   <ItemGroup>
     <ClInclude Include="..\..\includes\sparse_gw.hxx">
diff --git a/scilab/modules/sparse/src/fortran/blkslv.f b/scilab/modules/sparse/src/fortran/blkslv.f
new file mode 100644 (file)
index 0000000..2a2ed65
--- /dev/null
@@ -0,0 +1,104 @@
+C***********************************************************************
+C***********************************************************************
+C
+C   Version:        0.3
+C   Last modified:  December 27, 1994
+C   Authors:        Esmond G. Ng and Barry W. Peyton
+C
+C   Mathematical Sciences Section, Oak Ridge National Laboratory
+C
+C***********************************************************************
+C***********************************************************************
+C*********     BLKSLV ... BLOCK TRIANGULAR SOLUTIONS          **********
+C***********************************************************************
+C***********************************************************************
+C
+C   PURPOSE:
+C       GIVEN THE CHOLESKY FACTORIZATION OF A SPARSE SYMMETRIC
+C       POSITIVE DEFINITE MATRIX, THIS SUBROUTINE PERFORMS THE
+C       TRIANGULAR SOLUTION.  IT USES OUTPUT FROM BLKFCT.
+C
+C   INPUT PARAMETERS:
+C       NSUPER          -   NUMBER OF SUPERNODES.
+C       XSUPER          -   SUPERNODE PARTITION.
+C       (XLINDX,LINDX)  -   ROW INDICES FOR EACH SUPERNODE.
+C       (XLNZ,LNZ)      -   CHOLESKY FACTOR.
+C
+C   UPDATED PARAMETERS:
+C       RHS             -   ON INPUT, CONTAINS THE RIGHT HAND SIDE.  ON
+C                           OUTPUT, CONTAINS THE SOLUTION.
+C
+C***********************************************************************
+C
+      SUBROUTINE  BLKSLV (  NSUPER, XSUPER, XLINDX, LINDX , XLNZ  ,
+     &                      LNZ   , RHS                             )
+C
+C***********************************************************************
+C
+        INTEGER             NSUPER
+        INTEGER             LINDX(*)      , XSUPER(*)
+        INTEGER             XLINDX(*)     , XLNZ(*)
+        DOUBLE PRECISION    LNZ(*)        , RHS(*)
+C
+C***********************************************************************
+C
+        INTEGER             FJCOL , I     , IPNT  , IX    , IXSTOP,
+     &                      IXSTRT, JCOL  , JPNT  , JSUP  , LJCOL
+        DOUBLE PRECISION    T
+C
+C***********************************************************************
+C
+        IF  ( NSUPER .LE. 0 )  RETURN
+C
+C       ------------------------
+C       FORWARD SUBSTITUTION ...
+C       ------------------------
+        FJCOL = XSUPER(1)
+        DO  300  JSUP = 1, NSUPER
+            LJCOL  = XSUPER(JSUP+1) - 1
+            IXSTRT = XLNZ(FJCOL)
+            JPNT   = XLINDX(JSUP)
+            DO  200  JCOL = FJCOL, LJCOL
+                IXSTOP    = XLNZ(JCOL+1) - 1
+                T         = RHS(JCOL)/LNZ(IXSTRT)
+                RHS(JCOL) = T
+                IPNT      = JPNT + 1
+CDIR$           IVDEP
+                DO  100  IX = IXSTRT+1, IXSTOP
+                    I      = LINDX(IPNT)
+                    RHS(I) = RHS(I) - T*LNZ(IX)
+                    IPNT   = IPNT + 1
+  100           CONTINUE
+                IXSTRT = IXSTOP + 1
+                JPNT   = JPNT + 1
+  200       CONTINUE
+            FJCOL = LJCOL + 1
+  300   CONTINUE
+C
+C       -------------------------
+C       BACKWARD SUBSTITUTION ...
+C       -------------------------
+        LJCOL = XSUPER(NSUPER+1) - 1
+        DO  600  JSUP = NSUPER, 1, -1
+            FJCOL  = XSUPER(JSUP)
+            IXSTOP = XLNZ(LJCOL+1) - 1
+            JPNT   = XLINDX(JSUP) + (LJCOL - FJCOL)
+            DO  500  JCOL = LJCOL, FJCOL, -1
+                IXSTRT = XLNZ(JCOL)
+                IPNT   = JPNT + 1
+                T      = RHS(JCOL)
+CDIR$           IVDEP
+                DO  400  IX = IXSTRT+1, IXSTOP
+                    I    = LINDX(IPNT)
+                    T    = T - LNZ(IX)*RHS(I)
+                    IPNT = IPNT + 1
+  400           CONTINUE
+                RHS(JCOL) = T/LNZ(IXSTRT)
+                IXSTOP    = IXSTRT - 1
+                JPNT      = JPNT - 1
+  500       CONTINUE
+            LJCOL = FJCOL - 1
+  600   CONTINUE
+C
+        RETURN
+      END
index 3e953f2..bfd3ee4 100644 (file)
@@ -55,6 +55,7 @@
                <Filter Name="Source Files" Filter="f90;for;f;fpp;ftn;def;odl;idl">
                <File RelativePath=".\blkfc1.f"/>
                <File RelativePath=".\blkfct.f"/>
+               <File RelativePath=".\blkslv.f"/>
                <File RelativePath=".\inpnv.f"/>
                <File RelativePath="isort1.f"/>
                <File RelativePath=".\ordmmd.f"/>
diff --git a/scilab/modules/sparse/tests/nonreg_tests/bug_15246.tst b/scilab/modules/sparse/tests/nonreg_tests/bug_15246.tst
new file mode 100644 (file)
index 0000000..5a3eac2
--- /dev/null
@@ -0,0 +1,26 @@
+// =============================================================================
+// Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
+// Copyright (C) 2017 - Samuel GOUGEON
+//
+//  This file is distributed under the same license as the Scilab package.
+// =============================================================================
+
+// <-- CLI SHELL MODE -->
+// <-- NO CHECK REF -->
+
+// <-- Non-regression test for bug 15246 -->
+//
+// <-- Bugzilla URL -->
+// http://bugzilla.scilab.org/15246
+//
+// <-- Short Description -->
+//    chsolve() called a missing blkslv() macro, that called a missing blkslvi() builtin
+
+// From chsolve() example:
+A = sprand(20,20,0.1);
+A = A*A'+eye();
+spcho = chfact(A);
+sol = (1:20)';
+rhs = A*sol;
+spcho = chfact(A);
+chsolve(spcho,rhs);