Teuchos_BLAS.cpp

00001 // @HEADER
00002 // ***********************************************************************
00003 // 
00004 //                    Teuchos: Common Tools Package
00005 //                 Copyright (2004) Sandia Corporation
00006 // 
00007 // Under terms of Contract DE-AC04-94AL85000, there is a non-exclusive
00008 // license for use of this work by or on behalf of the U.S. Government.
00009 // 
00010 // This library is free software; you can redistribute it and/or modify
00011 // it under the terms of the GNU Lesser General Public License as
00012 // published by the Free Software Foundation; either version 2.1 of the
00013 // License, or (at your option) any later version.
00014 //  
00015 // This library is distributed in the hope that it will be useful, but
00016 // WITHOUT ANY WARRANTY; without even the implied warranty of
00017 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00018 // Lesser General Public License for more details.
00019 //  
00020 // You should have received a copy of the GNU Lesser General Public
00021 // License along with this library; if not, write to the Free Software
00022 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
00023 // USA
00024 // Questions? Contact Michael A. Heroux (maherou@sandia.gov) 
00025 // 
00026 // ***********************************************************************
00027 // @HEADER
00028 
00029 #include "Teuchos_BLAS.hpp"
00030 #include "Teuchos_BLAS_wrappers.hpp"
00031 
00032 #ifdef TEUCHOS_BLAS_APPLE_VECLIB_ERROR
00033 #include <vecLib/cblas.h>
00034 #endif
00035 
00036 const char Teuchos::ESideChar[] = {'L' , 'R' };
00037 const char Teuchos::ETranspChar[] = {'N' , 'T' , 'C' };
00038 const char Teuchos::EUploChar[] = {'U' , 'L' };
00039 const char Teuchos::EDiagChar[] = {'U' , 'N' };
00040 //const char Teuchos::EFactChar[] = {'F', 'N' };
00041 //const char Teuchos::ENormChar[] = {'O', 'I' };
00042 //const char Teuchos::ECompQChar[] = {'N', 'I', 'V' };
00043 //const char Teuchos::EJobChar[] = {'E', 'V', 'B' };
00044 //const char Teuchos::EJobSChar[] = {'E', 'S' };
00045 //const char Teuchos::EJobVSChar[] = {'V', 'N' };
00046 //const char Teuchos::EHowmnyChar[] = {'A', 'S' };
00047 //const char Teuchos::ECMachChar[] = {'E', 'S', 'B', 'P', 'N', 'R', 'M', 'U', 'L', 'O' };
00048 //const char Teuchos::ESortChar[] = {'N', 'S'};
00049 
00050 namespace Teuchos {
00051 
00052 #ifdef HAVE_TEUCHOS_BLASFLOAT
00053 
00054   // *************************** BLAS<int,float> DEFINITIONS ******************************  
00055 
00056   void BLAS<int, float>::ROTG(float* da, float* db, float* c, float* s) const
00057   { SROTG_F77(da, db, c, s ); }
00058 
00059   void BLAS<int, float>::ROT(const int n, float* dx, const int incx, float* dy, const int incy, float* c, float* s) const
00060   { SROT_F77(&n, dx, &incx, dy, &incy, c, s); }
00061 
00062   
00063   float BLAS<int, float>::ASUM(const int n, const float* x, const int incx) const
00064   {
00065     float tmp = SASUM_F77(&n, x, &incx);
00066     return tmp;
00067   }
00068     
00069   void BLAS<int, float>::AXPY(const int n, const float alpha, const float* x, const int incx, float* y, const int incy) const
00070   { SAXPY_F77(&n, &alpha, x, &incx, y, &incy); }
00071   
00072   void BLAS<int, float>::COPY(const int n, const float* x, const int incx, float* y, const int incy) const 
00073   { SCOPY_F77(&n, x, &incx, y, &incy); }
00074   
00075   float BLAS<int, float>::DOT(const int n, const float* x, const int incx, const float* y, const int incy) const
00076   { return SDOT_F77(&n, x, &incx, y, &incy); }
00077   
00078   int BLAS<int, float>::IAMAX(const int n, const float* x, const int incx) const
00079   { return ISAMAX_F77(&n, x, &incx); }
00080 
00081   float BLAS<int, float>::NRM2(const int n, const float* x, const int incx) const
00082   { return SNRM2_F77(&n, x, &incx); }
00083   
00084   void BLAS<int, float>::SCAL(const int n, const float alpha, float* x, const int incx) const
00085   { SSCAL_F77(&n, &alpha, x, &incx); }
00086   
00087   void BLAS<int, float>::GEMV(ETransp trans, const int m, const int n, const float alpha, const float* A, const int lda, const float* x, const int incx, const float beta, float* y, const int incy) const
00088   { SGEMV_F77(CHAR_MACRO(ETranspChar[trans]), &m, &n, &alpha, A, &lda, x, &incx, &beta, y, &incy); }
00089   
00090   void BLAS<int, float>::GER(const int m, const int n, const float alpha, const float* x, const int incx, const float* y, const int incy, float* A, const int lda) const
00091   { SGER_F77(&m, &n, &alpha, x, &incx, y, &incy, A, &lda); }
00092 
00093   void BLAS<int, float>::TRMV(EUplo uplo, ETransp trans, EDiag diag, const int n, const float* A, const int lda, float* x, const int incx) const
00094   { STRMV_F77(CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[trans]), CHAR_MACRO(EDiagChar[diag]), &n, A, &lda, x, &incx); }
00095   
00096   void BLAS<int, float>::GEMM(ETransp transa, ETransp transb, const int m, const int n, const int k, const float alpha, const float* A, const int lda, const float* B, const int ldb, const float beta, float* C, const int ldc) const
00097   { SGEMM_F77(CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(ETranspChar[transb]), &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00098   
00099   void BLAS<int, float>::SYMM(ESide side, EUplo uplo, const int m, const int n, const float alpha, const float* A, const int lda, const float* B, const int ldb, const float beta, float* C, const int ldc) const
00100   { SSYMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), &m, &n, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00101   
00102   void BLAS<int, float>::TRMM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const float alpha, const float* A, const int lda, float* B, const int ldb) const
00103   { STRMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00104   
00105   void BLAS<int, float>::TRSM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const float alpha, const float* A, const int lda, float* B, const int ldb) const
00106   { STRSM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00107 
00108 #endif // HAVE_TEUCHOS_BLASFLOAT
00109 
00110   // *************************** BLAS<int,double> DEFINITIONS ******************************  
00111   
00112   void BLAS<int, double>::ROTG(double* da, double* db, double* c, double* s) const
00113   { DROTG_F77(da, db, c, s); }
00114 
00115   void BLAS<int, double>::ROT(const int n, double* dx, const int incx, double* dy, const int incy, double* c, double* s) const
00116   { DROT_F77(&n, dx, &incx, dy, &incy, c, s); }
00117 
00118   double BLAS<int, double>::ASUM(const int n, const double* x, const int incx) const
00119   { return DASUM_F77(&n, x, &incx); }
00120   
00121   void BLAS<int, double>::AXPY(const int n, const double alpha, const double* x, const int incx, double* y, const int incy) const
00122   { DAXPY_F77(&n, &alpha, x, &incx, y, &incy); }
00123   
00124   void BLAS<int, double>::COPY(const int n, const double* x, const int incx, double* y, const int incy) const
00125   { DCOPY_F77(&n, x, &incx, y, &incy); }
00126   
00127   double BLAS<int, double>::DOT(const int n, const double* x, const int incx, const double* y, const int incy) const
00128   { return DDOT_F77(&n, x, &incx, y, &incy); }
00129   
00130   int BLAS<int, double>::IAMAX(const int n, const double* x, const int incx) const
00131   { return IDAMAX_F77(&n, x, &incx); }
00132 
00133   double BLAS<int, double>::NRM2(const int n, const double* x, const int incx) const
00134   { return DNRM2_F77(&n, x, &incx); }
00135   
00136   void BLAS<int, double>::SCAL(const int n, const double alpha, double* x, const int incx) const
00137   { DSCAL_F77(&n, &alpha, x, &incx); }
00138   
00139   void BLAS<int, double>::GEMV(ETransp trans, const int m, const int n, const double alpha, const double* A, const int lda, const double* x, const int incx, const double beta, double* y, const int incy) const
00140   { DGEMV_F77(CHAR_MACRO(ETranspChar[trans]), &m, &n, &alpha, A, &lda, x, &incx, &beta, y, &incy); }
00141   
00142   void BLAS<int, double>::GER(const int m, const int n, const double alpha, const double* x, const int incx, const double* y, const int incy, double* A, const int lda) const
00143   { DGER_F77(&m, &n, &alpha, x, &incx, y, &incy, A, &lda); }
00144 
00145   void BLAS<int, double>::TRMV(EUplo uplo, ETransp trans, EDiag diag, const int n, const double* A, const int lda, double* x, const int incx) const
00146   { DTRMV_F77(CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[trans]), CHAR_MACRO(EDiagChar[diag]), &n, A, &lda, x, &incx); }
00147   
00148   void BLAS<int, double>::GEMM(ETransp transa, ETransp transb, const int m, const int n, const int k, const double alpha, const double* A, const int lda, const double* B, const int ldb, const double beta, double* C, const int ldc) const
00149   { DGEMM_F77(CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(ETranspChar[transb]), &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00150   
00151   void BLAS<int, double>::SYMM(ESide side, EUplo uplo, const int m, const int n, const double alpha, const double* A, const int lda, const double *B, const int ldb, const double beta, double *C, const int ldc) const
00152   { DSYMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), &m, &n, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00153   
00154   void BLAS<int, double>::TRMM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const double alpha, const double* A, const int lda, double* B, const int ldb) const
00155   { DTRMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00156 
00157   void BLAS<int, double>::TRSM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const double alpha, const double* A, const int lda, double* B, const int ldb) const
00158   { DTRSM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00159   
00160 #ifdef HAVE_TEUCHOS_COMPLEX
00161 
00162 #ifdef HAVE_TEUCHOS_BLASFLOAT
00163 
00164   // *************************** BLAS<int,std::complex<float> > DEFINITIONS ******************************  
00165 
00166   void BLAS<int, std::complex<float> >::ROTG(std::complex<float>* da, std::complex<float>* db, float* c, std::complex<float>* s) const
00167   { CROTG_F77(da, db, c, s ); }
00168 
00169   void BLAS<int, std::complex<float> >::ROT(const int n, std::complex<float>* dx, const int incx, std::complex<float>* dy, const int incy, float* c, std::complex<float>* s) const
00170   { CROT_F77(&n, dx, &incx, dy, &incy, c, s); }
00171 
00172   float BLAS<int, std::complex<float> >::ASUM(const int n, const std::complex<float>* x, const int incx) const
00173   { return CASUM_F77(&n, x, &incx); }
00174   
00175   void BLAS<int, std::complex<float> >::AXPY(const int n, const std::complex<float> alpha, const std::complex<float>* x, const int incx, std::complex<float>* y, const int incy) const
00176   { CAXPY_F77(&n, &alpha, x, &incx, y, &incy); }
00177   
00178   void BLAS<int, std::complex<float> >::COPY(const int n, const std::complex<float>* x, const int incx, std::complex<float>* y, const int incy) const
00179   { CCOPY_F77(&n, x, &incx, y, &incy); }
00180   
00181   std::complex<float> BLAS<int, std::complex<float> >::DOT(const int n, const std::complex<float>* x, const int incx, const std::complex<float>* y, const int incy) const
00182   { 
00183 #ifdef TEUCHOS_BLAS_APPLE_VECLIB_ERROR
00184     std::complex<float> z;
00185     cblas_cdotc_sub(n,x,incx,y,incy,&z);
00186     return z;
00187 #else
00188     return CDOT_F77(&n, x, &incx, y, &incy); 
00189 #endif
00190   }
00191   
00192   int BLAS<int, std::complex<float> >::IAMAX(const int n, const std::complex<float>* x, const int incx) const
00193   { return ICAMAX_F77(&n, x, &incx); }
00194 
00195   float BLAS<int, std::complex<float> >::NRM2(const int n, const std::complex<float>* x, const int incx) const
00196   { return CNRM2_F77(&n, x, &incx); }
00197   
00198   void BLAS<int, std::complex<float> >::SCAL(const int n, const std::complex<float> alpha, std::complex<float>* x, const int incx) const
00199   { CSCAL_F77(&n, &alpha, x, &incx); }
00200   
00201   void BLAS<int, std::complex<float> >::GEMV(ETransp trans, const int m, const int n, const std::complex<float> alpha, const std::complex<float>* A, const int lda, const std::complex<float>* x, const int incx, const std::complex<float> beta, std::complex<float>* y, const int incy) const
00202   { CGEMV_F77(CHAR_MACRO(ETranspChar[trans]), &m, &n, &alpha, A, &lda, x, &incx, &beta, y, &incy); }
00203   
00204   void BLAS<int, std::complex<float> >::GER(const int m, const int n, const std::complex<float> alpha, const std::complex<float>* x, const int incx, const std::complex<float>* y, const int incy, std::complex<float>* A, const int lda) const
00205   { CGER_F77(&m, &n, &alpha, x, &incx, y, &incy, A, &lda); }
00206 
00207   void BLAS<int, std::complex<float> >::TRMV(EUplo uplo, ETransp trans, EDiag diag, const int n, const std::complex<float>* A, const int lda, std::complex<float>* x, const int incx) const
00208   { CTRMV_F77(CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[trans]), CHAR_MACRO(EDiagChar[diag]), &n, A, &lda, x, &incx); }
00209   
00210   void BLAS<int, std::complex<float> >::GEMM(ETransp transa, ETransp transb, const int m, const int n, const int k, const std::complex<float> alpha, const std::complex<float>* A, const int lda, const std::complex<float>* B, const int ldb, const std::complex<float> beta, std::complex<float>* C, const int ldc) const
00211   { CGEMM_F77(CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(ETranspChar[transb]), &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); } 
00212  
00213   void BLAS<int, std::complex<float> >::SYMM(ESide side, EUplo uplo, const int m, const int n, const std::complex<float> alpha, const std::complex<float>* A, const int lda, const std::complex<float>* B, const int ldb, const std::complex<float> beta, std::complex<float>* C, const int ldc) const
00214   { CSYMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), &m, &n, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00215   
00216   void BLAS<int, std::complex<float> >::TRMM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const std::complex<float> alpha, const std::complex<float>* A, const int lda, std::complex<float>* B, const int ldb) const
00217   { CTRMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00218   
00219   void BLAS<int, std::complex<float> >::TRSM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const std::complex<float> alpha, const std::complex<float>* A, const int lda, std::complex<float>* B, const int ldb) const
00220   { CTRSM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00221 
00222 #endif // HAVE_TEUCHOS_BLASFLOAT
00223 
00224   // *************************** BLAS<int,std::complex<double> > DEFINITIONS ******************************  
00225 
00226   void BLAS<int, std::complex<double> >::ROTG(std::complex<double>* da, std::complex<double>* db, double* c, std::complex<double>* s) const
00227   { ZROTG_F77(da, db, c, s); }
00228 
00229   void BLAS<int, std::complex<double> >::ROT(const int n, std::complex<double>* dx, const int incx, std::complex<double>* dy, const int incy, double* c, std::complex<double>* s) const
00230   { ZROT_F77(&n, dx, &incx, dy, &incy, c, s); }
00231 
00232   double BLAS<int, std::complex<double> >::ASUM(const int n, const std::complex<double>* x, const int incx) const
00233   { return ZASUM_F77(&n, x, &incx); }
00234   
00235   void BLAS<int, std::complex<double> >::AXPY(const int n, const std::complex<double> alpha, const std::complex<double>* x, const int incx, std::complex<double>* y, const int incy) const
00236   { ZAXPY_F77(&n, &alpha, x, &incx, y, &incy); }
00237   
00238   void BLAS<int, std::complex<double> >::COPY(const int n, const std::complex<double>* x, const int incx, std::complex<double>* y, const int incy) const
00239   { ZCOPY_F77(&n, x, &incx, y, &incy); }
00240   
00241   std::complex<double> BLAS<int, std::complex<double> >::DOT(const int n, const std::complex<double>* x, const int incx, const std::complex<double>* y, const int incy) const
00242   { 
00243 #ifdef TEUCHOS_BLAS_APPLE_VECLIB_ERROR
00244     std::complex<double> z;
00245     cblas_zdotc_sub(n,x,incx,y,incy,&z);
00246     return z;
00247 #else
00248     return ZDOT_F77(&n, x, &incx, y, &incy); 
00249 #endif
00250   }
00251   
00252   int BLAS<int, std::complex<double> >::IAMAX(const int n, const std::complex<double>* x, const int incx) const
00253   { return IZAMAX_F77(&n, x, &incx); }
00254 
00255   double BLAS<int, std::complex<double> >::NRM2(const int n, const std::complex<double>* x, const int incx) const
00256   { return ZNRM2_F77(&n, x, &incx); }
00257   
00258   void BLAS<int, std::complex<double> >::SCAL(const int n, const std::complex<double> alpha, std::complex<double>* x, const int incx) const
00259   { ZSCAL_F77(&n, &alpha, x, &incx); }
00260   
00261   void BLAS<int, std::complex<double> >::GEMV(ETransp trans, const int m, const int n, const std::complex<double> alpha, const std::complex<double>* A, const int lda, const std::complex<double>* x, const int incx, const std::complex<double> beta, std::complex<double>* y, const int incy) const
00262   { ZGEMV_F77(CHAR_MACRO(ETranspChar[trans]), &m, &n, &alpha, A, &lda, x, &incx, &beta, y, &incy); }
00263   
00264   void BLAS<int, std::complex<double> >::GER(const int m, const int n, const std::complex<double> alpha, const std::complex<double>* x, const int incx, const std::complex<double>* y, const int incy, std::complex<double>* A, const int lda) const
00265   { ZGER_F77(&m, &n, &alpha, x, &incx, y, &incy, A, &lda); }
00266 
00267   void BLAS<int, std::complex<double> >::TRMV(EUplo uplo, ETransp trans, EDiag diag, const int n, const std::complex<double>* A, const int lda, std::complex<double>* x, const int incx) const
00268   { ZTRMV_F77(CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[trans]), CHAR_MACRO(EDiagChar[diag]), &n, A, &lda, x, &incx); }
00269   
00270   void BLAS<int, std::complex<double> >::GEMM(ETransp transa, ETransp transb, const int m, const int n, const int k, const std::complex<double> alpha, const std::complex<double>* A, const int lda, const std::complex<double>* B, const int ldb, const std::complex<double> beta, std::complex<double>* C, const int ldc) const
00271   { ZGEMM_F77(CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(ETranspChar[transb]), &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00272   
00273   void BLAS<int, std::complex<double> >::SYMM(ESide side, EUplo uplo, const int m, const int n, const std::complex<double> alpha, const std::complex<double>* A, const int lda, const std::complex<double> *B, const int ldb, const std::complex<double> beta, std::complex<double> *C, const int ldc) const
00274   { ZSYMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), &m, &n, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }
00275   
00276   void BLAS<int, std::complex<double> >::TRMM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const std::complex<double> alpha, const std::complex<double>* A, const int lda, std::complex<double>* B, const int ldb) const
00277   { ZTRMM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00278 
00279   void BLAS<int, std::complex<double> >::TRSM(ESide side, EUplo uplo, ETransp transa, EDiag diag, const int m, const int n, const std::complex<double> alpha, const std::complex<double>* A, const int lda, std::complex<double>* B, const int ldb) const
00280   { ZTRSM_F77(CHAR_MACRO(ESideChar[side]), CHAR_MACRO(EUploChar[uplo]), CHAR_MACRO(ETranspChar[transa]), CHAR_MACRO(EDiagChar[diag]), &m, &n, &alpha, A, &lda, B, &ldb); }
00281   
00282 #endif // HAVE_TEUCHOS_COMPLEX
00283 
00284 }

Generated on Wed May 12 21:40:31 2010 for Teuchos - Trilinos Tools Package by  doxygen 1.4.7