nmatrix 0.0.6 → 0.0.7

data/ext/nmatrix/math/getri.h

@@ -0,0 +1,107 @@
+/////////////////////////////////////////////////////////////////////
+// = NMatrix
+//
+// A linear algebra library for scientific computation in Ruby.
+// NMatrix is part of SciRuby.
+//
+// NMatrix was originally inspired by and derived from NArray, by
+// Masahiro Tanaka: http://narray.rubyforge.org
+//
+// == Copyright Information
+//
+// SciRuby is Copyright (c) 2010 - 2013, Ruby Science Foundation
+// NMatrix is Copyright (c) 2013, Ruby Science Foundation
+//
+// Please see LICENSE.txt for additional copyright notices.
+//
+// == Contributing
+//
+// By contributing source code to SciRuby, you agree to be bound by
+// our Contributor Agreement:
+//
+// * https://github.com/SciRuby/sciruby/wiki/Contributor-Agreement
+//
+// == getri.h
+//
+// getri function in native C++.
+//
+
+/*
+ *             Automatically Tuned Linear Algebra Software v3.8.4
+ *                    (C) Copyright 1999 R. Clint Whaley
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *   1. Redistributions of source code must retain the above copyright
+ *      notice, this list of conditions and the following disclaimer.
+ *   2. Redistributions in binary form must reproduce the above copyright
+ *      notice, this list of conditions, and the following disclaimer in the
+ *      documentation and/or other materials provided with the distribution.
+ *   3. The name of the ATLAS group or the names of its contributers may
+ *      not be used to endorse or promote products derived from this
+ *      software without specific written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ATLAS GROUP OR ITS CONTRIBUTORS
+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#ifndef GETRI_H
+#define GETRI_H
+
+namespace nm { namespace math {
+
+template <typename DType>
+inline int getri(const enum CBLAS_ORDER order, const int n, DType* a, const int lda, const int* ipiv) {
+  rb_raise(rb_eNotImpError, "getri not yet implemented for non-BLAS dtypes");
+  return 0;
+}
+
+#ifdef HAVE_CLAPACK_H
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, float* a, const int lda, const int* ipiv) {
+  return clapack_sgetri(order, n, a, lda, ipiv);
+}
+
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, double* a, const int lda, const int* ipiv) {
+  return clapack_dgetri(order, n, a, lda, ipiv);
+}
+
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, Complex64* a, const int lda, const int* ipiv) {
+  return clapack_cgetri(order, n, reinterpret_cast<void*>(a), lda, ipiv);
+}
+
+template <>
+inline int getri(const enum CBLAS_ORDER order, const int n, Complex128* a, const int lda, const int* ipiv) {
+  return clapack_zgetri(order, n, reinterpret_cast<void*>(a), lda, ipiv);
+}
+#endif
+
+/*
+ * Function signature conversion for calling LAPACK's getri functions as directly as possible.
+ *
+ * For documentation: http://www.netlib.org/lapack/double/dgetri.f
+ *
+ * This function should normally go in math.cpp, but we need it to be available to nmatrix.cpp.
+ */
+template <typename DType>
+inline int clapack_getri(const enum CBLAS_ORDER order, const int n, void* a, const int lda, const int* ipiv) {
+  return getri<DType>(order, n, reinterpret_cast<DType*>(a), lda, ipiv);
+}
+
+
+} } // end nm::math
+
+#endif // GETRI_H

data/ext/nmatrix/math/getrs.h

