--- a/src/gmm/gmm_blas_interface.h +++ b/src/gmm/gmm_blas_interface.h @@ -52,6 +52,12 @@ #define GMMLAPACK_TRACE(f) // #define GMMLAPACK_TRACE(f) cout << "function " << f << " called" << endl; +#ifdef WeirdNEC // Rarely defined parameter (name taken from cblas_f77.h) + #define F77_INT long +#else // By default F77_INT will just be int in C + #define F77_INT int +#endif + /* ********************************************************************* */ /* Operations interfaced for T = float, double, std::complex */ /* or std::complex : */ @@ -151,13 +157,17 @@ /* 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 F77_INT *n, + const double *alpha, + const double *x, const F77_INT *incx, + double *y, const F77_INT *incy); + void dgemm_(const char *tA, const char *tB, + const F77_INT *m, const F77_INT *n, const F77_INT *k, + const double *alpha, + const double *A, const F77_INT *ldA, + const double *B, const F77_INT *ldB, + const double *beta, + double *C, const F77_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 +190,8 @@ inline number_traits::magnitude_type \ vect_norm2(param1(base_type)) { \ GMMLAPACK_TRACE("nrm2_interface"); \ - long inc(1), n(long(vect_size(x))); trans1(base_type); \ + F77_INT inc(1), n(F77_INT(vect_size(x))); \ + trans1(base_type); \ return blas_name(&n, &x[0], &inc); \ } @@ -200,7 +211,8 @@ 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); \ + F77_INT inc(1), n(F77_INT(vect_size(y))); \ return mult1 mult2 blas_name(&n, &x[0], &inc, &y[0], &inc); \ } @@ -267,7 +279,8 @@ 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); \ + F77_INT inc(1), n(F77_INT(vect_size(y))); \ return mult1 mult2 blas_name(&n, &x[0], &inc, &y[0], &inc); \ } @@ -332,7 +345,8 @@ # define axpy_interface(param1, trans1, blas_name, base_type) \ inline void add(param1(base_type), std::vector &y) { \ GMMLAPACK_TRACE("axpy_interface"); \ - long inc(1), n(long(vect_size(y))); trans1(base_type); \ + F77_INT inc(1), n(F77_INT(vect_size(y))); \ + trans1(base_type); \ if (n == 0) return; \ blas_name(&n, &a, &x[0], &inc, &y[0], &inc); \ } @@ -367,7 +381,8 @@ std::vector &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); \ + F77_INT m(F77_INT(mat_nrows(A))), lda(m); \ + F77_INT n(F77_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); \ @@ -489,7 +504,8 @@ std::vector &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); \ + F77_INT m(F77_INT(mat_nrows(A))), lda(m); \ + F77_INT n(F77_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); \ @@ -586,8 +602,8 @@ const std::vector &V, \ const std::vector &W) { \ GMMLAPACK_TRACE("ger_interface"); \ - long m(long(mat_nrows(A))), lda = m, n(long(mat_ncols(A))); \ - long incx = 1, incy = 1; \ + F77_INT m(F77_INT(mat_nrows(A))), lda = m; \ + F77_INT n(F77_INT(mat_ncols(A))), 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);\ @@ -604,8 +620,8 @@ const std::vector &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; \ + F77_INT m(F77_INT(mat_nrows(A))), lda = m; \ + F77_INT n(F77_INT(mat_ncols(A))), incx = 1, incy = 1; \ if (m && n) \ blas_name(&m, &n, &alpha, &x[0], &incx, &W[0], &incy, &A(0,0), &lda);\ } @@ -621,8 +637,8 @@ 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; \ + F77_INT m(F77_INT(mat_nrows(A))), lda = m; \ + F77_INT n(F77_INT(mat_ncols(A))), 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); \ @@ -643,9 +659,8 @@ dense_matrix &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; \ + F77_INT m(F77_INT(mat_nrows(A))), lda = m, k(F77_INT(mat_ncols(A))); \ + F77_INT n(F77_INT(mat_ncols(B))), ldb = k, ldc = m; \ base_type alpha(1), beta(0); \ if (m && k && n) \ blas_name(&t, &t, &m, &n, &k, &alpha, \ @@ -671,8 +686,8 @@ dense_matrix &A \ = const_cast &>(*(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; \ + F77_INT m(F77_INT(mat_ncols(A))), k(F77_INT(mat_nrows(A))); \ + F77_INT n(F77_INT(mat_ncols(B))), lda = k, ldb = k, ldc = m; \ base_type alpha(1), beta(0); \ if (m && k && n) \ blas_name(&t, &u, &m, &n, &k, &alpha, \ @@ -701,9 +716,8 @@ dense_matrix &B \ = const_cast &>(*(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; \ + F77_INT m(F77_INT(mat_nrows(A))), lda = m, k(F77_INT(mat_ncols(A))); \ + F77_INT n(F77_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, \ @@ -735,8 +749,8 @@ dense_matrix &B \ = const_cast &>(*(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; \ + F77_INT m(F77_INT(mat_ncols(A))), k(F77_INT(mat_nrows(A))); \ + F77_INT n(F77_INT(mat_nrows(B))), lda = k, ldb = n, ldc = m; \ base_type alpha(1), beta(0); \ if (m && k && n) \ blas_name(&t, &u, &m, &n, &k, &alpha, \ @@ -775,8 +789,8 @@ dense_matrix &A \ = const_cast &>(*(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; \ + F77_INT m(F77_INT(mat_ncols(A))), k(F77_INT(mat_nrows(A))); \ + F77_INT n(F77_INT(mat_ncols(B))), lda = k, ldb = k, ldc = m; \ base_type alpha(1), beta(0); \ if (m && k && n) \ blas_name(&t, &u, &m, &n, &k, &alpha, \ @@ -801,8 +815,8 @@ dense_matrix &B \ = const_cast &>(*(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; \ + F77_INT m(F77_INT(mat_nrows(A))), lda = m, k(F77_INT(mat_ncols(A))); \ + F77_INT n(F77_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, \ @@ -830,8 +844,8 @@ dense_matrix &B \ = const_cast &>(*(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; \ + F77_INT m(F77_INT(mat_ncols(A))), k(F77_INT(mat_nrows(A))), lda = k; \ + F77_INT n(F77_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, \ @@ -853,7 +867,7 @@ 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); \ + F77_INT lda(F77_INT(mat_nrows(A))), inc(1), n = F77_INT(k); \ if (lda) blas_name(&l, &t, &d, &n, &A(0,0), &lda, &x[0], &inc); \ } --- a/src/bgeot_sparse_tensors.cc +++ b/src/bgeot_sparse_tensors.cc @@ -907,10 +907,10 @@ } static bool do_reduction2v(bgeot::multi_tensor_iterator &mti) { - long n = mti.vectorized_size(); + F77_INT n = F77_INT(mti.vectorized_size()); const std::vector &s = mti.vectorized_strides(); if (n && s[0] && s[1] && s[2] == 0) { - long incx = s[1], incy = s[0]; + F77_INT incx = F77_INT(s[1]), incy = F77_INT(s[0]); /*mti.print(); scalar_type *b[3]; for (int i=0; i < 3; ++i) b[i] = &mti.p(i);*/ @@ -945,10 +945,10 @@ } static bool do_reduction3v(bgeot::multi_tensor_iterator &mti) { - long n = mti.vectorized_size(); + F77_INT n = F77_INT(mti.vectorized_size()); const std::vector &s = mti.vectorized_strides(); if (n && s[0] && s[1] && s[2] == 0 && s[3] == 0) { - long incx = s[1], incy = s[0]; + F77_INT incx = F77_INT(s[1]), incy = F77_INT(s[0]); do { double v = mti.p(2)*mti.p(3); gmm::daxpy_(&n, &v, &mti.p(1), &incx, &mti.p(0), &incy); --- a/src/getfem_assembling_tensors.cc +++ b/src/getfem_assembling_tensors.cc @@ -354,8 +354,8 @@ tensor_bases[k] = const_cast(&(*eltm[k]->begin())); } red.do_reduction(); - long one = 1, n = int(red.out_data.size()); assert(n); - gmm::daxpy_(&n, &c, const_cast(&(red.out_data[0])), + F77_INT one = 1, n = F77_INT(red.out_data.size()); assert(n); + gmm::daxpy_(&n, &c, const_cast(&(red.out_data[0])), &one, (double*)&(t[0]), &one); } void resize_t(bgeot::base_tensor &t) { --- a/src/getfem_mat_elem.cc +++ b/src/getfem_mat_elem.cc @@ -381,18 +381,18 @@ if (nm == 0) { t[0] += J; } else { - long n0 = int(es_end[0] - es_beg[0]); + F77_INT n0 = F77_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; + F77_INT one = 1; scalar_type V; do { for (V = Vtab[k]; k; --k) Vtab[k-1] = V = *pts[k] * V; GMM_ASSERT1(pt+n0 <= t.end(), "Internal error"); - gmm::daxpy_(&n0, &V, const_cast(&(pts0[0])), &one, + gmm::daxpy_(&n0, &V, const_cast(&(pts0[0])), &one, (double*)&(*pt), &one); pt+=n0; for (k=1; k != nm && ++pts[k] == es_end[k]; ++k)