Kokkos Node API and Local Linear Algebra Kernels Version of the Day
Tsqr_ZLapack.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(zlarnv, ZLARNV)
00034   (const int* const IDIST,
00035    int ISEED[],
00036    const int* const N,
00037    std::complex<double> X[]);
00038 
00039 extern "C" void F77_BLAS_MANGLE(zpotri, ZPOTRI)
00040   (const char* const UPLO,
00041    const int* const N,
00042    std::complex<double> A[],
00043    const int* const LDA,
00044    int* const INFO);
00045 
00046 extern "C" void F77_BLAS_MANGLE(zpotrf, ZPOTRF)
00047   (const char* const UPLO,
00048    const int* const N,
00049    std::complex<double> A[],
00050    const int* const LDA,
00051    int* const INFO);
00052 
00053 extern "C" void F77_BLAS_MANGLE(zpotrs, ZPOTRS)
00054   (const char* const UPLO,
00055    const int* const N,
00056    const int* const NRHS,
00057    const std::complex<double> A[],
00058    const int* const LDA,
00059    std::complex<double> B[],
00060    const int* const LDB,
00061    int* const INFO);
00062 
00063 #ifdef HAVE_LAPACK_ZLARFGP
00064 extern "C" void F77_BLAS_MANGLE(zlarfgp,ZLARFGP)
00065   (const int* const N,    // IN
00066    std::complex<double>* const ALPHA,   // IN/OUT
00067    std::complex<double> X[],            // IN/OUT
00068    const int* const INCX, // IN
00069    std::complex<double>* const TAU);    // OUT
00070 #else
00071 #  ifdef HAVE_LAPACK_ZLARFP
00072 extern "C" void F77_BLAS_MANGLE(zlarfp,ZLARFP)
00073   (const int* const N,    // IN
00074    std::complex<double>* const ALPHA,   // IN/OUT
00075    std::complex<double> X[],            // IN/OUT
00076    const int* const INCX, // IN
00077    std::complex<double>* const TAU);    // OUT
00078 #  else
00079 extern "C" void F77_BLAS_MANGLE(zlarfg,ZLARFG)
00080   (const int* const N,    // IN
00081    std::complex<double>* const ALPHA,   // IN/OUT
00082    std::complex<double> X[],            // IN/OUT
00083    const int* const INCX, // IN
00084    std::complex<double>* const TAU);    // OUT
00085 #  endif // HAVE_LAPACK_ZLARFP
00086 #endif // HAVE_LAPACK_ZLARFGP
00087 
00088 extern "C" void F77_BLAS_MANGLE(zgeqrf, ZGEQRF)
00089   (const int* const M,
00090    const int* const N,
00091    std::complex<double> A[],
00092    const int* const LDA,
00093    std::complex<double> TAU[],
00094    std::complex<double> WORK[],
00095    const int* const LWORK,
00096    int* const INFO);
00097 
00098 #ifdef HAVE_LAPACK_ZGEQRFP
00099 extern "C" void F77_BLAS_MANGLE(zgeqrfp, ZGEQRFP)
00100   (const int* const M,
00101    const int* const N,
00102    std::complex<double> A[],
00103    const int* const LDA,
00104    std::complex<double> TAU[],
00105    std::complex<double> WORK[],
00106    const int* const LWORK,
00107    int* const INFO);
00108 #endif // HAVE_LAPACK_ZGEQRFP
00109 
00110 extern "C" void F77_BLAS_MANGLE(zgeqr2, ZGEQR2)
00111   (const int* const M,
00112    const int* const N,
00113    std::complex<double> A[],
00114    const int* const LDA,
00115    std::complex<double> TAU[],
00116    std::complex<double> WORK[],
00117    int* const INFO);
00118 
00119 #ifdef HAVE_LAPACK_ZGEQR2P
00120 extern "C" void F77_BLAS_MANGLE(zgeqr2p, ZGEQR2P)
00121   (const int* const M,
00122    const int* const N,
00123    std::complex<double> A[],
00124    const int* const LDA,
00125    std::complex<double> TAU[],
00126    std::complex<double> WORK[],
00127    int* const INFO);
00128 #endif // HAVE_LAPACK_ZGEQR2P
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(zungqr, ZUNGQR)
00137   (const int* const M,
00138    const int* const N,
00139    const int* const K,
00140    std::complex<double> A[],
00141    const int* const LDA,
00142    std::complex<double> TAU[],
00143    std::complex<double> WORK[],
00144    const int* const LWORK,
00145    int* const INFO);
00146 
00147 extern "C" void F77_BLAS_MANGLE(zunmqr, ZUNMQR)
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<double> A[],
00154    const int* const LDA,
00155    const std::complex<double> TAU[],
00156    std::complex<double> C[],
00157    const int* const LDC,
00158    std::complex<double> WORK[],
00159    const int* const LWORK,
00160    int* const INFO);
00161 
00162 extern "C" void F77_BLAS_MANGLE(zunm2r, ZUNM2R)
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<double> A[],
00169    const int* const LDA,
00170    const std::complex<double> TAU[],
00171    std::complex<double> C[],
00172    const int* const LDC,
00173    std::complex<double> WORK[],
00174    int* const INFO);
00175 
00176 extern "C" void F77_BLAS_MANGLE(zgesvd, ZGESVD) 
00177   (const char* const JOBU, 
00178    const char* const JOBVT, 
00179    const int* const M, 
00180    const int* const N, 
00181    std::complex<double> A[], 
00182    const int* const LDA,
00183    double S[], 
00184    std::complex<double> U[], 
00185    const int* const LDU, 
00186    std::complex<double> VT[], 
00187    const int* const LDVT, 
00188    std::complex<double> work[],
00189    const int* const LWORK,
00190    double 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_ZGEQRFP
00201   template <>
00202   bool LAPACK<int, std::complex<double> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00203 #else
00204 #  ifdef HAVE_LAPACK_ZLARFP
00205   template <>
00206   bool LAPACK<int, std::complex<double> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00207 #  else
00208   template <>
00209   bool LAPACK<int, std::complex<double> >::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<double> >::
00220   LARFP (const int n, 
00221    std::complex<double>& alpha, 
00222    std::complex<double> x[], 
00223    const int incx, 
00224    std::complex<double>& tau)
00225   {
00226 #ifdef HAVE_LAPACK_ZLARFGP
00227     F77_BLAS_MANGLE(zlarfgp,ZLARFGP) (&n, &alpha, x, &incx, &tau);
00228 #else // Don't HAVE_LAPACK_CLARFGP
00229 #  ifdef HAVE_LAPACK_ZLARFP
00230     F77_BLAS_MANGLE(zlarfp,ZLARFP) (&n, &alpha, x, &incx, &tau);
00231 #  else
00232     F77_BLAS_MANGLE(zlarfg,ZLARFG) (&n, &alpha, x, &incx, &tau);
00233 #  endif // HAVE_LAPACK_ZLARFP
00234 #endif // HAVE_LAPACK_ZLARFGP
00235   }
00236 
00238   // GEQRF (implemented with _GEQRFP if available, else fall back to _GEQRF)
00240   template <>
00241   void
00242   LAPACK<int, std::complex<double> >::
00243   GEQRF (const int m,
00244    const int n, 
00245    std::complex<double> A[],
00246    const int lda, 
00247    std::complex<double> tau[],
00248    std::complex<double> work[],
00249    const int lwork,
00250    int* const INFO)
00251   {
00252 #ifdef HAVE_LAPACK_ZGEQRFP
00253     F77_BLAS_MANGLE(zgeqrfp, ZGEQRFP) (&m, &n, A, &lda, tau, work, &lwork, INFO);
00254 #else
00255     F77_BLAS_MANGLE(zgeqrf, ZGEQRF) (&m, &n, A, &lda, tau, work, &lwork, INFO);
00256 #endif // HAVE_LAPACK_ZGEQRFP
00257   }
00258 
00260   // GEQR2 (implemented with _GEQR2P if available, else fall back to _GEQR2)
00262   template <>
00263   void
00264   LAPACK<int, std::complex<double> >::
00265   GEQR2 (const int m,
00266    const int n, 
00267    std::complex<double> A[],
00268    const int lda, 
00269    std::complex<double> tau[],
00270    std::complex<double> work[],
00271    int* const INFO)
00272   {
00273 #ifdef HAVE_LAPACK_ZGEQR2P
00274     F77_BLAS_MANGLE(zgeqr2p, ZGEQR2P) (&m, &n, A, &lda, tau, work, INFO);
00275 #else
00276     F77_BLAS_MANGLE(zgeqr2, ZGEQR2) (&m, &n, A, &lda, tau, work, INFO);
00277 #endif // HAVE_LAPACK_ZGEQR2P
00278   }
00279 
00280   template <>
00281   void
00282   LAPACK<int, std::complex<double> >::
00283   ORMQR (const char* const side,
00284    const char* const trans,
00285    const int m,
00286    const int n,
00287    const int k,
00288    const std::complex<double> A[],
00289    const int lda,
00290    const std::complex<double> tau[],
00291    std::complex<double> C[],
00292    const int ldc,
00293    std::complex<double> work[],
00294    const int lwork,
00295    int* const INFO)
00296   {
00297     F77_BLAS_MANGLE(zunmqr, ZUNMQR) 
00298       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, &lwork, INFO);
00299   }
00300 
00301   template <>
00302   void
00303   LAPACK<int, std::complex<double> >::
00304   ORM2R (const char* const side,
00305    const char* const trans,
00306    const int m,
00307    const int n,
00308    const int k,
00309    const std::complex<double> A[],
00310    const int lda,
00311    const std::complex<double> tau[],
00312    std::complex<double> C[],
00313    const int ldc,
00314    std::complex<double> work[],
00315    int* const INFO)
00316   {
00317     F77_BLAS_MANGLE(zunm2r, ZUNM2R) 
00318       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, INFO);
00319   }
00320 
00321   template <>
00322   void
00323   LAPACK<int, std::complex<double> >::
00324   ORGQR (const int m,
00325    const int n,
00326    const int k,
00327    std::complex<double> A[],
00328    const int lda,
00329    std::complex<double> tau[],
00330    std::complex<double> work[],
00331    const int lwork,
00332    int* const INFO)
00333   {
00334     F77_BLAS_MANGLE(zungqr, ZUNGQR) 
00335       (&m, &n, &k, A, &lda, tau, work, &lwork, INFO);
00336   }
00337 
00338   template <>
00339   void
00340   LAPACK<int, std::complex<double> >::
00341   POTRF (const char* const uplo,
00342    const int n,
00343    std::complex<double> A[],
00344    const int lda,
00345    int* const INFO)
00346   {
00347     F77_BLAS_MANGLE(zpotrf, ZPOTRF) (uplo, &n, A, &lda, INFO);
00348   }
00349 
00350   template <>
00351   void
00352   LAPACK<int, std::complex<double> >::
00353   POTRS (const char* const uplo,
00354    const int n,
00355    const int nrhs,
00356    const std::complex<double> A[],
00357    const int lda,
00358    std::complex<double> B[],
00359    const int ldb,
00360    int* const INFO)
00361   {
00362     F77_BLAS_MANGLE(zpotrs, ZPOTRS) 
00363       (uplo, &n, &nrhs, A, &lda, B, &ldb, INFO);
00364   }
00365 
00366   template <>
00367   void
00368   LAPACK<int, std::complex<double> >::
00369   POTRI (const char* const uplo, 
00370    const int n, 
00371    std::complex<double> A[], 
00372    const int lda, 
00373    int* const INFO)
00374   {
00375     F77_BLAS_MANGLE(zpotri, ZPOTRI) (uplo, &n, A, &lda, INFO);
00376   }
00377 
00378   template <>
00379   void
00380   LAPACK<int, std::complex<double> >::
00381   LARNV (const int idist, 
00382    int iseed[],
00383    const int n,
00384    std::complex<double> x[])
00385   {
00386     F77_BLAS_MANGLE(zlarnv, ZLARNV) (&idist, iseed, &n, x);
00387   }
00388 
00389   template <>
00390   void
00391   LAPACK<int, std::complex<double> >::
00392   GESVD (const char* const jobu,
00393    const char* const jobvt,
00394    const int m,
00395    const int n,
00396    std::complex<double> A[],
00397    const int lda,
00398    double s[],
00399    std::complex<double> U[],
00400    const int ldu,
00401    std::complex<double> VT[],
00402    const int ldvt,
00403    std::complex<double> work[],
00404    const int lwork,
00405    double rwork[],
00406    int* const INFO)
00407   {
00408     F77_BLAS_MANGLE(zgesvd, ZGESVD) (jobu, jobvt, &m, &n, 
00409              A, &lda, s, 
00410              U, &ldu, VT, &ldvt, 
00411              work, &lwork, rwork, INFO);
00412   }
00413 
00414 
00415 } // namespace TSQR
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends