[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Getfem-commits] [getfem-commits] branch master updated: adaptation for
|
From: |
Yves Renard |
|
Subject: |
[Getfem-commits] [getfem-commits] branch master updated: adaptation for architectures that do not support the exchange of int * and long * |
|
Date: |
Sat, 18 Apr 2020 04:15:32 -0400 |
This is an automated email from the git hooks/post-receive script.
renard pushed a commit to branch master
in repository getfem.
The following commit(s) were added to refs/heads/master by this push:
new 986f77b adaptation for architectures that do not support the exchange
of int * and long *
986f77b is described below
commit 986f77bfb56f415171254395b15bba6ee84d0c37
Author: Yves Renard <address@hidden>
AuthorDate: Sat Apr 18 10:14:47 2020 +0200
adaptation for architectures that do not support the exchange of int * and
long *
---
configure.ac | 27 ++++++++++++
src/bgeot_sparse_tensors.cc | 8 ++--
src/getfem_assembling_tensors.cc | 3 +-
src/getfem_mat_elem.cc | 4 +-
src/gmm/gmm_blas_interface.h | 93 ++++++++++++++++++++++++----------------
src/gmm/gmm_lapack_interface.h | 81 ++++++++++++++++++----------------
6 files changed, 136 insertions(+), 80 deletions(-)
diff --git a/configure.ac b/configure.ac
index 0880d90..af85b06 100644
--- a/configure.ac
+++ b/configure.ac
@@ -348,6 +348,33 @@ if test x$useblasinterface = xYES; then
CPPFLAGS="$CPPFLAGS -DGMM_USES_BLAS_INTERFACE"
fi
+
+
+
+# 32 or 64 bits blas interface
+AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <stdlib.h>
+int main() {
+ int a; long b;
+ int *pa; long *pb; void *pc;
+
+ if (sizeof(long) > sizeof(int)) {
+ a = 0x3E0024; b = 0;
+ pb = &b; pc = (void *)(pb); pa = (int *)(pc); *pa = a;
+ if (int(b) != a) exit(1);
+ *pa = 0x3E0024;
+ if (int(b) != a) exit(1);
+ if (b != long(a)) exit(1);
+ }
+} ]])],[ac_int_long_exchangeable=yes; echo "checking if int and long pointers
are exchangeable...yes"],[ac_int_long_exchangeable=yes; echo "Int and long
pointers are not exchangeable"],[])
+
+if test "$ac_int_long_exchangeable" != yes; then
+ echo "Checking if int and long pointers are exchangeable...no"
+else
+ echo "Checking if int and long pointers are exchangeable...yes"
+ AC_DEFINE_UNQUOTED(INT_LONG_POINTER_ECHANGEABLE, 1, [int and long pointers
are exchangeable])
+fi
+
dnl ------------------------------LAPACK TEST--------------------------------
if test x"$acx_blas_ok" = xyes; then
diff --git a/src/bgeot_sparse_tensors.cc b/src/bgeot_sparse_tensors.cc
index 820b2e7..cbc89f2 100644
--- a/src/bgeot_sparse_tensors.cc
+++ b/src/bgeot_sparse_tensors.cc
@@ -907,10 +907,10 @@ namespace bgeot {
}
static bool do_reduction2v(bgeot::multi_tensor_iterator &mti) {
- long n = mti.vectorized_size();
+ BLAS_INT n = mti.vectorized_size();
const std::vector<stride_type> &s = mti.vectorized_strides();
if (n && s[0] && s[1] && s[2] == 0) {
- long incx = s[1], incy = s[0];
+ BLAS_INT incx = s[1], incy = s[0];
/*mti.print();
scalar_type *b[3];
for (int i=0; i < 3; ++i) b[i] = &mti.p(i);*/
@@ -945,10 +945,10 @@ namespace bgeot {
}
static bool do_reduction3v(bgeot::multi_tensor_iterator &mti) {
- long n = mti.vectorized_size();
+ BLAS_INT n = mti.vectorized_size();
const std::vector<stride_type> &s = mti.vectorized_strides();
if (n && s[0] && s[1] && s[2] == 0 && s[3] == 0) {
- long incx = s[1], incy = s[0];
+ BLAS_INT incx = s[1], incy = s[0];
do {
double v = mti.p(2)*mti.p(3);
gmm::daxpy_(&n, &v, &mti.p(1), &incx, &mti.p(0), &incy);
diff --git a/src/getfem_assembling_tensors.cc b/src/getfem_assembling_tensors.cc
index 404f629..d8a15d3 100644
--- a/src/getfem_assembling_tensors.cc
+++ b/src/getfem_assembling_tensors.cc
@@ -348,7 +348,8 @@ namespace getfem {
tensor_bases[k] = const_cast<TDIter>(&(*eltm[k]->begin()));
}
red.do_reduction();
- long one = 1, n = int(red.out_data.size()); assert(n);
+ BLAS_INT one = BLAS_INT(1), n = BLAS_INT(red.out_data.size());
+ assert(n);
gmm::daxpy_(&n, &c, const_cast<double*>(&(red.out_data[0])),
&one, (double*)&(t[0]), &one);
}
diff --git a/src/getfem_mat_elem.cc b/src/getfem_mat_elem.cc
index 80db291..dbe4960 100644
--- a/src/getfem_mat_elem.cc
+++ b/src/getfem_mat_elem.cc
@@ -398,12 +398,12 @@ namespace getfem {
if (nm == 0) {
t[0] += J;
} else {
- long n0 = int(es_end[0] - es_beg[0]);
+ BLAS_INT n0 = BLAS_INT(es_end[0] - es_beg[0]);
base_tensor::const_iterator pts0 = pts[0];
/* very heavy reduction .. takes much time */
k = nm-1; Vtab[k] = J;
- long one = 1;
+ BLAS_INT one = BLAS_INT(1);
scalar_type V;
do {
for (V = Vtab[k]; k; --k)
diff --git a/src/gmm/gmm_blas_interface.h b/src/gmm/gmm_blas_interface.h
index 6732b41..06252ef 100644
--- a/src/gmm/gmm_blas_interface.h
+++ b/src/gmm/gmm_blas_interface.h
@@ -52,6 +52,12 @@ namespace gmm {
#define GMMLAPACK_TRACE(f)
// #define GMMLAPACK_TRACE(f) cout << "function " << f << " called" << endl;
+#if defined(WeirdNEC) || defined(GMM_INT_LONG_POINTER_ECHANGEABLE)
+ #define BLAS_INT long
+#else // By default BLAS_INT will just be int in C
+ #define BLAS_INT int
+#endif
+
/* ********************************************************************* */
/* Operations interfaced for T = float, double, std::complex<float> */
/* or std::complex<double> : */
@@ -151,13 +157,13 @@ namespace gmm {
/* BLAS functions used. */
/* ********************************************************************* */
extern "C" {
- void daxpy_(const long *n, const double *alpha, const double *x,
- const long *incx, double *y, const long *incy);
- void dgemm_(const char *tA, const char *tB, const long *m,
- const long *n, const long *k, const double *alpha,
- const double *A, const long *ldA, const double *B,
- const long *ldB, const double *beta, double *C,
- const long *ldC);
+ void daxpy_(const BLAS_INT *n, const double *alpha, const double *x,
+ const BLAS_INT *incx, double *y, const BLAS_INT *incy);
+ void dgemm_(const char *tA, const char *tB, const BLAS_INT *m,
+ const BLAS_INT *n, const BLAS_INT *k, const double *alpha,
+ const double *A, const BLAS_INT *ldA, const double *B,
+ const BLAS_INT *ldB, const double *beta, double *C,
+ const BLAS_INT *ldC);
void sgemm_(...); void cgemm_(...); void zgemm_(...);
void sgemv_(...); void dgemv_(...); void cgemv_(...); void zgemv_(...);
void strsv_(...); void dtrsv_(...); void ctrsv_(...); void ztrsv_(...);
@@ -180,7 +186,7 @@ namespace gmm {
inline number_traits<base_type >::magnitude_type \
vect_norm2(param1(base_type)) { \
GMMLAPACK_TRACE("nrm2_interface"); \
- long inc(1), n(long(vect_size(x))); trans1(base_type); \
+ BLAS_INT inc(1), n(BLAS_INT(vect_size(x))); trans1(base_type); \
return blas_name(&n, &x[0], &inc); \
}
@@ -200,7 +206,8 @@ namespace gmm {
blas_name, base_type) \
inline base_type vect_sp(param1(base_type), param2(base_type)) { \
GMMLAPACK_TRACE("dot_interface"); \
- trans1(base_type); trans2(base_type); long inc(1), n(long(vect_size(y)));\
+ trans1(base_type); trans2(base_type); \
+ BLAS_INT inc(1), n(BLAS_INT(vect_size(y))); \
return mult1 mult2 blas_name(&n, &x[0], &inc, &y[0], &inc); \
}
@@ -267,7 +274,8 @@ namespace gmm {
blas_name, base_type) \
inline base_type vect_hp(param1(base_type), param2(base_type)) { \
GMMLAPACK_TRACE("dotc_interface"); \
- trans1(base_type); trans2(base_type); long inc(1), n(long(vect_size(y)));\
+ trans1(base_type); trans2(base_type); \
+ BLAS_INT inc(1), n(BLAS_INT(vect_size(y))); \
return mult1 mult2 blas_name(&n, &x[0], &inc, &y[0], &inc); \
}
@@ -410,7 +418,7 @@ namespace gmm {
# define axpy_interface(param1, trans1, blas_name, base_type) \
inline void add(param1(base_type), std::vector<base_type > &y) { \
GMMLAPACK_TRACE("axpy_interface"); \
- long inc(1), n(long(vect_size(y))); trans1(base_type); \
+ BLAS_INT inc(1), n(BLAS_INT(vect_size(y))); trans1(base_type); \
if(n == 0) return; \
else if(n < 25) add_for_short_vectors(x, y, n); \
else blas_name(&n, &a, &x[0], &inc, &y[0], &inc); \
@@ -419,7 +427,7 @@ namespace gmm {
# define axpy2_interface(param1, trans1, blas_name, base_type) \
inline void add(param1(base_type), std::vector<base_type > &y) { \
GMMLAPACK_TRACE("axpy_interface"); \
- long inc(1), n(long(vect_size(y))); trans1(base_type); \
+ BLAS_INT inc(1), n(BLAS_INT(vect_size(y))); trans1(base_type); \
if(n == 0) return; \
else if(n < 25) add_for_short_vectors(x, y, a, n); \
else blas_name(&n, &a, &x[0], &inc, &y[0], &inc); \
@@ -455,7 +463,8 @@ namespace gmm {
std::vector<base_type > &z, orien) { \
GMMLAPACK_TRACE("gemv_interface"); \
trans1(base_type); trans2(base_type); base_type beta(1); \
- long m(long(mat_nrows(A))), lda(m), n(long(mat_ncols(A))), inc(1); \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda(m); \
+ BLAS_INT n(BLAS_INT(mat_ncols(A))), inc(1); \
if (m && n) blas_name(&t, &m, &n, &alpha, &A(0,0), &lda, &x[0], &inc, \
&beta, &z[0], &inc); \
else gmm::clear(z); \
@@ -577,7 +586,8 @@ namespace gmm {
std::vector<base_type > &z, orien) { \
GMMLAPACK_TRACE("gemv_interface2"); \
trans1(base_type); trans2(base_type); base_type beta(0); \
- long m(long(mat_nrows(A))), lda(m), n(long(mat_ncols(A))), inc(1); \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda(m); \
+ BLAS_INT n(BLAS_INT(mat_ncols(A))), inc(1); \
if (m && n) \
blas_name(&t, &m, &n, &alpha, &A(0,0), &lda, &x[0], &inc, &beta, \
&z[0], &inc); \
@@ -674,8 +684,9 @@ namespace gmm {
const std::vector<base_type > &V, \
const std::vector<base_type > &W) { \
GMMLAPACK_TRACE("ger_interface"); \
- long m(long(mat_nrows(A))), lda = m, n(long(mat_ncols(A)));
\
- long incx = 1, incy = 1; \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda = m; \
+ BLAS_INT n(BLAS_INT(mat_ncols(A))); \
+ BLAS_INT incx = 1, incy = 1; \
base_type alpha(1); \
if (m && n)
\
blas_name(&m, &n, &alpha, &V[0], &incx, &W[0], &incy, &A(0,0), &lda);\
@@ -692,8 +703,9 @@ namespace gmm {
const std::vector<base_type > &W) { \
GMMLAPACK_TRACE("ger_interface"); \
gemv_trans2_s(base_type); \
- long m(long(mat_nrows(A))), lda = m, n(long(mat_ncols(A)));
\
- long incx = 1, incy = 1; \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda = m; \
+ BLAS_INT n(BLAS_INT(mat_ncols(A))); \
+ BLAS_INT incx = 1, incy = 1; \
if (m && n)
\
blas_name(&m, &n, &alpha, &x[0], &incx, &W[0], &incy, &A(0,0), &lda);\
}
@@ -709,8 +721,9 @@ namespace gmm {
gemv_p2_s(base_type)) { \
GMMLAPACK_TRACE("ger_interface"); \
gemv_trans2_s(base_type); \
- long m(long(mat_nrows(A))), lda = m, n(long(mat_ncols(A)));
\
- long incx = 1, incy = 1; \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda = m; \
+ BLAS_INT n(BLAS_INT(mat_ncols(A))); \
+ BLAS_INT incx = 1, incy = 1; \
base_type al2 = gmm::conj(alpha); \
if (m && n)
\
blas_name(&m, &n, &al2, &V[0], &incx, &x[0], &incy, &A(0,0), &lda); \
@@ -731,9 +744,10 @@ namespace gmm {
dense_matrix<base_type > &C, c_mult) { \
GMMLAPACK_TRACE("gemm_interface_nn"); \
const char t = 'N'; \
- long m(long(mat_nrows(A))), lda = m, k(long(mat_ncols(A)));
\
- long n(long(mat_ncols(B)));
\
- long ldb = k, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda = m; \
+ BLAS_INT k(BLAS_INT(mat_ncols(A))); \
+ BLAS_INT n(BLAS_INT(mat_ncols(B))); \
+ BLAS_INT ldb = k, ldc = m; \
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &t, &m, &n, &k, &alpha, \
@@ -759,8 +773,9 @@ namespace gmm {
dense_matrix<base_type > &A \
= const_cast<dense_matrix<base_type > &>(*(linalg_origin(A_))); \
const char t = 'T', u = 'N'; \
- long m(long(mat_ncols(A))), k(long(mat_nrows(A))), n(long(mat_ncols(B))); \
- long lda = k, ldb = k, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_ncols(A))), k(BLAS_INT(mat_nrows(A))); \
+ BLAS_INT n(BLAS_INT(mat_ncols(B))); \
+ BLAS_INT lda = k, ldb = k, ldc = m; \
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &u, &m, &n, &k, &alpha, \
@@ -789,9 +804,10 @@ namespace gmm {
dense_matrix<base_type > &B \
= const_cast<dense_matrix<base_type > &>(*(linalg_origin(B_))); \
const char t = 'N', u = 'T'; \
- long m(long(mat_nrows(A))), lda = m, k(long(mat_ncols(A))); \
- long n(long(mat_nrows(B)));
\
- long ldb = n, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda = m; \
+ BLAS_INT k(BLAS_INT(mat_ncols(A))); \
+ BLAS_INT n(BLAS_INT(mat_nrows(B))); \
+ BLAS_INT ldb = n, ldc = m; \
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &u, &m, &n, &k, &alpha, \
@@ -823,8 +839,9 @@ namespace gmm {
dense_matrix<base_type > &B \
= const_cast<dense_matrix<base_type > &>(*(linalg_origin(B_))); \
const char t = 'T', u = 'T'; \
- long m(long(mat_ncols(A))), k(long(mat_nrows(A))), n(long(mat_nrows(B))); \
- long lda = k, ldb = n, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_ncols(A))), k(BLAS_INT(mat_nrows(A))); \
+ BLAS_INT n(BLAS_INT(mat_nrows(B))); \
+ BLAS_INT lda = k, ldb = n, ldc = m;
\
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &u, &m, &n, &k, &alpha, \
@@ -863,8 +880,9 @@ namespace gmm {
dense_matrix<base_type > &A \
= const_cast<dense_matrix<base_type > &>(*(linalg_origin(A_))); \
const char t = 'C', u = 'N'; \
- long m(long(mat_ncols(A))), k(long(mat_nrows(A))), n(long(mat_ncols(B))); \
- long lda = k, ldb = k, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_ncols(A))), k(BLAS_INT(mat_nrows(A))); \
+ BLAS_INT n(BLAS_INT(mat_ncols(B))); \
+ BLAS_INT lda = k, ldb = k, ldc = m;
\
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &u, &m, &n, &k, &alpha, \
@@ -889,8 +907,9 @@ namespace gmm {
dense_matrix<base_type > &B \
= const_cast<dense_matrix<base_type > &>(*(linalg_origin(B_))); \
const char t = 'N', u = 'C'; \
- long m(long(mat_nrows(A))), lda = m, k(long(mat_ncols(A)));
\
- long n(long(mat_nrows(B))), ldb = n, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_nrows(A))), lda = m; \
+ BLAS_INT k(BLAS_INT(mat_ncols(A))); \
+ BLAS_INT n(BLAS_INT(mat_nrows(B))), ldb = n, ldc = m; \
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &u, &m, &n, &k, &alpha, \
@@ -918,8 +937,8 @@ namespace gmm {
dense_matrix<base_type > &B \
= const_cast<dense_matrix<base_type > &>(*(linalg_origin(B_))); \
const char t = 'C', u = 'C'; \
- long m(long(mat_ncols(A))), k(long(mat_nrows(A))), lda = k;
\
- long n(long(mat_nrows(B))), ldb = n, ldc = m; \
+ BLAS_INT m(BLAS_INT(mat_ncols(A))), k(BLAS_INT(mat_nrows(A))); \
+ BLAS_INT lda = k, n(BLAS_INT(mat_nrows(B))), ldb = n, ldc = m; \
base_type alpha(1), beta(0); \
if (m && k && n) \
blas_name(&t, &u, &m, &n, &k, &alpha, \
@@ -941,7 +960,7 @@ namespace gmm {
size_type k, bool is_unit) { \
GMMLAPACK_TRACE("trsv_interface"); \
loru; trans1(base_type); char d = is_unit ? 'U' : 'N'; \
- long lda(long(mat_nrows(A))), inc(1), n = long(k); \
+ BLAS_INT lda(BLAS_INT(mat_nrows(A))), inc(1), n = BLAS_INT(k); \
if (lda) blas_name(&l, &t, &d, &n, &A(0,0), &lda, &x[0], &inc); \
}
diff --git a/src/gmm/gmm_lapack_interface.h b/src/gmm/gmm_lapack_interface.h
index 06a956e..37bc48f 100644
--- a/src/gmm/gmm_lapack_interface.h
+++ b/src/gmm/gmm_lapack_interface.h
@@ -104,9 +104,11 @@ namespace gmm {
# define getrf_interface(lapack_name, base_type) inline \
size_type lu_factor(dense_matrix<base_type > &A, lapack_ipvt &ipvt){ \
GMMLAPACK_TRACE("getrf_interface"); \
- long m = long(mat_nrows(A)), n = long(mat_ncols(A)), lda(m), info(-1L); \
+ BLAS_INT m = BLAS_INT(mat_nrows(A)), n = BLAS_INT(mat_ncols(A)), lda(m); \
+ long info(-1L); \
if (m && n) lapack_name(&m, &n, &A(0,0), &lda, ipvt.pfirst(), &info); \
- if ((info & 0xFFFFFFFF00000000L) && !(info & 0x00000000FFFFFFFFL)) \
+ if ((sizeof(BLAS_INT) == 4) || \
+ ((info & 0xFFFFFFFF00000000L) && !(info & 0x00000000FFFFFFFFL))) \
/* For compatibility with lapack version with 32 bit integer. */ \
ipvt.set_to_int32(); \
return size_type(int(info & 0x00000000FFFFFFFFL)); \
@@ -126,7 +128,7 @@ namespace gmm {
const lapack_ipvt &ipvt, std::vector<base_type > &x, \
const std::vector<base_type > &b) { \
GMMLAPACK_TRACE("getrs_interface"); \
- long n = long(mat_nrows(A)), info(0), nrhs(1); \
+ BLAS_INT n = BLAS_INT(mat_nrows(A)), info(0), nrhs(1); \
gmm::copy(b, x); trans1; \
if (n) \
lapack_name(&t,&n,&nrhs,&(A(0,0)),&n,ipvt.pfirst(),&x[0],&n,&info); \
@@ -154,12 +156,13 @@ namespace gmm {
GMMLAPACK_TRACE("getri_interface"); \
dense_matrix<base_type >& \
A = const_cast<dense_matrix<base_type > &>(A_); \
- long n = int(mat_nrows(A)), info(0), lwork(-1); base_type work1; \
+ BLAS_INT n = BLAS_INT(mat_nrows(A)), info(0), lwork(-1); \
+ base_type work1; \
if (n) { \
gmm::copy(LU, A); \
lapack_name(&n, &A(0,0), &n, ipvt.pfirst(), &work1, &lwork, &info); \
lwork = int(gmm::real(work1)); \
- std::vector<base_type > work(lwork); \
+ std::vector<base_type> work(lwork); \
lapack_name(&n, &A(0,0), &n, ipvt.pfirst(), &work[0], &lwork,&info); \
} \
}
@@ -176,12 +179,13 @@ namespace gmm {
# define geqrf_interface(lapack_name1, base_type) inline \
void qr_factor(dense_matrix<base_type > &A){ \
GMMLAPACK_TRACE("geqrf_interface"); \
- long m = long(mat_nrows(A)), n=long(mat_ncols(A)), info(0), lwork(-1); \
+ BLAS_INT m = BLAS_INT(mat_nrows(A)), n=BLAS_INT(mat_ncols(A)); \
+ BLAS_INT info(0), lwork(-1); \
base_type work1; \
if (m && n) { \
std::vector<base_type > tau(n); \
lapack_name1(&m, &n, &A(0,0), &m, &tau[0], &work1 , &lwork, &info); \
- lwork = long(gmm::real(work1)); \
+ lwork = BLAS_INT(gmm::real(work1)); \
std::vector<base_type > work(lwork); \
lapack_name1(&m, &n, &A(0,0), &m, &tau[0], &work[0], &lwork, &info); \
GMM_ASSERT1(!info, "QR factorization failed"); \
@@ -199,19 +203,20 @@ namespace gmm {
void qr_factor(const dense_matrix<base_type > &A, \
dense_matrix<base_type > &Q, dense_matrix<base_type > &R) { \
GMMLAPACK_TRACE("geqrf_interface2"); \
- long m = long(mat_nrows(A)), n=long(mat_ncols(A)), info(0), lwork(-1); \
+ BLAS_INT m = BLAS_INT(mat_nrows(A)), n=BLAS_INT(mat_ncols(A)); \
+ BLAS_INT info(0), lwork(-1); \
base_type work1; \
if (m && n) { \
std::copy(A.begin(), A.end(), Q.begin());
\
std::vector<base_type > tau(n); \
lapack_name1(&m, &n, &Q(0,0), &m, &tau[0], &work1 , &lwork, &info); \
- lwork = long(gmm::real(work1)); \
+ lwork = BLAS_INT(gmm::real(work1)); \
std::vector<base_type > work(lwork); \
lapack_name1(&m, &n, &Q(0,0), &m, &tau[0], &work[0], &lwork, &info); \
GMM_ASSERT1(!info, "QR factorization failed"); \
base_type *p = &R(0,0), *q = &Q(0,0); \
- for (long j = 0; j < n; ++j, q += m-n) \
- for (long i = 0; i < n; ++i, ++p, ++q) \
+ for (BLAS_INT j = 0; j < n; ++j, q += m-n) \
+ for (BLAS_INT i = 0; i < n; ++i, ++p, ++q) \
*p = (j < i) ? base_type(0) : *q; \
lapack_name2(&m, &n, &n, &Q(0,0), &m,&tau[0],&work[0],&lwork,&info); \
} \
@@ -234,14 +239,15 @@ namespace gmm {
double tol=gmm::default_tol(base_type()), bool compvect = true) { \
GMMLAPACK_TRACE("gees_interface"); \
typedef bool (*L_fp)(...); L_fp p = 0; \
- long n=long(mat_nrows(A)), info(0), lwork(-1), sdim; base_type work1; \
+ BLAS_INT n=BLAS_INT(mat_nrows(A)), info(0), lwork(-1), sdim; \
+ base_type work1; \
if (!n) return; \
dense_matrix<base_type > H(n,n); gmm::copy(A, H); \
char jobvs = (compvect ? 'V' : 'N'), sort = 'N'; \
std::vector<double> rwork(n), eigv1(n), eigv2(n); \
lapack_name(&jobvs, &sort, p, &n, &H(0,0), &n, &sdim, &eigv1[0], \
&eigv2[0], &Q(0,0), &n, &work1, &lwork, &rwork[0], &info); \
- lwork = long(gmm::real(work1)); \
+ lwork = BLAS_INT(gmm::real(work1)); \
std::vector<base_type > work(lwork); \
lapack_name(&jobvs, &sort, p, &n, &H(0,0), &n, &sdim, &eigv1[0], \
&eigv2[0], &Q(0,0), &n, &work[0], &lwork, &rwork[0],&info);\
@@ -256,14 +262,15 @@ namespace gmm {
double tol=gmm::default_tol(base_type()), bool compvect = true) { \
GMMLAPACK_TRACE("gees_interface2"); \
typedef bool (*L_fp)(...); L_fp p = 0; \
- long n=long(mat_nrows(A)), info(0), lwork(-1), sdim; base_type work1; \
+ BLAS_INT n=BLAS_INT(mat_nrows(A)), info(0), lwork(-1), sdim; \
+ base_type work1; \
if (!n) return; \
dense_matrix<base_type > H(n,n); gmm::copy(A, H); \
char jobvs = (compvect ? 'V' : 'N'), sort = 'N'; \
std::vector<double> rwork(n), eigvv(n*2); \
lapack_name(&jobvs, &sort, p, &n, &H(0,0), &n, &sdim, &eigvv[0], \
&Q(0,0), &n, &work1, &lwork, &rwork[0], &rwork[0], &info); \
- lwork = long(gmm::real(work1)); \
+ lwork = BLAS_INT(gmm::real(work1)); \
std::vector<base_type > work(lwork); \
lapack_name(&jobvs, &sort, p, &n, &H(0,0), &n, &sdim, &eigvv[0], \
&Q(0,0), &n, &work[0], &lwork, &rwork[0], &rwork[0],&info);\
@@ -285,14 +292,15 @@ namespace gmm {
const dense_matrix<base_type > &A, const VECT &eigval_, \
dense_matrix<base_type > &Q) { \
GMMLAPACK_TRACE("geev_interface"); \
- long n = long(mat_nrows(A)), info(0), lwork(-1); base_type work1; \
+ BLAS_INT n = BLAS_INT(mat_nrows(A)), info(0), lwork(-1); \
+ base_type work1; \
if (!n) return; \
dense_matrix<base_type > H(n,n); gmm::copy(A, H); \
jobv_ ## side \
std::vector<base_type > eigvr(n), eigvi(n); \
lapack_name(&jobvl, &jobvr, &n, &H(0,0), &n, &eigvr[0], &eigvi[0], \
&Q(0,0), &n, &Q(0,0), &n, &work1, &lwork, &info); \
- lwork = long(gmm::real(work1)); \
+ lwork = BLAS_INT(gmm::real(work1)); \
std::vector<base_type > work(lwork); \
lapack_name(&jobvl, &jobvr, &n, &H(0,0), &n, &eigvr[0], &eigvi[0], \
&Q(0,0), &n, &Q(0,0), &n, &work[0], &lwork, &info); \
@@ -306,7 +314,8 @@ namespace gmm {
const dense_matrix<base_type > &A, const VECT &eigval_, \
dense_matrix<base_type > &Q) { \
GMMLAPACK_TRACE("geev_interface"); \
- long n = long(mat_nrows(A)), info(0), lwork(-1); base_type work1; \
+ BLAS_INT n = BLAS_INT(mat_nrows(A)), info(0), lwork(-1); \
+ base_type work1; \
if (!n) return; \
dense_matrix<base_type > H(n,n); gmm::copy(A, H); \
jobv_ ## side \
@@ -314,7 +323,7 @@ namespace gmm {
std::vector<base_type> eigv(n); \
lapack_name(&jobvl, &jobvr, &n, &H(0,0), &n, &eigv[0], &Q(0,0), &n, \
&Q(0,0), &n, &work1, &lwork, &rwork[0], &info); \
- lwork = long(gmm::real(work1)); \
+ lwork = BLAS_INT(gmm::real(work1)); \
std::vector<base_type > work(lwork); \
lapack_name(&jobvl, &jobvr, &n, &H(0,0), &n, &eigv[0], &Q(0,0), &n, \
&Q(0,0), &n, &work[0], &lwork, &rwork[0], &info); \
@@ -343,18 +352,18 @@ namespace gmm {
dense_matrix<base_type> &S, \
dense_matrix<base_type> &Q) { \
GMMLAPACK_TRACE("geesx_interface"); \
- long m = long(mat_nrows(A)), n = long(mat_ncols(A)); \
+ BLAS_INT m = BLAS_INT(mat_nrows(A)), n = BLAS_INT(mat_ncols(A)); \
GMM_ASSERT1(m == n, "Schur decomposition requires square matrix"); \
char jobvs = 'V', sort = 'N', sense = 'N'; \
bool select = false; \
- long lwork = 8*n, sdim = 0, liwork = 1; \
+ BLAS_INT lwork = 8*n, sdim = 0, liwork = 1; \
std::vector<base_type> work(lwork), wr(n), wi(n); \
- std::vector<long> iwork(liwork); \
- std::vector<long> bwork(1); \
+ std::vector<BLAS_INT> iwork(liwork); \
+ std::vector<BLAS_INT> bwork(1); \
resize(S, n, n); copy(A, S); \
resize(Q, n, n); \
base_type rconde(0), rcondv(0); \
- long info(0); \
+ BLAS_INT info(0); \
lapack_name(&jobvs, &sort, &select, &sense, &n, &S(0,0), &n, \
&sdim, &wr[0], &wi[0], &Q(0,0), &n, &rconde, &rcondv, \
&work[0], &lwork, &iwork[0], &liwork, &bwork[0], &info);\
@@ -366,18 +375,18 @@ namespace gmm {
dense_matrix<base_type> &S, \
dense_matrix<base_type> &Q) { \
GMMLAPACK_TRACE("geesx_interface"); \
- long m = long(mat_nrows(A)), n = long(mat_ncols(A)); \
+ BLAS_INT m = BLAS_INT(mat_nrows(A)), n = BLAS_INT(mat_ncols(A)); \
GMM_ASSERT1(m == n, "Schur decomposition requires square matrix"); \
char jobvs = 'V', sort = 'N', sense = 'N'; \
bool select = false; \
- long lwork = 8*n, sdim = 0; \
+ BLAS_INT lwork = 8*n, sdim = 0; \
std::vector<base_type::value_type> rwork(lwork); \
std::vector<base_type> work(lwork), w(n); \
- std::vector<long> bwork(1); \
+ std::vector<BLAS_INT> bwork(1); \
resize(S, n, n); copy(A, S); \
resize(Q, n, n); \
base_type rconde(0), rcondv(0); \
- long info(0); \
+ BLAS_INT info(0); \
lapack_name(&jobvs, &sort, &select, &sense, &n, &S(0,0), &n, \
&sdim, &w[0], &Q(0,0), &n, &rconde, &rcondv, \
&work[0], &lwork, &rwork[0], &bwork[0], &info); \
@@ -407,15 +416,15 @@ namespace gmm {
dense_matrix<base_type> &Vtransposed, \
std::vector<base_type> &sigma) { \
GMMLAPACK_TRACE("gesvd_interface"); \
- long m = long(mat_nrows(X)), n = long(mat_ncols(X)); \
- long mn_min = m < n ? m : n; \
+ BLAS_INT m = BLAS_INT(mat_nrows(X)), n = BLAS_INT(mat_ncols(X)); \
+ BLAS_INT mn_min = m < n ? m : n; \
sigma.resize(mn_min); \
std::vector<base_type> work(15 * mn_min); \
- long lwork = long(work.size()); \
+ BLAS_INT lwork = BLAS_INT(work.size()); \
resize(U, m, m); \
resize(Vtransposed, n, n); \
char job = 'A'; \
- long info(0); \
+ BLAS_INT info(0); \
lapack_name(&job, &job, &m, &n, &X(0,0), &m, &sigma[0], &U(0,0), \
&m, &Vtransposed(0,0), &n, &work[0], &lwork, &info); \
}
@@ -426,16 +435,16 @@ namespace gmm {
dense_matrix<base_type> &Vtransposed, \
std::vector<base_type2> &sigma) { \
GMMLAPACK_TRACE("gesvd_interface"); \
- long m = long(mat_nrows(X)), n = long(mat_ncols(X)); \
- long mn_min = m < n ? m : n; \
+ BLAS_INT m = BLAS_INT(mat_nrows(X)), n = BLAS_INT(mat_ncols(X)); \
+ BLAS_INT mn_min = m < n ? m : n; \
sigma.resize(mn_min); \
std::vector<base_type> work(15 * mn_min); \
std::vector<base_type2> rwork(5 * mn_min); \
- long lwork = long(work.size()); \
+ BLAS_INT lwork = BLAS_INT(work.size()); \
resize(U, m, m); \
resize(Vtransposed, n, n); \
char job = 'A'; \
- long info(0); \
+ BLAS_INT info(0); \
lapack_name(&job, &job, &m, &n, &X(0,0), &m, &sigma[0], &U(0,0), \
&m, &Vtransposed(0,0), &n, &work[0], &lwork, \
&rwork[0], &info); \
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Getfem-commits] [getfem-commits] branch master updated: adaptation for architectures that do not support the exchange of int * and long *,
Yves Renard <=