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 (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(clarnv, CLARNV)
00047   (const int* const IDIST,
00048    int ISEED[],
00049    const int* const N,
00050    std::complex<float> X[]);
00051 
00052 extern "C" void F77_BLAS_MANGLE(cpotri, CPOTRI)
00053   (const char* const UPLO,
00054    const int* const N,
00055    std::complex<float> A[],
00056    const int* const LDA,
00057    int* const INFO);
00058 
00059 extern "C" void F77_BLAS_MANGLE(cpotrf, CPOTRF)
00060   (const char* const UPLO,
00061    const int* const N,
00062    std::complex<float> A[],
00063    const int* const LDA,
00064    int* const INFO);
00065 
00066 extern "C" void F77_BLAS_MANGLE(cpotrs, CPOTRS)
00067   (const char* const UPLO,
00068    const int* const N,
00069    const int* const NRHS,
00070    const std::complex<float> A[],
00071    const int* const LDA,
00072    std::complex<float> B[],
00073    const int* const LDB,
00074    int* const INFO);
00075 
00076 #ifdef HAVE_LAPACK_CLARFGP
00077 extern "C" void F77_BLAS_MANGLE(clarfgp,CLARFGP)
00078   (const int* const N,                 // IN
00079    std::complex<float>* const ALPHA,   // IN/OUT
00080    std::complex<float> X[],            // IN/OUT
00081    const int* const INCX,              // IN
00082    std::complex<float>* const TAU);    // OUT
00083 #else
00084 #  ifdef HAVE_LAPACK_CLARFP
00085 extern "C" void F77_BLAS_MANGLE(clarfp,CLARFP)
00086   (const int* const N,                 // IN
00087    std::complex<float>* const ALPHA,   // IN/OUT
00088    std::complex<float> X[],            // IN/OUT
00089    const int* const INCX,              // IN
00090    std::complex<float>* const TAU);    // OUT
00091 #  else
00092 extern "C" void F77_BLAS_MANGLE(clarfg,CLARFG)
00093   (const int* const N,                 // IN
00094    std::complex<float>* const ALPHA,   // IN/OUT
00095    std::complex<float> X[],            // IN/OUT
00096    const int* const INCX,              // IN
00097    std::complex<float>* const TAU);    // OUT
00098 #  endif // HAVE_LAPACK_CLARFP
00099 #endif // HAVE_LAPACK_CLARFGP
00100 
00101 extern "C" void F77_BLAS_MANGLE(cgeqrf, CGEQRF)
00102   (const int* const M,
00103    const int* const N,
00104    std::complex<float> A[],
00105    const int* const LDA,
00106    std::complex<float> TAU[],
00107    std::complex<float> WORK[],
00108    const int* const LWORK,
00109    int* const INFO);
00110 
00111 #ifdef HAVE_LAPACK_CGEQRFP
00112 extern "C" void F77_BLAS_MANGLE(cgeqrfp, CGEQRFP)
00113   (const int* const M,
00114    const int* const N,
00115    std::complex<float> A[],
00116    const int* const LDA,
00117    std::complex<float> TAU[],
00118    std::complex<float> WORK[],
00119    const int* const LWORK,
00120    int* const INFO);
00121 #endif // HAVE_LAPACK_CGEQRFP
00122 
00123 extern "C" void F77_BLAS_MANGLE(cgeqr2, CGEQR2)
00124   (const int* const M,
00125    const int* const N,
00126    std::complex<float> A[],
00127    const int* const LDA,
00128    std::complex<float> TAU[],
00129    std::complex<float> WORK[],
00130    int* const INFO);
00131 
00132 #ifdef HAVE_LAPACK_CGEQR2P
00133 extern "C" void F77_BLAS_MANGLE(cgeqr2p, CGEQR2P)
00134   (const int* const M,
00135    const int* const N,
00136    std::complex<float> A[],
00137    const int* const LDA,
00138    std::complex<float> TAU[],
00139    std::complex<float> WORK[],
00140    int* const INFO);
00141 #endif // HAVE_LAPACK_CGEQR2P
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(cungqr, CUNGQR)
00150   (const int* const M,
00151    const int* const N,
00152    const int* const K,
00153    std::complex<float> A[],
00154    const int* const LDA,
00155    std::complex<float> TAU[],
00156    std::complex<float> WORK[],
00157    const int* const LWORK,
00158    int* const INFO);
00159 
00160 extern "C" void F77_BLAS_MANGLE(cunmqr, CUNMQR)
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<float> A[],
00167    const int* const LDA,
00168    const std::complex<float> TAU[],
00169    std::complex<float> C[],
00170    const int* const LDC,
00171    std::complex<float> WORK[],
00172    const int* const LWORK,
00173    int* const INFO);
00174 
00175 extern "C" void F77_BLAS_MANGLE(cunm2r, CUNM2R)
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<float> A[],
00182    const int* const LDA,
00183    const std::complex<float> TAU[],
00184    std::complex<float> C[],
00185    const int* const LDC,
00186    std::complex<float> WORK[],
00187    int* const INFO);
00188 
00189 extern "C" void F77_BLAS_MANGLE(cgesvd, CGESVD) 
00190   (const char* const JOBU, 
00191    const char* const JOBVT, 
00192    const int* const M, 
00193    const int* const N, 
00194    std::complex<float> A[], 
00195    const int* const LDA,
00196    float S[], 
00197    std::complex<float> U[], 
00198    const int* const LDU, 
00199    std::complex<float> VT[], 
00200    const int* const LDVT, 
00201    std::complex<float> work[],
00202    const int* const LWORK,
00203    float 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_CGEQRFP
00214   template <>
00215   bool LAPACK<int, std::complex<float> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00216 #else
00217 #  ifdef HAVE_LAPACK_CLARFP
00218   template <>
00219   bool LAPACK<int, std::complex<float> >::QR_produces_R_factor_with_nonnegative_diagonal() { return true; }
00220 #  else
00221   template <>
00222   bool LAPACK<int, std::complex<float> >::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<float> >::LARFP (const int n, 
00233               std::complex<float>& alpha, 
00234               std::complex<float> x[], 
00235               const int incx, 
00236               std::complex<float>& tau)
00237   {
00238 #ifdef HAVE_LAPACK_CLARFGP
00239     F77_BLAS_MANGLE(clarfgp,CLARFGP) (&n, &alpha, x, &incx, &tau);
00240 #else // Don't HAVE_LAPACK_CLARFGP
00241 #  ifdef HAVE_LAPACK_CLARFP
00242     F77_BLAS_MANGLE(clarfp,CLARFP) (&n, &alpha, x, &incx, &tau);
00243 #  else
00244     F77_BLAS_MANGLE(clarfg,CLARFG) (&n, &alpha, x, &incx, &tau);
00245 #  endif // HAVE_LAPACK_CLARFP
00246 #endif // HAVE_LAPACK_CLARFGP
00247   }
00248 
00250   // GEQRF (implemented with _GEQRFP if available, else fall back to _GEQRF)
00252   template <>
00253   void
00254   LAPACK<int, std::complex<float> >::GEQRF (const int m,
00255               const int n, 
00256               std::complex<float> A[],
00257               const int lda, 
00258               std::complex<float> tau[],
00259               std::complex<float> work[],
00260               const int lwork,
00261               int* const INFO)
00262   {
00263 #ifdef HAVE_LAPACK_CGEQRFP
00264     F77_BLAS_MANGLE(cgeqrfp, CGEQRFP) 
00265       (&m, &n, A, &lda, tau, work, &lwork, INFO);
00266 #else
00267     F77_BLAS_MANGLE(cgeqrf, CGEQRF) 
00268       (&m, &n, A, &lda, tau, work, &lwork, INFO);
00269 #endif // HAVE_LAPACK_CGEQRFP
00270   }
00271 
00273   // GEQR2 (implemented with _GEQR2P if available, else fall back to _GEQR2)
00275   template <>
00276   void
00277   LAPACK<int, std::complex<float> >::GEQR2 (const int m,
00278               const int n, 
00279               std::complex<float> A[],
00280               const int lda, 
00281               std::complex<float> tau[],
00282               std::complex<float> work[],
00283               int* const INFO)
00284   {
00285 #ifdef HAVE_LAPACK_CGEQR2P
00286     F77_BLAS_MANGLE(cgeqr2p, CGEQR2P) (&m, &n, A, &lda, tau, work, INFO);
00287 #else
00288     F77_BLAS_MANGLE(cgeqr2, CGEQR2) (&m, &n, A, &lda, tau, work, INFO);
00289 #endif // HAVE_LAPACK_CGEQR2P
00290   }
00291 
00292   template <>
00293   void
00294   LAPACK<int, std::complex<float> >::
00295   ORMQR (const char* const side,
00296    const char* const trans,
00297    const int m,
00298    const int n,
00299    const int k,
00300    const std::complex<float> A[],
00301    const int lda,
00302    const std::complex<float> tau[],
00303    std::complex<float> C[],
00304    const int ldc,
00305    std::complex<float> work[],
00306    const int lwork,
00307    int* const INFO)
00308   {
00309     F77_BLAS_MANGLE(cunmqr, CUNMQR) 
00310       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, &lwork, INFO);
00311   }
00312 
00313   template <>
00314   void
00315   LAPACK<int, std::complex<float> >::
00316   ORM2R (const char* const side,
00317    const char* const trans,
00318    const int m,
00319    const int n,
00320    const int k,
00321    const std::complex<float> A[],
00322    const int lda,
00323    const std::complex<float> tau[],
00324    std::complex<float> C[],
00325    const int ldc,
00326    std::complex<float> work[],
00327    int* const INFO)
00328   {
00329     F77_BLAS_MANGLE(cunm2r, CUNM2R) 
00330       (side, trans, &m, &n, &k, A, &lda, tau, C, &ldc, work, INFO);
00331   }
00332 
00333   template <>
00334   void
00335   LAPACK<int, std::complex<float> >::
00336   ORGQR (const int m,
00337    const int n,
00338    const int k,
00339    std::complex<float> A[],
00340    const int lda,
00341    std::complex<float> tau[],
00342    std::complex<float> work[],
00343    const int lwork,
00344    int* const INFO)
00345   {
00346     F77_BLAS_MANGLE(cungqr, CUNGQR) 
00347       (&m, &n, &k, A, &lda, tau, work, &lwork, INFO);
00348   }
00349 
00350   template <>
00351   void
00352   LAPACK<int, std::complex<float> >::POTRF (const char* const uplo,
00353               const int n,
00354               std::complex<float> A[],
00355               const int lda,
00356               int* const INFO)
00357   {
00358     F77_BLAS_MANGLE(cpotrf, CPOTRF) (uplo, &n, A, &lda, INFO);
00359   }
00360 
00361   template <>
00362   void
00363   LAPACK<int, std::complex<float> >::POTRS (const char* const uplo,
00364               const int n,
00365               const int nrhs,
00366               const std::complex<float> A[],
00367               const int lda,
00368               std::complex<float> B[],
00369               const int ldb,
00370               int* const INFO)
00371   {
00372     F77_BLAS_MANGLE(cpotrs, CPOTRS) (uplo, &n, &nrhs, A, &lda, B, &ldb, INFO);
00373   }
00374 
00375   template <>
00376   void
00377   LAPACK<int, std::complex<float> >::POTRI (const char* const uplo, 
00378               const int n, 
00379               std::complex<float> A[], 
00380               const int lda, 
00381               int* const INFO)
00382   {
00383     F77_BLAS_MANGLE(cpotri, CPOTRI) (uplo, &n, A, &lda, INFO);
00384   }
00385 
00386   template <>
00387   void
00388   LAPACK<int, std::complex<float> >::LARNV (const int idist, 
00389               int iseed[],
00390               const int n,
00391               std::complex<float> x[])
00392   {
00393     F77_BLAS_MANGLE(clarnv, CLARNV) (&idist, iseed, &n, x);
00394   }
00395 
00396   template <>
00397   void
00398   LAPACK<int, std::complex<float> >::
00399   GESVD (const char* const jobu,
00400    const char* const jobvt,
00401    const int m,
00402    const int n,
00403    std::complex<float> A[],
00404    const int lda,
00405    float s[],
00406    std::complex<float> U[],
00407    const int ldu,
00408    std::complex<float> VT[],
00409    const int ldvt,
00410    std::complex<float> work[],
00411    const int lwork,
00412    float rwork[],
00413    int* const INFO)
00414   {
00415     F77_BLAS_MANGLE(cgesvd, CGESVD) (jobu, jobvt, &m, &n, 
00416              A, &lda, s, 
00417              U, &ldu, VT, &ldvt, 
00418              work, &lwork, rwork, INFO);
00419   }
00420 
00421 
00422 } // namespace TSQR
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends