MAGMA  1.2.0
MatrixAlgebraonGPUandMulticoreArchitectures
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
Macros | Functions
magma_c.h File Reference
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Macros

#define PRECISION_c

Functions

magma_int_t magma_cgebrd (magma_int_t m, magma_int_t n, cuFloatComplex *A, magma_int_t lda, float *d, float *e, cuFloatComplex *tauq, cuFloatComplex *taup, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgehrd2 (magma_int_t n, magma_int_t ilo, magma_int_t ihi, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t *lwork, magma_int_t *info)
magma_int_t magma_cgehrd (magma_int_t n, magma_int_t ilo, magma_int_t ihi, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, cuFloatComplex *d_T, magma_int_t *info)
magma_int_t magma_cgelqf (magma_int_t m, magma_int_t n, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgeqlf (magma_int_t m, magma_int_t n, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgeqrf (magma_int_t m, magma_int_t n, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgeqrf4 (magma_int_t num_gpus, magma_int_t m, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgeqrf_ooc (magma_int_t m, magma_int_t n, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgesv (magma_int_t n, magma_int_t nrhs, cuFloatComplex *A, magma_int_t lda, magma_int_t *ipiv, cuFloatComplex *B, magma_int_t ldb, magma_int_t *info)
magma_int_t magma_cgetrf (magma_int_t m, magma_int_t n, cuFloatComplex *A, magma_int_t lda, magma_int_t *ipiv, magma_int_t *info)
magma_int_t magma_cgetrf2 (magma_int_t m, magma_int_t n, cuFloatComplex *a, magma_int_t lda, magma_int_t *ipiv, magma_int_t *info)
magma_int_t magma_clatrd (char uplo, magma_int_t n, magma_int_t nb, cuFloatComplex *a, magma_int_t lda, float *e, cuFloatComplex *tau, cuFloatComplex *w, magma_int_t ldw, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *dw, magma_int_t lddw)
magma_int_t magma_clatrd2 (char uplo, magma_int_t n, magma_int_t nb, cuFloatComplex *a, magma_int_t lda, float *e, cuFloatComplex *tau, cuFloatComplex *w, magma_int_t ldw, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *dw, magma_int_t lddw, cuFloatComplex *dwork, magma_int_t ldwork)
magma_int_t magma_clahr2 (magma_int_t m, magma_int_t n, magma_int_t nb, cuFloatComplex *da, cuFloatComplex *dv, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *t, magma_int_t ldt, cuFloatComplex *y, magma_int_t ldy)
magma_int_t magma_clahru (magma_int_t n, magma_int_t ihi, magma_int_t k, magma_int_t nb, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *da, cuFloatComplex *y, cuFloatComplex *v, cuFloatComplex *t, cuFloatComplex *dwork)
magma_int_t magma_cposv (char uplo, magma_int_t n, magma_int_t nrhs, cuFloatComplex *A, magma_int_t lda, cuFloatComplex *B, magma_int_t ldb, magma_int_t *info)
magma_int_t magma_cpotrf (char uplo, magma_int_t n, cuFloatComplex *A, magma_int_t lda, magma_int_t *info)
magma_int_t magma_cpotri (char uplo, magma_int_t n, cuFloatComplex *A, magma_int_t lda, magma_int_t *info)
magma_int_t magma_clauum (char uplo, magma_int_t n, cuFloatComplex *A, magma_int_t lda, magma_int_t *info)
magma_int_t magma_ctrtri (char uplo, char diag, magma_int_t n, cuFloatComplex *A, magma_int_t lda, magma_int_t *info)
magma_int_t magma_chetrd (char uplo, magma_int_t n, cuFloatComplex *A, magma_int_t lda, float *d, float *e, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cungqr (magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *dwork, magma_int_t nb, magma_int_t *info)
magma_int_t magma_cunmql (const char side, const char trans, magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *c, magma_int_t ldc, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cunmqr (char side, char trans, magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *c, magma_int_t ldc, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cunmtr (char side, char uplo, char trans, magma_int_t m, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *c, magma_int_t ldc, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cunghr (magma_int_t n, magma_int_t ilo, magma_int_t ihi, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *dT, magma_int_t nb, magma_int_t *info)
magma_int_t magma_cheev (char jobz, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, float *w, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t *info)
magma_int_t magma_cheevx (char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, float vl, float vu, magma_int_t il, magma_int_t iu, float abstol, magma_int_t *m, float *w, cuFloatComplex *z, magma_int_t ldz, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t *iwork, magma_int_t *ifail, magma_int_t *info)
magma_int_t magma_cgeev (char jobvl, char jobvr, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *w, cuFloatComplex *vl, magma_int_t ldvl, cuFloatComplex *vr, magma_int_t ldvr, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t *info)
magma_int_t magma_cgeqp3 (magma_int_t *m, magma_int_t *n, cuFloatComplex *a, magma_int_t *lda, magma_int_t *jpvt, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t *lwork, float *rwork, magma_int_t *info)
magma_int_t magma_cgesvd (char jobu, char jobvt, magma_int_t m, magma_int_t n, cuFloatComplex *a, magma_int_t lda, float *s, cuFloatComplex *u, magma_int_t ldu, cuFloatComplex *vt, magma_int_t ldvt, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t *info)
magma_int_t magma_cheevd (char jobz, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, float *w, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_cheevr (char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, float vl, float vu, magma_int_t il, magma_int_t iu, float abstol, magma_int_t *m, float *w, cuFloatComplex *z, magma_int_t ldz, magma_int_t *isuppz, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_chegvd (magma_int_t itype, char jobz, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *b, magma_int_t ldb, float *w, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_chegvdx (magma_int_t itype, char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *b, magma_int_t ldb, float vl, float vu, magma_int_t il, magma_int_t iu, magma_int_t *m, float *w, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_chegvx (magma_int_t itype, char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *b, magma_int_t ldb, float vl, float vu, magma_int_t il, magma_int_t iu, float abstol, magma_int_t *m, float *w, cuFloatComplex *z, magma_int_t ldz, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t *iwork, magma_int_t *ifail, magma_int_t *info)
magma_int_t magma_chegvr (magma_int_t itype, char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *b, magma_int_t ldb, float vl, float vu, magma_int_t il, magma_int_t iu, float abstol, magma_int_t *m, float *w, cuFloatComplex *z, magma_int_t ldz, magma_int_t *isuppz, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_cstedx (char range, magma_int_t n, float vl, float vu, magma_int_t il, magma_int_t iu, float *D, float *E, cuFloatComplex *Z, magma_int_t ldz, float *rwork, magma_int_t ldrwork, magma_int_t *iwork, magma_int_t liwork, float *dwork, magma_int_t *info)
magma_int_t magma_chegst (magma_int_t itype, char uplo, magma_int_t n, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *b, magma_int_t ldb, magma_int_t *info)
magma_int_t magma_cgels_gpu (char trans, magma_int_t m, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *dB, magma_int_t lddb, cuFloatComplex *hwork, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgels3_gpu (char trans, magma_int_t m, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *dB, magma_int_t lddb, cuFloatComplex *hwork, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgelqf_gpu (magma_int_t m, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgeqrf_gpu (magma_int_t m, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dT, magma_int_t *info)
magma_int_t magma_cgeqrf2_gpu (magma_int_t m, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *tau, magma_int_t *info)
magma_int_t magma_cgeqrf2_mgpu (magma_int_t num_gpus, magma_int_t m, magma_int_t n, cuFloatComplex **dlA, magma_int_t ldda, cuFloatComplex *tau, magma_int_t *info)
magma_int_t magma_cgeqrf3_gpu (magma_int_t m, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dT, magma_int_t *info)
magma_int_t magma_cgeqrs_gpu (magma_int_t m, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dT, cuFloatComplex *dB, magma_int_t lddb, cuFloatComplex *hwork, magma_int_t lhwork, magma_int_t *info)
magma_int_t magma_cgeqrs3_gpu (magma_int_t m, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dT, cuFloatComplex *dB, magma_int_t lddb, cuFloatComplex *hwork, magma_int_t lhwork, magma_int_t *info)
magma_int_t magma_cgessm_gpu (char storev, magma_int_t m, magma_int_t n, magma_int_t k, magma_int_t ib, magma_int_t *ipiv, cuFloatComplex *dL1, magma_int_t lddl1, cuFloatComplex *dL, magma_int_t lddl, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *info)
magma_int_t magma_cgesv_gpu (magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *ipiv, cuFloatComplex *dB, magma_int_t lddb, magma_int_t *info)
magma_int_t magma_cgetrl_gpu (char storev, magma_int_t m, magma_int_t n, magma_int_t ib, cuFloatComplex *hA, magma_int_t ldha, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *hL, magma_int_t ldhl, cuFloatComplex *dL, magma_int_t lddl, magma_int_t *ipiv, cuFloatComplex *dwork, magma_int_t lddwork, magma_int_t *info)
magma_int_t magma_cgetrf_gpu (magma_int_t m, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *ipiv, magma_int_t *info)
magma_int_t magma_cgetrf_nopiv_gpu (magma_int_t m, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *info)
magma_int_t magma_cgetri_gpu (magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *ipiv, cuFloatComplex *dwork, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_cgetrs_gpu (char trans, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *ipiv, cuFloatComplex *dB, magma_int_t lddb, magma_int_t *info)
magma_int_t magma_clabrd_gpu (magma_int_t m, magma_int_t n, magma_int_t nb, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *da, magma_int_t ldda, float *d, float *e, cuFloatComplex *tauq, cuFloatComplex *taup, cuFloatComplex *x, magma_int_t ldx, cuFloatComplex *dx, magma_int_t lddx, cuFloatComplex *y, magma_int_t ldy, cuFloatComplex *dy, magma_int_t lddy)
magma_int_t magma_clarfb_gpu (char side, char trans, char direct, char storev, magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *dv, magma_int_t ldv, cuFloatComplex *dt, magma_int_t ldt, cuFloatComplex *dc, magma_int_t ldc, cuFloatComplex *dowrk, magma_int_t ldwork)
magma_int_t magma_cposv_gpu (char uplo, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *dB, magma_int_t lddb, magma_int_t *info)
magma_int_t magma_cpotrf_gpu (char uplo, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *info)
magma_int_t magma_cpotri_gpu (char uplo, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *info)
magma_int_t magma_clauum_gpu (char uplo, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *info)
magma_int_t magma_ctrtri_gpu (char uplo, char diag, magma_int_t n, cuFloatComplex *dA, magma_int_t ldda, magma_int_t *info)
magma_int_t magma_chetrd_gpu (char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, float *d, float *e, cuFloatComplex *tau, cuFloatComplex *wa, magma_int_t ldwa, cuFloatComplex *work, magma_int_t lwork, magma_int_t *info)
magma_int_t magma_chetrd2_gpu (char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, float *d, float *e, cuFloatComplex *tau, cuFloatComplex *wa, magma_int_t ldwa, cuFloatComplex *work, magma_int_t lwork, cuFloatComplex *dwork, magma_int_t ldwork, magma_int_t *info)
magma_int_t magma_cpotrs_gpu (char uplo, magma_int_t n, magma_int_t nrhs, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *dB, magma_int_t lddb, magma_int_t *info)
magma_int_t magma_cssssm_gpu (char storev, magma_int_t m1, magma_int_t n1, magma_int_t m2, magma_int_t n2, magma_int_t k, magma_int_t ib, cuFloatComplex *dA1, magma_int_t ldda1, cuFloatComplex *dA2, magma_int_t ldda2, cuFloatComplex *dL1, magma_int_t lddl1, cuFloatComplex *dL2, magma_int_t lddl2, magma_int_t *IPIV, magma_int_t *info)
magma_int_t magma_ctstrf_gpu (char storev, magma_int_t m, magma_int_t n, magma_int_t ib, magma_int_t nb, cuFloatComplex *hU, magma_int_t ldhu, cuFloatComplex *dU, magma_int_t lddu, cuFloatComplex *hA, magma_int_t ldha, cuFloatComplex *dA, magma_int_t ldda, cuFloatComplex *hL, magma_int_t ldhl, cuFloatComplex *dL, magma_int_t lddl, magma_int_t *ipiv, cuFloatComplex *hwork, magma_int_t ldhwork, cuFloatComplex *dwork, magma_int_t lddwork, magma_int_t *info)
magma_int_t magma_cungqr_gpu (magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dwork, magma_int_t nb, magma_int_t *info)
magma_int_t magma_cunmql2_gpu (const char side, const char trans, magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dc, magma_int_t lddc, cuFloatComplex *wa, magma_int_t ldwa, magma_int_t *info)
magma_int_t magma_cunmqr_gpu (char side, char trans, magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *a, magma_int_t lda, cuFloatComplex *tau, cuFloatComplex *c, magma_int_t ldc, cuFloatComplex *work, magma_int_t lwork, cuFloatComplex *td, magma_int_t nb, magma_int_t *info)
magma_int_t magma_cunmqr2_gpu (const char side, const char trans, magma_int_t m, magma_int_t n, magma_int_t k, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dc, magma_int_t lddc, cuFloatComplex *wa, magma_int_t ldwa, magma_int_t *info)
magma_int_t magma_cunmtr_gpu (char side, char uplo, char trans, magma_int_t m, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *tau, cuFloatComplex *dc, magma_int_t lddc, cuFloatComplex *wa, magma_int_t ldwa, magma_int_t *info)
magma_int_t magma_cheevd_gpu (char jobz, char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, float *w, cuFloatComplex *wa, magma_int_t ldwa, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_cheevdx_gpu (char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, float vl, float vu, magma_int_t il, magma_int_t iu, magma_int_t *m, float *w, cuFloatComplex *wa, magma_int_t ldwa, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_cheevr_gpu (char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, float vl, float vu, magma_int_t il, magma_int_t iu, float abstol, magma_int_t *m, float *w, cuFloatComplex *dz, magma_int_t lddz, magma_int_t *isuppz, cuFloatComplex *wa, magma_int_t ldwa, cuFloatComplex *wz, magma_int_t ldwz, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t lrwork, magma_int_t *iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t magma_cheevx_gpu (char jobz, char range, char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, float vl, float vu, magma_int_t il, magma_int_t iu, float abstol, magma_int_t *m, float *w, cuFloatComplex *dz, magma_int_t lddz, cuFloatComplex *wa, magma_int_t ldwa, cuFloatComplex *wz, magma_int_t ldwz, cuFloatComplex *work, magma_int_t lwork, float *rwork, magma_int_t *iwork, magma_int_t *ifail, magma_int_t *info)
magma_int_t magma_chegst_gpu (magma_int_t itype, char uplo, magma_int_t n, cuFloatComplex *da, magma_int_t ldda, cuFloatComplex *db, magma_int_t lddb, magma_int_t *info)
void magma_cprint (int m, int n, cuFloatComplex *A, int lda)
void magma_cprint_gpu (int m, int n, cuFloatComplex *dA, int ldda)
void cpanel_to_q (char uplo, int ib, cuFloatComplex *A, int lda, cuFloatComplex *work)
void cq_to_panel (char uplo, int ib, cuFloatComplex *A, int lda, cuFloatComplex *work)

Macro Definition Documentation

#define PRECISION_c

Definition at line 13 of file magma_c.h.

Function Documentation

void cpanel_to_q ( char  uplo,
int  ib,
cuFloatComplex *  A,
int  lda,
cuFloatComplex *  work 
)

Definition at line 17 of file cpanel_to_q.cpp.

References MAGMA_C_ONE, and MAGMA_C_ZERO.

{
int i, j, k = 0;
cuFloatComplex *col;
cuFloatComplex c_zero = MAGMA_C_ZERO;
cuFloatComplex c_one = MAGMA_C_ONE;
if (uplo == 'U' || uplo == 'u'){
for(i = 0; i < ib; ++i){
col = A + i*lda;
for(j = 0; j < i; ++j){
work[k] = col[j];
col [j] = c_zero;
++k;
}
work[k] = col[i];
col [j] = c_one;
++k;
}
}
else {
for(i=0; i<ib; ++i){
col = A + i*lda;
work[k] = col[i];
col [i] = c_one;
++k;
for(j=i+1; j<ib; ++j){
work[k] = col[j];
col [j] = c_zero;
++k;
}
}
}
}

Here is the caller graph for this function:

void cq_to_panel ( char  uplo,
int  ib,
cuFloatComplex *  A,
int  lda,
cuFloatComplex *  work 
)

Definition at line 57 of file cpanel_to_q.cpp.

{
int i, j, k = 0;
cuFloatComplex *col;
if (uplo == 'U' || uplo == 'u'){
for(i = 0; i < ib; ++i){
col = A + i*lda;
for(j = 0; j <= i; ++j){
col[j] = work[k];
++k;
}
}
}
else {
for(i = 0; i < ib; ++i){
col = A + i*lda;
for(j = i; j < ib; ++j){
col[j] = work[k];
++k;
}
}
}
}

Here is the caller graph for this function:

magma_int_t magma_cgebrd ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  A,
magma_int_t  lda,
float *  d,
float *  e,
cuFloatComplex *  tauq,
cuFloatComplex *  taup,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 24 of file cgebrd.cpp.

References __func__, A, dA, dwork, lapackf77_cgebrd(), MAGMA_C_MAKE, MAGMA_C_NEG_ONE, MAGMA_C_ONE, MAGMA_C_SET2REAL, magma_cgemm(), magma_cgetmatrix(), magma_clabrd_gpu(), magma_cmalloc(), magma_csetmatrix(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgebrd_nb(), MAGMA_SUCCESS, magma_xerbla(), MagmaConjTrans, MagmaNoTrans, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEBRD reduces a general complex M-by-N matrix A to upper or lower
bidiagonal form B by an orthogonal transformation: Q**H * A * P = B.
If m >= n, B is upper bidiagonal; if m < n, B is lower bidiagonal.
Arguments
=========
M (input) INTEGER
The number of rows in the matrix A. M >= 0.
N (input) INTEGER
The number of columns in the matrix A. N >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N general matrix to be reduced.
On exit,
if m >= n, the diagonal and the first superdiagonal are
overwritten with the upper bidiagonal matrix B; the
elements below the diagonal, with the array TAUQ, represent
the orthogonal matrix Q as a product of elementary
reflectors, and the elements above the first superdiagonal,
with the array TAUP, represent the orthogonal matrix P as
a product of elementary reflectors;
if m < n, the diagonal and the first subdiagonal are
overwritten with the lower bidiagonal matrix B; the
elements below the first subdiagonal, with the array TAUQ,
represent the orthogonal matrix Q as a product of
elementary reflectors, and the elements above the diagonal,
with the array TAUP, represent the orthogonal matrix P as
a product of elementary reflectors.
See Further Details.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
D (output) real array, dimension (min(M,N))
The diagonal elements of the bidiagonal matrix B:
D(i) = A(i,i).
E (output) real array, dimension (min(M,N)-1)
The off-diagonal elements of the bidiagonal matrix B:
if m >= n, E(i) = A(i,i+1) for i = 1,2,...,n-1;
if m < n, E(i) = A(i+1,i) for i = 1,2,...,m-1.
TAUQ (output) COMPLEX array dimension (min(M,N))
The scalar factors of the elementary reflectors which
represent the orthogonal matrix Q. See Further Details.
TAUP (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors which
represent the orthogonal matrix P. See Further Details.
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The length of the array WORK. LWORK >= max(1,M,N).
For optimum performance LWORK >= (M+N)*NB, where NB
is the optimal blocksize.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
Further Details
===============
The matrices Q and P are represented as products of elementary
reflectors:
If m >= n,
Q = H(1) H(2) . . . H(n) and P = G(1) G(2) . . . G(n-1)
Each H(i) and G(i) has the form:
H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
where tauq and taup are complex scalars, and v and u are complex vectors;
v(1:i-1) = 0, v(i) = 1, and v(i+1:m) is stored on exit in A(i+1:m,i);
u(1:i) = 0, u(i+1) = 1, and u(i+2:n) is stored on exit in A(i,i+2:n);
tauq is stored in TAUQ(i) and taup in TAUP(i).
If m < n,
Q = H(1) H(2) . . . H(m-1) and P = G(1) G(2) . . . G(m)
Each H(i) and G(i) has the form:
H(i) = I - tauq * v * v' and G(i) = I - taup * u * u'
where tauq and taup are complex scalars, and v and u are complex vectors;
v(1:i) = 0, v(i+1) = 1, and v(i+2:m) is stored on exit in A(i+2:m,i);
u(1:i-1) = 0, u(i) = 1, and u(i+1:n) is stored on exit in A(i,i+1:n);
tauq is stored in TAUQ(i) and taup in TAUP(i).
The contents of A on exit are illustrated by the following examples:
m = 6 and n = 5 (m > n): m = 5 and n = 6 (m < n):
( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
( v1 v2 v3 v4 v5 )
where d and e denote diagonal and off-diagonal elements of B, vi
denotes an element of the vector defining H(i), and ui an element of
the vector defining G(i).
===================================================================== */
cuFloatComplex c_neg_one = MAGMA_C_NEG_ONE;
cuFloatComplex c_one = MAGMA_C_ONE;
cuFloatComplex *da, *dwork;
magma_int_t ncol, nrow, jmax, nb, ldda;
static magma_int_t i, j, nx;
static cuFloatComplex ws;
static magma_int_t iinfo;
magma_int_t minmn;
magma_int_t ldwrkx, ldwrky, lwkopt;
magma_int_t lquery;
nb = magma_get_cgebrd_nb(n);
ldda = m;
lwkopt = (m + n) * nb;
work[0] = MAGMA_C_MAKE( lwkopt, 0. );
lquery = (lwork == -1);
/* Check arguments */
*info = 0;
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (lda < max(1,m)) {
*info = -4;
} else if ( (lwork < max( max(1, m), n)) && (! lquery) ) {
*info = -10;
}
if (*info < 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
/* Quick return if possible */
minmn = min(m,n);
if (minmn == 0) {
work[0] = c_one;
return *info;
}
if (MAGMA_SUCCESS != magma_cmalloc( &da, n*ldda + (m + n)*nb )) {
fprintf (stderr, "!!!! device memory allocation error in cgebrd\n" );
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
dwork = da + (n)*ldda;
MAGMA_C_SET2REAL( ws, max(m,n) );
ldwrkx = m;
ldwrky = n;
/* Set the block/unblock crossover point NX. */
nx = 128;
/* Copy the matrix to the GPU */
if (minmn-nx>=1)
magma_csetmatrix( m, n, a, lda, da, ldda );
for (i=0; i< (minmn - nx); i += nb) {
/* Reduce rows and columns i:i+nb-1 to bidiagonal form and return
the matrices X and Y which are needed to update the unreduced
part of the matrix */
nrow = m - i;
ncol = n - i;
/* Get the current panel (no need for the 1st iteration) */
if ( i > 0 ) {
magma_cgetmatrix( nrow, nb, dA(i, i), ldda, A( i, i), lda );
magma_cgetmatrix( nb, ncol - nb,
dA(i, i+nb), ldda,
A( i, i+nb), lda );
}
magma_clabrd_gpu(nrow, ncol, nb,
A(i, i), lda, dA(i, i), ldda,
d+i, e+i, tauq+i, taup+i,
work, ldwrkx, dwork, ldwrkx, // x, dx
work+(ldwrkx*nb), ldwrky, dwork+(ldwrkx*nb), ldwrky); // y, dy
/* Update the trailing submatrix A(i+nb:m,i+nb:n), using an update
of the form A := A - V*Y' - X*U' */
nrow = m - i - nb;
ncol = n - i - nb;
// Send Y back to the GPU
magma_csetmatrix( nrow, nb, work + nb, ldwrkx, dwork + nb, ldwrkx );
magma_csetmatrix( ncol, nb,
work + (ldwrkx+1)*nb, ldwrky,
dwork + (ldwrkx+1)*nb, ldwrky );
magma_cgemm( MagmaNoTrans, MagmaConjTrans,
nrow, ncol, nb,
c_neg_one, dA(i+nb, i ), ldda,
dwork+(ldwrkx+1)*nb, ldwrky,
c_one, dA(i+nb, i+nb), ldda);
magma_cgemm( MagmaNoTrans, MagmaNoTrans,
nrow, ncol, nb,
c_neg_one, dwork+nb, ldwrkx,
dA( i, i+nb ), ldda,
c_one, dA( i+nb, i+nb ), ldda);
/* Copy diagonal and off-diagonal elements of B back into A */
if (m >= n) {
jmax = i + nb;
for (j = i; j < jmax; ++j) {
*A(j, j ) = MAGMA_C_MAKE( d[j], 0. );
*A(j, j+1) = MAGMA_C_MAKE( e[j], 0. );
}
} else {
jmax = i + nb;
for (j = i; j < jmax; ++j) {
*A(j, j ) = MAGMA_C_MAKE( d[j], 0. );
*A(j+1, j ) = MAGMA_C_MAKE( e[j], 0. );
/* L20: */
}
}
}
/* Use unblocked code to reduce the remainder of the matrix */
nrow = m - i;
ncol = n - i;
if ( 0 < (minmn-nx) )
magma_cgetmatrix( nrow, ncol, dA(i, i), ldda, A( i, i), lda );
lapackf77_cgebrd( &nrow, &ncol,
A(i, i), &lda, d+i, e+i,
tauq+i, taup+i, work, &lwork, &iinfo);
work[0] = ws;
magma_free( da );
return *info;
} /* cgebrd_ */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeev ( char  jobvl,
char  jobvr,
magma_int_t  n,
cuFloatComplex *  a,
magma_int_t  lda,
cuFloatComplex *  w,
cuFloatComplex *  vl,
magma_int_t  ldvl,
cuFloatComplex *  vr,
magma_int_t  ldvr,
cuFloatComplex *  work,
magma_int_t  lwork,
float *  rwork,
magma_int_t *  info 
)

Definition at line 24 of file cgeev.cpp.

References __func__, cblas_cscal(), cblas_csscal(), cblas_isamax(), CBLAS_SADDR, cblas_scnrm2(), dT, lapackf77_cgebak(), lapackf77_cgebal(), lapackf77_cgehrd(), lapackf77_chseqr(), lapackf77_clacpy(), lapackf77_clange(), lapackf77_clascl(), lapackf77_ctrevc(), lapackf77_cunghr(), lapackf77_lsame, lapackf77_slabad, lapackf77_slamch, MAGMA_C_CNJG, MAGMA_C_DSCALE, MAGMA_C_IMAG, MAGMA_C_MAKE, MAGMA_C_REAL, MAGMA_C_SET2REAL, magma_cgehrd(), magma_cgehrd2(), magma_cmalloc(), magma_cunghr(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgehrd_nb(), magma_ssqrt, MAGMA_SUCCESS, magma_xerbla(), MagmaLowerStr, max, side, and codegen::work.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEEV computes for an N-by-N complex nonsymmetric matrix A, the
eigenvalues and, optionally, the left and/or right eigenvectors.
The right eigenvector v(j) of A satisfies
A * v(j) = lambda(j) * v(j)
where lambda(j) is its eigenvalue.
The left eigenvector u(j) of A satisfies
u(j)**H * A = lambda(j) * u(j)**H
where u(j)**H denotes the conjfugate transpose of u(j).
The computed eigenvectors are normalized to have Euclidean norm
equal to 1 and largest component real.
Arguments
=========
JOBVL (input) CHARACTER*1
= 'N': left eigenvectors of A are not computed;
= 'V': left eigenvectors of are computed.
JOBVR (input) CHARACTER*1
= 'N': right eigenvectors of A are not computed;
= 'V': right eigenvectors of A are computed.
N (input) INTEGER
The order of the matrix A. N >= 0.
A (input/output) COMPLEX*16 array, dimension (LDA,N)
On entry, the N-by-N matrix A.
On exit, A has been overwritten.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
W (output) COMPLEX*16 array, dimension (N)
W contains the computed eigenvalues.
VL (output) COMPLEX*16 array, dimension (LDVL,N)
If JOBVL = 'V', the left eigenvectors u(j) are stored one
after another in the columns of VL, in the same order
as their eigenvalues.
If JOBVL = 'N', VL is not referenced.
u(j) = VL(:,j), the j-th column of VL.
LDVL (input) INTEGER
The leading dimension of the array VL. LDVL >= 1; if
JOBVL = 'V', LDVL >= N.
VR (output) COMPLEX*16 array, dimension (LDVR,N)
If JOBVR = 'V', the right eigenvectors v(j) are stored one
after another in the columns of VR, in the same order
as their eigenvalues.
If JOBVR = 'N', VR is not referenced.
v(j) = VR(:,j), the j-th column of VR.
LDVR (input) INTEGER
The leading dimension of the array VR. LDVR >= 1; if
JOBVR = 'V', LDVR >= N.
WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= (1+nb)*N.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
RWORK (workspace) DOUBLE PRECISION array, dimension (2*N)
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if INFO = i, the QR algorithm failed to compute all the
eigenvalues, and no eigenvectors have been computed;
elements and i+1:N of W contain eigenvalues which have
converged.
===================================================================== */
magma_int_t c__1 = 1;
magma_int_t c__0 = 0;
magma_int_t a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1,
i__2, i__3;
float d__1, d__2;
cuFloatComplex z__1, z__2;
magma_int_t i__, k, ihi;
float scl;
magma_int_t ilo;
float dum[1], eps;
cuFloatComplex tmp;
magma_int_t ibal;
float anrm;
magma_int_t ierr, itau, iwrk, nout;
magma_int_t scalea;
float cscale;
magma_int_t select[1];
static float bignum;
magma_int_t minwrk;
magma_int_t wantvl;
static float smlnum;
static magma_int_t irwork;
magma_int_t lquery, wantvr;
magma_int_t nb = 0;
cuFloatComplex *dT = NULL;
//magma_timestr_t start, end;
char side[2] = {0, 0};
char jobvl_[2] = {jobvl, 0};
char jobvr_[2] = {jobvr, 0};
*info = 0;
lquery = lwork == -1;
wantvl = lapackf77_lsame(jobvl_, "V");
wantvr = lapackf77_lsame(jobvr_, "V");
if (! wantvl && ! lapackf77_lsame(jobvl_, "N")) {
*info = -1;
} else if (! wantvr && ! lapackf77_lsame(jobvr_, "N")) {
*info = -2;
} else if (n < 0) {
*info = -3;
} else if (lda < max(1,n)) {
*info = -5;
} else if ( (ldvl < 1) || (wantvl && (ldvl < n))) {
*info = -8;
} else if ( (ldvr < 1) || (wantvr && (ldvr < n))) {
*info = -10;
}
/* Compute workspace */
if (*info == 0) {
nb = magma_get_cgehrd_nb(n);
minwrk = (1+nb)*n;
work[0] = MAGMA_C_MAKE((float) minwrk, 0.);
if (lwork < minwrk && ! lquery) {
*info = -12;
}
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (n == 0) {
return *info;
}
// if eigenvectors are needed
#if defined(VERSION3)
if (MAGMA_SUCCESS != magma_cmalloc( &dT, nb*n )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
#endif
a_dim1 = lda;
a_offset = 1 + a_dim1;
a -= a_offset;
vl_dim1 = ldvl;
vl_offset = 1 + vl_dim1;
vl -= vl_offset;
vr_dim1 = ldvr;
vr_offset = 1 + vr_dim1;
vr -= vr_offset;
--work;
--rwork;
/* Get machine constants */
eps = lapackf77_slamch("P");
smlnum = lapackf77_slamch("S");
bignum = 1. / smlnum;
lapackf77_slabad(&smlnum, &bignum);
smlnum = magma_ssqrt(smlnum) / eps;
bignum = 1. / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
anrm = lapackf77_clange("M", &n, &n, &a[a_offset], &lda, dum);
scalea = 0;
if (anrm > 0. && anrm < smlnum) {
scalea = 1;
cscale = smlnum;
} else if (anrm > bignum) {
scalea = 1;
cscale = bignum;
}
if (scalea) {
lapackf77_clascl("G", &c__0, &c__0, &anrm, &cscale, &n, &n, &a[a_offset], &lda, &
ierr);
}
/* Balance the matrix
(CWorkspace: none)
(RWorkspace: need N) */
ibal = 1;
lapackf77_cgebal("B", &n, &a[a_offset], &lda, &ilo, &ihi, &rwork[ibal], &ierr);
/* Reduce to upper Hessenberg form
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: none) */
itau = 1;
iwrk = itau + n;
i__1 = lwork - iwrk + 1;
//start = get_current_time();
#if defined(VERSION1)
/*
* Version 1 - LAPACK
*/
lapackf77_cgehrd(&n, &ilo, &ihi, &a[a_offset], &lda,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION2)
/*
* Version 2 - LAPACK consistent HRD
*/
magma_cgehrd2(n, ilo, ihi, &a[a_offset], lda,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION3)
/*
* Version 3 - LAPACK consistent MAGMA HRD + matrices T stored,
*/
magma_cgehrd(n, ilo, ihi, &a[a_offset], lda,
&work[itau], &work[iwrk], i__1, dT, &ierr);
#endif
//end = get_current_time();
//printf(" Time for cgehrd = %5.2f sec\n", GetTimerValue(start,end)/1000.);
if (wantvl) {
/* Want left eigenvectors
Copy Householder vectors to VL */
side[0] = 'L';
lapackf77_clacpy(MagmaLowerStr, &n, &n,
&a[a_offset], &lda, &vl[vl_offset], &ldvl);
/* Generate unitary matrix in VL
(CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
(RWorkspace: none) */
i__1 = lwork - iwrk + 1;
//start = get_current_time();
#if defined(VERSION1) || defined(VERSION2)
/*
* Version 1 & 2 - LAPACK
*/
lapackf77_cunghr(&n, &ilo, &ihi, &vl[vl_offset], &ldvl,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION3)
/*
* Version 3 - LAPACK consistent MAGMA HRD + matrices T stored
*/
magma_cunghr(n, ilo, ihi, &vl[vl_offset], ldvl, &work[itau],
dT, nb, &ierr);
#endif
//end = get_current_time();
//printf(" Time for cunghr = %5.2f sec\n", GetTimerValue(start,end)/1000.);
/* Perform QR iteration, accumulating Schur vectors in VL
(CWorkspace: need 1, prefer HSWORK (see comments) )
(RWorkspace: none) */
iwrk = itau;
i__1 = lwork - iwrk + 1;
lapackf77_chseqr("S", "V", &n, &ilo, &ihi, &a[a_offset], &lda, geev_w_array,
&vl[vl_offset], &ldvl, &work[iwrk], &i__1, info);
if (wantvr)
{
/* Want left and right eigenvectors
Copy Schur vectors to VR */
side[0] = 'B';
lapackf77_clacpy("F", &n, &n, &vl[vl_offset], &ldvl, &vr[vr_offset], &ldvr);
}
} else if (wantvr) {
/* Want right eigenvectors
Copy Householder vectors to VR */
side[0] = 'R';
lapackf77_clacpy("L", &n, &n, &a[a_offset], &lda, &vr[vr_offset], &ldvr);
/* Generate unitary matrix in VR
(CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
(RWorkspace: none) */
i__1 = lwork - iwrk + 1;
//start = get_current_time();
#if defined(VERSION1) || defined(VERSION2)
/*
* Version 1 & 2 - LAPACK
*/
lapackf77_cunghr(&n, &ilo, &ihi, &vr[vr_offset], &ldvr,
&work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION3)
/*
* Version 3 - LAPACK consistent MAGMA HRD + matrices T stored
*/
magma_cunghr(n, ilo, ihi, &vr[vr_offset], ldvr,
&work[itau], dT, nb, &ierr);
#endif
//end = get_current_time();
//printf(" Time for cunghr = %5.2f sec\n", GetTimerValue(start,end)/1000.);
/* Perform QR iteration, accumulating Schur vectors in VR
(CWorkspace: need 1, prefer HSWORK (see comments) )
(RWorkspace: none) */
iwrk = itau;
i__1 = lwork - iwrk + 1;
lapackf77_chseqr("S", "V", &n, &ilo, &ihi, &a[a_offset], &lda, geev_w_array,
&vr[vr_offset], &ldvr, &work[iwrk], &i__1, info);
} else {
/* Compute eigenvalues only
(CWorkspace: need 1, prefer HSWORK (see comments) )
(RWorkspace: none) */
iwrk = itau;
i__1 = lwork - iwrk + 1;
lapackf77_chseqr("E", "N", &n, &ilo, &ihi, &a[a_offset], &lda, geev_w_array,
&vr[vr_offset], &ldvr, &work[iwrk], &i__1, info);
}
/* If INFO > 0 from ZHSEQR, then quit */
if (*info > 0) {
goto L50;
}
if (wantvl || wantvr) {
/* Compute left and/or right eigenvectors
(CWorkspace: need 2*N)
(RWorkspace: need 2*N) */
irwork = ibal + n;
lapackf77_ctrevc(side, "B", select, &n, &a[a_offset], &lda, &vl[vl_offset], &ldvl,
&vr[vr_offset], &ldvr, &n, &nout, &work[iwrk], &rwork[irwork],
&ierr);
}
if (wantvl) {
/* Undo balancing of left eigenvectors
(CWorkspace: none)
(RWorkspace: need N) */
lapackf77_cgebak("B", "L", &n, &ilo, &ihi, &rwork[ibal], &n,
&vl[vl_offset], &ldvl, &ierr);
/* Normalize left eigenvectors and make largest component real */
for (i__ = 1; i__ <= n; ++i__) {
scl = 1. / cblas_scnrm2(n, &vl[i__ * vl_dim1 + 1], 1);
cblas_csscal(n, scl, &vl[i__ * vl_dim1 + 1], 1);
i__2 = n;
for (k = 1; k <= i__2; ++k)
{
i__3 = k + i__ * vl_dim1;
/* Computing 2nd power */
d__1 = MAGMA_C_REAL(vl[i__3]);
/* Computing 2nd power */
d__2 = MAGMA_C_IMAG(vl[k + i__ * vl_dim1]);
rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
}
/* Comment:
Fortran BLAS does not have to add 1
C BLAS must add one to cblas_isamax */
k = cblas_isamax(n, &rwork[irwork], 1)+1;
z__2 = MAGMA_C_CNJG(vl[k + i__ * vl_dim1]);
d__1 = magma_ssqrt(rwork[irwork + k - 1]);
MAGMA_C_DSCALE(z__1, z__2, d__1);
tmp = z__1;
cblas_cscal(n, CBLAS_SADDR(tmp), &vl[i__ * vl_dim1 + 1], 1);
i__2 = k + i__ * vl_dim1;
i__3 = k + i__ * vl_dim1;
d__1 = MAGMA_C_REAL(vl[i__3]);
MAGMA_C_SET2REAL(z__1, d__1);
vl[i__2] = z__1;
}
}
if (wantvr) {
/* Undo balancing of right eigenvectors
(CWorkspace: none)
(RWorkspace: need N) */
lapackf77_cgebak("B", "R", &n, &ilo, &ihi, &rwork[ibal], &n,
&vr[vr_offset], &ldvr, &ierr);
/* Normalize right eigenvectors and make largest component real */
for (i__ = 1; i__ <= n; ++i__) {
scl = 1. / cblas_scnrm2(n, &vr[i__ * vr_dim1 + 1], 1);
cblas_csscal(n, scl, &vr[i__ * vr_dim1 + 1], 1);
i__2 = n;
for (k = 1; k <= i__2; ++k) {
i__3 = k + i__ * vr_dim1;
/* Computing 2nd power */
d__1 = MAGMA_C_REAL(vr[i__3]);
/* Computing 2nd power */
d__2 = MAGMA_C_IMAG(vr[k + i__ * vr_dim1]);
rwork[irwork + k - 1] = d__1 * d__1 + d__2 * d__2;
}
/* Comment:
Fortran BLAS does not have to add 1
C BLAS must add one to cblas_isamax */
k = cblas_isamax(n, &rwork[irwork], 1)+1;
z__2 = MAGMA_C_CNJG(vr[k + i__ * vr_dim1]);
d__1 = magma_ssqrt(rwork[irwork + k - 1]);
MAGMA_C_DSCALE(z__1, z__2, d__1);
tmp = z__1;
cblas_cscal(n, CBLAS_SADDR(tmp), &vr[i__ * vr_dim1 + 1], 1);
i__2 = k + i__ * vr_dim1;
i__3 = k + i__ * vr_dim1;
d__1 = MAGMA_C_REAL(vr[i__3]);
MAGMA_C_SET2REAL(z__1, d__1);
vr[i__2] = z__1;
}
}
/* Undo scaling if necessary */
L50:
if (scalea) {
i__1 = n - *info;
/* Computing MAX */
i__3 = n - *info;
i__2 = max(i__3,1);
lapackf77_clascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1,
geev_w_array + *info, &i__2, &ierr);
if (*info > 0) {
i__1 = ilo - 1;
lapackf77_clascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1,
geev_w_array, &n, &ierr);
}
}
#if defined(VERSION3)
magma_free( dT );
#endif
return *info;
} /* magma_cgeev */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgehrd ( magma_int_t  n,
magma_int_t  ilo,
magma_int_t  ihi,
cuFloatComplex *  A,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
cuFloatComplex *  d_T,
magma_int_t *  info 
)

Definition at line 14 of file cgehrd.cpp.

References __func__, czero_nbxnb_block(), lapackf77_cgehd2(), MAGMA_C_ONE, MAGMA_C_SET2REAL, MAGMA_C_ZERO, magma_cgetmatrix(), magma_clahr2(), magma_clahru(), magma_cmalloc(), magma_csetmatrix(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_cgehrd_nb(), MAGMA_SUCCESS, magma_xerbla(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEHRD reduces a COMPLEX general matrix A to upper Hessenberg form H by
an orthogonal similarity transformation: Q' * A * Q = H . This version
stores the triangular matrices used in the factorization so that they can
be applied directly (i.e., without being recomputed) later. As a result,
the application of Q is much faster.
Arguments
=========
N (input) INTEGER
The order of the matrix A. N >= 0.
ILO (input) INTEGER
IHI (input) INTEGER
It is assumed that A is already upper triangular in rows
and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
set by a previous call to DGEBAL; otherwise they should be
set to 1 and N respectively. See Further Details.
1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the N-by-N general matrix to be reduced.
On exit, the upper triangle and the first subdiagonal of A
are overwritten with the upper Hessenberg matrix H, and the
elements below the first subdiagonal, with the array TAU,
represent the orthogonal matrix Q as a product of elementary
reflectors. See Further Details.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
TAU (output) COMPLEX array, dimension (N-1)
The scalar factors of the elementary reflectors (see Further
Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
zero.
WORK (workspace/output) COMPLEX array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The length of the array WORK. LWORK >= max(1,N).
For optimum performance LWORK >= N*NB, where NB is the
optimal blocksize.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
dT (output) COMPLEX array on the GPU, dimension N*NB,
where NB is the optimal blocksize. It stores the NB*NB blocks
of the triangular T matrices, used the the reduction.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
Further Details
===============
The matrix Q is represented as a product of (ihi-ilo) elementary
reflectors
Q = H(ilo) H(ilo+1) . . . H(ihi-1).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
exit in A(i+2:ihi,i), and tau in TAU(i).
The contents of A are illustrated by the following example, with
n = 7, ilo = 2 and ihi = 6:
on entry, on exit,
( a a a a a a a ) ( a a h h h h a )
( a a a a a a ) ( a h h h h a )
( a a a a a a ) ( h h h h h h )
( a a a a a a ) ( v2 h h h h h )
( a a a a a a ) ( v2 v3 h h h h )
( a a a a a a ) ( v2 v3 v4 h h h )
( a ) ( a )
where a denotes an element of the original matrix A, h denotes a
modified element of the upper Hessenberg matrix H, and vi denotes an
element of the vector defining H(i).
This implementation follows the hybrid algorithm and notations described in
S. Tomov and J. Dongarra, "Accelerating the reduction to upper Hessenberg
form through hybrid GPU-based computing," University of Tennessee Computer
Science Technical Report, UT-CS-09-642 (also LAPACK Working Note 219),
May 24, 2009.
===================================================================== */
cuFloatComplex c_one = MAGMA_C_ONE;
cuFloatComplex c_zero = MAGMA_C_ZERO;
magma_int_t nb = magma_get_cgehrd_nb(n);
magma_int_t N = n, ldda = n;
magma_int_t ib;
magma_int_t nh, iws;
magma_int_t nbmin, iinfo;
magma_int_t ldwork;
magma_int_t lquery;
--tau;
*info = 0;
MAGMA_C_SET2REAL( work[0], (float) n * nb );
lquery = lwork == -1;
if (n < 0) {
*info = -1;
} else if (ilo < 1 || ilo > max(1,n)) {
*info = -2;
} else if (ihi < min(ilo,n) || ihi > n) {
*info = -3;
} else if (lda < max(1,n)) {
*info = -5;
} else if (lwork < max(1,n) && ! lquery) {
*info = -8;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
/* Quick return if possible */
nh = ihi - ilo + 1;
if (nh <= 1) {
work[0] = c_one;
return *info;
}
cuFloatComplex *da;
if (MAGMA_SUCCESS != magma_cmalloc( &da, N*ldda + 2*N*nb + nb*nb )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
cuFloatComplex *d_A = da;
cuFloatComplex *d_work = da + (N+nb)*ldda;
magma_int_t i__;
cuFloatComplex *t, *d_t;
t = (cuFloatComplex*) malloc(nb*nb*sizeof(cuFloatComplex));
if ( t == NULL ) {
magma_free( da );
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
d_t = d_work + nb * ldda;
czero_nbxnb_block(nb, d_A+N*ldda, ldda);
/* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */
for (i__ = 1; i__ < ilo; ++i__)
tau[i__] = c_zero;
for (i__ = max(1,ihi); i__ < n; ++i__)
tau[i__] = c_zero;
for(i__=0; i__< nb*nb; i__+=4)
t[i__] = t[i__+1] = t[i__+2] = t[i__+3] = c_zero;
nbmin = 2;
iws = 1;
if (nb > 1 && nb < nh) {
/* Determine when to cross over from blocked to unblocked code
(last block is always handled by unblocked code) */
if (nb < nh) {
/* Determine if workspace is large enough for blocked code */
iws = n * nb;
if (lwork < iws) {
/* Not enough workspace to use optimal NB: determine the
minimum value of NB, and reduce NB or force use of
unblocked code */
nbmin = nb;
if (lwork >= n * nbmin)
nb = lwork / n;
else
nb = 1;
}
}
}
ldwork = n;
if (nb < nbmin || nb >= nh) {
/* Use unblocked code below */
i__ = ilo;
} else {
/* Use blocked code */
/* Copy the matrix to the GPU */
magma_csetmatrix( N, N-ilo+1, a+(ilo-1)*(lda), lda, d_A, ldda );
for (i__ = ilo; i__ < ihi - nb; i__ += nb) {
/* Computing MIN */
ib = min(nb, ihi - i__);
/* Reduce columns i:i+ib-1 to Hessenberg form, returning the
matrices V and T of the block reflector H = I - V*T*V'
which performs the reduction, and also the matrix Y = A*V*T */
/* Get the current panel (no need for the 1st iteration) */
magma_cgetmatrix( ihi-i__+1, ib,
d_A + (i__ - ilo)*ldda + i__ - 1, ldda,
a + (i__ - 1 )*lda + i__ - 1, lda );
magma_clahr2(ihi, i__, ib,
d_A + (i__ - ilo)*ldda,
d_A + N*ldda + 1,
a + (i__ - 1 )*(lda) , lda,
&tau[i__], t, nb, work, ldwork);
/* Copy T from the CPU to D_T on the GPU */
d_t = dT + (i__ - ilo)*nb;
magma_csetmatrix( nb, nb, t, nb, d_t, nb );
magma_clahru(n, ihi, i__ - 1, ib,
a + (i__ - 1 )*(lda), lda,
d_A + (i__ - ilo)*ldda,
d_A + (i__ - ilo)*ldda + i__ - 1,
d_A + N*ldda, d_t, d_work);
}
}
/* Use unblocked code to reduce the rest of the matrix */
if (!(nb < nbmin || nb >= nh))
magma_cgetmatrix( n, n-i__+1,
d_A+ (i__-ilo)*ldda, ldda,
a + (i__-1)*(lda), lda );
lapackf77_cgehd2(&n, &i__, &ihi, a, &lda, &tau[1], work, &iinfo);
MAGMA_C_SET2REAL( work[0], (float) iws );
magma_free( da );
free(t);
return *info;
} /* magma_cgehrd */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgehrd2 ( magma_int_t  n,
magma_int_t  ilo,
magma_int_t  ihi,
cuFloatComplex *  A,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t *  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgehrd2.cpp.

References __func__, czero_nbxnb_block(), lapackf77_cgehd2(), MAGMA_C_ONE, MAGMA_C_SET2REAL, MAGMA_C_ZERO, magma_cgetmatrix(), magma_clahr2(), magma_clahru(), magma_cmalloc(), magma_csetmatrix(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_cgehrd_nb(), MAGMA_SUCCESS, magma_xerbla(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEHRD2 reduces a COMPLEX general matrix A to upper Hessenberg form H by
an orthogonal similarity transformation: Q' * A * Q = H .
Arguments
=========
N (input) INTEGER
The order of the matrix A. N >= 0.
ILO (input) INTEGER
IHI (input) INTEGER
It is assumed that A is already upper triangular in rows
and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
set by a previous call to DGEBAL; otherwise they should be
set to 1 and N respectively. See Further Details.
1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the N-by-N general matrix to be reduced.
On exit, the upper triangle and the first subdiagonal of A
are overwritten with the upper Hessenberg matrix H, and the
elements below the first subdiagonal, with the array TAU,
represent the orthogonal matrix Q as a product of elementary
reflectors. See Further Details.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
TAU (output) COMPLEX array, dimension (N-1)
The scalar factors of the elementary reflectors (see Further
Details). Elements 1:ILO-1 and IHI:N-1 of TAU are set to
zero.
WORK (workspace/output) COMPLEX array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The length of the array WORK. LWORK >= max(1,N).
For optimum performance LWORK >= N*NB, where NB is the
optimal blocksize.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value.
Further Details
===============
The matrix Q is represented as a product of (ihi-ilo) elementary
reflectors
Q = H(ilo) H(ilo+1) . . . H(ihi-1).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
exit in A(i+2:ihi,i), and tau in TAU(i).
The contents of A are illustrated by the following example, with
n = 7, ilo = 2 and ihi = 6:
on entry, on exit,
( a a a a a a a ) ( a a h h h h a )
( a a a a a a ) ( a h h h h a )
( a a a a a a ) ( h h h h h h )
( a a a a a a ) ( v2 h h h h h )
( a a a a a a ) ( v2 v3 h h h h )
( a a a a a a ) ( v2 v3 v4 h h h )
( a ) ( a )
where a denotes an element of the original matrix A, h denotes a
modified element of the upper Hessenberg matrix H, and vi denotes an
element of the vector defining H(i).
This implementation follows the hybrid algorithm and notations described in
S. Tomov and J. Dongarra, "Accelerating the reduction to upper Hessenberg
form through hybrid GPU-based computing," University of Tennessee Computer
Science Technical Report, UT-CS-09-642 (also LAPACK Working Note 219),
May 24, 2009.
===================================================================== */
cuFloatComplex c_one = MAGMA_C_ONE;
cuFloatComplex c_zero = MAGMA_C_ZERO;
magma_int_t nb = magma_get_cgehrd_nb(n);
magma_int_t N = n, ldda = n;
magma_int_t ib;
magma_int_t nh, iws;
magma_int_t nbmin, iinfo;
magma_int_t ldwork;
magma_int_t lquery;
--tau;
*info = 0;
MAGMA_C_SET2REAL( work[0], (float) n * nb );
lquery = *lwork == -1;
if (n < 0) {
*info = -1;
} else if (ilo < 1 || ilo > max(1,n)) {
*info = -2;
} else if (ihi < min(ilo,n) || ihi > n) {
*info = -3;
} else if (lda < max(1,n)) {
*info = -5;
} else if (*lwork < max(1,n) && ! lquery) {
*info = -8;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
/* Quick return if possible */
nh = ihi - ilo + 1;
if (nh <= 1) {
work[0] = c_one;
return *info;
}
cuFloatComplex *da;
if (MAGMA_SUCCESS != magma_cmalloc( &da, N*ldda + 2*N*nb + nb*nb )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
cuFloatComplex *d_A = da;
cuFloatComplex *d_work = da + (N+nb)*ldda;
magma_int_t i__;
cuFloatComplex *t, *d_t;
t = (cuFloatComplex*) malloc( nb*nb * sizeof(cuFloatComplex));
if ( t == NULL ) {
magma_free( da );
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
d_t = d_work + nb * ldda;
czero_nbxnb_block(nb, d_A+N*ldda, ldda);
/* Set elements 1:ILO-1 and IHI:N-1 of TAU to zero */
for (i__ = 1; i__ < ilo; ++i__)
tau[i__] = c_zero;
for (i__ = max(1,ihi); i__ < n; ++i__)
tau[i__] = c_zero;
for(i__=0; i__< nb*nb; i__+=4)
t[i__] = t[i__+1] = t[i__+2] = t[i__+3] = c_zero;
nbmin = 2;
iws = 1;
if (nb > 1 && nb < nh) {
/* Determine when to cross over from blocked to unblocked code
(last block is always handled by unblocked code) */
if (nb < nh) {
/* Determine if workspace is large enough for blocked code */
iws = n * nb;
if (*lwork < iws) {
/* Not enough workspace to use optimal NB: determine the
minimum value of NB, and reduce NB or force use of
unblocked code */
nbmin = nb;
if (*lwork >= n * nbmin)
nb = *lwork / n;
else
nb = 1;
}
}
}
ldwork = n;
if (nb < nbmin || nb >= nh) {
/* Use unblocked code below */
i__ = ilo;
} else {
/* Use blocked code */
/* Copy the matrix to the GPU */
magma_csetmatrix( N, N-ilo+1, a+(ilo-1)*(lda), lda, d_A, ldda );
for (i__ = ilo; i__ < ihi - nb; i__ += nb) {
/* Computing MIN */
ib = min(nb, ihi - i__);
/* Reduce columns i:i+ib-1 to Hessenberg form, returning the
matrices V and T of the block reflector H = I - V*T*V'
which performs the reduction, and also the matrix Y = A*V*T */
/* Get the current panel (no need for the 1st iteration) */
magma_cgetmatrix( ihi-i__+1, ib,
d_A + (i__ - ilo)*ldda + i__ - 1, ldda,
a + (i__ - 1 )*lda + i__ - 1, lda );
magma_clahr2(ihi, i__, ib,
d_A + (i__ - ilo)*ldda,
d_A + N*ldda + 1,
a + (i__ - 1 )*(lda) , lda,
&tau[i__], t, nb, work, ldwork);
/* Copy T from the CPU to D_T on the GPU */
magma_csetmatrix( nb, nb, t, nb, d_t, nb );
magma_clahru(n, ihi, i__ - 1, ib,
a + (i__ - 1 )*(lda), lda,
d_A + (i__ - ilo)*ldda,
d_A + (i__ - ilo)*ldda + i__ - 1,
d_A + N*ldda, d_t, d_work);
}
}
/* Use unblocked code to reduce the rest of the matrix */
if (!(nb < nbmin || nb >= nh))
magma_cgetmatrix( n, n-i__+1,
d_A+ (i__-ilo)*ldda, ldda,
a + (i__-1)*(lda), lda );
lapackf77_cgehd2(&n, &i__, &ihi, a, &lda, &tau[1], work, &iinfo);
MAGMA_C_SET2REAL( work[0], (float) iws );
magma_free( da );
free(t);
return *info;
} /* magma_cgehrd2 */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgelqf ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  A,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgelqf.cpp.

References __func__, dA, MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf2_gpu(), magma_cgetmatrix(), magma_cmalloc(), magma_csetmatrix(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgelqf_nb(), MAGMA_SUCCESS, magma_xerbla(), magmablas_cinplace_transpose(), magmablas_ctranspose2(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGELQF computes an LQ factorization of a COMPLEX M-by-N matrix A:
A = L * Q.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, the elements on and below the diagonal of the array
contain the m-by-min(m,n) lower trapezoidal matrix L (L is
lower triangular if m <= n); the elements above the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of elementary reflectors (see Further Details).
Higher performance is achieved if A is in pinned memory, e.g.
allocated using magma_malloc_host.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
Higher performance is achieved if WORK is in pinned memory, e.g.
allocated using magma_malloc_host.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,M).
For optimum performance LWORK >= M*NB, where NB is the
optimal blocksize.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
if INFO = -10 internal GPU memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(k) . . . H(2) H(1), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) ( a+(a_2)*(lda) + (a_1))
cuFloatComplex *dA, *dAT;
cuFloatComplex c_one = MAGMA_C_ONE;
magma_int_t maxm, maxn, maxdim, nb;
magma_int_t iinfo, ldda;
long int lquery;
/* Function Body */
*info = 0;
nb = magma_get_cgelqf_nb(m);
work[0] = MAGMA_C_MAKE( (float)(m*nb), 0 );
lquery = (lwork == -1);
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (lda < max(1,m)) {
*info = -4;
} else if (lwork < max(1,m) && ! lquery) {
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (min(m, n) == 0) {
work[0] = c_one;
return *info;
}
maxm = ((m + 31)/32)*32;
maxn = ((n + 31)/32)*32;
maxdim = max(maxm, maxn);
if (maxdim*maxdim < 2*maxm*maxn)
{
ldda = maxdim;
if (MAGMA_SUCCESS != magma_cmalloc( &dA, maxdim*maxdim )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_csetmatrix( m, n, a, lda, dA, ldda );
dAT = dA;
magmablas_cinplace_transpose( dAT, ldda, ldda );
}
else
{
ldda = maxn;
if (MAGMA_SUCCESS != magma_cmalloc( &dA, 2*maxn*maxm )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magma_csetmatrix( m, n, a, lda, dA, maxm );
dAT = dA + maxn * maxm;
magmablas_ctranspose2( dAT, ldda, dA, maxm, m, n );
}
magma_cgeqrf2_gpu(n, m, dAT, ldda, tau, &iinfo);
if (maxdim*maxdim< 2*maxm*maxn){
magmablas_cinplace_transpose( dAT, ldda, ldda );
magma_cgetmatrix( m, n, dA, ldda, a, lda );
} else {
magmablas_ctranspose2( dA, maxm, dAT, ldda, n, m );
magma_cgetmatrix( m, n, dA, maxm, a, lda );
}
magma_free( dA );
return *info;
} /* magma_cgelqf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgelqf_gpu ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgelqf_gpu.cpp.

References __func__, dA, MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf2_gpu(), magma_cmalloc(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgelqf_nb(), MAGMA_SUCCESS, magma_xerbla(), magmablas_cinplace_transpose(), magmablas_ctranspose2(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGELQF computes an LQ factorization of a COMPLEX M-by-N matrix dA:
dA = L * Q.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
dA (input/output) COMPLEX array on the GPU, dimension (LDA,N)
On entry, the M-by-N matrix dA.
On exit, the elements on and below the diagonal of the array
contain the m-by-min(m,n) lower trapezoidal matrix L (L is
lower triangular if m <= n); the elements above the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of elementary reflectors (see Further Details).
LDA (input) INTEGER
The leading dimension of the array dA. LDA >= max(1,M).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
Higher performance is achieved if WORK is in pinned memory, e.g.
allocated using magma_malloc_host.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,M).
For optimum performance LWORK >= M*NB, where NB is the
optimal blocksize.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
if INFO = -10 internal GPU memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(k) . . . H(2) H(1), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n),
and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) ( dA+(a_2)*(lda) + (a_1))
cuFloatComplex *dAT;
cuFloatComplex c_one = MAGMA_C_ONE;
magma_int_t maxm, maxn, maxdim, nb;
magma_int_t iinfo;
long int lquery;
*info = 0;
nb = magma_get_cgelqf_nb(m);
work[0] = MAGMA_C_MAKE( (float)(m*nb), 0 );
lquery = (lwork == -1);
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (lda < max(1,m)) {
*info = -4;
} else if (lwork < max(1,m) && ! lquery) {
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (min(m, n) == 0) {
work[0] = c_one;
return *info;
}
maxm = ((m + 31)/32)*32;
maxn = ((n + 31)/32)*32;
maxdim = max(maxm, maxn);
int ldat = maxn;
dAT = dA;
if ((m == n) && (m % 32 == 0) && (lda%32 == 0)){
ldat = lda;
magmablas_cinplace_transpose( dAT, lda, maxm );
}
else {
if (MAGMA_SUCCESS != magma_cmalloc( &dAT, maxm*maxn ) ){
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
magmablas_ctranspose2( dAT, ldat, dA, lda, m, n );
}
magma_cgeqrf2_gpu(n, m, dAT, ldat, tau, &iinfo);
if ((m == n) && (m % 32 == 0) && (lda%32 == 0)){
magmablas_cinplace_transpose( dAT, ldat, maxm );
}
else {
magmablas_ctranspose2( dA, lda, dAT, ldat, n, m );
magma_free( dAT );
}
return *info;
} /* magma_cgelqf_gpu */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgels3_gpu ( char  trans,
magma_int_t  m,
magma_int_t  n,
magma_int_t  nrhs,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  dB,
magma_int_t  lddb,
cuFloatComplex *  hwork,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgels3_gpu.cpp.

References __func__, dT, MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf3_gpu(), magma_cgeqrs3_gpu(), magma_cmalloc(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_cgeqrf_nb(), MAGMA_SUCCESS, magma_xerbla(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
Solves the overdetermined, least squares problem
min || A*X - C ||
using the QR factorization A.
The underdetermined problem (m < n) is not currently handled.
Arguments
=========
TRANS (input) CHARACTER*1
= 'N': the linear system involves A.
Only trans='N' is currently handled.
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. M >= N >= 0.
NRHS (input) INTEGER
The number of columns of the matrix C. NRHS >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, A is overwritten by details of its QR
factorization as returned by CGEQRF3.
LDDA (input) INTEGER
The leading dimension of the array A, LDDA >= M.
DB (input/output) COMPLEX array on the GPU, dimension (LDDB,NRHS)
On entry, the M-by-NRHS matrix C.
On exit, the N-by-NRHS solution matrix X.
LDDB (input) INTEGER
The leading dimension of the array DB. LDDB >= M.
HWORK (workspace/output) COMPLEX array, dimension MAX(1,LWORK).
On exit, if INFO = 0, HWORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array HWORK, LWORK >= max(1,NRHS).
For optimum performance LWORK >= (M-N+NB)*(NRHS + 2*NB), where
NB is the blocksize given by magma_get_cgeqrf_nb( M ).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the HWORK array, returns
this value as the first entry of the HWORK array.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
===================================================================== */
#define a_ref(a_1,a_2) (dA+(a_2)*(ldda) + (a_1))
cuFloatComplex *dT, *tau;
magma_int_t k;
magma_int_t nb = magma_get_cgeqrf_nb(m);
magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
long int lquery = (lwork == -1);
hwork[0] = MAGMA_C_MAKE( (float)lwkopt, 0. );
*info = 0;
/* For now, N is the only case working */
if ( (trans != 'N') && (trans != 'n' ) )
*info = -1;
else if (m < 0)
*info = -2;
else if (n < 0 || m < n) /* LQ is not handle for now*/
*info = -3;
else if (nrhs < 0)
*info = -4;
else if (ldda < max(1,m))
*info = -6;
else if (lddb < max(1,m))
*info = -8;
else if (lwork < lwkopt && ! lquery)
*info = -10;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
k = min(m,n);
if (k == 0) {
hwork[0] = MAGMA_C_ONE;
return *info;
}
/*
* Allocate temporary buffers
*/
int ldtwork = ( 2*k + ((n+31)/32)*32 )*nb;
if (nb < nrhs)
ldtwork = ( 2*k + ((n+31)/32)*32 )*nrhs;
if (MAGMA_SUCCESS != magma_cmalloc( &dT, ldtwork )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
tau = (cuFloatComplex*) malloc( k * sizeof(cuFloatComplex) );
if( tau == NULL ) {
magma_free( dT );
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
magma_cgeqrf3_gpu( m, n, dA, ldda, tau, dT, info );
if ( *info == 0 ) {
magma_cgeqrs3_gpu( m, n, nrhs,
dA, ldda, tau, dT,
dB, lddb, hwork, lwork, info );
}
magma_free( dT );
free(tau);
return *info;
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgels_gpu ( char  trans,
magma_int_t  m,
magma_int_t  n,
magma_int_t  nrhs,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  dB,
magma_int_t  lddb,
cuFloatComplex *  hwork,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgels_gpu.cpp.

References __func__, dT, MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf_gpu(), magma_cgeqrs_gpu(), magma_cmalloc(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_cgeqrf_nb(), MAGMA_SUCCESS, magma_xerbla(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
Solves the overdetermined, least squares problem
min || A*X - C ||
using the QR factorization A.
The underdetermined problem (m < n) is not currently handled.
Arguments
=========
TRANS (input) CHARACTER*1
= 'N': the linear system involves A.
Only trans='N' is currently handled.
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. M >= N >= 0.
NRHS (input) INTEGER
The number of columns of the matrix C. NRHS >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, A is overwritten by details of its QR
factorization as returned by CGEQRF.
LDDA (input) INTEGER
The leading dimension of the array A, LDDA >= M.
DB (input/output) COMPLEX array on the GPU, dimension (LDDB,NRHS)
On entry, the M-by-NRHS matrix C.
On exit, the N-by-NRHS solution matrix X.
LDDB (input) INTEGER
The leading dimension of the array DB. LDDB >= M.
HWORK (workspace/output) COMPLEX array, dimension MAX(1,LWORK).
On exit, if INFO = 0, HWORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array HWORK, LWORK >= max(1,NRHS).
For optimum performance LWORK >= (M-N+NB)*(NRHS + 2*NB), where
NB is the blocksize given by magma_get_cgeqrf_nb( M ).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the HWORK array, returns
this value as the first entry of the HWORK array.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
===================================================================== */
#define a_ref(a_1,a_2) (dA+(a_2)*(ldda) + (a_1))
cuFloatComplex *dT, *tau;
magma_int_t k;
magma_int_t nb = magma_get_cgeqrf_nb(m);
magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
long int lquery = (lwork == -1);
hwork[0] = MAGMA_C_MAKE( (float)lwkopt, 0. );
*info = 0;
/* For now, N is the only case working */
if ( (trans != 'N') && (trans != 'n' ) )
*info = -1;
else if (m < 0)
*info = -2;
else if (n < 0 || m < n) /* LQ is not handle for now*/
*info = -3;
else if (nrhs < 0)
*info = -4;
else if (ldda < max(1,m))
*info = -6;
else if (lddb < max(1,m))
*info = -8;
else if (lwork < lwkopt && ! lquery)
*info = -10;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
k = min(m,n);
if (k == 0) {
hwork[0] = MAGMA_C_ONE;
return *info;
}
/*
* Allocate temporary buffers
*/
int ldtwork = ( 2*k + ((n+31)/32)*32 )*nb;
if (nb < nrhs)
ldtwork = ( 2*k + ((n+31)/32)*32 )*nrhs;
if (MAGMA_SUCCESS != magma_cmalloc( &dT, ldtwork )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
tau = (cuFloatComplex*) malloc( k * sizeof(cuFloatComplex) );
if( tau == NULL ) {
magma_free( dT );
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
magma_cgeqrf_gpu( m, n, dA, ldda, tau, dT, info );
if ( *info == 0 ) {
magma_cgeqrs_gpu( m, n, nrhs,
dA, ldda, tau, dT,
dB, lddb, hwork, lwork, info );
}
magma_free( dT );
free(tau);
return *info;
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqlf ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  A,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgeqlf.cpp.

References __func__, a_ref, cpanel_to_q(), cq_to_panel(), da_ref, dwork, lapackf77_cgeqlf(), lapackf77_clarft(), MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgetmatrix(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc(), magma_csetmatrix(), magma_csetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgeqlf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaBackward, MagmaBackwardStr, MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaLeft, MagmaLower, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
SGEQLF computes a QL factorization of a COMPLEX M-by-N matrix A:
A = Q * L.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, if m >= n, the lower triangle of the subarray
A(m-n+1:m,1:n) contains the N-by-N lower triangular matrix L;
if m <= n, the elements on and below the (n-m)-th
superdiagonal contain the M-by-N lower trapezoidal matrix L;
the remaining elements, with the array TAU, represent the
orthogonal matrix Q as a product of elementary reflectors
(see Further Details).
Higher performance is achieved if A is in pinned memory, e.g.
allocated using magma_malloc_host.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
Higher performance is achieved if WORK is in pinned memory, e.g.
allocated using magma_malloc_host.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= max(1,N).
For optimum performance LWORK >= N*NB, where NB can be obtained
through magma_get_cgeqlf_nb(M).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(k) . . . H(2) H(1), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(m-k+i+1:m) = 0 and v(m-k+i) = 1; v(1:m-k+i-1) is stored on exit in
A(1:m-k+i-1,n-k+i), and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) ( a+(a_2)*(lda) + (a_1))
#define da_ref(a_1,a_2) (da+(a_2)*ldda + (a_1))
cuFloatComplex *da, *dwork;
cuFloatComplex c_one = MAGMA_C_ONE;
magma_int_t i, k, lddwork, old_i, old_ib, nb;
magma_int_t rows, cols;
magma_int_t ib, ki, kk, mu, nu, iinfo, ldda;
long int lquery;
nb = magma_get_cgeqlf_nb(m);
*info = 0;
lquery = (lwork == -1);
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (lda < max(1,m)) {
*info = -4;
}
if (*info == 0) {
k = min(m,n);
if (k == 0)
work[0] = c_one;
else {
work[0] = MAGMA_C_MAKE( n*nb, 0 );
}
if (lwork < max(1,n) && ! lquery)
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
/* Quick return if possible */
if (k == 0)
return *info;
lddwork = ((n+31)/32)*32;
ldda = ((m+31)/32)*32;
if (MAGMA_SUCCESS != magma_cmalloc( &da, (n)*ldda + nb*lddwork )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
dwork = da + ldda*(n);
static cudaStream_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
if ( (nb > 1) && (nb < k) ) {
/* Use blocked code initially.
The last kk columns are handled by the block method.
First, copy the matrix on the GPU except the last kk columns */
magma_csetmatrix_async( (m), (n-nb),
a_ref(0, 0), lda,
da_ref(0, 0), ldda, stream[0] );
ki = ((k - nb - 1) / nb) * nb;
kk = min(k, ki + nb);
for (i = k - kk + ki; i >= k -kk; i -= nb) {
ib = min(k-i,nb);
if (i< k - kk + ki){
/* 1. Copy asynchronously the current panel to the CPU.
2. Copy asynchronously the submatrix below the panel
to the CPU) */
rows = m - k + i + ib;
magma_cgetmatrix_async( rows, ib,
da_ref(0, n-k+i), ldda,
a_ref(0, n-k+i), lda, stream[1] );
magma_cgetmatrix_async( (m-rows), ib,
da_ref(rows, n-k+i), ldda,
a_ref(rows, n-k+i), lda, stream[0] );
/* Apply H' to A(1:m-k+i+ib-1,1:n-k+i-1) from the left in
two steps - implementing the lookahead techniques.
This is the main update from the lookahead techniques. */
rows = m - k + old_i + old_ib;
cols = n - k + old_i - old_ib;
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaBackward, MagmaColumnwise,
rows, cols, old_ib,
da_ref(0, cols+old_ib), ldda, dwork, lddwork,
da_ref(0, 0 ), ldda, dwork+old_ib, lddwork);
}
magma_queue_sync( stream[1] );
/* Compute the QL factorization of the current block
A(1:m-k+i+ib-1,n-k+i:n-k+i+ib-1) */
rows = m - k + i + ib;
cols = n - k + i;
lapackf77_cgeqlf(&rows,&ib, a_ref(0,cols), &lda, tau+i, work, &lwork, &iinfo);
if (cols > 0) {
/* Form the triangular factor of the block reflector
H = H(i+ib-1) . . . H(i+1) H(i) */
lapackf77_clarft( MagmaBackwardStr, MagmaColumnwiseStr,
&rows, &ib,
a_ref(0, cols), &lda, tau + i, work, &ib);
cpanel_to_q( MagmaLower, ib, a_ref(rows-ib,cols), lda, work+ib*ib);
magma_csetmatrix( rows, ib,
a_ref(0,cols), lda,
da_ref(0,cols), ldda );
cq_to_panel( MagmaLower, ib, a_ref(rows-ib,cols), lda, work+ib*ib);
// Send the triangular part on the GPU
magma_csetmatrix( ib, ib, work, ib, dwork, lddwork );
/* Apply H' to A(1:m-k+i+ib-1,1:n-k+i-1) from the left in
two steps - implementing the lookahead techniques.
This is the update of first ib columns. */
if (i-ib >= k -kk)
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaBackward, MagmaColumnwise,
rows, ib, ib,
da_ref(0, cols), ldda, dwork, lddwork,
da_ref(0,cols-ib), ldda, dwork+ib, lddwork);
else{
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaBackward, MagmaColumnwise,
rows, cols, ib,
da_ref(0, cols), ldda, dwork, lddwork,
da_ref(0, 0 ), ldda, dwork+ib, lddwork);
}
old_i = i;
old_ib = ib;
}
}
mu = m - k + i + nb;
nu = n - k + i + nb;
magma_cgetmatrix( m, nu, da_ref(0,0), ldda, a_ref(0,0), lda );
} else {
mu = m;
nu = n;
}
/* Use unblocked code to factor the last or only block */
if (mu > 0 && nu > 0)
lapackf77_cgeqlf(&mu, &nu, a_ref(0,0), &lda, tau, work, &lwork, &iinfo);
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free( da );
return *info;
} /* magma_cgeqlf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqp3 ( magma_int_t *  m,
magma_int_t *  n,
cuFloatComplex *  a,
magma_int_t *  lda,
magma_int_t *  jpvt,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t *  lwork,
float *  rwork,
magma_int_t *  info 
)
magma_int_t magma_cgeqrf ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  A,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgeqrf.cpp.

References __func__, a_ref, cpanel_to_q(), cq_to_panel(), da_ref, dwork, lapackf77_cgeqrf(), lapackf77_clarft(), MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf4(), magma_cgeqrf_ooc(), magma_cgetmatrix(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc(), magma_csetmatrix(), magma_csetmatrix_async(), magma_free(), magma_get_cgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaUpper, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF computes a QR factorization of a COMPLEX M-by-N matrix A:
A = Q * R. This version does not require work space on the GPU
passed as input. GPU memory is allocated in the routine.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
Higher performance is achieved if A is in pinned memory, e.g.
allocated using magma_malloc_host.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
Higher performance is achieved if WORK is in pinned memory, e.g.
allocated using magma_malloc_host.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= N*NB,
where NB can be obtained through magma_get_cgeqrf_nb(M).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) ( a+(a_2)*(lda) + (a_1))
#define da_ref(a_1,a_2) (da+(a_2)*ldda + (a_1))
cuFloatComplex *da, *dwork;
cuFloatComplex c_one = MAGMA_C_ONE;
int i, k, lddwork, old_i, old_ib;
int ib, ldda;
/* Function Body */
*info = 0;
int nb = magma_get_cgeqrf_nb(min(m, n));
int lwkopt = n * nb;
work[0] = MAGMA_C_MAKE( (float)lwkopt, 0 );
long int lquery = (lwork == -1);
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (lda < max(1,m)) {
*info = -4;
} else if (lwork < max(1,n) && ! lquery) {
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
k = min(m,n);
if (k == 0) {
work[0] = c_one;
return *info;
}
lddwork = ((n+31)/32)*32;
ldda = ((m+31)/32)*32;
magma_int_t num_gpus = 1;
char * num_gpus_char = getenv("MAGMA_NUM_GPUS");
if (num_gpus_char != NULL ) num_gpus = atoi(num_gpus_char);
if( num_gpus > 1 ) {
/* call multiple-GPU interface */
return magma_cgeqrf4(num_gpus, m, n, a, lda, tau, work, lwork, info);
}
if (MAGMA_SUCCESS != magma_cmalloc( &da, (n)*ldda + nb*lddwork )) {
/* Switch to the "out-of-core" (out of GPU-memory) version */
return magma_cgeqrf_ooc(m, n, a, lda, tau, work, lwork, info);
}
static cudaStream_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
dwork = da + ldda*(n);
if ( (nb > 1) && (nb < k) ) {
/* Use blocked code initially */
magma_csetmatrix_async( (m), (n-nb),
a_ref(0,nb), lda,
da_ref(0,nb), ldda, stream[0] );
old_i = 0; old_ib = nb;
for (i = 0; i < k-nb; i += nb) {
ib = min(k-i, nb);
if (i>0){
magma_cgetmatrix_async( (m-i), ib,
da_ref(i,i), ldda,
a_ref(i,i), lda, stream[1] );
magma_cgetmatrix_async( i, ib,
da_ref(0,i), ldda,
a_ref(0,i), lda, stream[0] );
/* Apply H' to A(i:m,i+2*ib:n) from the left */
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
m-old_i, n-old_i-2*old_ib, old_ib,
da_ref(old_i, old_i), ldda, dwork, lddwork,
da_ref(old_i, old_i+2*old_ib), ldda, dwork+old_ib, lddwork);
}
magma_queue_sync( stream[1] );
int rows = m-i;
lapackf77_cgeqrf(&rows, &ib, a_ref(i,i), &lda, tau+i, work, &lwork, info);
/* Form the triangular factor of the block reflector
H = H(i) H(i+1) . . . H(i+ib-1) */
lapackf77_clarft( MagmaForwardStr, MagmaColumnwiseStr,
&rows, &ib, a_ref(i,i), &lda, tau+i, work, &ib);
cpanel_to_q(MagmaUpper, ib, a_ref(i,i), lda, work+ib*ib);
magma_csetmatrix( rows, ib, a_ref(i,i), lda, da_ref(i,i), ldda );
cq_to_panel(MagmaUpper, ib, a_ref(i,i), lda, work+ib*ib);
if (i + ib < n) {
magma_csetmatrix( ib, ib, work, ib, dwork, lddwork );
if (i+ib < k-nb)
/* Apply H' to A(i:m,i+ib:i+2*ib) from the left */
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, ib, ib,
da_ref(i, i ), ldda, dwork, lddwork,
da_ref(i, i+ib), ldda, dwork+ib, lddwork);
else
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, n-i-ib, ib,
da_ref(i, i ), ldda, dwork, lddwork,
da_ref(i, i+ib), ldda, dwork+ib, lddwork);
old_i = i;
old_ib = ib;
}
}
} else {
i = 0;
}
/* Use unblocked code to factor the last or only block. */
if (i < k) {
ib = n-i;
if (i!=0)
magma_cgetmatrix( m, ib, da_ref(0,i), ldda, a_ref(0,i), lda );
int rows = m-i;
lapackf77_cgeqrf(&rows, &ib, a_ref(i,i), &lda, tau+i, work, &lwork, info);
}
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free( da );
return *info;
} /* magma_cgeqrf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrf2_gpu ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  tau,
magma_int_t *  info 
)

Definition at line 14 of file cgeqrf2_gpu.cpp.

References __func__, cpanel_to_q(), cq_to_panel(), dwork, hwork, lapackf77_cgeqrf(), lapackf77_clarft(), magma_cgetmatrix(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc(), magma_cmalloc_host(), magma_csetmatrix(), magma_csetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_free_host(), magma_get_cgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaUpper, max, min, codegen::work, and work_ref.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF computes a QR factorization of a complex M-by-N matrix A:
A = Q * R.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
dA (input/output) COMPLEX array on the GPU, dimension (LDDA,N)
On entry, the M-by-N matrix dA.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
LDDA (input) INTEGER
The leading dimension of the array dA. LDDA >= max(1,M).
To benefit from coalescent memory accesses LDDA must be
dividable by 16.
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
#define dA(a_1,a_2) ( dA+(a_2)*(ldda) + (a_1))
#define work_ref(a_1) ( work + (a_1))
#define hwork ( work + (nb)*(m))
cuFloatComplex *dwork;
cuFloatComplex *work;
int i, k, ldwork, lddwork, old_i, old_ib, rows;
int nbmin, nx, ib, nb;
int lhwork, lwork;
/* Function Body */
*info = 0;
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (ldda < max(1,m)) {
*info = -4;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
k = min(m,n);
if (k == 0)
return *info;
nb = magma_get_cgeqrf_nb(m);
lwork = (m+n) * nb;
lhwork = lwork - (m)*nb;
if (MAGMA_SUCCESS != magma_cmalloc( &dwork, (n)*nb )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
if (MAGMA_SUCCESS != magma_cmalloc_host( &work, lwork )) {
magma_free( dwork );
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
static cudaStream_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
nbmin = 2;
nx = nb;
ldwork = m;
lddwork= n;
if (nb >= nbmin && nb < k && nx < k) {
/* Use blocked code initially */
old_i = 0; old_ib = nb;
for (i = 0; i < k-nx; i += nb) {
ib = min(k-i, nb);
rows = m -i;
magma_cgetmatrix_async( rows, ib,
dA(i,i), ldda,
work_ref(i), ldwork, stream[1] );
if (i>0){
/* Apply H' to A(i:m,i+2*ib:n) from the left */
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
m-old_i, n-old_i-2*old_ib, old_ib,
dA(old_i, old_i ), ldda, dwork, lddwork,
dA(old_i, old_i+2*old_ib), ldda, dwork+old_ib, lddwork);
magma_csetmatrix_async( old_ib, old_ib,
work_ref(old_i), ldwork,
dA(old_i, old_i), ldda, stream[0] );
}
magma_queue_sync( stream[1] );
lapackf77_cgeqrf(&rows, &ib, work_ref(i), &ldwork, tau+i, hwork, &lhwork, info);
/* Form the triangular factor of the block reflector
H = H(i) H(i+1) . . . H(i+ib-1) */
lapackf77_clarft( MagmaForwardStr, MagmaColumnwiseStr,
&rows, &ib,
work_ref(i), &ldwork, tau+i, hwork, &ib);
cpanel_to_q( MagmaUpper, ib, work_ref(i), ldwork, hwork+ib*ib );
magma_csetmatrix( rows, ib, work_ref(i), ldwork, dA(i,i), ldda );
cq_to_panel( MagmaUpper, ib, work_ref(i), ldwork, hwork+ib*ib );
if (i + ib < n) {
magma_csetmatrix( ib, ib, hwork, ib, dwork, lddwork );
if (i+nb < k-nx)
/* Apply H' to A(i:m,i+ib:i+2*ib) from the left */
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, ib, ib,
dA(i, i ), ldda, dwork, lddwork,
dA(i, i+ib), ldda, dwork+ib, lddwork);
else {
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, n-i-ib, ib,
dA(i, i ), ldda, dwork, lddwork,
dA(i, i+ib), ldda, dwork+ib, lddwork);
magma_csetmatrix( ib, ib,
work_ref(i), ldwork,
dA(i,i), ldda );
}
old_i = i;
old_ib = ib;
}
}
} else {
i = 0;
}
magma_free( dwork );
/* Use unblocked code to factor the last or only block. */
if (i < k) {
ib = n-i;
rows = m-i;
magma_cgetmatrix( rows, ib, dA(i, i), ldda, work, rows );
lhwork = lwork - rows*ib;
lapackf77_cgeqrf(&rows, &ib, work, &rows, tau+i, work+ib*rows, &lhwork, info);
magma_csetmatrix( rows, ib, work, rows, dA(i, i), ldda );
}
magma_free_host( work );
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
return *info;
} /* magma_cgeqrf2_gpu */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrf2_mgpu ( magma_int_t  num_gpus,
magma_int_t  m,
magma_int_t  n,
cuFloatComplex **  dlA,
magma_int_t  ldda,
cuFloatComplex *  tau,
magma_int_t *  info 
)

Definition at line 125 of file cgeqrf_mgpu-trace.cpp.

References __func__, core_cpu_event_end, core_cpu_event_start, core_gpu_event_end, core_gpu_event_start, core_log_event, cpanel_to_q(), cq_to_panel(), dump_trace(), dwork, get_current_cpu_time(), hwrk_ref, lapackf77_cgeqrf(), lapackf77_clarft(), lhwrk, magma_cgetmatrix(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc(), magma_cmalloc_host(), magma_csetmatrix(), magma_csetmatrix_async(), magma_device_sync(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_event_create(), magma_event_record(), magma_free(), magma_get_cgeqrf_nb(), magma_getdevice(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), magma_setdevice(), MAGMA_SUCCESS, magma_xerbla(), magmablas_cgetmatrix_1D_bcyclic(), magmablas_csetmatrix_1D_bcyclic(), MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaUpper, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF2_MGPU computes a QR factorization of a complex M-by-N matrix A:
A = Q * R. This is a GPU interface of the routine.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
dA (input/output) COMPLEX array on the GPU, dimension (LDDA,N)
On entry, the M-by-N matrix dA.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
LDDA (input) INTEGER
The leading dimension of the array dA. LDDA >= max(1,M).
To benefit from coalescent memory accesses LDDA must be
dividable by 16.
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
#define dlA(gpu,a_1,a_2) ( dlA[gpu]+(a_2)*(ldda) + (a_1))
#define work_ref(a_1) ( work + (a_1))
#define hwork ( work + (nb)*(m))
#define hwrk_ref(a_1) ( local_work + (a_1))
#define lhwrk ( local_work + (nb)*(m))
cuFloatComplex *dwork[4], *panel[4], *local_work;
magma_int_t i, j, k, ldwork, lddwork, old_i, old_ib, rows;
magma_int_t nbmin, nx, ib, nb;
magma_int_t lhwork, lwork;
magma_int_t cdevice;
magma_getdevice(&cdevice);
float ctime, dtime;
int panel_gpunum=-1, i_local, n_local[4], la_gpu, displacement;
*info = 0;
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (ldda < max(1,m)) {
*info = -4;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
k = min(m,n);
if (k == 0)
return *info;
nb = magma_get_cgeqrf_nb(m);
displacement = n * nb;
lwork = max((m+n+64) * nb,n*m+n*nb);
lhwork = lwork - (m)*nb;
for(i=0; i<num_gpus; i++){
#ifdef MultiGPUs
magma_setdevice(i);
#endif
if (MAGMA_SUCCESS != magma_cmalloc( &(dwork[i]), (n + ldda)*nb )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
}
/* Set the number of local n for each GPU */
for(i=0; i<num_gpus; i++){
n_local[i] = ((n/nb)/num_gpus)*nb;
if (i < (n/nb)%num_gpus)
n_local[i] += nb;
else if (i == (n/nb)%num_gpus)
n_local[i] += n%nb;
}
if (MAGMA_SUCCESS != magma_cmalloc_host( &local_work, lwork )) {
for(i=0; i<num_gpus; i++){
#ifdef MultiGPUs
magma_setdevice(i);
#endif
magma_free( dwork[i] );
}
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
static cudaStream_t streaml[4][2];
cudaEvent_t start[4], stop[4][10];
for(i=0; i<num_gpus; i++){
#ifdef MultiGPUs
magma_setdevice(i);
#endif
magma_queue_create( &streaml[i][0] );
magma_queue_create( &streaml[i][1] );
magma_event_create( &start[i] );
for(j=0; j<10; j++)
magma_event_create( &stop[i][j] );
magma_event_record( start[i], 0 );
}
core_cpu_event_start(num_gpus);
core_cpu_event_end(num_gpus);
core_log_event(0x666666, num_gpus);
dtime = get_current_cpu_time();
for(j=0; j<num_gpus; j++){
magma_setdevice(j);
magma_event_record(stop[j][0], 0);
magma_event_record(stop[j][1], 0);
magma_device_sync();
core_gpu_event_start(j, start[j], stop[j][0]);
core_gpu_event_end(j, start[j], stop[j][1]);
core_log_event(0x666666, j);
}
nbmin = 2;
nx = nb;
ldwork = m;
lddwork= n;
// magmablasSetKernelStream(streaml[0][0]);
if (nb >= nbmin && nb < k && nx < k) {
/* Use blocked code initially */
old_i = 0; old_ib = nb;
for (i = 0; i < k-nx; i += nb)
{
/* Set the GPU number that holds the current panel */
panel_gpunum = (i/nb)%num_gpus;
/* Set the local index where the current panel is */
i_local = i/(nb*num_gpus)*nb;
ib = min(k-i, nb);
rows = m -i;
/* Send current panel to the CPU */
#ifdef MultiGPUs
magma_setdevice(panel_gpunum);
#endif
magma_cgetmatrix_async( rows, ib,
dlA(panel_gpunum, i, i_local), ldda,
hwrk_ref(i), ldwork, streaml[panel_gpunum][1] );
if (i>0){
/* Apply H' to A(i:m,i+2*ib:n) from the left; this is the look-ahead
application to the trailing matrix */
la_gpu = panel_gpunum;
/* only the GPU that has next panel is done look-ahead */
#ifdef MultiGPUs
magma_setdevice(la_gpu);
#endif
magma_event_record(stop[la_gpu][0], 0);
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
m-old_i, n_local[la_gpu]-i_local-old_ib, old_ib,
panel[la_gpu], ldda, dwork[la_gpu], lddwork,
dlA(la_gpu, old_i, i_local+old_ib), ldda,
dwork[la_gpu]+old_ib, lddwork);
magma_event_record(stop[la_gpu][1], 0);
la_gpu = ((i-nb)/nb)%num_gpus;
#ifdef MultiGPUs
magma_setdevice(la_gpu);
#endif
magma_csetmatrix_async( old_ib, old_ib,
hwrk_ref(old_i), ldwork,
panel[la_gpu], ldda, streaml[la_gpu][0] );
}
#ifdef MultiGPUs
magma_setdevice(panel_gpunum);
#endif
magma_queue_sync( streaml[panel_gpunum][1] );
core_cpu_event_start(num_gpus);
lapackf77_cgeqrf(&rows, &ib, hwrk_ref(i), &ldwork, tau+i, lhwrk, &lhwork, info);
// Form the triangular factor of the block reflector
// H = H(i) H(i+1) . . . H(i+ib-1)
lapackf77_clarft( MagmaForwardStr, MagmaColumnwiseStr,
&rows, &ib,
hwrk_ref(i), &ldwork, tau+i, lhwrk, &ib);
cpanel_to_q( MagmaUpper, ib, hwrk_ref(i), ldwork, lhwrk+ib*ib );
core_cpu_event_end(num_gpus);
core_log_event(0x006680, num_gpus);
core_cpu_event_start(num_gpus);
// Send the current panel back to the GPUs
// Has to be done with asynchronous copies
for(j=0; j<num_gpus; j++)
{
#ifdef MultiGPUs
magma_setdevice(j);
#endif
if (j == panel_gpunum)
panel[j] = dlA(j, i, i_local);
else
panel[j] = dwork[j]+displacement;
magma_csetmatrix_async( rows, ib,
hwrk_ref(i), ldwork,
panel[j], ldda, streaml[j][0] );
}
for(j=0; j<num_gpus; j++)
{
#ifdef MultiGPUs
magma_setdevice(j);
#endif
magma_queue_sync( streaml[j][0] );
}
core_cpu_event_end(num_gpus);
core_log_event(0xDD0000, num_gpus);
//=================== take the values of all counters
/* Restore the panel */
core_cpu_event_start(num_gpus);
cq_to_panel( MagmaUpper, ib, hwrk_ref(i), ldwork, lhwrk+ib*ib );
core_cpu_event_end(num_gpus);
core_log_event(0x006680, num_gpus);
if (i>0){
for(j=0; j<num_gpus; j++){
magma_setdevice(j);
core_gpu_event_start(j, start[j], stop[j][2]);
core_gpu_event_end(j, start[j], stop[j][3]);
core_log_event(0x880000, j);
core_gpu_event_start(j, start[j], stop[j][3]);
core_gpu_event_end(j, start[j], stop[j][0]);
core_log_event(0xDD0000, j);
}
}
magma_setdevice(panel_gpunum);
core_gpu_event_start(panel_gpunum, start[panel_gpunum], stop[panel_gpunum][0]);
core_gpu_event_end(panel_gpunum, start[panel_gpunum], stop[panel_gpunum][1]);
core_log_event(0x660000, panel_gpunum);
if (i + ib < n)
{
/* Send the T matrix to the GPU.
Has to be done with asynchronous copies */
for(j=0; j<num_gpus; j++)
{
#ifdef MultiGPUs
magma_setdevice(j);
#endif
magma_csetmatrix_async( ib, ib,
lhwrk, ib,
dwork[j], lddwork, streaml[j][0] );
}
if (i+nb < k-nx)
{
/* Apply H' to A(i:m,i+ib:i+2*ib) from the left;
This is update for the next panel; part of the look-ahead */
la_gpu = (panel_gpunum+1)%num_gpus;
int i_loc = (i+nb)/(nb*num_gpus)*nb;
for(j=0; j<num_gpus; j++){
#ifdef MultiGPUs
magma_setdevice(j);
#endif
//magma_queue_sync( streaml[j][0] );
magma_device_sync();
magma_event_record(stop[j][2], 0);
if (j==la_gpu)
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, ib, ib,
panel[j], ldda, dwork[j], lddwork,
dlA(j, i, i_loc), ldda, dwork[j]+ib, lddwork);
else if (j<=panel_gpunum)
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, n_local[j]-i_local-ib, ib,
panel[j], ldda, dwork[j], lddwork,
dlA(j, i, i_local+ib), ldda, dwork[j]+ib, lddwork);
else
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, n_local[j]-i_local, ib,
panel[j], ldda, dwork[j], lddwork,
dlA(j, i, i_local), ldda, dwork[j]+ib, lddwork);
magma_event_record(stop[j][3], 0);
}
}
else {
/* do the entire update as we exit and there would be no lookahead */
la_gpu = (panel_gpunum+1)%num_gpus;
int i_loc = (i+nb)/(nb*num_gpus)*nb;
#ifdef MultiGPUs
magma_setdevice(la_gpu);
#endif
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, n_local[la_gpu]-i_loc, ib,
panel[la_gpu], ldda, dwork[la_gpu], lddwork,
dlA(la_gpu, i, i_loc), ldda, dwork[la_gpu]+ib, lddwork);
#ifdef MultiGPUs
magma_setdevice(panel_gpunum);
#endif
magma_csetmatrix( ib, ib,
hwrk_ref(i), ldwork,
dlA(panel_gpunum, i, i_local), ldda );
}
old_i = i;
old_ib = ib;
}
}
} else {
i = 0;
}
for(j=0; j<num_gpus; j++){
#ifdef MultiGPUs
magma_setdevice(j);
#endif
magma_free( dwork[j] );
}
/* Use unblocked code to factor the last or only block. */
if (i < k) {
ib = n-i;
rows = m-i;
lhwork = lwork - rows*ib;
panel_gpunum = (panel_gpunum+1)%num_gpus;
int i_loc = (i)/(nb*num_gpus)*nb;
#ifdef MultiGPUs
magma_setdevice(panel_gpunum);
#endif
if (i == 0) {
magmablas_cgetmatrix_1D_bcyclic(m, n, dlA, ldda, lhwrk, m, num_gpus, nb);
} else {
magma_cgetmatrix( rows, ib,
dlA(panel_gpunum, i, i_loc), ldda,
lhwrk, rows );
}
lhwork = lwork - rows*ib;
lapackf77_cgeqrf(&rows, &ib, lhwrk, &rows, tau+i, lhwrk+ib*rows, &lhwork, info);
if (i == 0) {
magmablas_csetmatrix_1D_bcyclic(m, n, lhwrk, m, dlA, ldda, num_gpus, nb);
} else {
magma_csetmatrix( rows, ib,
lhwrk, rows,
dlA(panel_gpunum, i, i_loc), ldda );
}
}
for(i=0; i<num_gpus; i++){
#ifdef MultiGPUs
magma_setdevice(i);
#endif
magma_queue_destroy( streaml[i][0] );
magma_queue_destroy( streaml[i][1] );
}
magma_setdevice(cdevice);
dump_trace(num_gpus+1);
return *info;
} /* magma_cgeqrf2_mgpu */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrf3_gpu ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  tau,
cuFloatComplex *  dT,
magma_int_t *  info 
)

Definition at line 38 of file cgeqrf3_gpu.cpp.

References __func__, a_ref, csplit_diag_block3(), d_ref, dd_ref, hwork, lapackf77_cgeqrf(), lapackf77_clarft(), magma_cgetmatrix(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc_host(), magma_csetmatrix(), magma_csetmatrix_async(), MAGMA_ERR_HOST_ALLOC, magma_free_host(), magma_get_cgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaForward, MagmaForwardStr, MagmaLeft, max, min, t_ref, codegen::work, and work_ref.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF3 computes a QR factorization of a COMPLEX M-by-N matrix A:
A = Q * R. This version stores the triangular matrices T used in
the block QR factorization so that Q can be applied directly (i.e.,
without being recomputed) later. As a result, the application
of Q is much faster. The upper triangular matrices for V have 0s
in them and the corresponding parts of the upper triangular R are
stored separately.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array on the GPU, dimension (LDDA,N)
On entry, the M-by-N matrix A.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
LDDA (input) INTEGER
The leading dimension of the array A. LDDA >= max(1,M).
To benefit from coalescent memory accesses LDDA must be
dividable by 16.
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
dT (workspace/output) COMPLEX array on the GPU,
dimension (2*MIN(M, N) + (N+31)/32*32 )*NB,
where NB can be obtained through magma_get_cgeqrf_nb(M).
It starts with MIN(M,N)*NB block that store the triangular T
matrices, followed by the MIN(M,N)*NB block of the diagonal
matrices for the R matrix. The rest of the array is used as workspace.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) (dA+(a_2)*(ldda) + (a_1))
#define t_ref(a_1) (dT+(a_1)*nb)
#define d_ref(a_1) (dT+(minmn+(a_1))*nb)
#define dd_ref(a_1) (dT+(2*minmn+(a_1))*nb)
#define work_ref(a_1) ( work + (a_1))
#define hwork ( work + (nb)*(m))
magma_int_t i, k, minmn, old_i, old_ib, rows, cols;
magma_int_t ib, nb;
magma_int_t ldwork, lddwork, lwork, lhwork;
cuFloatComplex *work, *ut;
/* check arguments */
*info = 0;
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (ldda < max(1,m)) {
*info = -4;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
k = minmn = min(m,n);
if (k == 0)
return *info;
nb = magma_get_cgeqrf_nb(m);
lwork = (m + n + nb)*nb;
lhwork = lwork - m*nb;
if (MAGMA_SUCCESS != magma_cmalloc_host( &work, lwork )) {
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
ut = hwork+nb*(n);
memset( ut, 0, nb*nb*sizeof(cuFloatComplex));
static cudaStream_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
ldwork = m;
lddwork= n;
if ( (nb > 1) && (nb < k) ) {
/* Use blocked code initially */
old_i = 0; old_ib = nb;
for (i = 0; i < k-nb; i += nb) {
ib = min(k-i, nb);
rows = m -i;
magma_cgetmatrix_async( rows, ib,
a_ref(i,i), ldda,
work_ref(i), ldwork, stream[1] );
if (i>0){
/* Apply H' to A(i:m,i+2*ib:n) from the left */
cols = n-old_i-2*old_ib;
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
m-old_i, cols, old_ib,
a_ref(old_i, old_i ), ldda, t_ref(old_i), nb,
a_ref(old_i, old_i+2*old_ib), ldda, dd_ref(0), lddwork);
/* store the diagonal */
magma_csetmatrix_async( old_ib, old_ib,
ut, old_ib,
d_ref(old_i), old_ib, stream[0] );
}
magma_queue_sync( stream[1] );
lapackf77_cgeqrf(&rows, &ib, work_ref(i), &ldwork, tau+i, hwork, &lhwork, info);
/* Form the triangular factor of the block reflector
H = H(i) H(i+1) . . . H(i+ib-1) */
lapackf77_clarft( MagmaForwardStr, MagmaColumnwiseStr,
&rows, &ib,
work_ref(i), &ldwork, tau+i, hwork, &ib);
/* Put 0s in the upper triangular part of a panel (and 1s on the
diagonal); copy the upper triangular in ut. */
magma_queue_sync( stream[0] );
csplit_diag_block3(ib, work_ref(i), ldwork, ut);
magma_csetmatrix( rows, ib, work_ref(i), ldwork, a_ref(i,i), ldda );
if (i + ib < n) {
/* Send the triangular factor T to the GPU */
magma_csetmatrix( ib, ib, hwork, ib, t_ref(i), nb );
if (i+nb < k-nb){
/* Apply H' to A(i:m,i+ib:i+2*ib) from the left */
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, ib, ib,
a_ref(i, i ), ldda, t_ref(i), nb,
a_ref(i, i+ib), ldda, dd_ref(0), lddwork);
}
else {
cols = n-i-ib;
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, cols, ib,
a_ref(i, i ), ldda, t_ref(i), nb,
a_ref(i, i+ib), ldda, dd_ref(0), lddwork);
/* Fix the diagonal block */
magma_csetmatrix( ib, ib, ut, ib, d_ref(i), ib );
}
old_i = i;
old_ib = ib;
}
}
} else {
i = 0;
}
/* Use unblocked code to factor the last or only block. */
if (i < k) {
ib = n-i;
rows = m-i;
magma_cgetmatrix( rows, ib, a_ref(i, i), ldda, work, rows );
lhwork = lwork - rows*ib;
lapackf77_cgeqrf(&rows, &ib, work, &rows, tau+i, work+ib*rows, &lhwork, info);
magma_csetmatrix( rows, ib, work, rows, a_ref(i, i), ldda );
}
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free_host( work );
return *info;
/* End of MAGMA_CGEQRF */
} /* magma_cgeqrf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrf4 ( magma_int_t  num_gpus,
magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  a,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgeqrf-v4.cpp.

References __func__, lapackf77_cgeqrf(), MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf2_mgpu(), magma_cmalloc(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgeqrf_nb(), magma_setdevice(), MAGMA_SUCCESS, magma_xerbla(), magmablas_cgetmatrix_1D_bcyclic(), magmablas_csetmatrix_1D_bcyclic(), max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF4 computes a QR factorization of a COMPLEX M-by-N matrix A:
A = Q * R using multiple GPUs. This version does not require work space on the GPU
passed as input. GPU memory is allocated in the routine.
Arguments
=========
NUM_GPUS
(input) INTEGER
The number of GPUs to be used for the factorization.
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
Higher performance is achieved if A is in pinned memory, e.g.
allocated using magma_malloc_host.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
Higher performance is achieved if WORK is in pinned memory, e.g.
allocated using magma_malloc_host.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= N*NB,
where NB can be obtained through magma_get_cgeqrf_nb(M).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
cuFloatComplex *da[4];
cuFloatComplex c_one = MAGMA_C_ONE;
int i, k, ldda;
*info = 0;
int nb = magma_get_cgeqrf_nb(min(m, n));
int lwkopt = n * nb;
work[0] = MAGMA_C_MAKE( (float)lwkopt, 0 );
long int lquery = (lwork == -1);
if (num_gpus <0 || num_gpus > 4) {
*info = -1;
} else if (m < 0) {
*info = -2;
} else if (n < 0) {
*info = -3;
} else if (lda < max(1,m)) {
*info = -5;
} else if (lwork < max(1,n) && ! lquery) {
*info = -8;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
k = min(m,n);
if (k == 0) {
work[0] = c_one;
return *info;
}
ldda = ((m+31)/32)*32;
magma_int_t n_local[4];
for(i=0; i<num_gpus; i++){
n_local[i] = ((n/nb)/num_gpus)*nb;
if (i < (n/nb)%num_gpus)
n_local[i] += nb;
else if (i == (n/nb)%num_gpus)
n_local[i] += n%nb;
magma_setdevice(i);
// TODO on failure, free previously allocated memory
if (MAGMA_SUCCESS != magma_cmalloc( &da[i], ldda*n_local[i] )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
}
if (m > nb && n > nb) {
/* Copy the matrix to the GPUs in 1D block cyclic distribution */
magmablas_csetmatrix_1D_bcyclic(m, n, a, lda, da, ldda, num_gpus, nb);
/* Factor using the GPU interface */
magma_cgeqrf2_mgpu( num_gpus, m, n, da, ldda, tau, info);
/* Copy the matrix back from the GPUs to the CPU */
magmablas_cgetmatrix_1D_bcyclic(m, n, da, ldda, a, lda, num_gpus, nb);
} else {
lapackf77_cgeqrf(&m, &n, a, &lda, tau, work, &lwork, info);
}
/* Free the allocated GPU memory */
for(i=0; i<num_gpus; i++){
magma_setdevice(i);
magma_free( da[i] );
}
return *info;
} /* magma_cgeqrf4 */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrf_gpu ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  tau,
cuFloatComplex *  dT,
magma_int_t *  info 
)

Definition at line 41 of file cgeqrf_gpu.cpp.

References __func__, a_ref, csplit_diag_block(), d_ref, dd_ref, hwork, lapackf77_cgeqrf(), lapackf77_clarft(), magma_cgetmatrix(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc_host(), magma_csetmatrix(), magma_csetmatrix_async(), MAGMA_ERR_HOST_ALLOC, magma_free_host(), magma_get_cgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaForward, MagmaForwardStr, MagmaLeft, max, min, t_ref, codegen::work, and work_ref.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF computes a QR factorization of a COMPLEX M-by-N matrix A:
A = Q * R. This version stores the triangular matrices used in
the factorization so that they can be applied directly (i.e.,
without being recomputed) later. As a result, the application
of Q is much faster.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array on the GPU, dimension (LDDA,N)
On entry, the M-by-N matrix A.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
LDDA (input) INTEGER
The leading dimension of the array A. LDDA >= max(1,M).
To benefit from coalescent memory accesses LDDA must be
dividable by 16.
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
dT (workspace/output) COMPLEX array on the GPU,
dimension (2*MIN(M, N) + (N+31)/32*32 )*NB,
where NB can be obtained through magma_get_cgeqrf_nb(M).
It starts with MIN(M,N)*NB block that store the triangular T
matrices, followed by the MIN(M,N)*NB block of the diagonal
inverses for the R matrix. The rest of the array is used as workspace.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) (dA+(a_2)*(ldda) + (a_1))
#define t_ref(a_1) (dT+(a_1)*nb)
#define d_ref(a_1) (dT+(minmn+(a_1))*nb)
#define dd_ref(a_1) (dT+(2*minmn+(a_1))*nb)
#define work_ref(a_1) ( work + (a_1))
#define hwork ( work + (nb)*(m))
magma_int_t i, k, minmn, old_i, old_ib, rows, cols;
magma_int_t ib, nb;
magma_int_t ldwork, lddwork, lwork, lhwork;
cuFloatComplex *work, *ut;
/* check arguments */
*info = 0;
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (ldda < max(1,m)) {
*info = -4;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
k = minmn = min(m,n);
if (k == 0)
return *info;
nb = magma_get_cgeqrf_nb(m);
lwork = (m + n + nb)*nb;
lhwork = lwork - m*nb;
if (MAGMA_SUCCESS != magma_cmalloc_host( &work, lwork )) {
*info = MAGMA_ERR_HOST_ALLOC;
return *info;
}
ut = hwork+nb*(n);
memset( ut, 0, nb*nb*sizeof(cuFloatComplex));
static cudaStream_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
ldwork = m;
lddwork= n;
if ( (nb > 1) && (nb < k) ) {
/* Use blocked code initially */
old_i = 0; old_ib = nb;
for (i = 0; i < k-nb; i += nb) {
ib = min(k-i, nb);
rows = m -i;
magma_cgetmatrix_async( rows, ib,
a_ref(i,i), ldda,
work_ref(i), ldwork, stream[1] );
if (i>0){
/* Apply H' to A(i:m,i+2*ib:n) from the left */
cols = n-old_i-2*old_ib;
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
m-old_i, cols, old_ib,
a_ref(old_i, old_i ), ldda, t_ref(old_i), nb,
a_ref(old_i, old_i+2*old_ib), ldda, dd_ref(0), lddwork);
/* store the diagonal */
magma_csetmatrix_async( old_ib, old_ib,
ut, old_ib,
d_ref(old_i), old_ib, stream[0] );
}
magma_queue_sync( stream[1] );
lapackf77_cgeqrf(&rows, &ib, work_ref(i), &ldwork, tau+i, hwork, &lhwork, info);
/* Form the triangular factor of the block reflector
H = H(i) H(i+1) . . . H(i+ib-1) */
lapackf77_clarft( MagmaForwardStr, MagmaColumnwiseStr,
&rows, &ib,
work_ref(i), &ldwork, tau+i, hwork, &ib);
/* Put 0s in the upper triangular part of a panel (and 1s on the
diagonal); copy the upper triangular in ut and invert it */
magma_queue_sync( stream[0] );
csplit_diag_block(ib, work_ref(i), ldwork, ut);
magma_csetmatrix( rows, ib, work_ref(i), ldwork, a_ref(i,i), ldda );
if (i + ib < n) {
/* Send the triangular factor T to the GPU */
magma_csetmatrix( ib, ib, hwork, ib, t_ref(i), nb );
if (i+nb < k-nb){
/* Apply H' to A(i:m,i+ib:i+2*ib) from the left */
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, ib, ib,
a_ref(i, i ), ldda, t_ref(i), nb,
a_ref(i, i+ib), ldda, dd_ref(0), lddwork);
}
else {
cols = n-i-ib;
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, cols, ib,
a_ref(i, i ), ldda, t_ref(i), nb,
a_ref(i, i+ib), ldda, dd_ref(0), lddwork);
/* Fix the diagonal block */
magma_csetmatrix( ib, ib, ut, ib, d_ref(i), ib );
}
old_i = i;
old_ib = ib;
}
}
} else {
i = 0;
}
/* Use unblocked code to factor the last or only block. */
if (i < k) {
ib = n-i;
rows = m-i;
magma_cgetmatrix( rows, ib, a_ref(i, i), ldda, work, rows );
lhwork = lwork - rows*ib;
lapackf77_cgeqrf(&rows, &ib, work, &rows, tau+i, work+ib*rows, &lhwork, info);
magma_csetmatrix( rows, ib, work, rows, a_ref(i, i), ldda );
}
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free_host( work );
return *info;
/* End of MAGMA_CGEQRF */
} /* magma_cgeqrf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrf_ooc ( magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  A,
magma_int_t  lda,
cuFloatComplex *  tau,
cuFloatComplex *  work,
magma_int_t  lwork,
magma_int_t *  info 
)

Definition at line 14 of file cgeqrf_ooc.cpp.

References __func__, a_ref, cpanel_to_q(), cq_to_panel(), da_ref, dwork, lapackf77_clarft(), MAGMA_C_MAKE, MAGMA_C_ONE, magma_cgeqrf(), magma_cgeqrf2_gpu(), magma_cgetmatrix_async(), magma_clarfb_gpu(), magma_cmalloc(), magma_csetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_cgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaConjTrans, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaUpper, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGEQRF_OOC computes a QR factorization of a COMPLEX M-by-N matrix A:
A = Q * R. This version does not require work space on the GPU
passed as input. GPU memory is allocated in the routine.
This is an out-of-core (ooc) version that is similar to magma_cgeqrf but
the difference is that this version can use a GPU even if the matrix
does not fit into the GPU memory at once.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) COMPLEX array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit, the elements on and above the diagonal of the array
contain the min(M,N)-by-N upper trapezoidal matrix R (R is
upper triangular if m >= n); the elements below the diagonal,
with the array TAU, represent the orthogonal matrix Q as a
product of min(m,n) elementary reflectors (see Further
Details).
Higher performance is achieved if A is in pinned memory, e.g.
allocated using magma_malloc_host.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors (see Further
Details).
WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
Higher performance is achieved if WORK is in pinned memory, e.g.
allocated using magma_malloc_host.
LWORK (input) INTEGER
The dimension of the array WORK. LWORK >= N*NB,
where NB can be obtained through magma_get_cgeqrf_nb(M).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
Further Details
===============
The matrix Q is represented as a product of elementary reflectors
Q = H(1) H(2) . . . H(k), where k = min(m,n).
Each H(i) has the form
H(i) = I - tau * v * v'
where tau is a complex scalar, and v is a complex vector with
v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
and tau in TAU(i).
===================================================================== */
#define a_ref(a_1,a_2) ( a+(a_2)*(lda) + (a_1))
#define da_ref(a_1,a_2) (da+(a_2)*ldda + (a_1))
cuFloatComplex *da, *dwork;
cuFloatComplex c_one = MAGMA_C_ONE;
int k, lddwork, ldda;
*info = 0;
int nb = magma_get_cgeqrf_nb(min(m, n));
int lwkopt = n * nb;
work[0] = MAGMA_C_MAKE( (float)lwkopt, 0 );
long int lquery = (lwork == -1);
if (m < 0) {
*info = -1;
} else if (n < 0) {
*info = -2;
} else if (lda < max(1,m)) {
*info = -4;
} else if (lwork < max(1,n) && ! lquery) {
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
/* Check how much memory do we have */
#if CUDA_VERSION > 3010
size_t totalMem;
#else
unsigned int totalMem;
#endif
CUdevice dev;
cuDeviceGet( &dev, 0);
cuDeviceTotalMem( &totalMem, dev );
totalMem /= sizeof(cuFloatComplex);
magma_int_t IB, NB = (magma_int_t)(0.8*totalMem/m);
NB = (NB / nb) * nb;
if (NB >= n)
return magma_cgeqrf(m, n, a, lda, tau, work, lwork, info);
k = min(m,n);
if (k == 0) {
work[0] = c_one;
return *info;
}
lddwork = ((NB+31)/32)*32+nb;
ldda = ((m+31)/32)*32;
if (MAGMA_SUCCESS != magma_cmalloc( &da, (NB + nb)*ldda + nb*lddwork )) {
*info = MAGMA_ERR_DEVICE_ALLOC;
return *info;
}
static cudaStream_t stream[2];
magma_queue_create( &stream[0] );
magma_queue_create( &stream[1] );
// magmablasSetKernelStream(stream[1]);
cuFloatComplex *ptr = da + ldda * NB;
dwork = da + ldda*(NB + nb);
/* start the main loop over the blocks that fit in the GPU memory */
for(int i=0; i<n; i+=NB)
{
IB = min(n-i, NB);
//printf("Processing %5d columns -- %5d to %5d ... \n", IB, i, i+IB);
/* 1. Copy the next part of the matrix to the GPU */
magma_csetmatrix_async( (m), IB,
a_ref(0,i), lda,
da_ref(0,0), ldda, stream[0] );
magma_queue_sync( stream[0] );
/* 2. Update it with the previous transformations */
for(int j=0; j<min(i,k); j+=nb)
{
magma_int_t ib = min(k-j, nb);
/* Get a panel in ptr. */
// 1. Form the triangular factor of the block reflector
// 2. Send it to the GPU.
// 3. Put 0s in the upper triangular part of V.
// 4. Send V to the GPU in ptr.
// 5. Update the matrix.
// 6. Restore the upper part of V.
int rows = m-j;
lapackf77_clarft( MagmaForwardStr, MagmaColumnwiseStr,
&rows, &ib, a_ref(j,j), &lda, tau+j, work, &ib);
magma_csetmatrix_async( ib, ib,
work, ib,
dwork, lddwork, stream[1] );
cpanel_to_q(MagmaUpper, ib, a_ref(j,j), lda, work+ib*ib);
magma_csetmatrix_async( rows, ib,
a_ref(j,j), lda,
ptr, rows, stream[1] );
magma_queue_sync( stream[1] );
magma_clarfb_gpu( MagmaLeft, MagmaConjTrans, MagmaForward, MagmaColumnwise,
rows, IB, ib,
ptr, rows, dwork, lddwork,
da_ref(j, 0), ldda, dwork+ib, lddwork);
cq_to_panel(MagmaUpper, ib, a_ref(j,j), lda, work+ib*ib);
}
/* 3. Do a QR on the current part */
if (i<k)
magma_cgeqrf2_gpu(m-i, IB, da_ref(i,0), ldda, tau+i, info);
/* 4. Copy the current part back to the CPU */
magma_cgetmatrix_async( (m), IB,
da_ref(0,0), ldda,
a_ref(0,i), lda, stream[0] );
}
magma_queue_sync( stream[0] );
magma_queue_destroy( stream[0] );
magma_queue_destroy( stream[1] );
magma_free( da );
return *info;
} /* magma_cgeqrf_ooc */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrs3_gpu ( magma_int_t  m,
magma_int_t  n,
magma_int_t  nrhs,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  tau,
cuFloatComplex *  dT,
cuFloatComplex *  dB,
magma_int_t  lddb,
cuFloatComplex *  hwork,
magma_int_t  lhwork,
magma_int_t *  info 
)

Definition at line 14 of file cgeqrs3_gpu.cpp.

References __func__, a_ref, d_ref, MAGMA_C_MAKE, MAGMA_C_ONE, magma_ctrsm(), magma_ctrsv(), magma_cunmqr_gpu(), magma_get_cgeqrf_nb(), magma_xerbla(), magmablas_cswapdblk(), MagmaConjTrans, MagmaLeft, MagmaNonUnit, MagmaNoTrans, MagmaUpper, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
Solves the least squares problem
min || A*X - C ||
using the QR factorization A = Q*R computed by CGEQRF3_GPU.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. M >= N >= 0.
NRHS (input) INTEGER
The number of columns of the matrix C. NRHS >= 0.
A (input) COMPLEX array on the GPU, dimension (LDDA,N)
The i-th column must contain the vector which defines the
elementary reflector H(i), for i = 1,2,...,n, as returned by
CGEQRF3_GPU in the first n columns of its array argument A.
LDDA (input) INTEGER
The leading dimension of the array A, LDDA >= M.
TAU (input) COMPLEX array, dimension (N)
TAU(i) must contain the scalar factor of the elementary
reflector H(i), as returned by MAGMA_CGEQRF_GPU.
DB (input/output) COMPLEX array on the GPU, dimension (LDDB,NRHS)
On entry, the M-by-NRHS matrix C.
On exit, the N-by-NRHS solution matrix X.
DT (input) COMPLEX array that is the output (the 6th argument)
of magma_cgeqrf_gpu of size
2*MIN(M, N)*NB + ((N+31)/32*32 )* MAX(NB, NRHS).
The array starts with a block of size MIN(M,N)*NB that stores
the triangular T matrices used in the QR factorization,
followed by MIN(M,N)*NB block storing the diagonal block
matrices for the R matrix, followed by work space of size
((N+31)/32*32 )* MAX(NB, NRHS).
LDDB (input) INTEGER
The leading dimension of the array DB. LDDB >= M.
HWORK (workspace/output) COMPLEX array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK, LWORK >= max(1,NRHS).
For optimum performance LWORK >= (M-N+NB)*(NRHS + 2*NB), where
NB is the blocksize given by magma_get_cgeqrf_nb( M ).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the HWORK array, returns
this value as the first entry of the WORK array.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
===================================================================== */
#define a_ref(a_1,a_2) (dA+(a_2)*(ldda) + (a_1))
#define d_ref(a_1) (dT+(lddwork+(a_1))*nb)
cuFloatComplex c_one = MAGMA_C_ONE;
magma_int_t k, lddwork;
magma_int_t nb = magma_get_cgeqrf_nb(m);
magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
long int lquery = (lwork == -1);
hwork[0] = MAGMA_C_MAKE( (float)lwkopt, 0. );
*info = 0;
if (m < 0)
*info = -1;
else if (n < 0 || m < n)
*info = -2;
else if (nrhs < 0)
*info = -3;
else if (ldda < max(1,m))
*info = -5;
else if (lddb < max(1,m))
*info = -8;
else if (lwork < lwkopt && ! lquery)
*info = -10;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
k = min(m,n);
if (k == 0) {
hwork[0] = c_one;
return *info;
}
lddwork= k;
/* B := Q' * B */
magma_cunmqr_gpu( MagmaLeft, MagmaConjTrans,
m, nrhs, n,
a_ref(0,0), ldda, tau,
dB, lddb, hwork, lwork, dT, nb, info );
if ( *info != 0 ) {
return *info;
}
/* Solve R*X = B(1:n,:)
1. Move the block diagonal submatrices from d_ref to R
2. Solve
3. Restore the data format moving data from R back to d_ref
*/
magmablas_cswapdblk(k, nb, a_ref(0,0), ldda, 1, d_ref(0), nb, 0);
if ( nrhs == 1 ) {
magma_ctrsv(MagmaUpper, MagmaNoTrans, MagmaNonUnit,
n, a_ref(0,0), ldda, dB, 1);
} else {
magma_ctrsm(MagmaLeft, MagmaUpper, MagmaNoTrans, MagmaNonUnit,
n, nrhs, c_one, a_ref(0,0), ldda, dB, lddb);
}
magmablas_cswapdblk(k, nb, d_ref(0), nb, 0, a_ref(0,0), ldda, 1);
return *info;
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgeqrs_gpu ( magma_int_t  m,
magma_int_t  n,
magma_int_t  nrhs,
cuFloatComplex *  dA,
magma_int_t  ldda,
cuFloatComplex *  tau,
cuFloatComplex *  dT,
cuFloatComplex *  dB,
magma_int_t  lddb,
cuFloatComplex *  hwork,
magma_int_t  lhwork,
magma_int_t *  info 
)

Definition at line 14 of file cgeqrs_gpu.cpp.

References __func__, a_ref, blasf77_ctrsm(), blasf77_ctrsv(), d_ref, dwork, MAGMA_C_MAKE, MAGMA_C_NEG_ONE, MAGMA_C_ONE, MAGMA_C_ZERO, magma_ccopymatrix(), magma_cgemm(), magma_cgemv(), magma_csetmatrix(), magma_cunmqr_gpu(), magma_get_cgeqrf_nb(), magma_xerbla(), MagmaConjTrans, MagmaLeft, MagmaLeftStr, MagmaNonUnitStr, MagmaNoTrans, MagmaNoTransStr, MagmaUpperStr, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
Solves the least squares problem
min || A*X - C ||
using the QR factorization A = Q*R computed by CGEQRF_GPU.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. M >= N >= 0.
NRHS (input) INTEGER
The number of columns of the matrix C. NRHS >= 0.
A (input) COMPLEX array on the GPU, dimension (LDDA,N)
The i-th column must contain the vector which defines the
elementary reflector H(i), for i = 1,2,...,n, as returned by
CGEQRF_GPU in the first n columns of its array argument A.
LDDA (input) INTEGER
The leading dimension of the array A, LDDA >= M.
TAU (input) COMPLEX array, dimension (N)
TAU(i) must contain the scalar factor of the elementary
reflector H(i), as returned by MAGMA_CGEQRF_GPU.
DB (input/output) COMPLEX array on the GPU, dimension (LDDB,NRHS)
On entry, the M-by-NRHS matrix C.
On exit, the N-by-NRHS solution matrix X.
DT (input) COMPLEX array that is the output (the 6th argument)
of magma_cgeqrf_gpu of size
2*MIN(M, N)*NB + ((N+31)/32*32 )* MAX(NB, NRHS).
The array starts with a block of size MIN(M,N)*NB that stores
the triangular T matrices used in the QR factorization,
followed by MIN(M,N)*NB block storing the diagonal block
inverses for the R matrix, followed by work space of size
((N+31)/32*32 )* MAX(NB, NRHS).
LDDB (input) INTEGER
The leading dimension of the array DB. LDDB >= M.
HWORK (workspace/output) COMPLEX array, dimension (LWORK)
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK, LWORK >= max(1,NRHS).
For optimum performance LWORK >= (M-N+NB)*(NRHS + 2*NB), where
NB is the blocksize given by magma_get_cgeqrf_nb( M ).
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the HWORK array, returns
this value as the first entry of the WORK array.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
===================================================================== */
#define a_ref(a_1,a_2) (dA+(a_2)*(ldda) + (a_1))
#define d_ref(a_1) (dT+(lddwork+(a_1))*nb)
cuFloatComplex c_zero = MAGMA_C_ZERO;
cuFloatComplex c_one = MAGMA_C_ONE;
cuFloatComplex c_neg_one = MAGMA_C_NEG_ONE;
cuFloatComplex *dwork;
magma_int_t i, k, lddwork, rows, ib;
magma_int_t ione = 1;
magma_int_t nb = magma_get_cgeqrf_nb(m);
magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
long int lquery = (lwork == -1);
hwork[0] = MAGMA_C_MAKE( (float)lwkopt, 0. );
*info = 0;
if (m < 0)
*info = -1;
else if (n < 0 || m < n)
*info = -2;
else if (nrhs < 0)
*info = -3;
else if (ldda < max(1,m))
*info = -5;
else if (lddb < max(1,m))
*info = -8;
else if (lwork < lwkopt && ! lquery)
*info = -10;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery)
return *info;
k = min(m,n);
if (k == 0) {
hwork[0] = c_one;
return *info;
}
/* B := Q' * B */
magma_cunmqr_gpu( MagmaLeft, MagmaConjTrans,
m, nrhs, n,
a_ref(0,0), ldda, tau,
dB, lddb, hwork, lwork, dT, nb, info );
if ( *info != 0 ) {
return *info;
}
/* Solve R*X = B(1:n,:) */
lddwork= k;
if (nb < k)
dwork = dT+2*lddwork*nb;
// To do: Why did we have this line originally; seems to be a bug (Stan)?
// dwork = dT;
i = (k-1)/nb * nb;
ib = n-i;
rows = m-i;
if ( nrhs == 1 ) {
blasf77_ctrsv( MagmaUpperStr, MagmaNoTransStr, MagmaNonUnitStr,
&ib, hwork, &rows,
hwork+rows*ib, &ione);
} else {
blasf77_ctrsm( MagmaLeftStr, MagmaUpperStr, MagmaNoTransStr, MagmaNonUnitStr,
&ib, &nrhs,
&c_one, hwork, &rows,
hwork+rows*ib, &rows);
}
// update the solution vector
magma_csetmatrix( ib, nrhs, hwork+rows*ib, rows, dwork+i, lddwork );
// update c
if (nrhs == 1)
magma_cgemv( MagmaNoTrans, i, ib,
c_neg_one, a_ref(0, i), ldda,
dwork + i, 1,
c_one, dB, 1);
else
magma_cgemm( MagmaNoTrans, MagmaNoTrans,
i, nrhs, ib,
c_neg_one, a_ref(0, i), ldda,
dwork + i, lddwork,
c_one, dB, lddb);
int start = i-nb;
if (nb < k) {
for (i = start; i >=0; i -= nb) {
ib = min(k-i, nb);
rows = m -i;
if (i + ib < n) {
if (nrhs == 1)
{
magma_cgemv( MagmaNoTrans, ib, ib,
c_one, d_ref(i), ib,
dB+i, 1,
c_zero, dwork+i, 1);
magma_cgemv( MagmaNoTrans, i, ib,
c_neg_one, a_ref(0, i), ldda,
dwork + i, 1,
c_one, dB, 1);
}
else
{
magma_cgemm( MagmaNoTrans, MagmaNoTrans,
ib, nrhs, ib,
c_one, d_ref(i), ib,
dB+i, lddb,
c_zero, dwork+i, lddwork);
magma_cgemm( MagmaNoTrans, MagmaNoTrans,
i, nrhs, ib,
c_neg_one, a_ref(0, i), ldda,
dwork + i, lddwork,
c_one, dB, lddb);
}
}
}
}
magma_ccopymatrix( (n), nrhs,
dwork, lddwork,
dB, lddb );
return *info;
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgessm_gpu ( char  storev,
magma_int_t  m,
magma_int_t  n,
magma_int_t  k,
magma_int_t  ib,
magma_int_t *  ipiv,
cuFloatComplex *  dL1,
magma_int_t  lddl1,
cuFloatComplex *  dL,
magma_int_t  lddl,
cuFloatComplex *  dA,
magma_int_t  ldda,
magma_int_t *  info 
)

Definition at line 21 of file cgessm_gpu.cpp.

References __func__, AT, dA, L, MAGMA_C_NEG_ONE, MAGMA_C_ONE, magma_cgemm, magma_ctrmm(), magma_ctrsm(), magma_xerbla(), magmablas_cgetmo_in, magmablas_claswp(), MagmaLower, MagmaNoTrans, MagmaRight, MagmaTrans, MagmaUnit, max, and min.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
SGETRF computes an LU factorization of a general M-by-N matrix A
using partial pivoting with row interchanges.
The factorization has the form
A = P * L * U
where P is a permutation matrix, L is lower triangular with unit
diagonal elements (lower trapezoidal if m > n), and U is upper
triangular (upper trapezoidal if m < n).
This is the right-looking Level 3 BLAS version of the algorithm.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input/output) REAL array on the GPU, dimension (LDA,N).
On entry, the M-by-N matrix to be factored.
On exit, the factors L and U from the factorization
A = P*L*U; the unit diagonal elements of L are not stored.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
IPIV (output) INTEGER array, dimension (min(M,N))
The pivot indices; for 1 <= i <= min(M,N), row i of the
matrix was interchanged with row IPIV(i).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
or another error occured, such as memory allocation failed.
> 0: if INFO = i, U(i,i) is exactly zero. The factorization
has been completed, but the factor U is exactly
singular, and division by zero will occur if it is used
to solve a system of equations.
===================================================================== */
#define AT(i,j) (dAT + (i)*ldda + (j) )
#define L(i,j) (dL + (i) + (j)*lddl )
#define dL1(j) (dL1 + (j)*lddl1)
cuFloatComplex c_one = MAGMA_C_ONE;
cuFloatComplex c_neg_one = MAGMA_C_NEG_ONE;
int i, s, sb;
cuFloatComplex *dAT;
/* Check arguments */
*info = 0;
if (m < 0)
*info = -1;
else if (n < 0)
*info = -2;
else if (ldda < max(1,m))
*info = -4;
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
/* Quick return if possible */
if (m == 0 || n == 0)
return *info;
if ( (storev == 'C') || (storev == 'c') ) {
magmablas_cgetmo_in( dA, dAT, ldda, m, n );
} else {
dAT = dA;
}
s = k / ib;
for(i = 0; i < k; i += ib) {
sb = min(ib, k-i);
magmablas_claswp( n, dAT, ldda, i+1, i+sb, ipiv, 1 );
#ifndef WITHOUTTRTRI
magma_ctrmm( MagmaRight, MagmaLower, MagmaTrans, MagmaUnit,
n, sb,
c_one, dL1(i), lddl1,
AT(i, 0), ldda);
#else
magma_ctrsm( MagmaRight, MagmaLower, MagmaTrans, MagmaUnit,
n, sb,
c_one, L( i, i), lddl,
AT(i, 0), ldda);
#endif
if ( (i+sb) < m) {
magma_cgemm( MagmaNoTrans, MagmaTrans,
n, m-(i+sb), sb,
c_neg_one, AT(i, 0), ldda,
L( i+sb, i), lddl,
c_one, AT(i+sb, 0), ldda );
}
}
if ( (storev == 'C') || (storev == 'c') ) {
magmablas_cgetmo_in( dA, dAT, ldda, m, n );
}
return *info;
/* End of MAGMA_CGETRF_GPU */
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgesv ( magma_int_t  n,
magma_int_t  nrhs,
cuFloatComplex *  A,
magma_int_t  lda,
magma_int_t *  ipiv,
cuFloatComplex *  B,
magma_int_t  ldb,
magma_int_t *  info 
)

Definition at line 14 of file cgesv.cpp.

References __func__, lapackf77_cgetrs(), magma_cgetrf(), magma_xerbla(), MagmaNoTransStr, and max.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
Solves a system of linear equations
A * X = B
where A is a general N-by-N matrix and X and B are N-by-NRHS matrices.
The LU decomposition with partial pivoting and row interchanges is
used to factor A as
A = P * L * U,
where P is a permutation matrix, L is unit lower triangular, and U is
upper triangular. The factored form of A is then used to solve the
system of equations A * X = B.
Arguments
=========
N (input) INTEGER
The order of the matrix A. N >= 0.
NRHS (input) INTEGER
The number of right hand sides, i.e., the number of columns
of the matrix B. NRHS >= 0.
A (input/output) COMPLEX array on the GPU, dimension (LDA,N).
On entry, the M-by-N matrix to be factored.
On exit, the factors L and U from the factorization
A = P*L*U; the unit diagonal elements of L are not stored.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
IPIV (output) INTEGER array, dimension (min(M,N))
The pivot indices; for 1 <= i <= min(M,N), row i of the
matrix was interchanged with row IPIV(i).
B (input/output) COMPLEX array on the GPU, dimension (LDB,NRHS)
On entry, the right hand side matrix B.
On exit, the solution matrix X.
LDB (input) INTEGER
The leading dimension of the array B. LDB >= max(1,N).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
===================================================================== */
*info = 0;
if (n < 0) {
*info = -1;
} else if (nrhs < 0) {
*info = -2;
} else if (lda < max(1,n)) {
*info = -4;
} else if (ldb < max(1,n)) {
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
/* Quick return if possible */
if (n == 0 || nrhs == 0) {
return *info;
}
magma_cgetrf( n, n, A, lda, ipiv, info );
if ( *info == 0 ) {
lapackf77_cgetrs( MagmaNoTransStr, &n, &nrhs, A, &lda, ipiv, B, &ldb, info );
}
return *info;
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgesv_gpu ( magma_int_t  n,
magma_int_t  nrhs,
cuFloatComplex *  dA,
magma_int_t  ldda,
magma_int_t *  ipiv,
cuFloatComplex *  dB,
magma_int_t  lddb,
magma_int_t *  info 
)

Definition at line 21 of file cgesv_gpu.cpp.

References __func__, magma_cgetrf_gpu(), magma_cgetrs_gpu(), magma_xerbla(), MagmaNoTrans, and max.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
Solves a system of linear equations
A * X = B
where A is a general N-by-N matrix and X and B are N-by-NRHS matrices.
The LU decomposition with partial pivoting and row interchanges is
used to factor A as
A = P * L * U,
where P is a permutation matrix, L is unit lower triangular, and U is
upper triangular. The factored form of A is then used to solve the
system of equations A * X = B.
Arguments
=========
N (input) INTEGER
The order of the matrix A. N >= 0.
NRHS (input) INTEGER
The number of right hand sides, i.e., the number of columns
of the matrix B. NRHS >= 0.
A (input/output) COMPLEX array on the GPU, dimension (LDDA,N).
On entry, the M-by-N matrix to be factored.
On exit, the factors L and U from the factorization
A = P*L*U; the unit diagonal elements of L are not stored.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,N).
IPIV (output) INTEGER array, dimension (min(M,N))
The pivot indices; for 1 <= i <= min(M,N), row i of the
matrix was interchanged with row IPIV(i).
B (input/output) COMPLEX array on the GPU, dimension (LDB,NRHS)
On entry, the right hand side matrix B.
On exit, the solution matrix X.
LDB (input) INTEGER
The leading dimension of the array B. LDB >= max(1,N).
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
===================================================================== */
*info = 0;
if (n < 0) {
*info = -1;
} else if (nrhs < 0) {
*info = -2;
} else if (ldda < max(1,n)) {
*info = -4;
} else if (lddb < max(1,n)) {
*info = -7;
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
/* Quick return if possible */
if (n == 0 || nrhs == 0) {
return *info;
}
magma_cgetrf_gpu( n, n, dA, ldda, ipiv, info );
if ( *info == 0 ) {
magma_cgetrs_gpu( MagmaNoTrans, n, nrhs, dA, ldda, ipiv, dB, lddb, info );
}
return *info;
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_cgesvd ( char  jobu,
char  jobvt,
magma_int_t  m,
magma_int_t  n,
cuFloatComplex *  a,
magma_int_t  lda,
float *  s,
cuFloatComplex *  u,
magma_int_t  ldu,
cuFloatComplex *  vt,
magma_int_t  ldvt,
cuFloatComplex *  work,
magma_int_t  lwork,
float *  rwork,
magma_int_t *  info 
)

Definition at line 16 of file cgesvd.cpp.

References __func__, blasf77_cgemm(), lapackf77_cbdsqr(), lapackf77_cgelqf(), lapackf77_cgeqrf(), lapackf77_cgesvd(), lapackf77_clacpy(), lapackf77_clange(), lapackf77_clascl(), lapackf77_claset(), lapackf77_cungbr(), lapackf77_cunglq(), lapackf77_cungqr(), lapackf77_cunmbr(), lapackf77_lsame, lapackf77_slamch, lapackf77_slascl(), MAGMA_C_ONE, MAGMA_C_REAL, MAGMA_C_SET2REAL, MAGMA_C_ZERO, magma_cgebrd(), magma_get_cgebrd_nb(), magma_ssqrt, magma_xerbla(), max, min, and codegen::work.

{
/* -- MAGMA (version 1.2.0) --
Univ. of Tennessee, Knoxville
Univ. of California, Berkeley
Univ. of Colorado, Denver
May 2012
Purpose
=======
CGESVD computes the singular value decomposition (SVD) of a complex
M-by-N matrix A, optionally computing the left and/or right singular
vectors. The SVD is written
A = U * SIGMA * conjfugate-transpose(V)
where SIGMA is an M-by-N matrix which is zero except for its
min(m,n) diagonal elements, U is an M-by-M unitary matrix, and
V is an N-by-N unitary matrix. The diagonal elements of SIGMA
are the singular values of A; they are real and non-negative, and
are returned in descending order. The first min(m,n) columns of
U and V are the left and right singular vectors of A.
Note that the routine returns V**H, not V.
Arguments
=========
JOBU (input) CHARACTER*1
Specifies options for computing all or part of the matrix U:
= 'A': all M columns of U are returned in array U:
= 'S': the first min(m,n) columns of U (the left singular
vectors) are returned in the array U;
= 'O': the first min(m,n) columns of U (the left singular
vectors) are overwritten on the array A;
= 'N': no columns of U (no left singular vectors) are
computed.
JOBVT (input) CHARACTER*1
Specifies options for computing all or part of the matrix
V**H:
= 'A': all N rows of V**H are returned in the array VT;
= 'S': the first min(m,n) rows of V**H (the right singular
vectors) are returned in the array VT;
= 'O': the first min(m,n) rows of V**H (the right singular
vectors) are overwritten on the array A;
= 'N': no rows of V**H (no right singular vectors) are
computed.
JOBVT and JOBU cannot both be 'O'.
M (input) INTEGER
The number of rows of the input matrix A. M >= 0.
N (input) INTEGER
The number of columns of the input matrix A. N >= 0.
A (input/output) COMPLEX*16 array, dimension (LDA,N)
On entry, the M-by-N matrix A.
On exit,
if JOBU = 'O', A is overwritten with the first min(m,n)
columns of U (the left singular vectors,
stored columnwise);
if JOBVT = 'O', A is overwritten with the first min(m,n)
rows of V**H (the right singular vectors,
stored rowwise);
if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
are destroyed.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= max(1,M).
S (output) DOUBLE PRECISION array, dimension (min(M,N))
The singular values of A, sorted so that S(i) >= S(i+1).
U (output) COMPLEX*16 array, dimension (LDU,UCOL)
(LDU,M) if JOBU = 'A' or (LDU,min(M,N)) if JOBU = 'S'.
If JOBU = 'A', U contains the M-by-M unitary matrix U;
if JOBU = 'S', U contains the first min(m,n) columns of U
(the left singular vectors, stored columnwise);
if JOBU = 'N' or 'O', U is not referenced.
LDU (input) INTEGER
The leading dimension of the array U. LDU >= 1; if
JOBU = 'S' or 'A', LDU >= M.
VT (output) COMPLEX*16 array, dimension (LDVT,N)
If JOBVT = 'A', VT contains the N-by-N unitary matrix
V**H;
if JOBVT = 'S', VT contains the first min(m,n) rows of
V**H (the right singular vectors, stored rowwise);
if JOBVT = 'N' or 'O', VT is not referenced.
LDVT (input) INTEGER
The leading dimension of the array VT. LDVT >= 1; if
JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
LWORK (input) INTEGER
The dimension of the array WORK.
LWORK >= (M+N)*nb+N.
If LWORK = -1, then a workspace query is assumed; the routine
only calculates the optimal size of the WORK array, returns
this value as the first entry of the WORK array, and no error
message related to LWORK is issued by XERBLA.
RWORK (workspace) DOUBLE PRECISION array, dimension (5*min(M,N))
On exit, if INFO > 0, RWORK(1:MIN(M,N)-1) contains the
unconverged superdiagonal elements of an upper bidiagonal
matrix B whose diagonal is in S (not necessarily sorted).
B satisfies A = U * B * VT, so it has the same singular
values as A, and singular vectors related by U and VT.
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: if ZBDSQR did not converge, INFO specifies how many
superdiagonals of an intermediate bidiagonal form B
did not converge to zero. See the description of RWORK
above for details.
===================================================================== */
char jobu_[2] = {jobu, 0};
char jobvt_[2] = {jobvt, 0};
magma_int_t *m = &m_;
magma_int_t *n = &n_;
magma_int_t *lda = &lda_;
magma_int_t *ldu = &ldu_;
magma_int_t *ldvt = &ldvt_;
magma_int_t *lwork = &lwork_;
static cuFloatComplex c_b1 = MAGMA_C_ZERO;
static cuFloatComplex c_b2 = MAGMA_C_ONE;
static magma_int_t c__0 = 0;
static magma_int_t c__1 = 1;
static magma_int_t c_n1 = -1;
magma_int_t a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset,
i__2, i__3, i__4;
static magma_int_t i__, ie, ir, iu, blk, ncu;
static float dum[1], eps;
static magma_int_t nru;
static cuFloatComplex cdum[1];
static magma_int_t iscl;
static float anrm;
static magma_int_t ierr, itau, ncvt, nrvt;
static magma_int_t chunk, minmn;
static magma_int_t wrkbl, itaup, itauq, mnthr, iwork;
magma_int_t wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs;
static float bignum;
static magma_int_t ldwrkr;
static magma_int_t ldwrku, maxwrk;
magma_int_t minwrk;
static float smlnum;
static magma_int_t irwork;
magma_int_t lquery, wntuas, wntvas;
magma_int_t nb;
*info = 0;
minmn = min(*m,*n);
wntua = lapackf77_lsame(jobu_, "A");
mnthr = (magma_int_t)( (float)(min( m_, n_ )) * 1.6 );
wntus = lapackf77_lsame(jobu_, "S");
wntuas = wntua || wntus;
wntuo = lapackf77_lsame(jobu_, "O");
wntun = lapackf77_lsame(jobu_, "N");
wntva = lapackf77_lsame(jobvt_, "A");
wntvs = lapackf77_lsame(jobvt_, "S");
wntvas = wntva || wntvs;
wntvo = lapackf77_lsame(jobvt_, "O");
wntvn = lapackf77_lsame(jobvt_, "N");
lquery = *lwork == -1;
if (! (wntua || wntus || wntuo || wntun)) {
*info = -1;
} else if (! (wntva || wntvs || wntvo || wntvn) || (wntvo && wntuo) ) {
*info = -2;
} else if (*m < 0) {
*info = -3;
} else if (*n < 0) {
*info = -4;
} else if (*lda < max(1,*m)) {
*info = -6;
} else if ((*ldu < 1) || (wntuas && (*ldu < *m)) ) {
*info = -9;
} else if ((*ldvt < 1) || (wntva && (*ldvt < *n)) || (wntvs && (*ldvt < minmn)) ) {
*info = -11;
}
/* Compute workspace */
lapackf77_cgesvd(jobu_, jobvt_, m, n, a, lda, s, u, ldu,
vt, ldvt, work, &c_n1, rwork, info );
maxwrk = (magma_int_t)MAGMA_C_REAL(work[0]);
if (*info == 0) {
nb = magma_get_cgebrd_nb(*n);
minwrk = ((*m)+(*n))*nb+(*n);
MAGMA_C_SET2REAL(work[0], (float) minwrk);
if ( !lquery && (lwork_ < minwrk) ) {
*info = -13;
}
}
if (*info != 0) {
magma_xerbla( __func__, -(*info) );
return *info;
}
else if (lquery) {
return *info;
}
/* Quick return if possible */
if (*m == 0 || *n == 0) {
return *info;
}
mnthr = (magma_int_t)( (float)(min( m_, n_ )) * 1.6 );
wrkbl = maxwrk; /* Not optimal */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--s;
u_dim1 = *ldu;
u_offset = 1 + u_dim1;
u -= u_offset;
vt_dim1 = *ldvt;
vt_offset = 1 + vt_dim1;
vt -= vt_offset;
--work;
--rwork;
/* Get machine constants */
eps = lapackf77_slamch("P");
smlnum = magma_ssqrt(lapackf77_slamch("S")) / eps;
bignum = 1. / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
anrm = lapackf77_clange("M", m, n, &a[a_offset], lda, dum);
iscl = 0;
if (anrm > 0. && anrm < smlnum) {
iscl = 1;
lapackf77_clascl("G", &c__0, &c__0, &anrm, &smlnum, m, n,
&a[a_offset], lda, &ierr);
} else if (anrm > bignum) {
iscl = 1;
lapackf77_clascl("G", &c__0, &c__0, &anrm, &bignum, m, n,
&a[a_offset], lda, &ierr);
}
if (*m >= *n) {
/* A has at least as many rows as columns. If A has sufficiently
more rows than columns, first reduce using the QR
decomposition (if sufficient workspace available) */
if (*m >= mnthr) {
if (wntun) {
/* Path 1 (M much larger than N, JOBU_='N')
No left singular vectors to be computed */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: need 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
/* Zero out below R */
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &a[a_dim1 + 2], lda);
ie = 1;
itauq = 1;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in A
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &a[a_offset], lda, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], &i__2, &ierr);
*/
magma_cgebrd(*n, *n, &a[a_offset], *lda, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], i__2, &ierr);
ncvt = 0;
if (wntvo || wntvas) {
/* If right singular vectors desired, generate P'.
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &
work[iwork], &i__2, &ierr);
ncvt = *n;
}
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing right
singular vectors of A in A if desired
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &ncvt, &c__0, &c__0, &s[1], &rwork[ie],
&a[a_offset], lda, cdum, &c__1, cdum, &c__1, &rwork[irwork], info);
/* If right singular vectors desired in VT, copy them there */
if (wntvas) {
lapackf77_clacpy("F", n, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
}
} else if (wntuo && wntvn) {
/* Path 2 (M much larger than N, JOBU_='O', JOBVT_='N')
N left singular vectors to be overwritten on A and
no right singular vectors to be computed */
if (*lwork >= *n * *n + *n * 3) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
/* Computing MAX */
i__2 = wrkbl, i__3 = *lda * *n;
if (*lwork >= max(i__2,i__3) + *lda * *n) {
/* WORK(IU) is LDA by N, WORK(IR) is LDA by N */
ldwrku = *lda;
ldwrkr = *lda;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__2 = wrkbl, i__3 = *lda * *n;
if (*lwork >= max(i__2,i__3) + *n * *n) {
/* WORK(IU) is LDA by N, WORK(IR) is N by N */
ldwrku = *lda;
ldwrkr = *n;
} else {
/* WORK(IU) is LDWRKU by N, WORK(IR) is N by N */
ldwrku = (*lwork - *n * *n) / *n;
ldwrkr = *n;
}
}
itau = ir + ldwrkr * *n;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy R to WORK(IR) and zero out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[ir + 1], &ldwrkr);
/* Generate Q in A
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &i__2, &
ierr);
*/
magma_cgebrd(*n, *n, &work[ir], ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], i__2, &
ierr);
/* Generate left vectors bidiagonalizing R
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: need 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IR)
(CWorkspace: need N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &c__0, n, &c__0, &s[1], &rwork[ie], cdum,
&c__1, &work[ir], &ldwrkr, cdum, &c__1,
&rwork[irwork], info);
iu = itauq;
/* Multiply Q in A by left singular vectors of R in
WORK(IR), storing result in WORK(IU) and copying to A
(CWorkspace: need N*N+N, prefer N*N+M*N)
(RWorkspace: 0) */
i__2 = *m;
i__3 = ldwrku;
for(i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
{
/* Computing MIN */
i__4 = *m - i__ + 1;
chunk = min(i__4,ldwrku);
blasf77_cgemm("N", "N", &chunk, n, n, &c_b2, &a[i__ + a_dim1]
, lda, &work[ir], &ldwrkr, &c_b1, &work[iu], &
ldwrku);
lapackf77_clacpy("F", &chunk, n, &work[iu], &ldwrku,
&a[i__ + a_dim1], lda);
}
} else {
/* Insufficient workspace for a fast algorithm */
ie = 1;
itauq = 1;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize A
(CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
(RWorkspace: N) */
i__3 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, n, &a[a_offset], lda, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], &i__3, &ierr);
*/
magma_cgebrd(*m, *n, &a[a_offset], *lda, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], i__3, &ierr);
/* Generate left vectors bidiagonalizing A
(CWorkspace: need 3*N, prefer 2*N+N*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], &
work[iwork], &i__3, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in A
(CWorkspace: need 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &c__0, m, &c__0, &s[1], &rwork[ie], cdum,
&c__1, &a[a_offset], lda, cdum, &c__1,
&rwork[irwork], info);
}
} else if (wntuo && wntvas) {
/* Path 3 (M much larger than N, JOBU_='O', JOBVT_='S' or 'A')
N left singular vectors to be overwritten on A and
N right singular vectors to be computed in VT */
if (*lwork >= *n * *n + *n * 3) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
/* Computing MAX */
i__3 = wrkbl, i__2 = *lda * *n;
if (*lwork >= max(i__3,i__2) + *lda * *n) {
/* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
ldwrku = *lda;
ldwrkr = *lda;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__3 = wrkbl, i__2 = *lda * *n;
if (*lwork >= max(i__3,i__2) + *n * *n) {
/* WORK(IU) is LDA by N and WORK(IR) is N by N */
ldwrku = *lda;
ldwrkr = *n;
} else {
/* WORK(IU) is LDWRKU by N and WORK(IR) is N by N */
ldwrku = (*lwork - *n * *n) / *n;
ldwrkr = *n;
}
}
itau = ir + ldwrkr * *n;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
, &i__3, &ierr);
/* Copy R to VT, zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
if (*n > 1) {
i__3 = *n - 1;
i__2 = *n - 1;
lapackf77_claset("L", &i__3, &i__2, &c_b1, &c_b1, &vt[vt_dim1
+ 2], ldvt);
}
/* Generate Q in A
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__3, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in VT, copying result to WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__3 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &i__3, &
ierr);
*/
magma_cgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], i__3, &ierr);
lapackf77_clacpy("L", n, n, &vt[vt_offset], ldvt, &work[ir], &
ldwrkr);
/* Generate left vectors bidiagonalizing R in WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
work[iwork], &i__3, &ierr);
/* Generate right vectors bidiagonalizing R in VT
(CWorkspace: need N*N+3*N-1, prefer N*N+2*N+(N-1)*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup],
&work[iwork], &i__3, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IR) and computing right
singular vectors of R in VT
(CWorkspace: need N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, n, &c__0, &s[1], &rwork[ie],
&vt[vt_offset], ldvt, &work[ir], &ldwrkr, cdum, &c__1,
&rwork[irwork], info);
iu = itauq;
/* Multiply Q in A by left singular vectors of R in
WORK(IR), storing result in WORK(IU) and copying to A
(CWorkspace: need N*N+N, prefer N*N+M*N)
(RWorkspace: 0) */
i__3 = *m;
i__2 = ldwrku;
for(i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ += i__2)
{
/* Computing MIN */
i__4 = *m - i__ + 1;
chunk = min(i__4,ldwrku);
blasf77_cgemm("N", "N", &chunk, n, n, &c_b2, &a[i__ + a_dim1]
, lda, &work[ir], &ldwrkr, &c_b1, &work[iu], &
ldwrku);
lapackf77_clacpy("F", &chunk, n, &work[iu], &ldwrku,
&a[i__ + a_dim1], lda);
}
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
, &i__2, &ierr);
/* Copy R to VT, zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
if (*n > 1) {
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &vt[vt_dim1+2], ldvt);
}
/* Generate Q in A
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in VT
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &i__2, &
ierr);
*/
magma_cgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], i__2, &ierr);
/* Multiply Q in A by left vectors bidiagonalizing R
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt, &
work[itauq], &a[a_offset], lda, &work[iwork], &
i__2, &ierr);
/* Generate right vectors bidiagonalizing R in VT
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup],
&work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in A and computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, m, &c__0, &s[1], &rwork[ie],
&vt[vt_offset], ldvt, &a[a_offset], lda, cdum, &c__1,
&rwork[irwork], info);
}
} else if (wntus) {
if (wntvn) {
/* Path 4 (M much larger than N, JOBU_='S', JOBVT_='N')
N left singular vectors to be computed in U and
no right singular vectors to be computed */
if (*lwork >= *n * *n + *n * 3) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
if (*lwork >= wrkbl + *lda * *n) {
/* WORK(IR) is LDA by N */
ldwrkr = *lda;
} else {
/* WORK(IR) is N by N */
ldwrkr = *n;
}
itau = ir + ldwrkr * *n;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy R to WORK(IR), zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[ir], &
ldwrkr);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[ir + 1]
, &ldwrkr);
/* Generate Q in A
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &a[a_offset], lda, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &work[ir], ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Generate left vectors bidiagonalizing R in WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
, &work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IR)
(CWorkspace: need N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &c__0, n, &c__0, &s[1], &rwork[ie],
cdum, &c__1, &work[ir], &ldwrkr, cdum, &c__1,
&rwork[irwork], info);
/* Multiply Q in A by left singular vectors of R in
WORK(IR), storing result in U
(CWorkspace: need N*N)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, n, &c_b2, &a[a_offset], lda, &
work[ir], &ldwrkr, &c_b1, &u[u_offset], ldu);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Zero out below R in A */
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &a[a_dim1 +
2], lda);
/* Bidiagonalize R in A
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply Q in U by left vectors bidiagonalizing R
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &a[a_offset], lda, &
work[itauq], &u[u_offset], ldu, &work[iwork],
&i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &c__0, m, &c__0, &s[1], &rwork[ie],
cdum, &c__1, &u[u_offset], ldu, cdum, &c__1, &
rwork[irwork], info);
}
} else if (wntvo) {
/* Path 5 (M much larger than N, JOBU_='S', JOBVT_='O')
N left singular vectors to be computed in U and
N right singular vectors to be overwritten on A */
if (*lwork >= (*n << 1) * *n + *n * 3) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + (*lda << 1) * *n) {
/* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
ldwrku = *lda;
ir = iu + ldwrku * *n;
ldwrkr = *lda;
} else if (*lwork >= wrkbl + (*lda + *n) * *n) {
/* WORK(IU) is LDA by N and WORK(IR) is N by N */
ldwrku = *lda;
ir = iu + ldwrku * *n;
ldwrkr = *n;
} else {
/* WORK(IU) is N by N and WORK(IR) is N by N */
ldwrku = *n;
ir = iu + ldwrku * *n;
ldwrkr = *n;
}
itau = ir + ldwrkr * *n;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy R to WORK(IU), zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
, &ldwrku);
/* Generate Q in A
(CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &a[a_offset], lda, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IU), copying result to
WORK(IR)
(CWorkspace: need 2*N*N+3*N,
prefer 2*N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("U", n, n, &work[iu], &ldwrku, &work[ir], &
ldwrkr);
/* Generate left bidiagonalizing vectors in WORK(IU)
(CWorkspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
, &work[iwork], &i__2, &ierr);
/* Generate right bidiagonalizing vectors in WORK(IR)
(CWorkspace: need 2*N*N+3*N-1,
prefer 2*N*N+2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
, &work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IU) and computing
right singular vectors of R in WORK(IR)
(CWorkspace: need 2*N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, n, &c__0, &s[1], &rwork[ie],
&work[ir], &ldwrkr, &work[iu], &ldwrku, cdum, &c__1,
&rwork[irwork], info);
/* Multiply Q in A by left singular vectors of R in
WORK(IU), storing result in U
(CWorkspace: need N*N)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, n, &c_b2, &a[a_offset], lda, &
work[iu], &ldwrku, &c_b1, &u[u_offset], ldu);
/* Copy right singular vectors of R to A
(CWorkspace: need N*N)
(RWorkspace: 0) */
lapackf77_clacpy("F", n, n, &work[ir], &ldwrkr, &a[a_offset],
lda);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Zero out below R in A */
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &a[a_dim1 +
2], lda);
/* Bidiagonalize R in A
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply Q in U by left vectors bidiagonalizing R
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &a[a_offset], lda, &
work[itauq], &u[u_offset], ldu, &work[iwork],
&i__2, &ierr);
/* Generate right vectors bidiagonalizing R in A
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &a[a_offset], lda, &work[itaup],
&work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U and computing right
singular vectors of A in A
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, m, &c__0, &s[1], &rwork[ie],
&a[a_offset], lda, &u[u_offset], ldu, cdum, &
c__1, &rwork[irwork], info);
}
} else if (wntvas) {
/* Path 6 (M much larger than N, JOBU_='S', JOBVT_='S' or 'A')
N left singular vectors to be computed in U and
N right singular vectors to be computed in VT */
if (*lwork >= *n * *n + *n * 3) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + *lda * *n) {
/* WORK(IU) is LDA by N */
ldwrku = *lda;
} else {
/* WORK(IU) is N by N */
ldwrku = *n;
}
itau = iu + ldwrku * *n;
iwork = itau + *n;
/* Compute A=Q*R
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
/* Copy R to WORK(IU), zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
, &ldwrku);
/* Generate Q in A
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &a[a_offset], lda, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IU), copying result to VT
(CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("U", n, n, &work[iu], &ldwrku, &vt[vt_offset],
ldvt);
/* Generate left bidiagonalizing vectors in WORK(IU)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
, &work[iwork], &i__2, &ierr);
/* Generate right bidiagonalizing vectors in VT
(CWorkspace: need N*N+3*N-1,
prefer N*N+2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
itaup], &work[iwork], &i__2, &ierr)
;
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IU) and computing
right singular vectors of R in VT
(CWorkspace: need N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, n, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &work[iu], &ldwrku, cdum, &
c__1, &rwork[irwork], info);
/* Multiply Q in A by left singular vectors of R in
WORK(IU), storing result in U
(CWorkspace: need N*N)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, n, &c_b2, &a[a_offset], lda, &
work[iu], &ldwrku, &c_b1, &u[u_offset], ldu);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, n, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
/* Copy R to VT, zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
if (*n > 1) {
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &vt[
vt_dim1 + 2], ldvt);
}
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in VT
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply Q in U by left bidiagonalizing vectors
in VT
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt,
&work[itauq], &u[u_offset], ldu, &work[iwork],
&i__2, &ierr);
/* Generate right bidiagonalizing vectors in VT
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
itaup], &work[iwork], &i__2, &ierr)
;
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U and computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, m, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &u[u_offset], ldu, cdum, &
c__1, &rwork[irwork], info);
}
}
} else if (wntua) {
if (wntvn) {
/* Path 7 (M much larger than N, JOBU_='A', JOBVT_='N')
M left singular vectors to be computed in U and
no right singular vectors to be computed
Computing MAX */
i__2 = *n + *m, i__3 = *n * 3;
if (*lwork >= *n * *n + max(i__2,i__3)) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
if (*lwork >= wrkbl + *lda * *n) {
/* WORK(IR) is LDA by N */
ldwrkr = *lda;
} else {
/* WORK(IR) is N by N */
ldwrkr = *n;
}
itau = ir + ldwrkr * *n;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Copy R to WORK(IR), zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[ir], &
ldwrkr);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[ir + 1]
, &ldwrkr);
/* Generate Q in U
(CWorkspace: need N*N+N+M, prefer N*N+N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, m, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &work[ir], ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Generate left bidiagonalizing vectors in WORK(IR)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
, &work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IR)
(CWorkspace: need N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &c__0, n, &c__0, &s[1], &rwork[ie],
cdum, &c__1, &work[ir], &ldwrkr, cdum, &c__1,
&rwork[irwork], info);
/* Multiply Q in U by left singular vectors of R in
WORK(IR), storing result in A
(CWorkspace: need N*N)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &
work[ir], &ldwrkr, &c_b1, &a[a_offset], lda);
/* Copy left singular vectors of A from A to U */
lapackf77_clacpy("F", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need N+M, prefer N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, m, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Zero out below R in A */
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &a[a_dim1 +
2], lda);
/* Bidiagonalize R in A
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply Q in U by left bidiagonalizing vectors
in A
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &a[a_offset], lda, &
work[itauq], &u[u_offset], ldu, &work[iwork],
&i__2, &ierr)
;
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &c__0, m, &c__0, &s[1], &rwork[ie],
cdum, &c__1, &u[u_offset], ldu, cdum, &c__1, &
rwork[irwork], info);
}
} else if (wntvo) {
/* Path 8 (M much larger than N, JOBU_='A', JOBVT_='O')
M left singular vectors to be computed in U and
N right singular vectors to be overwritten on A
Computing MAX */
i__2 = *n + *m, i__3 = *n * 3;
if (*lwork >= (*n << 1) * *n + max(i__2,i__3)) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + (*lda << 1) * *n) {
/* WORK(IU) is LDA by N and WORK(IR) is LDA by N */
ldwrku = *lda;
ir = iu + ldwrku * *n;
ldwrkr = *lda;
} else if (*lwork >= wrkbl + (*lda + *n) * *n) {
/* WORK(IU) is LDA by N and WORK(IR) is N by N */
ldwrku = *lda;
ir = iu + ldwrku * *n;
ldwrkr = *n;
} else {
/* WORK(IU) is N by N and WORK(IR) is N by N */
ldwrku = *n;
ir = iu + ldwrku * *n;
ldwrkr = *n;
}
itau = ir + ldwrkr * *n;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, m, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
/* Copy R to WORK(IU), zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
, &ldwrku);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IU), copying result to
WORK(IR)
(CWorkspace: need 2*N*N+3*N,
prefer 2*N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("U", n, n, &work[iu], &ldwrku, &work[ir], &
ldwrkr);
/* Generate left bidiagonalizing vectors in WORK(IU)
(CWorkspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
, &work[iwork], &i__2, &ierr);
/* Generate right bidiagonalizing vectors in WORK(IR)
(CWorkspace: need 2*N*N+3*N-1,
prefer 2*N*N+2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
, &work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IU) and computing
right singular vectors of R in WORK(IR)
(CWorkspace: need 2*N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, n, &c__0, &s[1], &rwork[ie], &work[
ir], &ldwrkr, &work[iu], &ldwrku, cdum, &c__1,
&rwork[irwork], info);
/* Multiply Q in U by left singular vectors of R in
WORK(IU), storing result in A
(CWorkspace: need N*N)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &
work[iu], &ldwrku, &c_b1, &a[a_offset], lda);
/* Copy left singular vectors of A from A to U */
lapackf77_clacpy("F", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Copy right singular vectors of R from WORK(IR) to A */
lapackf77_clacpy("F", n, n, &work[ir], &ldwrkr, &a[a_offset],
lda);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need N+M, prefer N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, m, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Zero out below R in A */
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &a[a_dim1 +
2], lda);
/* Bidiagonalize R in A
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply Q in U by left bidiagonalizing vectors
in A
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &a[a_offset], lda, &
work[itauq], &u[u_offset], ldu, &work[iwork],
&i__2, &ierr)
;
/* Generate right bidiagonalizing vectors in A
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &a[a_offset], lda, &work[itaup],
&work[iwork], &i__2, &ierr);
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U and computing right
singular vectors of A in A
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, m, &c__0, &s[1], &rwork[ie], &a[
a_offset], lda, &u[u_offset], ldu, cdum, &
c__1, &rwork[irwork], info);
}
} else if (wntvas) {
/* Path 9 (M much larger than N, JOBU_='A', JOBVT_='S'
or 'A')
M left singular vectors to be computed in U and
N right singular vectors to be computed in VT
Computing MAX */
i__2 = *n + *m, i__3 = *n * 3;
if (*lwork >= *n * *n + max(i__2,i__3)) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + *lda * *n) {
/* WORK(IU) is LDA by N */
ldwrku = *lda;
} else {
/* WORK(IU) is N by N */
ldwrku = *n;
}
itau = iu + ldwrku * *n;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need N*N+2*N, prefer N*N+N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need N*N+N+M, prefer N*N+N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, m, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
/* Copy R to WORK(IU), zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &work[iu + 1]
, &ldwrku);
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in WORK(IU), copying result to VT
(CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("U", n, n, &work[iu], &ldwrku, &vt[vt_offset],
ldvt);
/* Generate left bidiagonalizing vectors in WORK(IU)
(CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
, &work[iwork], &i__2, &ierr);
/* Generate right bidiagonalizing vectors in VT
(CWorkspace: need N*N+3*N-1,
prefer N*N+2*N+(N-1)*NB)
(RWorkspace: need 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
itaup], &work[iwork], &i__2, &ierr)
;
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of R in WORK(IU) and computing
right singular vectors of R in VT
(CWorkspace: need N*N)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, n, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &work[iu], &ldwrku, cdum, &
c__1, &rwork[irwork], info);
/* Multiply Q in U by left singular vectors of R in
WORK(IU), storing result in A
(CWorkspace: need N*N)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, n, &c_b2, &u[u_offset], ldu, &
work[iu], &ldwrku, &c_b1, &a[a_offset], lda);
/* Copy left singular vectors of A from A to U */
lapackf77_clacpy("F", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *n;
/* Compute A=Q*R, copying result to U
(CWorkspace: need 2*N, prefer N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset],
ldu);
/* Generate Q in U
(CWorkspace: need N+M, prefer N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungqr(m, m, n, &u[u_offset], ldu, &work[itau], &
work[iwork], &i__2, &ierr);
/* Copy R from A to VT, zeroing out below it */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
if (*n > 1) {
i__2 = *n - 1;
i__3 = *n - 1;
lapackf77_claset("L", &i__2, &i__3, &c_b1, &c_b1, &vt[
vt_dim1 + 2], ldvt);
}
ie = 1;
itauq = itau;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize R in VT
(CWorkspace: need 3*N, prefer 2*N+2*N*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(n, n, &vt[vt_offset], ldvt, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply Q in U by left bidiagonalizing vectors
in VT
(CWorkspace: need 2*N+M, prefer 2*N+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("Q", "R", "N", m, n, n, &vt[vt_offset], ldvt,
&work[itauq], &u[u_offset], ldu, &work[iwork],
&i__2, &ierr);
/* Generate right bidiagonalizing vectors in VT
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
itaup], &work[iwork], &i__2, &ierr)
;
irwork = ie + *n;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U and computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, n, m, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &u[u_offset], ldu, cdum, &
c__1, &rwork[irwork], info);
}
}
}
} else {
/* M .LT. MNTHR
Path 10 (M at least N, but not much larger)
Reduce to bidiagonal form without QR decomposition */
ie = 1;
itauq = 1;
itaup = itauq + *n;
iwork = itaup + *n;
/* Bidiagonalize A
(CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB)
(RWorkspace: need N) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[itauq],
&work[itaup], &work[iwork], &i__2, &ierr);
*/
magma_cgebrd(*m, *n, &a[a_offset], *lda, &s[1], &rwork[ie], &work[itauq],
&work[itaup], &work[iwork], i__2, &ierr);
if (wntuas) {
/* If left singular vectors desired in U, copy result to U
and generate left bidiagonalizing vectors in U
(CWorkspace: need 2*N+NCU, prefer 2*N+NCU*NB)
(RWorkspace: 0) */
lapackf77_clacpy("L", m, n, &a[a_offset], lda, &u[u_offset], ldu);
if (wntus) {
ncu = *n;
}
if (wntua) {
ncu = *m;
}
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, &ncu, n, &u[u_offset], ldu, &work[itauq], &
work[iwork], &i__2, &ierr);
}
if (wntvas) {
/* If right singular vectors desired in VT, copy result to
VT and generate right bidiagonalizing vectors in VT
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
lapackf77_clacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], &
work[iwork], &i__2, &ierr);
}
if (wntuo) {
/* If left singular vectors desired in A, generate left
bidiagonalizing vectors in A
(CWorkspace: need 3*N, prefer 2*N+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[
iwork], &i__2, &ierr);
}
if (wntvo) {
/* If right singular vectors desired in A, generate right
bidiagonalizing vectors in A
(CWorkspace: need 3*N-1, prefer 2*N+(N-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[
iwork], &i__2, &ierr);
}
irwork = ie + *n;
if (wntuas || wntuo) {
nru = *m;
}
if (wntun) {
nru = 0;
}
if (wntvas || wntvo) {
ncvt = *n;
}
if (wntvn) {
ncvt = 0;
}
if (! wntuo && ! wntvo) {
/* Perform bidiagonal QR iteration, if desired, computing
left singular vectors in U and computing right singular
vectors in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &u[u_offset], ldu, cdum, &c__1, &
rwork[irwork], info);
} else if (! wntuo && wntvo) {
/* Perform bidiagonal QR iteration, if desired, computing
left singular vectors in U and computing right singular
vectors in A
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &a[
a_offset], lda, &u[u_offset], ldu, cdum, &c__1, &
rwork[irwork], info);
} else {
/* Perform bidiagonal QR iteration, if desired, computing
left singular vectors in A and computing right singular
vectors in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &a[a_offset], lda, cdum, &c__1, &
rwork[irwork], info);
}
}
} else {
/* A has more columns than rows. If A has sufficiently more
columns than rows, first reduce using the LQ decomposition (if
sufficient workspace available) */
if (*n >= mnthr) {
if (wntvn) {
/* Path 1t(N much larger than M, JOBVT_='N')
No right singular vectors to be computed */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork], &
i__2, &ierr);
/* Zero out above L */
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 << 1) + 1]
, lda);
ie = 1;
itauq = 1;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in A
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &work[
itauq], &work[itaup], &work[iwork], &i__2, &ierr);
*/
magma_cgebrd(*m, *m, &a[a_offset], *lda, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], i__2, &ierr);
if (wntuo || wntuas) {
/* If left singular vectors desired, generate Q
(CWorkspace: need 3*M, prefer 2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], &
work[iwork], &i__2, &ierr);
}
irwork = ie + *m;
nru = 0;
if (wntuo || wntuas) {
nru = *m;
}
/* Perform bidiagonal QR iteration, computing left singular
vectors of A in A if desired
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, &c__0, &nru, &c__0, &s[1], &rwork[ie], cdum, &
c__1, &a[a_offset], lda, cdum, &c__1, &rwork[irwork],
info);
/* If left singular vectors desired in U, copy them there */
if (wntuas) {
lapackf77_clacpy("F", m, m, &a[a_offset], lda, &u[u_offset], ldu);
}
} else if (wntvo && wntun) {
/* Path 2t(N much larger than M, JOBU_='N', JOBVT_='O')
M right singular vectors to be overwritten on A and
no left singular vectors to be computed */
if (*lwork >= *m * *m + *m * 3) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
/* Computing MAX */
i__2 = wrkbl, i__3 = *lda * *n;
if (*lwork >= max(i__2,i__3) + *lda * *m) {
/* WORK(IU) is LDA by N and WORK(IR) is LDA by M */
ldwrku = *lda;
chunk = *n;
ldwrkr = *lda;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__2 = wrkbl, i__3 = *lda * *n;
if (*lwork >= max(i__2,i__3) + *m * *m) {
/* WORK(IU) is LDA by N and WORK(IR) is M by M */
ldwrku = *lda;
chunk = *n;
ldwrkr = *m;
} else {
/* WORK(IU) is M by CHUNK and WORK(IR) is M by M */
ldwrku = *m;
chunk = (*lwork - *m * *m) / *m;
ldwrkr = *m;
}
}
itau = ir + ldwrkr * *m;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
, &i__2, &ierr);
/* Copy L to WORK(IR) and zero out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[ir +
ldwrkr], &ldwrkr);
/* Generate Q in A
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IR)
(CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &i__2, &
ierr);
*/
magma_cgebrd(*m, *m, &work[ir], ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], i__2, &
ierr);
/* Generate right vectors bidiagonalizing L
(CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing right
singular vectors of L in WORK(IR)
(CWorkspace: need M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, &c__0, &c__0, &s[1], &rwork[ie], &work[
ir], &ldwrkr, cdum, &c__1, cdum, &c__1, &rwork[
irwork], info);
iu = itauq;
/* Multiply right singular vectors of L in WORK(IR) by Q
in A, storing result in WORK(IU) and copying to A
(CWorkspace: need M*M+M, prefer M*M+M*N)
(RWorkspace: 0) */
i__2 = *n;
i__3 = chunk;
for (i__ = 1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ +=
i__3) {
/* Computing MIN */
i__4 = *n - i__ + 1;
blk = min(i__4,chunk);
blasf77_cgemm("N", "N", m, &blk, m, &c_b2, &work[ir], &
ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b1, &
work[iu], &ldwrku);
lapackf77_clacpy("F", m, &blk, &work[iu], &ldwrku, &a[i__ *
a_dim1 + 1], lda);
/* L30: */
}
} else {
/* Insufficient workspace for a fast algorithm */
ie = 1;
itauq = 1;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize A
(CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB)
(RWorkspace: need M) */
i__3 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, n, &a[a_offset], lda, &s[1], &rwork[ie], &work[
itauq], &work[itaup], &work[iwork], &i__3, &ierr);
*/
magma_cgebrd(*m, *n, &a[a_offset], *lda, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], i__3, &ierr);
/* Generate right vectors bidiagonalizing A
(CWorkspace: need 3*M, prefer 2*M+M*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, n, m, &a[a_offset], lda, &work[itaup], &
work[iwork], &i__3, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing right
singular vectors of A in A
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("L", m, n, &c__0, &c__0, &s[1], &rwork[ie], &a[
a_offset], lda, cdum, &c__1, cdum, &c__1, &rwork[
irwork], info);
}
} else if (wntvo && wntuas) {
/* Path 3t(N much larger than M, JOBU_='S' or 'A', jobvt_='O')
M right singular vectors to be overwritten on A and
M left singular vectors to be computed in U */
if (*lwork >= *m * *m + *m * 3) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
/* Computing MAX */
i__3 = wrkbl, i__2 = *lda * *n;
if (*lwork >= max(i__3,i__2) + *lda * *m) {
/* WORK(IU) is LDA by N and WORK(IR) is LDA by M */
ldwrku = *lda;
chunk = *n;
ldwrkr = *lda;
} else /* if(complicated condition) */ {
/* Computing MAX */
i__3 = wrkbl, i__2 = *lda * *n;
if (*lwork >= max(i__3,i__2) + *m * *m) {
/* WORK(IU) is LDA by N and WORK(IR) is M by M */
ldwrku = *lda;
chunk = *n;
ldwrkr = *m;
} else {
/* WORK(IU) is M by CHUNK and WORK(IR) is M by M */
ldwrku = *m;
chunk = (*lwork - *m * *m) / *m;
ldwrkr = *m;
}
}
itau = ir + ldwrkr * *m;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
, &i__3, &ierr);
/* Copy L to U, zeroing about above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
i__3 = *m - 1;
i__2 = *m - 1;
lapackf77_claset("U", &i__3, &i__2, &c_b1, &c_b1, &u[(u_dim1 << 1)
+ 1], ldu);
/* Generate Q in A
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &a[a_offset], lda, &work[itau],
&work[iwork], &i__3, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in U, copying result to WORK(IR)
(CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__3 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &work[
itauq], &work[itaup], &work[iwork], &i__3, &ierr);
*/
magma_cgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], i__3, &ierr);
lapackf77_clacpy("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr);
/* Generate right vectors bidiagonalizing L in WORK(IR)
(CWorkspace: need M*M+3*M-1, prefer M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
work[iwork], &i__3, &ierr);
/* Generate left vectors bidiagonalizing L in U
(CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
(RWorkspace: 0) */
i__3 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
work[iwork], &i__3, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of L in U, and computing right
singular vectors of L in WORK(IR)
(CWorkspace: need M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[ir],
&ldwrkr, &u[u_offset], ldu, cdum, &c__1, &rwork[
irwork], info);
iu = itauq;
/* Multiply right singular vectors of L in WORK(IR) by Q
in A, storing result in WORK(IU) and copying to A
(CWorkspace: need M*M+M, prefer M*M+M*N))
(RWorkspace: 0) */
i__3 = *n;
i__2 = chunk;
for (i__ = 1; i__2 < 0 ? i__ >= i__3 : i__ <= i__3; i__ +=
i__2) {
/* Computing MIN */
i__4 = *n - i__ + 1;
blk = min(i__4,chunk);
blasf77_cgemm("N", "N", m, &blk, m, &c_b2, &work[ir], &
ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b1, &
work[iu], &ldwrku);
lapackf77_clacpy("F", m, &blk, &work[iu], &ldwrku, &a[i__ *
a_dim1 + 1], lda);
/* L40: */
}
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
, &i__2, &ierr);
/* Copy L to U, zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &u[(u_dim1 << 1)
+ 1], ldu);
/* Generate Q in A
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in U
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &work[
itauq], &work[itaup], &work[iwork], &i__2, &ierr);
*/
magma_cgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &rwork[ie],
&work[itauq], &work[itaup], &work[iwork], i__2, &ierr);
/* Multiply right vectors bidiagonalizing L by Q in A
(CWorkspace: need 2*M+N, prefer 2*M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("P", "L", "C", m, n, m, &u[u_offset], ldu, &work[
itaup], &a[a_offset], lda, &work[iwork], &i__2, &
ierr);
/* Generate left vectors bidiagonalizing L in U
(CWorkspace: need 3*M, prefer 2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U and computing right
singular vectors of A in A
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, n, m, &c__0, &s[1], &rwork[ie], &a[
a_offset], lda, &u[u_offset], ldu, cdum, &c__1, &
rwork[irwork], info);
}
} else if (wntvs) {
if (wntun) {
/* Path 4t(N much larger than M, JOBU_='N', JOBVT='S')
M right singular vectors to be computed in VT and
no left singular vectors to be computed */
if (*lwork >= *m * *m + *m * 3) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
if (*lwork >= wrkbl + *lda * *m) {
/* WORK(IR) is LDA by M */
ldwrkr = *lda;
} else {
/* WORK(IR) is M by M */
ldwrkr = *m;
}
itau = ir + ldwrkr * *m;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
/* Copy L to WORK(IR), zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[ir], &
ldwrkr);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[ir +
ldwrkr], &ldwrkr);
/* Generate Q in A
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IR)
(CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &work[ir], ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Generate right vectors bidiagonalizing L in
WORK(IR)
(CWorkspace: need M*M+3*M, prefer M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
, &work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing right
singular vectors of L in WORK(IR)
(CWorkspace: need M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, &c__0, &c__0, &s[1], &rwork[ie], &
work[ir], &ldwrkr, cdum, &c__1, cdum, &c__1, &
rwork[irwork], info);
/* Multiply right singular vectors of L in WORK(IR) by
Q in A, storing result in VT
(CWorkspace: need M*M)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, m, &c_b2, &work[ir], &ldwrkr, &
a[a_offset], lda, &c_b1, &vt[vt_offset], ldvt);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
/* Copy result to VT */
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Zero out above L in A */
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
1) + 1], lda);
/* Bidiagonalize L in A
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply right vectors bidiagonalizing L by Q in VT
(CWorkspace: need 2*M+N, prefer 2*M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("P", "L", "C", m, n, m, &a[a_offset], lda, &
work[itaup], &vt[vt_offset], ldvt, &work[
iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, n, &c__0, &c__0, &s[1], &rwork[ie], &
vt[vt_offset], ldvt, cdum, &c__1, cdum, &c__1,
&rwork[irwork], info);
}
} else if (wntuo) {
/* Path 5t(N much larger than M, JOBU_='O', JOBVT='S')
M right singular vectors to be computed in VT and
M left singular vectors to be overwritten on A */
if (*lwork >= (*m << 1) * *m + *m * 3) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + (*lda << 1) * *m) {
/* WORK(IU) is LDA by M and WORK(IR) is LDA by M */
ldwrku = *lda;
ir = iu + ldwrku * *m;
ldwrkr = *lda;
} else if (*lwork >= wrkbl + (*lda + *m) * *m) {
/* WORK(IU) is LDA by M and WORK(IR) is M by M */
ldwrku = *lda;
ir = iu + ldwrku * *m;
ldwrkr = *m;
} else {
/* WORK(IU) is M by M and WORK(IR) is M by M */
ldwrku = *m;
ir = iu + ldwrku * *m;
ldwrkr = *m;
}
itau = ir + ldwrkr * *m;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
/* Copy L to WORK(IU), zeroing out below it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
ldwrku], &ldwrku);
/* Generate Q in A
(CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IU), copying result to
WORK(IR)
(CWorkspace: need 2*M*M+3*M,
prefer 2*M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("L", m, m, &work[iu], &ldwrku, &work[ir], &
ldwrkr);
/* Generate right bidiagonalizing vectors in WORK(IU)
(CWorkspace: need 2*M*M+3*M-1,
prefer 2*M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
, &work[iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors in WORK(IR)
(CWorkspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
, &work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of L in WORK(IR) and computing
right singular vectors of L in WORK(IU)
(CWorkspace: need 2*M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
iu], &ldwrku, &work[ir], &ldwrkr, cdum, &c__1,
&rwork[irwork], info);
/* Multiply right singular vectors of L in WORK(IU) by
Q in A, storing result in VT
(CWorkspace: need M*M)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
a[a_offset], lda, &c_b1, &vt[vt_offset], ldvt);
/* Copy left singular vectors of L to A
(CWorkspace: need M*M)
(RWorkspace: 0) */
lapackf77_clacpy("F", m, m, &work[ir], &ldwrkr, &a[a_offset],
lda);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Zero out above L in A */
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
1) + 1], lda);
/* Bidiagonalize L in A
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply right vectors bidiagonalizing L by Q in VT
(CWorkspace: need 2*M+N, prefer 2*M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("P", "L", "C", m, n, m, &a[a_offset], lda, &
work[itaup], &vt[vt_offset], ldvt, &work[
iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors of L in A
(CWorkspace: need 3*M, prefer 2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &a[a_offset], lda, &work[itauq],
&work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in A and computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &a[a_offset], lda, cdum, &
c__1, &rwork[irwork], info);
}
} else if (wntuas) {
/* Path 6t(N much larger than M, JOBU_='S' or 'A',
JOBVT='S')
M right singular vectors to be computed in VT and
M left singular vectors to be computed in U */
if (*lwork >= *m * *m + *m * 3) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + *lda * *m) {
/* WORK(IU) is LDA by N */
ldwrku = *lda;
} else {
/* WORK(IU) is LDA by M */
ldwrku = *m;
}
itau = iu + ldwrku * *m;
iwork = itau + *m;
/* Compute A=L*Q
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
/* Copy L to WORK(IU), zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
ldwrku], &ldwrku);
/* Generate Q in A
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &a[a_offset], lda, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IU), copying result to U
(CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("L", m, m, &work[iu], &ldwrku, &u[u_offset],
ldu);
/* Generate right bidiagonalizing vectors in WORK(IU)
(CWorkspace: need M*M+3*M-1,
prefer M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
, &work[iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors in U
(CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
&work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of L in U and computing right
singular vectors of L in WORK(IU)
(CWorkspace: need M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
iu], &ldwrku, &u[u_offset], ldu, cdum, &c__1,
&rwork[irwork], info);
/* Multiply right singular vectors of L in WORK(IU) by
Q in A, storing result in VT
(CWorkspace: need M*M)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
a[a_offset], lda, &c_b1, &vt[vt_offset], ldvt);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(m, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy L to U, zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &u[u_offset],
ldu);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &u[(u_dim1 <<
1) + 1], ldu);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in U
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply right bidiagonalizing vectors in U by Q
in VT
(CWorkspace: need 2*M+N, prefer 2*M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("P", "L", "C", m, n, m, &u[u_offset], ldu, &
work[itaup], &vt[vt_offset], ldvt, &work[
iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors in U
(CWorkspace: need 3*M, prefer 2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
&work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in U and computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &u[u_offset], ldu, cdum, &
c__1, &rwork[irwork], info);
}
}
} else if (wntva) {
if (wntun) {
/* Path 7t(N much larger than M, JOBU_='N', JOBVT='A')
N right singular vectors to be computed in VT and
no left singular vectors to be computed
Computing MAX */
i__2 = *n + *m, i__3 = *m * 3;
if (*lwork >= *m * *m + max(i__2,i__3)) {
/* Sufficient workspace for a fast algorithm */
ir = 1;
if (*lwork >= wrkbl + *lda * *m) {
/* WORK(IR) is LDA by M */
ldwrkr = *lda;
} else {
/* WORK(IR) is M by M */
ldwrkr = *m;
}
itau = ir + ldwrkr * *m;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Copy L to WORK(IR), zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[ir], &
ldwrkr);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[ir +
ldwrkr], &ldwrkr);
/* Generate Q in VT
(CWorkspace: need M*M+M+N, prefer M*M+M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(n, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IR)
(CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[ir], &ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &work[ir], ldwrkr, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Generate right bidiagonalizing vectors in WORK(IR)
(CWorkspace: need M*M+3*M-1,
prefer M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
, &work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing right
singular vectors of L in WORK(IR)
(CWorkspace: need M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, &c__0, &c__0, &s[1], &rwork[ie], &
work[ir], &ldwrkr, cdum, &c__1, cdum, &c__1, &
rwork[irwork], info);
/* Multiply right singular vectors of L in WORK(IR) by
Q in VT, storing result in A
(CWorkspace: need M*M)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, m, &c_b2, &work[ir], &ldwrkr, &
vt[vt_offset], ldvt, &c_b1, &a[a_offset], lda);
/* Copy right singular vectors of A from A to VT */
lapackf77_clacpy("F", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need M+N, prefer M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(n, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Zero out above L in A */
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
1) + 1], lda);
/* Bidiagonalize L in A
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply right bidiagonalizing vectors in A by Q
in VT
(CWorkspace: need 2*M+N, prefer 2*M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("P", "L", "C", m, n, m, &a[a_offset], lda, &
work[itaup], &vt[vt_offset], ldvt, &work[
iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, n, &c__0, &c__0, &s[1], &rwork[ie], &
vt[vt_offset], ldvt, cdum, &c__1, cdum, &c__1,
&rwork[irwork], info);
}
} else if (wntuo) {
/* Path 8t(N much larger than M, JOBU_='O', JOBVT='A')
N right singular vectors to be computed in VT and
M left singular vectors to be overwritten on A
Computing MAX */
i__2 = *n + *m, i__3 = *m * 3;
if (*lwork >= (*m << 1) * *m + max(i__2,i__3)) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + (*lda << 1) * *m) {
/* WORK(IU) is LDA by M and WORK(IR) is LDA by M */
ldwrku = *lda;
ir = iu + ldwrku * *m;
ldwrkr = *lda;
} else if (*lwork >= wrkbl + (*lda + *m) * *m) {
/* WORK(IU) is LDA by M and WORK(IR) is M by M */
ldwrku = *lda;
ir = iu + ldwrku * *m;
ldwrkr = *m;
} else {
/* WORK(IU) is M by M and WORK(IR) is M by M */
ldwrku = *m;
ir = iu + ldwrku * *m;
ldwrkr = *m;
}
itau = ir + ldwrkr * *m;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(n, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy L to WORK(IU), zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
ldwrku], &ldwrku);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IU), copying result to
WORK(IR)
(CWorkspace: need 2*M*M+3*M,
prefer 2*M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("L", m, m, &work[iu], &ldwrku, &work[ir], &
ldwrkr);
/* Generate right bidiagonalizing vectors in WORK(IU)
(CWorkspace: need 2*M*M+3*M-1,
prefer 2*M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
, &work[iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors in WORK(IR)
(CWorkspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
, &work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of L in WORK(IR) and computing
right singular vectors of L in WORK(IU)
(CWorkspace: need 2*M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
iu], &ldwrku, &work[ir], &ldwrkr, cdum, &c__1,
&rwork[irwork], info);
/* Multiply right singular vectors of L in WORK(IU) by
Q in VT, storing result in A
(CWorkspace: need M*M)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
vt[vt_offset], ldvt, &c_b1, &a[a_offset], lda);
/* Copy right singular vectors of A from A to VT */
lapackf77_clacpy("F", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Copy left singular vectors of A from WORK(IR) to A */
lapackf77_clacpy("F", m, m, &work[ir], &ldwrkr, &a[a_offset],
lda);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need M+N, prefer M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(n, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Zero out above L in A */
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &a[(a_dim1 <<
1) + 1], lda);
/* Bidiagonalize L in A
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &a[a_offset], lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &a[a_offset], *lda, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
/* Multiply right bidiagonalizing vectors in A by Q
in VT (CWorkspace: need 2*M+N, prefer 2*M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunmbr("P", "L", "C", m, n, m, &a[a_offset], lda, &
work[itaup], &vt[vt_offset], ldvt, &work[
iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors in A
(CWorkspace: need 3*M, prefer 2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &a[a_offset], lda, &work[itauq],
&work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of A in A and computing right
singular vectors of A in VT
(CWorkspace: 0)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, n, m, &c__0, &s[1], &rwork[ie], &vt[
vt_offset], ldvt, &a[a_offset], lda, cdum, &
c__1, &rwork[irwork], info);
}
} else if (wntuas) {
/* Path 9t(N much larger than M, JOBU_='S' or 'A',
JOBVT='A')
N right singular vectors to be computed in VT and
M left singular vectors to be computed in U
Computing MAX */
i__2 = *n + *m, i__3 = *m * 3;
if (*lwork >= *m * *m + max(i__2,i__3)) {
/* Sufficient workspace for a fast algorithm */
iu = 1;
if (*lwork >= wrkbl + *lda * *m) {
/* WORK(IU) is LDA by M */
ldwrku = *lda;
} else {
/* WORK(IU) is M by M */
ldwrku = *m;
}
itau = iu + ldwrku * *m;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need M*M+2*M, prefer M*M+M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need M*M+M+N, prefer M*M+M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(n, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy L to WORK(IU), zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &work[iu], &
ldwrku);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &work[iu +
ldwrku], &ldwrku);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in WORK(IU), copying result to U
(CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &work[iu], &ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &work[iu], ldwrku, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork],
i__2, &ierr);
lapackf77_clacpy("L", m, m, &work[iu], &ldwrku, &u[u_offset],
ldu);
/* Generate right bidiagonalizing vectors in WORK(IU)
(CWorkspace: need M*M+3*M, prefer M*M+2*M+(M-1)*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
, &work[iwork], &i__2, &ierr);
/* Generate left bidiagonalizing vectors in U
(CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cungbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq],
&work[iwork], &i__2, &ierr);
irwork = ie + *m;
/* Perform bidiagonal QR iteration, computing left
singular vectors of L in U and computing right
singular vectors of L in WORK(IU)
(CWorkspace: need M*M)
(RWorkspace: need BDSPAC) */
lapackf77_cbdsqr("U", m, m, m, &c__0, &s[1], &rwork[ie], &work[
iu], &ldwrku, &u[u_offset], ldu, cdum, &c__1,
&rwork[irwork], info);
/* Multiply right singular vectors of L in WORK(IU) by
Q in VT, storing result in A
(CWorkspace: need M*M)
(RWorkspace: 0) */
blasf77_cgemm("N", "N", m, n, m, &c_b2, &work[iu], &ldwrku, &
vt[vt_offset], ldvt, &c_b1, &a[a_offset], lda);
/* Copy right singular vectors of A from A to VT */
lapackf77_clacpy("F", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
} else {
/* Insufficient workspace for a fast algorithm */
itau = 1;
iwork = itau + *m;
/* Compute A=L*Q, copying result to VT
(CWorkspace: need 2*M, prefer M+M*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
iwork], &i__2, &ierr);
lapackf77_clacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset],
ldvt);
/* Generate Q in VT
(CWorkspace: need M+N, prefer M+N*NB)
(RWorkspace: 0) */
i__2 = *lwork - iwork + 1;
lapackf77_cunglq(n, n, m, &vt[vt_offset], ldvt, &work[itau],
&work[iwork], &i__2, &ierr);
/* Copy L to U, zeroing out above it */
lapackf77_clacpy("L", m, m, &a[a_offset], lda, &u[u_offset],
ldu);
i__2 = *m - 1;
i__3 = *m - 1;
lapackf77_claset("U", &i__2, &i__3, &c_b1, &c_b1, &u[(u_dim1 <<
1) + 1], ldu);
ie = 1;
itauq = itau;
itaup = itauq + *m;
iwork = itaup + *m;
/* Bidiagonalize L in U
(CWorkspace: need 3*M, prefer 2*M+2*M*NB)
(RWorkspace: need M) */
i__2 = *lwork - iwork + 1;
/*
lapackf77_cgebrd(m, m, &u[u_offset], ldu, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &work[iwork], &
i__2, &ierr);
*/
magma_cgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &rwork[ie], &
work[itauq], &work[itaup], &