Kokkos Node API and Local Linear Algebra Kernels Version of the Day
Tsqr_CLapack.cpp
00001 //@HEADER
00002 // ************************************************************************
00003 // 
00004 //          Kokkos: Node API and Parallel Node Kernels
00005 //              Copyright (2009) 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 <Tsqr_Lapack.hpp>
00030 #include <complex>
00031 
00032 
00033 extern "C" void F77_BLAS_MANGLE(clarnv, CLARNV)
00034   (const int* const IDIST,
00035    int ISEED[],
00036    const int* const N,
00037    std::complex<float> X[]);
00038 
00039 extern "C" void F77_BLAS_MANGLE(cpotri, CPOTRI)
00040   (const char* const UPLO,
00041    const int* const N,
00042    std::complex<float> A[],
00043    const int* const LDA,
00044    int* const INFO);
00045 
00046 extern "C" void F77_BLAS_MANGLE(cpotrf, CPOTRF)
00047   (const char* const UPLO,
00048    const int* const N,
00049    std::complex<float> A[],
00050    const int* const LDA,
00051    int* const INFO);
00052 
00053 extern "C" void F77_BLAS_MANGLE(cpotrs, CPOTRS)
00054   (const char* const UPLO,
00055    const int* const N,
00056    const int* const NRHS,
00057    const std::complex<float> A[],
00058    const int* const LDA,
00059    std::complex<float> B[],
00060    const int* const LDB,
00061    int* const INFO);
00062 
00063 #ifdef HAVE_LAPACK_CLARFGP
00064 extern "C" void F77_BLAS_MANGLE(clarfgp,CLARFGP)
00065   (const int* const N,                 // IN
00066    std::complex<float>* const ALPHA,   // IN/OUT
00067    std::complex<float> X[],            // IN/OUT
00068    const int* const INCX,              // IN
00069    std::complex<float>* const TAU);    // OUT
00070 #else
00071 #  ifdef HAVE_LAPACK_CLARFP
00072 extern "C" void F77_BLAS_MANGLE(clarfp,CLARFP)
00073   (const int* const N,                 // IN
00074    std::complex<float>* const ALPHA,   // IN/OUT
00075    std::complex<float> X[],            // IN/OUT
00076    const int* const INCX,              // IN
00077    std::complex<float>* const TAU);    // OUT
00078 #  else
00079 extern "C" void F77_BLAS_MANGLE(clarfg,CLARFG)
00080   (const int* const N,                 // IN
00081    std::complex<float>* const ALPHA,   // IN/OUT
00082    std::complex<float> X[],            // IN/OUT
00083    const int* const INCX,              // IN
00084    std::complex<float>* const TAU);    // OUT
00085 #  endif // HAVE_LAPACK_CLARFP
00086 #endif // HAVE_LAPACK_CLARFGP
00087 
00088 extern "C" void F77_BLAS_MANGLE(cgeqrf, CGEQRF)
00089   (const int* const M,
00090    const int* const N,
00091    std::complex<float> A[],
00092    const int* const LDA,
00093    std::complex<float> TAU[],
00094    std::complex<float> WORK[],
00095    const int* const LWORK,
00096    int* const INFO);
00097 
00098 #ifdef HAVE_LAPACK_CGEQRFP
00099 extern "C" void F77_BLAS_MANGLE(cgeqrfp, CGEQRFP)
00100   (const int* const M,
00101    const int* const N,
00102    std::complex<float> A[],
00103    const int* const LDA,
00104    std::complex<float> TAU[],
00105    std::complex<float> WORK[],
00106    const int* const LWORK,
00107    int* const INFO);
00108 #endif // HAVE_LAPACK_CGEQRFP
00109 
00110 extern "C" void F77_BLAS_MANGLE(cgeqr2, CGEQR2)
00111   (const int* const M,
00112    const int* const N,
00113    std::complex<float> A[],
00114    const int* const LDA,
00115    std::complex<float> TAU[],
00116    std::complex<float> WORK[],
00117    int* const INFO);
00118 
00119 #ifdef HAVE_LAPACK_CGEQR2P
00120 extern "C" void F77_BLAS_MANGLE(cgeqr2p, CGEQR2P)
00121   (const int* const M,
00122    const int* const N,
00123    std::complex<float> A[],
00124    const int* const LDA,
00125    std::complex<float> TAU[],
00126    std::complex<float> WORK[],
00127    int* const INFO);
00128 #endif // HAVE_LAPACK_CGEQR2P
00129 
00130 // In the complex case, Q is called UNitary rather than ORthogonal.
00131 // This is why we have ZUNGQR and CUNGQR, rather than ZORGQR and
00132 // CORGQR.  The interface is exactly the same as in the real case,
00133 // though, so our LAPACK::ORMQR(), etc. wrappers have the same name
00134 // for both the real and the complex cases.
00135 
00136 extern "C" void F77_BLAS_MANGLE(cungqr, CUNGQR)
00137   (const int* const M,
00138    const int* const N,
00139    const int* const K,
00140    std::complex<float> A[],
00141    const int* const LDA,
00142    std::complex<float> TAU[],
00143    std::complex<float> WORK[],
00144    const int* const LWORK,
00145    int* const INFO);
00146 
00147 extern "C" void F77_BLAS_MANGLE(cunmqr, CUNMQR)
00148   (const char* const SIDE,
00149    const char* const TRANS,
00150    const int* const M,
00151    const int* const N,
00152    const int* const K,
00153    const std::complex<float> A[],
00154    const int* const LDA,
00155    const std::complex<float> TAU[],
00156    std::complex<float> C[],
00157    const int* const LDC,
00158    std::complex<float> WORK[],
00159    const int* const LWORK,
00160    int* const INFO);
00161 
00162 extern "C" void F77_BLAS_MANGLE(cunm2r, CUNM2R)
00163   (const char* const SIDE,
00164    const char* const TRANS,
00165    const int* const M,
00166    const int* const N,
00167    const int* const K,
00168    const std::complex<float> A[],
00169    const int* const LDA,
00170    const std::complex<float> TAU[],
00171    std::complex<float> C[],
00172    const int* const LDC,
00173    std::complex<float> WORK[],
00174    int* const INFO);
00175 
00176 extern "C" void F77_BLAS_MANGLE(cgesvd, CGESVD) 
00177   (const char* const JOBU, 
00178    const char* const JOBVT, 
00179    const int* const M, 
00180    const int* const N, 
00181    std::complex<float> A[], 
00182    const int* const LDA,
00183    float S[], 
00184    std::complex<float> U[], 
00185    const int* const LDU, 
00186    std::complex<float> VT[], 
00187    const int* const LDVT, 
00188    std::complex<float> work[],
00189    const int* const LWORK,
00190    float RWORK[],
00191    int* const INFO);
00192 
00195 
00196 namespace TSQR {
00197 
00198   // If _GEQRFP is available, LAPACK::GEQRF() calls it.  If _LARFP is
00199   // available, LAPACK::GEQRF() calls _GEQRF, which uses _LARFP.
00200 #ifdef HAVE_LAPACK_CGEQRFP
00201   template <>
00202   bool LAPACK<int, std::complex<float> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00203 #else
00204 #  ifdef HAVE_LAPACK_CLARFP
00205   template <>
00206   bool LAPACK<int, std::complex<float> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00207 #  else
00208   template <>
00209   bool LAPACK<int, std::complex<float> >::QR_produces_R_factor_with_nonnegative_diagonal() { return false; }
00210 #  endif
00211 #endif
00212 
00214   // LARFP (implemented with _LARFGP if available, else with _LARFP if
00215   // available, else fall back to _LARFG)
00217   template <>
00218   void 
00219   LAPACK<int, std::complex<float> >::LARFP (const int n, 
00220               std::complex<float>& alpha, 
00221               std::complex<float> x[], 
00222               const int incx, 
00223               std::complex<float>& tau)
00224   {
00225 #ifdef HAVE_LAPACK_CLARFGP
00226     F77_BLAS_MANGLE(clarfgp,CLARFGP) (&n, &alpha, x, &incx, &tau);
00227 #else // Don't HAVE_LAPACK_CLARFGP
00228 #  ifdef HAVE_LAPACK_CLARFP
00229     F77_BLAS_MANGLE(clarfp,CLARFP) (&n, &alpha, x, &incx, &tau);
00230 #  else
00231     F77_BLAS_MANGLE(clarfg,CLARFG) (&n, &alpha, x, &incx, &tau);
00232 #  endif // HAVE_LAPACK_CLARFP
00233 #endif // HAVE_LAPACK_CLARFGP
00234   }
00235 
00237   // GEQRF (implemented with _GEQRFP if available, else fall back to _GEQRF)
00239   template <>
00240   void
00241   LAPACK<int, std::complex<float> >::GEQRF (const int m,
00242               const int n, 
00243               std::complex<float> A[],
00244               const int lda, 
00245               std::complex<float> tau[],
00246               std::complex<float> work[],
00247               const int lwork,
00248               int* const INFO)
00249   {
00250 #ifdef HAVE_LAPACK_CGEQRFP
00251     F77_BLAS_MANGLE(cgeqrfp, CGEQRFP) 
00252       (&m, &n, A, &lda, tau, work, &lwork, INFO);
00253 #else
00254     F77_BLAS_MANGLE(cgeqrf, CGEQRF) 
00255       (&m, &n, A, &lda, tau, work, &lwork, INFO);
00256 #endif // HAVE_LAPACK_CGEQRFP
00257   }
00258 
00260   // GEQR2 (implemented with _GEQR2P if available, else fall back to _GEQR2)
00262   template <>
00263   void
00264   LAPACK<int, std::complex<float> >::GEQR2 (const int m,
00265               const int n, 
00266               std::complex<float> A[],
00267               const int lda, 
00268               std::complex<float> tau[],
00269               std::complex<float> work[],
00270               int* const INFO)
00271   {
00272 #ifdef HAVE_LAPACK_CGEQR2P
00273     F77_BLAS_MANGLE(cgeqr2p, CGEQR2P) (&m, &n, A, &lda, tau, work, INFO);
00274 #else
00275     F77_BLAS_MANGLE(cgeqr2, CGEQR2) (&m, &n, A, &lda, tau, work, INFO);
00276 #endif // HAVE_LAPACK_CGEQR2P
00277   }
00278 
00279   template <>
00280   void
00281   LAPACK<int, std::complex<float> >::
00282   ORMQR (const char* const side,
00283    const char* const trans,
00284    const int m,
00285    const int n,
00286    const int k,
00287    const std::complex<float> A[],
00288    const int lda,
00289    const std::complex<float> tau[],
00290    std::complex<float> C[],
00291    const int ldc,
00292    std::complex<float> work[],
00293    const int lwork,
00294    int* const INFO)
00295   {
00296     F77_BLAS_MANGLE(cunmqr, CUNMQR) 
00297       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, &lwork, INFO);
00298   }
00299 
00300   template <>
00301   void
00302   LAPACK<int, std::complex<float> >::
00303   ORM2R (const char* const side,
00304    const char* const trans,
00305    const int m,
00306    const int n,
00307    const int k,
00308    const std::complex<float> A[],
00309    const int lda,
00310    const std::complex<float> tau[],
00311    std::complex<float> C[],
00312    const int ldc,
00313    std::complex<float> work[],
00314    int* const INFO)
00315   {
00316     F77_BLAS_MANGLE(cunm2r, CUNM2R) 
00317       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, INFO);
00318   }
00319 
00320   template <>
00321   void
00322   LAPACK<int, std::complex<float> >::
00323   ORGQR (const int m,
00324    const int n,
00325    const int k,
00326    std::complex<float> A[],
00327    const int lda,
00328    std::complex<float> tau[],
00329    std::complex<float> work[],
00330    const int lwork,
00331    int* const INFO)
00332   {
00333     F77_BLAS_MANGLE(cungqr, CUNGQR) 
00334       (&m, &n, &k, A, &lda, tau, work, &lwork, INFO);
00335   }
00336 
00337   template <>
00338   void
00339   LAPACK<int, std::complex<float> >::POTRF (const char* const uplo,
00340               const int n,
00341               std::complex<float> A[],
00342               const int lda,
00343               int* const INFO)
00344   {
00345     F77_BLAS_MANGLE(cpotrf, CPOTRF) (uplo, &n, A, &lda, INFO);
00346   }
00347 
00348   template <>
00349   void
00350   LAPACK<int, std::complex<float> >::POTRS (const char* const uplo,
00351               const int n,
00352               const int nrhs,
00353               const std::complex<float> A[],
00354               const int lda,
00355               std::complex<float> B[],
00356               const int ldb,
00357               int* const INFO)
00358   {
00359     F77_BLAS_MANGLE(cpotrs, CPOTRS) (uplo, &n, &nrhs, A, &lda, B, &ldb, INFO);
00360   }
00361 
00362   template <>
00363   void
00364   LAPACK<int, std::complex<float> >::POTRI (const char* const uplo, 
00365               const int n, 
00366               std::complex<float> A[], 
00367               const int lda, 
00368               int* const INFO)
00369   {
00370     F77_BLAS_MANGLE(cpotri, CPOTRI) (uplo, &n, A, &lda, INFO);
00371   }
00372 
00373   template <>
00374   void
00375   LAPACK<int, std::complex<float> >::LARNV (const int idist, 
00376               int iseed[],
00377               const int n,
00378               std::complex<float> x[])
00379   {
00380     F77_BLAS_MANGLE(clarnv, CLARNV) (&idist, iseed, &n, x);
00381   }
00382 
00383   template <>
00384   void
00385   LAPACK<int, std::complex<float> >::
00386   GESVD (const char* const jobu,
00387    const char* const jobvt,
00388    const int m,
00389    const int n,
00390    std::complex<float> A[],
00391    const int lda,
00392    float s[],
00393    std::complex<float> U[],
00394    const int ldu,
00395    std::complex<float> VT[],
00396    const int ldvt,
00397    std::complex<float> work[],
00398    const int lwork,
00399    float rwork[],
00400    int* const INFO)
00401   {
00402     F77_BLAS_MANGLE(cgesvd, CGESVD) (jobu, jobvt, &m, &n, 
00403              A, &lda, s, 
00404              U, &ldu, VT, &ldvt, 
00405              work, &lwork, rwork, INFO);
00406   }
00407 
00408 
00409 } // namespace TSQR
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends