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 (2008) Sandia Corporation
00006 // 
00007 // Under the terms of Contract DE-AC04-94AL85000 with Sandia Corporation,
00008 // the U.S. Government retains certain rights in this software.
00009 // 
00010 // Redistribution and use in source and binary forms, with or without
00011 // modification, are permitted provided that the following conditions are
00012 // met:
00013 //
00014 // 1. Redistributions of source code must retain the above copyright
00015 // notice, this list of conditions and the following disclaimer.
00016 //
00017 // 2. Redistributions in binary form must reproduce the above copyright
00018 // notice, this list of conditions and the following disclaimer in the
00019 // documentation and/or other materials provided with the distribution.
00020 //
00021 // 3. Neither the name of the Corporation nor the names of the
00022 // contributors may be used to endorse or promote products derived from
00023 // this software without specific prior written permission.
00024 //
00025 // THIS SOFTWARE IS PROVIDED BY SANDIA CORPORATION "AS IS" AND ANY
00026 // EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
00027 // IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
00028 // PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SANDIA CORPORATION OR THE
00029 // CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
00030 // EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
00031 // PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
00032 // PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
00033 // LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
00034 // NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
00035 // SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
00036 //
00037 // Questions? Contact Michael A. Heroux (maherou@sandia.gov) 
00038 // 
00039 // ************************************************************************
00040 //@HEADER
00041 
00042 #include <Tsqr_Lapack.hpp>
00043 #include <complex>
00044 
00045 
00046 extern "C" void F77_BLAS_MANGLE(zlarnv, ZLARNV)
00047   (const int* const IDIST,
00048    int ISEED[],
00049    const int* const N,
00050    std::complex<double> X[]);
00051 
00052 extern "C" void F77_BLAS_MANGLE(zpotri, ZPOTRI)
00053   (const char* const UPLO,
00054    const int* const N,
00055    std::complex<double> A[],
00056    const int* const LDA,
00057    int* const INFO);
00058 
00059 extern "C" void F77_BLAS_MANGLE(zpotrf, ZPOTRF)
00060   (const char* const UPLO,
00061    const int* const N,
00062    std::complex<double> A[],
00063    const int* const LDA,
00064    int* const INFO);
00065 
00066 extern "C" void F77_BLAS_MANGLE(zpotrs, ZPOTRS)
00067   (const char* const UPLO,
00068    const int* const N,
00069    const int* const NRHS,
00070    const std::complex<double> A[],
00071    const int* const LDA,
00072    std::complex<double> B[],
00073    const int* const LDB,
00074    int* const INFO);
00075 
00076 #ifdef HAVE_LAPACK_ZLARFGP
00077 extern "C" void F77_BLAS_MANGLE(zlarfgp,ZLARFGP)
00078   (const int* const N,    // IN
00079    std::complex<double>* const ALPHA,   // IN/OUT
00080    std::complex<double> X[],            // IN/OUT
00081    const int* const INCX, // IN
00082    std::complex<double>* const TAU);    // OUT
00083 #else
00084 #  ifdef HAVE_LAPACK_ZLARFP
00085 extern "C" void F77_BLAS_MANGLE(zlarfp,ZLARFP)
00086   (const int* const N,    // IN
00087    std::complex<double>* const ALPHA,   // IN/OUT
00088    std::complex<double> X[],            // IN/OUT
00089    const int* const INCX, // IN
00090    std::complex<double>* const TAU);    // OUT
00091 #  else
00092 extern "C" void F77_BLAS_MANGLE(zlarfg,ZLARFG)
00093   (const int* const N,    // IN
00094    std::complex<double>* const ALPHA,   // IN/OUT
00095    std::complex<double> X[],            // IN/OUT
00096    const int* const INCX, // IN
00097    std::complex<double>* const TAU);    // OUT
00098 #  endif // HAVE_LAPACK_ZLARFP
00099 #endif // HAVE_LAPACK_ZLARFGP
00100 
00101 extern "C" void F77_BLAS_MANGLE(zgeqrf, ZGEQRF)
00102   (const int* const M,
00103    const int* const N,
00104    std::complex<double> A[],
00105    const int* const LDA,
00106    std::complex<double> TAU[],
00107    std::complex<double> WORK[],
00108    const int* const LWORK,
00109    int* const INFO);
00110 
00111 #ifdef HAVE_LAPACK_ZGEQRFP
00112 extern "C" void F77_BLAS_MANGLE(zgeqrfp, ZGEQRFP)
00113   (const int* const M,
00114    const int* const N,
00115    std::complex<double> A[],
00116    const int* const LDA,
00117    std::complex<double> TAU[],
00118    std::complex<double> WORK[],
00119    const int* const LWORK,
00120    int* const INFO);
00121 #endif // HAVE_LAPACK_ZGEQRFP
00122 
00123 extern "C" void F77_BLAS_MANGLE(zgeqr2, ZGEQR2)
00124   (const int* const M,
00125    const int* const N,
00126    std::complex<double> A[],
00127    const int* const LDA,
00128    std::complex<double> TAU[],
00129    std::complex<double> WORK[],
00130    int* const INFO);
00131 
00132 #ifdef HAVE_LAPACK_ZGEQR2P
00133 extern "C" void F77_BLAS_MANGLE(zgeqr2p, ZGEQR2P)
00134   (const int* const M,
00135    const int* const N,
00136    std::complex<double> A[],
00137    const int* const LDA,
00138    std::complex<double> TAU[],
00139    std::complex<double> WORK[],
00140    int* const INFO);
00141 #endif // HAVE_LAPACK_ZGEQR2P
00142 
00143 // In the complex case, Q is called UNitary rather than ORthogonal.
00144 // This is why we have ZUNGQR and CUNGQR, rather than ZORGQR and
00145 // CORGQR.  The interface is exactly the same as in the real case,
00146 // though, so our LAPACK::ORMQR(), etc. wrappers have the same name
00147 // for both the real and the complex cases.
00148 
00149 extern "C" void F77_BLAS_MANGLE(zungqr, ZUNGQR)
00150   (const int* const M,
00151    const int* const N,
00152    const int* const K,
00153    std::complex<double> A[],
00154    const int* const LDA,
00155    std::complex<double> TAU[],
00156    std::complex<double> WORK[],
00157    const int* const LWORK,
00158    int* const INFO);
00159 
00160 extern "C" void F77_BLAS_MANGLE(zunmqr, ZUNMQR)
00161   (const char* const SIDE,
00162    const char* const TRANS,
00163    const int* const M,
00164    const int* const N,
00165    const int* const K,
00166    const std::complex<double> A[],
00167    const int* const LDA,
00168    const std::complex<double> TAU[],
00169    std::complex<double> C[],
00170    const int* const LDC,
00171    std::complex<double> WORK[],
00172    const int* const LWORK,
00173    int* const INFO);
00174 
00175 extern "C" void F77_BLAS_MANGLE(zunm2r, ZUNM2R)
00176   (const char* const SIDE,
00177    const char* const TRANS,
00178    const int* const M,
00179    const int* const N,
00180    const int* const K,
00181    const std::complex<double> A[],
00182    const int* const LDA,
00183    const std::complex<double> TAU[],
00184    std::complex<double> C[],
00185    const int* const LDC,
00186    std::complex<double> WORK[],
00187    int* const INFO);
00188 
00189 extern "C" void F77_BLAS_MANGLE(zgesvd, ZGESVD) 
00190   (const char* const JOBU, 
00191    const char* const JOBVT, 
00192    const int* const M, 
00193    const int* const N, 
00194    std::complex<double> A[], 
00195    const int* const LDA,
00196    double S[], 
00197    std::complex<double> U[], 
00198    const int* const LDU, 
00199    std::complex<double> VT[], 
00200    const int* const LDVT, 
00201    std::complex<double> work[],
00202    const int* const LWORK,
00203    double RWORK[],
00204    int* const INFO);
00205 
00208 
00209 namespace TSQR {
00210 
00211   // If _GEQRFP is available, LAPACK::GEQRF() calls it.  If _LARFP is
00212   // available, LAPACK::GEQRF() calls _GEQRF, which uses _LARFP.
00213 #ifdef HAVE_LAPACK_ZGEQRFP
00214   template <>
00215   bool LAPACK<int, std::complex<double> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00216 #else
00217 #  ifdef HAVE_LAPACK_ZLARFP
00218   template <>
00219   bool LAPACK<int, std::complex<double> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00220 #  else
00221   template <>
00222   bool LAPACK<int, std::complex<double> >::QR_produces_R_factor_with_nonnegative_diagonal() { return false; }
00223 #  endif
00224 #endif
00225 
00227   // LARFP (implemented with _LARFGP if available, else with _LARFP if
00228   // available, else fall back to _LARFG)
00230   template <>
00231   void 
00232   LAPACK<int, std::complex<double> >::
00233   LARFP (const int n, 
00234    std::complex<double>& alpha, 
00235    std::complex<double> x[], 
00236    const int incx, 
00237    std::complex<double>& tau)
00238   {
00239 #ifdef HAVE_LAPACK_ZLARFGP
00240     F77_BLAS_MANGLE(zlarfgp,ZLARFGP) (&n, &alpha, x, &incx, &tau);
00241 #else // Don't HAVE_LAPACK_CLARFGP
00242 #  ifdef HAVE_LAPACK_ZLARFP
00243     F77_BLAS_MANGLE(zlarfp,ZLARFP) (&n, &alpha, x, &incx, &tau);
00244 #  else
00245     F77_BLAS_MANGLE(zlarfg,ZLARFG) (&n, &alpha, x, &incx, &tau);
00246 #  endif // HAVE_LAPACK_ZLARFP
00247 #endif // HAVE_LAPACK_ZLARFGP
00248   }
00249 
00251   // GEQRF (implemented with _GEQRFP if available, else fall back to _GEQRF)
00253   template <>
00254   void
00255   LAPACK<int, std::complex<double> >::
00256   GEQRF (const int m,
00257    const int n, 
00258    std::complex<double> A[],
00259    const int lda, 
00260    std::complex<double> tau[],
00261    std::complex<double> work[],
00262    const int lwork,
00263    int* const INFO)
00264   {
00265 #ifdef HAVE_LAPACK_ZGEQRFP
00266     F77_BLAS_MANGLE(zgeqrfp, ZGEQRFP) (&m, &n, A, &lda, tau, work, &lwork, INFO);
00267 #else
00268     F77_BLAS_MANGLE(zgeqrf, ZGEQRF) (&m, &n, A, &lda, tau, work, &lwork, INFO);
00269 #endif // HAVE_LAPACK_ZGEQRFP
00270   }
00271 
00273   // GEQR2 (implemented with _GEQR2P if available, else fall back to _GEQR2)
00275   template <>
00276   void
00277   LAPACK<int, std::complex<double> >::
00278   GEQR2 (const int m,
00279    const int n, 
00280    std::complex<double> A[],
00281    const int lda, 
00282    std::complex<double> tau[],
00283    std::complex<double> work[],
00284    int* const INFO)
00285   {
00286 #ifdef HAVE_LAPACK_ZGEQR2P
00287     F77_BLAS_MANGLE(zgeqr2p, ZGEQR2P) (&m, &n, A, &lda, tau, work, INFO);
00288 #else
00289     F77_BLAS_MANGLE(zgeqr2, ZGEQR2) (&m, &n, A, &lda, tau, work, INFO);
00290 #endif // HAVE_LAPACK_ZGEQR2P
00291   }
00292 
00293   template <>
00294   void
00295   LAPACK<int, std::complex<double> >::
00296   ORMQR (const char* const side,
00297    const char* const trans,
00298    const int m,
00299    const int n,
00300    const int k,
00301    const std::complex<double> A[],
00302    const int lda,
00303    const std::complex<double> tau[],
00304    std::complex<double> C[],
00305    const int ldc,
00306    std::complex<double> work[],
00307    const int lwork,
00308    int* const INFO)
00309   {
00310     F77_BLAS_MANGLE(zunmqr, ZUNMQR) 
00311       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, &lwork, INFO);
00312   }
00313 
00314   template <>
00315   void
00316   LAPACK<int, std::complex<double> >::
00317   ORM2R (const char* const side,
00318    const char* const trans,
00319    const int m,
00320    const int n,
00321    const int k,
00322    const std::complex<double> A[],
00323    const int lda,
00324    const std::complex<double> tau[],
00325    std::complex<double> C[],
00326    const int ldc,
00327    std::complex<double> work[],
00328    int* const INFO)
00329   {
00330     F77_BLAS_MANGLE(zunm2r, ZUNM2R) 
00331       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, INFO);
00332   }
00333 
00334   template <>
00335   void
00336   LAPACK<int, std::complex<double> >::
00337   ORGQR (const int m,
00338    const int n,
00339    const int k,
00340    std::complex<double> A[],
00341    const int lda,
00342    std::complex<double> tau[],
00343    std::complex<double> work[],
00344    const int lwork,
00345    int* const INFO)
00346   {
00347     F77_BLAS_MANGLE(zungqr, ZUNGQR) 
00348       (&m, &n, &k, A, &lda, tau, work, &lwork, INFO);
00349   }
00350 
00351   template <>
00352   void
00353   LAPACK<int, std::complex<double> >::
00354   POTRF (const char* const uplo,
00355    const int n,
00356    std::complex<double> A[],
00357    const int lda,
00358    int* const INFO)
00359   {
00360     F77_BLAS_MANGLE(zpotrf, ZPOTRF) (uplo, &n, A, &lda, INFO);
00361   }
00362 
00363   template <>
00364   void
00365   LAPACK<int, std::complex<double> >::
00366   POTRS (const char* const uplo,
00367    const int n,
00368    const int nrhs,
00369    const std::complex<double> A[],
00370    const int lda,
00371    std::complex<double> B[],
00372    const int ldb,
00373    int* const INFO)
00374   {
00375     F77_BLAS_MANGLE(zpotrs, ZPOTRS) 
00376       (uplo, &n, &nrhs, A, &lda, B, &ldb, INFO);
00377   }
00378 
00379   template <>
00380   void
00381   LAPACK<int, std::complex<double> >::
00382   POTRI (const char* const uplo, 
00383    const int n, 
00384    std::complex<double> A[], 
00385    const int lda, 
00386    int* const INFO)
00387   {
00388     F77_BLAS_MANGLE(zpotri, ZPOTRI) (uplo, &n, A, &lda, INFO);
00389   }
00390 
00391   template <>
00392   void
00393   LAPACK<int, std::complex<double> >::
00394   LARNV (const int idist, 
00395    int iseed[],
00396    const int n,
00397    std::complex<double> x[])
00398   {
00399     F77_BLAS_MANGLE(zlarnv, ZLARNV) (&idist, iseed, &n, x);
00400   }
00401 
00402   template <>
00403   void
00404   LAPACK<int, std::complex<double> >::
00405   GESVD (const char* const jobu,
00406    const char* const jobvt,
00407    const int m,
00408    const int n,
00409    std::complex<double> A[],
00410    const int lda,
00411    double s[],
00412    std::complex<double> U[],
00413    const int ldu,
00414    std::complex<double> VT[],
00415    const int ldvt,
00416    std::complex<double> work[],
00417    const int lwork,
00418    double rwork[],
00419    int* const INFO)
00420   {
00421     F77_BLAS_MANGLE(zgesvd, ZGESVD) (jobu, jobvt, &m, &n, 
00422              A, &lda, s, 
00423              U, &ldu, VT, &ldvt, 
00424              work, &lwork, rwork, INFO);
00425   }
00426 
00427 
00428 } // namespace TSQR
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends