1 /******************************************************************************* 2 * Copyright (c) 2018, College of William & Mary 3 * All rights reserved. 4 * 5 * Redistribution and use in source and binary forms, with or without 6 * modification, are permitted provided that the following conditions are met: 7 * * Redistributions of source code must retain the above copyright 8 * notice, this list of conditions and the following disclaimer. 9 * * Redistributions in binary form must reproduce the above copyright 10 * notice, this list of conditions and the following disclaimer in the 11 * documentation and/or other materials provided with the distribution. 12 * * Neither the name of the College of William & Mary nor the 13 * names of its contributors may be used to endorse or promote products 14 * derived from this software without specific prior written permission. 15 * 16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 17 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 18 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 * DISCLAIMED. IN NO EVENT SHALL THE COLLEGE OF WILLIAM & MARY BE LIABLE FOR ANY 20 * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 21 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 22 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 23 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 24 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 25 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 * 27 * PRIMME: https://github.com/primme/primme 28 * Contact: Andreas Stathopoulos, a n d r e a s _at_ c s . w m . e d u 29 ******************************************************************************* 30 * File: numerical_private.h 31 * 32 * Purpose - Contains definitions and prototypes of BLAS and LAPACK functions. 33 * 34 ******************************************************************************/ 35 36 #ifndef NUMERICAL_PRIVATE_H 37 #define NUMERICAL_PRIVATE_H 38 39 #include "numerical.h" 40 41 #if !defined(PRIMME_BLASINT_SIZE) || PRIMME_BLASINT_SIZE == 32 42 # include <stdint.h> 43 # include <inttypes.h> 44 # define PRIMME_BLASINT int32_t 45 # define PRIMME_BLASINT_P PRId32 46 # define PRIMME_BLASINT_MAX INT32_MAX 47 #elif PRIMME_BLASINT_SIZE == 0 48 # include <limits.h> 49 # define PRIMME_BLASINT int 50 # define PRIMME_BLASINT_P "d" 51 # define PRIMME_BLASINT_MAX INT_MAX 52 #elif PRIMME_BLASINT_SIZE == 64 53 # include <stdint.h> 54 # include <inttypes.h> 55 # define PRIMME_BLASINT int64_t 56 # define PRIMME_BLASINT_P PRId64 57 # define PRIMME_BLASINT_MAX INT64_MAX 58 #else 59 # define PRIMME_BLASINT PRIMME_BLASINT_SIZE 60 # define PRIMME_BLASINT_P "d" 61 # define PRIMME_BLASINT_MAX ((PRIMME_BLASINT_SIZE)INT_MAX)*INT_MAX 62 #endif 63 64 #ifndef PRIMME_BLAS_SUFFIX 65 # define PRIMME_BLAS_SUFFIX 66 #endif 67 68 #define LAPACK(X) FORTRAN_FUNCTION(CONCAT(X,PRIMME_BLAS_SUFFIX)) 69 70 #define XCOPY LAPACK(ARITH(hcopy , kcopy , scopy , ccopy , dcopy , zcopy , , )) 71 #define XSWAP LAPACK(ARITH(hswap , kswap , sswap , cswap , dswap , zswap , , )) 72 #define XGEMM LAPACK(ARITH(hgemm , kgemm , sgemm , cgemm , dgemm , zgemm , , )) 73 #define XTRMM LAPACK(ARITH(htrmm , ktrmm , strmm , ctrmm , dtrmm , ztrmm , , )) 74 #define XTRSM LAPACK(ARITH(htrsm , ktrsm , strsm , ctrsm , dtrsm , ztrsm , , )) 75 #define XHEMM LAPACK(ARITH(hsymm , khemm , ssymm , chemm , dsymm , zhemm , , )) 76 #define XHEMV LAPACK(ARITH(hsymv , khemv , ssymv , chemv , dsymv , zhemv , , )) 77 #define XAXPY LAPACK(ARITH(haxpy , kaxpy , saxpy , caxpy , daxpy , zaxpy , , )) 78 #define XGEMV LAPACK(ARITH(hgemv , kgemv , sgemv , cgemv , dgemv , zgemv , , )) 79 #define XDOT LAPACK(ARITH(hdot , , sdot , , ddot , , , )) 80 #define XSCAL LAPACK(ARITH(hscal , kscal , sscal , cscal , dscal , zscal , , )) 81 #define XLARNV LAPACK(ARITH(hlarnv, klarnv, slarnv, clarnv, dlarnv, zlarnv, , )) 82 #define XHEEV LAPACK(ARITH(hsyev , kheev , ssyev , cheev , dsyev , zheev , , )) 83 #define XHEEVX LAPACK(ARITH(hsyevx, kheevx, ssyevx, cheevx, dsyevx, zheevx, , )) 84 #define XGEES LAPACK(ARITH(hgees , kgees , sgees , cgees , dgees , zgees , , )) 85 #define XHEGV LAPACK(ARITH(hsygv , khegv , ssygv , chegv , dsygv , zhegv , , )) 86 #define XGESV LAPACK(ARITH(hgesv , kgesv , sgesv , cgesv , dgesv , zgesv , , )) 87 #define XHEGVX LAPACK(ARITH(hsygvx, khegvx, ssygvx, chegvx, dsygvx, zhegvx, , )) 88 #define XGESVD LAPACK(ARITH(hgesvd, kgesvd, sgesvd, cgesvd, dgesvd, zgesvd, , )) 89 #define XHETRF LAPACK(ARITH(hsytrf, khetrf, ssytrf, chetrf, dsytrf, zhetrf, , )) 90 #define XHETRS LAPACK(ARITH(hsytrs, khetrs, ssytrs, chetrs, dsytrs, zhetrs, , )) 91 #define XPOTRF LAPACK(ARITH(hpotrf, kpotrf, spotrf, cpotrf, dpotrf, zpotrf, , )) 92 #define XGETRF LAPACK(ARITH(hgetrf, kgetrf, sgetrf, cgetrf, dgetrf, zgetrf, , )) 93 #define XGETRS LAPACK(ARITH(hgetrs, kgetrs, sgetrs, cgetrs, dgetrs, zgetrs, , )) 94 95 #define STRING const char * 96 97 #endif /* NUMERICAL_PRIVATE_H */ 98 99 // This is a temporary hack for avoiding warnings when CRAN package is built 100 // with LTO. Next R version includes a mechanism to opt out LTO. 101 // The hack consists in using R BLAS functions declarations instead of our own. 102 103 #ifdef BLASSCALAR 104 # undef BLASSCALAR 105 #endif 106 #if defined(PRIMME_BLAS_RCOMPLEX) 107 # ifndef CHECK_TEMPLATE 108 # include <R_ext/BLAS.h> 109 # endif 110 # ifndef USE_COMPLEX 111 # define BLASSCALAR SCALAR 112 # else 113 # define BLASSCALAR Rcomplex 114 # endif 115 #else 116 # define BLASSCALAR SCALAR 117 #endif 118 119 120 #if (!defined(USE_HALF) && !defined(USE_HALFCOMPLEX)) || defined(BLASLAPACK_WITH_HALF) 121 122 #ifdef __cplusplus 123 extern "C" { 124 #endif /* __cplusplus */ 125 126 127 #ifndef PRIMME_BLAS_RCOMPLEX 128 void XCOPY(PRIMME_BLASINT *n, const SCALAR *x, PRIMME_BLASINT *incx, SCALAR *y, PRIMME_BLASINT *incy); 129 void XSWAP(PRIMME_BLASINT *n, SCALAR *x, PRIMME_BLASINT *incx, SCALAR *y, PRIMME_BLASINT *incy); 130 void XGEMM(STRING transa, STRING transb, PRIMME_BLASINT *m, PRIMME_BLASINT *n, PRIMME_BLASINT *k, const BLASSCALAR *alpha, const SCALAR *a, PRIMME_BLASINT *lda, const SCALAR *b, PRIMME_BLASINT *ldb, const SCALAR *beta, SCALAR *c, PRIMME_BLASINT *ldc); 131 void XGEMV(STRING transa, PRIMME_BLASINT *m, PRIMME_BLASINT *n, const SCALAR *alpha, const SCALAR *a, PRIMME_BLASINT *lda, const SCALAR *x, PRIMME_BLASINT *incx, const SCALAR *beta, SCALAR *y, PRIMME_BLASINT *incy); 132 void XTRMM(STRING side, STRING uplo, STRING transa, STRING diag, PRIMME_BLASINT *m, PRIMME_BLASINT *n, const SCALAR *alpha, const SCALAR *a, PRIMME_BLASINT *lda, SCALAR *b, PRIMME_BLASINT *ldb); 133 void XTRSM(STRING side, STRING uplo, STRING transa, STRING diag, PRIMME_BLASINT *m, PRIMME_BLASINT *n, SCALAR *alpha, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *b, PRIMME_BLASINT *ldb); 134 void XHEMM(STRING side, STRING uplo, PRIMME_BLASINT *m, PRIMME_BLASINT *n, const SCALAR *alpha, const SCALAR *a, PRIMME_BLASINT *lda, const SCALAR *b, PRIMME_BLASINT *ldb, const SCALAR *beta, SCALAR *c, PRIMME_BLASINT *ldc); 135 void XHEMV(STRING uplo, PRIMME_BLASINT *n, SCALAR *alpha, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *x, PRIMME_BLASINT *lncx, SCALAR *beta, SCALAR *y, PRIMME_BLASINT *lncy); 136 void XAXPY(PRIMME_BLASINT *n, const SCALAR *alpha, const SCALAR *x, PRIMME_BLASINT *incx, SCALAR *y, PRIMME_BLASINT *incy); 137 void XSCAL(PRIMME_BLASINT *n, const SCALAR *alpha, SCALAR *x, PRIMME_BLASINT *incx); 138 # ifndef USE_COMPLEX 139 SCALAR XDOT(PRIMME_BLASINT *n, const SCALAR *x, PRIMME_BLASINT *incx, SCALAR *y, PRIMME_BLASINT *incy); 140 # endif /* USE_COMPLEX */ 141 #endif /* PRIMME_BLAS_RCOMPLEX */ 142 143 #ifndef USE_COMPLEX 144 void XHEEV(STRING jobz, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *w, SCALAR *work, PRIMME_BLASINT *ldwork, PRIMME_BLASINT *info); 145 void XHEEVX(STRING jobz, STRING range, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *vl, SCALAR *vu, PRIMME_BLASINT *il, PRIMME_BLASINT *iu, SCALAR *abstol, PRIMME_BLASINT *m, SCALAR *w, SCALAR *z, PRIMME_BLASINT *ldz, SCALAR *work, PRIMME_BLASINT *ldwork, PRIMME_BLASINT *iwork, PRIMME_BLASINT *ifail, PRIMME_BLASINT *info); 146 void XHEGV(PRIMME_BLASINT *itype, STRING jobz, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *b, PRIMME_BLASINT *ldb, SCALAR *w, SCALAR *work, PRIMME_BLASINT *ldwork, PRIMME_BLASINT *info); 147 void XHEGVX(PRIMME_BLASINT *itype, STRING jobz, STRING range, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *b, PRIMME_BLASINT *ldb, SCALAR *vl, SCALAR *vu, PRIMME_BLASINT *il, PRIMME_BLASINT *iu, SCALAR *abstol, PRIMME_BLASINT *m, SCALAR *w, SCALAR *z, PRIMME_BLASINT *ldz, SCALAR *work, PRIMME_BLASINT *ldwork, PRIMME_BLASINT *iwork, PRIMME_BLASINT *ifail, PRIMME_BLASINT *info); 148 void XGESVD(STRING jobu, STRING jobvt, PRIMME_BLASINT *m, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *s, SCALAR *u, PRIMME_BLASINT *ldu, SCALAR *vt, PRIMME_BLASINT *ldvt, SCALAR *work, PRIMME_BLASINT *ldwork, PRIMME_BLASINT *info); 149 #else 150 void XHEEV(STRING jobz, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, REAL *w, SCALAR *work, PRIMME_BLASINT *ldwork, REAL *rwork, PRIMME_BLASINT *info); 151 void XHEEVX(STRING jobz, STRING range, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, REAL *vl, REAL *vu, PRIMME_BLASINT *il, PRIMME_BLASINT *iu, REAL *abstol, PRIMME_BLASINT *m, REAL *w, SCALAR *z, PRIMME_BLASINT *ldz, SCALAR *work, PRIMME_BLASINT *ldwork, REAL *rwork, PRIMME_BLASINT *iwork, PRIMME_BLASINT *ifail, PRIMME_BLASINT *info); 152 void XGEES(STRING jobvs, STRING uplo, void *, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *sdim, SCALAR *w, SCALAR *vs, PRIMME_BLASINT *ldvs, SCALAR *work, PRIMME_BLASINT *ldwork, REAL *rwork, PRIMME_BLASINT *bwork, PRIMME_BLASINT *info); 153 void XHEGV(PRIMME_BLASINT *itype, STRING jobz, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *b, PRIMME_BLASINT *ldb, REAL *w, SCALAR *work, PRIMME_BLASINT *ldwork, REAL *rwork, PRIMME_BLASINT *info); 154 void XHEGVX(PRIMME_BLASINT *itype, STRING jobz, STRING range, STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, SCALAR *b, PRIMME_BLASINT *ldb, REAL *vl, REAL *vu, PRIMME_BLASINT *il, PRIMME_BLASINT *iu, REAL *abstol, PRIMME_BLASINT *m, REAL *w, SCALAR *z, PRIMME_BLASINT *ldz, SCALAR *work, PRIMME_BLASINT *ldwork, REAL *rwork, PRIMME_BLASINT *iwork, PRIMME_BLASINT *ifail, PRIMME_BLASINT *info); 155 void XGESVD(STRING jobu, STRING jobvt, PRIMME_BLASINT *m, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, REAL *s, SCALAR *u, PRIMME_BLASINT *ldu, SCALAR *vt, PRIMME_BLASINT *ldvt, SCALAR *work, PRIMME_BLASINT *ldwork, REAL *rwork, PRIMME_BLASINT *info); 156 #endif 157 void XGESV(PRIMME_BLASINT *n, PRIMME_BLASINT *nrhs, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *ipiv, SCALAR *b, PRIMME_BLASINT *ldb, PRIMME_BLASINT *info); 158 void XLARNV(PRIMME_BLASINT *idist, PRIMME_BLASINT *iseed, PRIMME_BLASINT *n, SCALAR *x); 159 void XHETRF(STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *ipivot, SCALAR *work, PRIMME_BLASINT *ldwork, PRIMME_BLASINT *info); 160 void XHETRS(STRING uplo, PRIMME_BLASINT *n, PRIMME_BLASINT *nrhs, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *ipivot, SCALAR *b, PRIMME_BLASINT *ldb, PRIMME_BLASINT *info); 161 void XPOTRF(STRING uplo, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *info); 162 void XGETRF(PRIMME_BLASINT *m, PRIMME_BLASINT *n, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *ipivot, PRIMME_BLASINT *info); 163 void XGETRS(STRING trans, PRIMME_BLASINT *n, PRIMME_BLASINT *nrhs, SCALAR *a, PRIMME_BLASINT *lda, PRIMME_BLASINT *ipivot, SCALAR *b, PRIMME_BLASINT *ldb, PRIMME_BLASINT *info); 164 165 #ifdef __cplusplus 166 } 167 #endif /* __cplusplus */ 168 169 #endif /* (!defined(USE_HALF) && !defined(USE_HALFCOMPLEX)) || defined(BLASLAPACK_WITH_HALF) */ 170