@@ -0,0 +1,125 @@
+/////////////////////////////////////////////////////////////////////
+// = NMatrix
+//
+// A linear algebra library for scientific computation in Ruby.
+// NMatrix is part of SciRuby.
+//
+// NMatrix was originally inspired by and derived from NArray, by
+// Masahiro Tanaka: http://narray.rubyforge.org
+//
+// == Copyright Information
+//
+// SciRuby is Copyright (c) 2010 - 2013, Ruby Science Foundation
+// NMatrix is Copyright (c) 2013, Ruby Science Foundation
+//
+// Please see LICENSE.txt for additional copyright notices.
+//
+// == Contributing
+//
+// By contributing source code to SciRuby, you agree to be bound by
+// our Contributor Agreement:
+//
+// * https://github.com/SciRuby/sciruby/wiki/Contributor-Agreement
+//
+// == getrs.h
+//
+// getrs function in native C++.
+//
+
+/*
+ *             Automatically Tuned Linear Algebra Software v3.8.4
+ *                    (C) Copyright 1999 R. Clint Whaley
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *   1. Redistributions of source code must retain the above copyright
+ *      notice, this list of conditions and the following disclaimer.
+ *   2. Redistributions in binary form must reproduce the above copyright
+ *      notice, this list of conditions, and the following disclaimer in the
+ *      documentation and/or other materials provided with the distribution.
+ *   3. The name of the ATLAS group or the names of its contributers may
+ *      not be used to endorse or promote products derived from this
+ *      software without specific written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ATLAS GROUP OR ITS CONTRIBUTORS
+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#ifndef GETRS_H
+#define GETRS_H
+
+extern "C" {
+  #include <cblas.h>
+}
+
+namespace nm { namespace math {
+
+
+/*
+ * Solves a system of linear equations A*X = B with a general NxN matrix A using the LU factorization computed by GETRF.
+ *
+ * From ATLAS 3.8.0.
+ */
+template <typename DType>
+int getrs(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE Trans, const int N, const int NRHS, const DType* A,
+           const int lda, const int* ipiv, DType* B, const int ldb)
+{
+  // enum CBLAS_DIAG Lunit, Uunit; // These aren't used. Not sure why they're declared in ATLAS' src.
+
+  if (!N || !NRHS) return 0;
+
+  const DType ONE = 1;
+
+  if (Order == CblasColMajor) {
+    if (Trans == CblasNoTrans) {
+      nm::math::laswp<DType>(NRHS, B, ldb, 0, N, ipiv, 1);
+      nm::math::trsm<DType>(Order, CblasLeft, CblasLower, CblasNoTrans, CblasUnit, N, NRHS, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, N, NRHS, ONE, A, lda, B, ldb);
+    } else {
+      nm::math::trsm<DType>(Order, CblasLeft, CblasUpper, Trans, CblasNonUnit, N, NRHS, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasLeft, CblasLower, Trans, CblasUnit, N, NRHS, ONE, A, lda, B, ldb);
+      nm::math::laswp<DType>(NRHS, B, ldb, 0, N, ipiv, -1);
+    }
+  } else {
+    if (Trans == CblasNoTrans) {
+      nm::math::trsm<DType>(Order, CblasRight, CblasLower, CblasTrans, CblasNonUnit, NRHS, N, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasRight, CblasUpper, CblasTrans, CblasUnit, NRHS, N, ONE, A, lda, B, ldb);
+      nm::math::laswp<DType>(NRHS, B, ldb, 0, N, ipiv, -1);
+    } else {
+      nm::math::laswp<DType>(NRHS, B, ldb, 0, N, ipiv, 1);
+      nm::math::trsm<DType>(Order, CblasRight, CblasUpper, CblasNoTrans, CblasUnit, NRHS, N, ONE, A, lda, B, ldb);
+      nm::math::trsm<DType>(Order, CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, NRHS, N, ONE, A, lda, B, ldb);
+    }
+  }
+  return 0;
+}
+
+
+/*
+* Function signature conversion for calling LAPACK's getrs functions as directly as possible.
+*
+* For documentation: http://www.netlib.org/lapack/double/dgetrs.f
+*
+* This function should normally go in math.cpp, but we need it to be available to nmatrix.cpp.
+*/
+template <typename DType>
+inline int clapack_getrs(const enum CBLAS_ORDER order, const enum CBLAS_TRANSPOSE trans, const int n, const int nrhs,
+                         const void* a, const int lda, const int* ipiv, void* b, const int ldb) {
+  return getrs<DType>(order, trans, n, nrhs, reinterpret_cast<const DType*>(a), lda, ipiv, reinterpret_cast<DType*>(b), ldb);
+}
+
+
+} } // end nm::math
+
+#endif // GETRS_H

data/ext/nmatrix/math/idamax.h

