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