@@ -0,0 +1,86 @@
+/////////////////////////////////////////////////////////////////////
+// = NMatrix
+//
+// A linear algebra library for scientific computation in Ruby.
+// NMatrix is part of SciRuby.
+//
+// NMatrix was originally inspired by and derived from NArray, by
+// Masahiro Tanaka: http://narray.rubyforge.org
+//
+// == Copyright Information
+//
+// SciRuby is Copyright (c) 2010 - 2013, Ruby Science Foundation
+// NMatrix is Copyright (c) 2013, Ruby Science Foundation
+//
+// Please see LICENSE.txt for additional copyright notices.
+//
+// == Contributing
+//
+// By contributing source code to SciRuby, you agree to be bound by
+// our Contributor Agreement:
+//
+// * https://github.com/SciRuby/sciruby/wiki/Contributor-Agreement
+//
+// == idamax.h
+//
+// LAPACK idamax function in native C.
+//
+
+#ifndef IDAMAX_H
+#define IDAMAX_H
+
+namespace nm { namespace math {
+
+/*  Purpose */
+/*  ======= */
+
+/*     IDAMAX finds the index of element having max. absolute value. */
+
+/*  Further Details */
+/*  =============== */
+
+/*     jack dongarra, linpack, 3/11/78. */
+/*     modified 3/93 to return if incx .le. 0. */
+/*     modified 12/3/93, array(1) declarations changed to array(*) */
+
+/*  ===================================================================== */
+
+template <typename DType>
+inline int idamax(size_t n, DType *dx, int incx) {
+
+  /* Function Body */
+  if (n < 1 || incx <= 0) return -1;
+  if (n == 1)             return 0;
+
+  DType dmax;
+  size_t imax = 0;
+
+  if (incx == 1) { // if incrementing by 1
+
+    dmax = abs(dx[0]);
+
+    for (size_t i = 1; i < n; ++i) {
+      if (std::abs(dx[i]) > dmax) {
+        imax = i;
+        dmax = std::abs(dx[i]);
+      }
+    }
+
+  } else { // if incrementing by more than 1
+
+    dmax = std::abs(dx[0]);
+
+    for (size_t i = 1, ix = incx; i < n; ++i, ix += incx) {
+      if (std::abs(dx[ix]) > dmax) {
+        imax = i;
+        dmax = std::abs(dx[ix]);
+      }
+    }
+  }
+  return imax;
+} /* idamax_ */
+
+}} // end of namespace nm::math
+
+#endif
+

data/ext/nmatrix/{util → math}/lapack.h

@@ -328,93 +328,7 @@ inline int iparmq(int ispec, int ilo, int ihi) {
 
 /*  ===================================================================== */
 
-template <typename DType>
-inline int ger(int m, int n, DType alpha, DType* x, int incx, DType* y, int incy, DType* a, int lda) {
-
-  // FIXME: Call BLAS ger if available
-
-  if (m < 0) {
-    return 1;
-  } else if (n < 0) {
-    return 2;
-  } else if (incx == 0) {
-    return 5;
-  } else if (incy == 0) {
-    return 7;
-  } else if (lda < std::max(1,m)) {
-    return 9;
-  }
-
-  if (m == 0 || n == 0 || alpha == 0) return 0; /* Quick return if possible. */
-
-  /*     Start the operations. In this version the elements of A are */
-  /*     accessed sequentially with one pass through A. */
-
-  // FIXME: These have been unrolled in a way that the compiler can handle. Collapse into a single case, or optimize
-  // FIXME: in a more modern way.
-
-  int jy = incy > 0 ? 0 :  -(n-1) * incy;
-
-  if (incx == 1) {
-
-	  for (size_t j = 0; j < n; ++j, jy += incy) {
-	    if (y[jy] != 0) {
-		    DType temp = alpha * y[jy];
-		    for (size_t i = 0; i < m; ++i) {
-		      a[i + j * lda] += x[i] * temp;
-		    }
-	    }
-	  }
-
-  } else {
-
-    int kx = incx > 0 ? 0 : -(m-1) * incx;
-
-	  for (size_t j = 0; j < n; ++j, jy += incy) {
-	    if (y[jy] != 0) {
-    		DType temp = alpha * y[jy];
-
-    		for (size_t i = 0, ix = kx; i < m; ++i, ix += incx) {
-          a[i + j * lda] += x[ix] * temp;
-    		}
-	    }
-	  }
-
-  }
-
-  return 0;
-
-/*     End of DGER  . */
 
-} /* dger_ */
-
-
-/*  Purpose */
-/*  ======= */
-
-/*     DSCAL scales a vector by a constant. */
-/*     uses unrolled loops for increment equal to one. */
-
-/*  Further Details */
-/*  =============== */
-
-/*     jack dongarra, linpack, 3/11/78. */
-/*     modified 3/93 to return if incx .le. 0. */
-/*     modified 12/3/93, array(1) declarations changed to array(*) */
-
-/*  ===================================================================== */
-
-template <typename DType>
-inline void scal(const int n, const DType da, DType* dx,	const int incx) {
-
-  // This used to have unrolled loops, like dswap. They were in the way.
-
-  if (n <= 0 || incx <= 0) return;
-
-  for (int i = 0; incx < 0 ? i > n*incx : i < n*incx; i += incx) {
-    dx[i] = da * dx[i];
-  }
-} /* scal */
 
 
 /*  Purpose */
@@ -431,118 +345,6 @@ inline void scal(const int n, const DType da, DType* dx,	const int incx) {
 
 /*  ===================================================================== */
 // Formerly dswap
-template <typename DType>
-inline void swap(int n, DType *dx, int incx, DType *dy, int incy) {
-
-    /* Function Body */
-    if (n <= 0) return;
-
-    /*
-     * The NETLIB version of dswap has loops manually unrolled, per commented code below.
-     * This doesn't make sense with modern compilers, which know much more about arch-
-     * itectures than we do. Combine that with our use of templates, and it's much more
-     * efficient to let the compiler do the unrolling in most cases.
-     */
-/*
-    if (incx == 1 && incy == 1) { // if both increments are 1
-
-
-      m = n % 3;
-      if (m) {
-        for (size_t i = 0; i < m; ++i) { // If number is not divisible by three, swap just one or two singly.
-          dtemp = dx[i];
-          dx[i] = dy[i];
-          dy[i] = dtemp;
-        }
-        if (n < 3) return;
-      }
-
-      for (i = m; i < n; i += 3) { // Why does it swap three at a time? -- John 8/27/12
-        DType dtemp = dx[i];
-        dx[i]       = dy[i];
-        dy[i]       = dtemp;
-
-        dtemp = dx[i + 1];
-        dx[i + 1] = dy[i + 1];
-        dy[i + 1] = dtemp;
-
-        dtemp = dx[i + 2];
-        dx[i + 2] = dy[i + 2];
-        dy[i + 2] = dtemp;
-      }
-
-    } else { // when any increment is not 1
-*/
-
-  // For negative increments, start at the end of the array.
-  int ix = incx < 0 ? (-n+1)*incx : 0,
-      iy = incy < 0 ? (-n+1)*incy : 0;
-
-  if (incx < 0) ix = (-n + 1) * incx;
-  if (incy < 0) iy = (-n + 1) * incy;
-
-  for (size_t i = 0; i < n; ++i, ix += incx, iy += incy) {
-    DType dtemp = dx[ix];
-    dx[ix]      = dy[iy];
-    dy[iy]      = dtemp;
-  }
-  /*} */
-  return;
-} /* dswap */
-
-
-
-
-/*  Purpose */
-/*  ======= */
-
-/*     IDAMAX finds the index of element having max. absolute value. */
-
-/*  Further Details */
-/*  =============== */
-
-/*     jack dongarra, linpack, 3/11/78. */
-/*     modified 3/93 to return if incx .le. 0. */
-/*     modified 12/3/93, array(1) declarations changed to array(*) */
-
-/*  ===================================================================== */
-
-template <typename DType>
-inline int idamax(size_t n, DType *dx, int incx) {
-
-  /* Function Body */
-  if (n < 1 || incx <= 0) return -1;
-  if (n == 1)             return 0;
-
-  DType dmax;
-  size_t imax = 0;
-
-  if (incx == 1) { // if incrementing by 1
-
-    dmax = abs(dx[0]);
-
-    for (size_t i = 1; i < n; ++i) {
-      if (std::abs(dx[i]) > dmax) {
-        imax = i;
-        dmax = std::abs(dx[i]);
-      }
-    }
-
-  } else { // if incrementing by more than 1
-
-    dmax = std::abs(dx[0]);
-
-    for (size_t i = 1, ix = incx; i < n; ++i, ix += incx) {
-      if (std::abs(dx[ix]) > dmax) {
-        imax = i;
-        dmax = std::abs(dx[ix]);
-      }
-    }
-  }
-  return imax;
-} /* idamax_ */
-
-
 
 
 
@@ -995,181 +797,83 @@ inline int ilaenv(int ispec, const std::string& name, int n1, int n2, int n3, in
 
 
 
-/* > \brief \b DGETF2 */
-
-/*  =========== DOCUMENTATION =========== */
-
-/* Online html documentation available at */
-/*            http://www.netlib.org/lapack/explore-html/ */
-
-/* > \htmlonly */
-/* > Download DGETF2 + dependencies */
-/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetf2.
-f"> */
-/* > [TGZ]</a> */
-/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetf2.
-f"> */
-/* > [ZIP]</a> */
-/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetf2.
-f"> */
-/* > [TXT]</a> */
-/* > \endhtmlonly */
-
-/*  Definition: */
-/*  =========== */
-
-/*       SUBROUTINE DGETF2( M, N, A, LDA, IPIV, INFO ) */
-
-/*       .. Scalar Arguments .. */
-/*       INTEGER            INFO, LDA, M, N */
-/*       .. */
-/*       .. Array Arguments .. */
-/*       INTEGER            IPIV( * ) */
-/*       DOUBLE PRECISION   A( LDA, * ) */
-/*       .. */
-
-
-/* > \par Purpose: */
-/*  ============= */
-/* > */
-/* > \verbatim */
-/* > */
-/* > DGETF2 computes an LU factorization of a general m-by-n matrix A */
-/* > using partial pivoting with row interchanges. */
-/* > */
-/* > The factorization has the form */
-/* >    A = P * L * U */
-/* > where P is a permutation matrix, L is lower triangular with unit */
-/* > diagonal elements (lower trapezoidal if m > n), and U is upper */
-/* > triangular (upper trapezoidal if m < n). */
-/* > */
-/* > This is the right-looking Level 2 BLAS version of the algorithm. */
-/* > \endverbatim */
-
-/*  Arguments: */
-/*  ========== */
-
-/* > \param[in] M */
-/* > \verbatim */
-/* >          M is INTEGER */
-/* >          The number of rows of the matrix A.  M >= 0. */
-/* > \endverbatim */
-/* > */
-/* > \param[in] N */
-/* > \verbatim */
-/* >          N is INTEGER */
-/* >          The number of columns of the matrix A.  N >= 0. */
-/* > \endverbatim */
-/* > */
-/* > \param[in,out] A */
-/* > \verbatim */
-/* >          A is DOUBLE PRECISION array, dimension (LDA,N) */
-/* >          On entry, the m by n matrix to be factored. */
-/* >          On exit, the factors L and U from the factorization */
-/* >          A = P*L*U; the unit diagonal elements of L are not stored. */
-/* > \endverbatim */
-/* > */
-/* > \param[in] LDA */
-/* > \verbatim */
-/* >          LDA is INTEGER */
-/* >          The leading dimension of the array A.  LDA >= max(1,M). */
-/* > \endverbatim */
-/* > */
-/* > \param[out] IPIV */
-/* > \verbatim */
-/* >          IPIV is INTEGER array, dimension (min(M,N)) */
-/* >          The pivot indices; for 1 <= i <= min(M,N), row i of the */
-/* >          matrix was interchanged with row IPIV(i). */
-/* > \endverbatim */
-/* > */
-/* > \param[out] INFO */
-/* > \verbatim */
-/* >          INFO is INTEGER */
-/* >          = 0: successful exit */
-/* >          < 0: if INFO = -k, the k-th argument had an illegal value */
-/* >          > 0: if INFO = k, U(k,k) is exactly zero. The factorization */
-/* >               has been completed, but the factor U is exactly */
-/* >               singular, and division by zero will occur if it is used */
-/* >               to solve a system of equations. */
-/* > \endverbatim */
-
-/*  Authors: */
-/*  ======== */
-
-/* > \author Univ. of Tennessee */
-/* > \author Univ. of California Berkeley */
-/* > \author Univ. of Colorado Denver */
-/* > \author NAG Ltd. */
-
-/* > \date November 2011 */
-
-/* > \ingroup doubleGEcomputational */
-
-/*  ===================================================================== */
-
 template <typename DType>
-inline int getf2(const int m, const int n, DType* a, const int lda, int *ipiv) {
-
-  /* Function Body */
-  if (m < 0)                      return -1; // error
-  else if (n < 0)                 return -2; // error
-  else if (lda < std::max(1,m))   return -4; // error
-
-
-  if (m == 0 || n == 0)     return 0;   /* Quick return if possible */
+inline int lsame(char const *ca, char const *cb, int ca_len, int cb_len)
+{
+  int ret_val;
 
-  for (size_t j = 0; j < std::min(m,n); ++j) { // changed
-
-    /* Find pivot and test for singularity. */
-
-    int jp = j - 1 + idamax<DType>(m-j+1, &a[j + j * lda], 1);
-
-    ipiv[j] = jp;
+  int static inta, intb, zcode;
+/*  -- LAPACK auxiliary routine (version 3.2) -- */
+/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/*     November 2006 */
 
+/*     .. Scalar Arguments .. */
+/*     .. */
 
-    if (a[jp + j*lda] != 0) {
+/*  Purpose */
+/*  ======= */
 
-      /* Apply the interchange to columns 1:N. */
-      // (Don't swap two columns that are the same.)
-      if (jp != j) swap<DType>(n, &a[j], lda, &a[jp], lda);
+/*  LSAME returns .TRUE. if CA is the same letter as CB regardless of */
+/*  case. */
 
-      /* Compute elements J+1:M of J-th column. */
+/*  Arguments */
+/*  ========= */
 
-	    if (j < m-1) {
-        if (std::abs(a[j+j*lda]) >= std::numeric_limits<DType>::min()) {
-          scal<DType>(m-j, 1.0 / a[j+j*lda], &a[j+1+j*lda], 1);
-		    } else {
-		      for (size_t i = 0; i < m-j; ++i) { // changed
-			      a[j+i+j*lda] /= a[j+j*lda];
-		      }
-		    }
-	    }
+/*  CA      (input) CHARACTER*1 */
+/*  CB      (input) CHARACTER*1 */
+/*          CA and CB specify the single characters to be compared. */
 
-    } else { // singular matrix
-      return j; // U(j,j) is exactly zero, div by zero if answer is used to solve a system of equations.
+/* ===================================================================== */
+  inta = *(unsigned char *)ca;
+  intb = *(unsigned char *)cb;
+  ret_val = inta == intb;
+  if (ret_val) {
+    return ret_val;
+  }
+  
+  zcode = (int)"Z";
+
+  if (zcode == 90 || zcode == 122 ) {
+/*        ASCII is assumed - ZCODE is the ASCII code of either lower or */
+/*        upper case 'Z'. */
+    if (inta >=97 && inta <= 122) {
+      inta += -32;
+    }
+    if (intb >= 97 && intb <= 122) {
+      intb += -32;
+    }
+  } else if (zcode == 233 || zcode == 169) {
+/*        EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
+/*        upper case 'Z'. */	
+    if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta >= 162 && inta <= 169) {
+      inta += 64;
+    }
+    if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb >= 162 && intb <= 169) {
+      intb += 64;
     }
+  } else if (zcode = 218 || zcode == 250) {
+/*        ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
+/*        plus 128 of either lower or upper case 'Z'. */
+    if (inta >= 225 && inta <= 250) {
+      inta += -32;
+    }
+    if (intb >= 225 && intb <= 250) {
+	    intb += -32;
+    }
+  }
+  ret_val = inta == intb;
 
-    if (j < std::min(m,n)-1) /*           Update trailing submatrix. */
-      ger<DType>(m-j, n-j, -1.0, &a[j+1+j*lda], 1, &a[j+(j+1)*lda], lda, &a[j+1+(j+1)*lda], lda);
+  return ret_val;
+}
 
-  }
-  return 0;
-} /* dgetf2_ */
 
 
 
 } // end namespace lapack
 
-/*
- * Function signature conversion for LAPACK's scal function.
- */
-template <typename DType>
-inline void clapack_scal(const int n, const void* da, void* dx, const int incx) {
-  // FIXME: See if we can call the clapack version instead of our C++ version.
-  nm::math::lapack::scal<DType>(n, *reinterpret_cast<const DType*>(da), reinterpret_cast<DType*>(dx), incx);
-}
+
 
 
 }}
 
-#endif
+#endif