This graph shows which files directly or indirectly include this file:

Macros
#define	PRECISION_d

Functions
magma_int_t	magma_dgebrd (magma_int_t m, magma_int_t n, double A, magma_int_t lda, double d, double e, double tauq, double taup, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dgehrd2 (magma_int_t n, magma_int_t ilo, magma_int_t ihi, double A, magma_int_t lda, double tau, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dgehrd (magma_int_t n, magma_int_t ilo, magma_int_t ihi, double A, magma_int_t lda, double tau, double work, magma_int_t lwork, double d_T, magma_int_t *info)
magma_int_t	magma_dgelqf (magma_int_t m, magma_int_t n, double A, magma_int_t lda, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgeqlf (magma_int_t m, magma_int_t n, double A, magma_int_t lda, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgeqrf (magma_int_t m, magma_int_t n, double A, magma_int_t lda, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgeqrf4 (magma_int_t num_gpus, magma_int_t m, magma_int_t n, double a, magma_int_t lda, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgeqrf_ooc (magma_int_t m, magma_int_t n, double A, magma_int_t lda, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgesv (magma_int_t n, magma_int_t nrhs, double A, magma_int_t lda, magma_int_t ipiv, double B, magma_int_t ldb, magma_int_t info)
magma_int_t	magma_dgetrf (magma_int_t m, magma_int_t n, double A, magma_int_t lda, magma_int_t ipiv, magma_int_t *info)
magma_int_t	magma_dgetrf2 (magma_int_t m, magma_int_t n, double a, magma_int_t lda, magma_int_t ipiv, magma_int_t *info)
magma_int_t	magma_dlatrd (char uplo, magma_int_t n, magma_int_t nb, double a, magma_int_t lda, double e, double tau, double w, magma_int_t ldw, double da, magma_int_t ldda, double dw, magma_int_t lddw)
magma_int_t	magma_dlatrd2 (char uplo, magma_int_t n, magma_int_t nb, double a, magma_int_t lda, double e, double tau, double w, magma_int_t ldw, double da, magma_int_t ldda, double dw, magma_int_t lddw, double *dwork, magma_int_t ldwork)
magma_int_t	magma_dlahr2 (magma_int_t m, magma_int_t n, magma_int_t nb, double da, double dv, double a, magma_int_t lda, double tau, double t, magma_int_t ldt, double y, magma_int_t ldy)
magma_int_t	magma_dlahru (magma_int_t n, magma_int_t ihi, magma_int_t k, magma_int_t nb, double a, magma_int_t lda, double da, double y, double v, double t, double dwork)
magma_int_t	magma_dposv (char uplo, magma_int_t n, magma_int_t nrhs, double A, magma_int_t lda, double B, magma_int_t ldb, magma_int_t *info)
magma_int_t	magma_dpotrf (char uplo, magma_int_t n, double A, magma_int_t lda, magma_int_t info)
magma_int_t	magma_dpotri (char uplo, magma_int_t n, double A, magma_int_t lda, magma_int_t info)
magma_int_t	magma_dlauum (char uplo, magma_int_t n, double A, magma_int_t lda, magma_int_t info)
magma_int_t	magma_dtrtri (char uplo, char diag, magma_int_t n, double A, magma_int_t lda, magma_int_t info)
magma_int_t	magma_dsytrd (char uplo, magma_int_t n, double A, magma_int_t lda, double d, double e, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dorgqr (magma_int_t m, magma_int_t n, magma_int_t k, double a, magma_int_t lda, double tau, double dwork, magma_int_t nb, magma_int_t info)
magma_int_t	magma_dormql (const char side, const char trans, magma_int_t m, magma_int_t n, magma_int_t k, double a, magma_int_t lda, double tau, double c, magma_int_t ldc, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dormqr (char side, char trans, magma_int_t m, magma_int_t n, magma_int_t k, double a, magma_int_t lda, double tau, double c, magma_int_t ldc, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dormtr (char side, char uplo, char trans, magma_int_t m, magma_int_t n, double a, magma_int_t lda, double tau, double c, magma_int_t ldc, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dorghr (magma_int_t n, magma_int_t ilo, magma_int_t ihi, double a, magma_int_t lda, double tau, double dT, magma_int_t nb, magma_int_t info)
magma_int_t	magma_dsyev (char jobz, char uplo, magma_int_t n, double a, magma_int_t lda, double w, double work, magma_int_t lwork, double rwork, magma_int_t *info)
magma_int_t	magma_dsyevx (char jobz, char range, char uplo, magma_int_t n, double a, magma_int_t lda, double vl, double vu, magma_int_t il, magma_int_t iu, double abstol, magma_int_t m, double w, double z, magma_int_t ldz, double work, magma_int_t lwork, double rwork, magma_int_t iwork, magma_int_t ifail, magma_int_t *info)
magma_int_t	magma_dgeev (char jobvl, char jobvr, magma_int_t n, double a, magma_int_t lda, double wr, double wi, double vl, magma_int_t ldvl, double vr, magma_int_t ldvr, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dgeqp3 (magma_int_t m, magma_int_t n, double a, magma_int_t lda, magma_int_t jpvt, double tau, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dgesvd (char jobu, char jobvt, magma_int_t m, magma_int_t n, double a, magma_int_t lda, double s, double u, magma_int_t ldu, double vt, magma_int_t ldvt, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dsyevd (char jobz, char uplo, magma_int_t n, double a, magma_int_t lda, double w, double work, magma_int_t lwork, magma_int_t iwork, magma_int_t liwork, magma_int_t *info)
magma_int_t	magma_dsygvd (magma_int_t itype, char jobz, char uplo, magma_int_t n, double a, magma_int_t lda, double b, magma_int_t ldb, double w, double work, magma_int_t lwork, magma_int_t iwork, magma_int_t liwork, magma_int_t info)
magma_int_t	magma_dstedx (char range, magma_int_t n, double vl, double vu, magma_int_t il, magma_int_t iu, double d, double e, double z, magma_int_t ldz, double work, magma_int_t lwork, magma_int_t iwork, magma_int_t liwork, double dwork, magma_int_t *info)
magma_int_t	magma_dlaex0 (magma_int_t n, double d, double e, double q, magma_int_t ldq, double work, magma_int_t iwork, double dwork, char range, double vl, double vu, magma_int_t il, magma_int_t iu, magma_int_t *info)
magma_int_t	magma_dlaex1 (magma_int_t n, double d, double q, magma_int_t ldq, magma_int_t indxq, double rho, magma_int_t cutpnt, double work, magma_int_t iwork, double dwork, char range, double vl, double vu, magma_int_t il, magma_int_t iu, magma_int_t *info)
magma_int_t	magma_dlaex3 (magma_int_t k, magma_int_t n, magma_int_t n1, double d, double q, magma_int_t ldq, double rho, double dlamda, double q2, magma_int_t indx, magma_int_t ctot, double w, double s, magma_int_t indxq, double dwork, char range, double vl, double vu, magma_int_t il, magma_int_t iu, magma_int_t *info)
magma_int_t	magma_dsygst (magma_int_t itype, char uplo, magma_int_t n, double a, magma_int_t lda, double b, magma_int_t ldb, magma_int_t *info)
magma_int_t	magma_dgels_gpu (char trans, magma_int_t m, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, double dB, magma_int_t lddb, double hwork, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgels3_gpu (char trans, magma_int_t m, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, double dB, magma_int_t lddb, double hwork, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgelqf_gpu (magma_int_t m, magma_int_t n, double dA, magma_int_t ldda, double tau, double work, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgeqrf_gpu (magma_int_t m, magma_int_t n, double dA, magma_int_t ldda, double tau, double dT, magma_int_t info)
magma_int_t	magma_dgeqrf2_gpu (magma_int_t m, magma_int_t n, double dA, magma_int_t ldda, double tau, magma_int_t *info)
magma_int_t	magma_dgeqrf2_mgpu (magma_int_t num_gpus, magma_int_t m, magma_int_t n, double *dlA, magma_int_t ldda, double tau, magma_int_t *info)
magma_int_t	magma_dgeqrf3_gpu (magma_int_t m, magma_int_t n, double dA, magma_int_t ldda, double tau, double dT, magma_int_t info)
magma_int_t	magma_dgeqrs_gpu (magma_int_t m, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, double tau, double dT, double dB, magma_int_t lddb, double hwork, magma_int_t lhwork, magma_int_t info)
magma_int_t	magma_dgeqrs3_gpu (magma_int_t m, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, double tau, double dT, double dB, magma_int_t lddb, double hwork, magma_int_t lhwork, magma_int_t info)
magma_int_t	magma_dgessm_gpu (char storev, magma_int_t m, magma_int_t n, magma_int_t k, magma_int_t ib, magma_int_t ipiv, double dL1, magma_int_t lddl1, double dL, magma_int_t lddl, double dA, magma_int_t ldda, magma_int_t *info)
magma_int_t	magma_dgesv_gpu (magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, magma_int_t ipiv, double dB, magma_int_t lddb, magma_int_t info)
magma_int_t	magma_dgetrl_gpu (char storev, magma_int_t m, magma_int_t n, magma_int_t ib, double hA, magma_int_t ldha, double dA, magma_int_t ldda, double hL, magma_int_t ldhl, double dL, magma_int_t lddl, magma_int_t ipiv, double dwork, magma_int_t lddwork, magma_int_t *info)
magma_int_t	magma_dgetrf_gpu (magma_int_t m, magma_int_t n, double dA, magma_int_t ldda, magma_int_t ipiv, magma_int_t *info)
magma_int_t	magma_dgetrf_nopiv_gpu (magma_int_t m, magma_int_t n, double dA, magma_int_t ldda, magma_int_t info)
magma_int_t	magma_dgetri_gpu (magma_int_t n, double dA, magma_int_t ldda, magma_int_t ipiv, double dwork, magma_int_t lwork, magma_int_t info)
magma_int_t	magma_dgetrs_gpu (char trans, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, magma_int_t ipiv, double dB, magma_int_t lddb, magma_int_t info)
magma_int_t	magma_dlabrd_gpu (magma_int_t m, magma_int_t n, magma_int_t nb, double a, magma_int_t lda, double da, magma_int_t ldda, double d, double e, double tauq, double taup, double x, magma_int_t ldx, double dx, magma_int_t lddx, double y, magma_int_t ldy, double dy, magma_int_t lddy)
magma_int_t	magma_dlarfb_gpu (char side, char trans, char direct, char storev, magma_int_t m, magma_int_t n, magma_int_t k, double dv, magma_int_t ldv, double dt, magma_int_t ldt, double dc, magma_int_t ldc, double dowrk, magma_int_t ldwork)
magma_int_t	magma_dposv_gpu (char uplo, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, double dB, magma_int_t lddb, magma_int_t *info)
magma_int_t	magma_dpotrf_gpu (char uplo, magma_int_t n, double dA, magma_int_t ldda, magma_int_t info)
magma_int_t	magma_dpotri_gpu (char uplo, magma_int_t n, double dA, magma_int_t ldda, magma_int_t info)
magma_int_t	magma_dlauum_gpu (char uplo, magma_int_t n, double dA, magma_int_t ldda, magma_int_t info)
magma_int_t	magma_dtrtri_gpu (char uplo, char diag, magma_int_t n, double dA, magma_int_t ldda, magma_int_t info)
magma_int_t	magma_dsytrd_gpu (char uplo, magma_int_t n, double da, magma_int_t ldda, double d, double e, double tau, double wa, magma_int_t ldwa, double work, magma_int_t lwork, magma_int_t *info)
magma_int_t	magma_dsytrd2_gpu (char uplo, magma_int_t n, double da, magma_int_t ldda, double d, double e, double tau, double wa, magma_int_t ldwa, double work, magma_int_t lwork, double dwork, magma_int_t ldwork, magma_int_t info)
magma_int_t	magma_dpotrs_gpu (char uplo, magma_int_t n, magma_int_t nrhs, double dA, magma_int_t ldda, double dB, magma_int_t lddb, magma_int_t *info)
magma_int_t	magma_dssssm_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, double dA1, magma_int_t ldda1, double dA2, magma_int_t ldda2, double dL1, magma_int_t lddl1, double dL2, magma_int_t lddl2, magma_int_t IPIV, magma_int_t info)
magma_int_t	magma_dtstrf_gpu (char storev, magma_int_t m, magma_int_t n, magma_int_t ib, magma_int_t nb, double hU, magma_int_t ldhu, double dU, magma_int_t lddu, double hA, magma_int_t ldha, double dA, magma_int_t ldda, double hL, magma_int_t ldhl, double dL, magma_int_t lddl, magma_int_t ipiv, double hwork, magma_int_t ldhwork, double dwork, magma_int_t lddwork, magma_int_t info)
magma_int_t	magma_dorgqr_gpu (magma_int_t m, magma_int_t n, magma_int_t k, double da, magma_int_t ldda, double tau, double dwork, magma_int_t nb, magma_int_t info)
magma_int_t	magma_dormql2_gpu (const char side, const char trans, magma_int_t m, magma_int_t n, magma_int_t k, double da, magma_int_t ldda, double tau, double dc, magma_int_t lddc, double wa, magma_int_t ldwa, magma_int_t *info)
magma_int_t	magma_dormqr_gpu (char side, char trans, magma_int_t m, magma_int_t n, magma_int_t k, double a, magma_int_t lda, double tau, double c, magma_int_t ldc, double work, magma_int_t lwork, double td, magma_int_t nb, magma_int_t info)
magma_int_t	magma_dormqr2_gpu (const char side, const char trans, magma_int_t m, magma_int_t n, magma_int_t k, double da, magma_int_t ldda, double tau, double dc, magma_int_t lddc, double wa, magma_int_t ldwa, magma_int_t *info)
magma_int_t	magma_dormtr_gpu (char side, char uplo, char trans, magma_int_t m, magma_int_t n, double da, magma_int_t ldda, double tau, double dc, magma_int_t lddc, double wa, magma_int_t ldwa, magma_int_t *info)
magma_int_t	magma_dsyevd_gpu (char jobz, char uplo, magma_int_t n, double da, magma_int_t ldda, double w, double wa, magma_int_t ldwa, double work, magma_int_t lwork, magma_int_t iwork, magma_int_t liwork, magma_int_t info)
magma_int_t	magma_dsyevx_gpu (char jobz, char range, char uplo, magma_int_t n, double da, magma_int_t ldda, double vl, double vu, magma_int_t il, magma_int_t iu, double abstol, magma_int_t m, double w, double dz, magma_int_t lddz, double wa, magma_int_t ldwa, double wz, magma_int_t ldwz, double work, magma_int_t lwork, double rwork, magma_int_t iwork, magma_int_t ifail, magma_int_t *info)
magma_int_t	magma_dsygst_gpu (magma_int_t itype, char uplo, magma_int_t n, double da, magma_int_t ldda, double db, magma_int_t lddb, magma_int_t *info)
void	magma_dprint (int m, int n, double *A, int lda)
void	magma_dprint_gpu (int m, int n, double *dA, int ldda)
void	dpanel_to_q (char uplo, int ib, double A, int lda, double work)
void	dq_to_panel (char uplo, int ib, double A, int lda, double work)

Macro Definition Documentation

#define PRECISION_d

Definition at line 13 of file magma_d.h.

Function Documentation

void dpanel_to_q	(	char	uplo,
		int	ib,
		double *	A,
		int	lda,
		double *	work
	)

Definition at line 17 of file dpanel_to_q.cpp.

References MAGMA_D_ONE, and MAGMA_D_ZERO.

{
    int i, j, k = 0;
    double *col;
    double c_zero = MAGMA_D_ZERO;
    double c_one  = MAGMA_D_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 dq_to_panel	(	char	uplo,
		int	ib,
		double *	A,
		int	lda,
		double *	work
	)

Definition at line 57 of file dpanel_to_q.cpp.

{
    int i, j, k = 0;
    double *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_dgebrd	(	magma_int_t	m,
		magma_int_t	n,
		double *	A,
		magma_int_t	lda,
		double *	d,
		double *	e,
		double *	tauq,
		double *	taup,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 24 of file dgebrd.cpp.

References __func__, A, dA, dwork, lapackf77_dgebrd(), MAGMA_D_MAKE, MAGMA_D_NEG_ONE, MAGMA_D_ONE, MAGMA_D_SET2REAL, magma_dgemm, magma_dgetmatrix(), magma_dlabrd_gpu(), magma_dmalloc(), magma_dsetmatrix(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgebrd_nb(), MAGMA_SUCCESS, magma_xerbla(), MagmaNoTrans, MagmaTrans, max, and min.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose
    =======
    DGEBRD reduces a general real M-by-N matrix A to upper or lower
    bidiagonal form B by an orthogonal transformation: Q**T * 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) DOUBLE_PRECISION 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) double precision array, dimension (min(M,N))
            The diagonal elements of the bidiagonal matrix B:
            D(i) = A(i,i).
    E       (output) double precision 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) DOUBLE_PRECISION array dimension (min(M,N))
            The scalar factors of the elementary reflectors which
            represent the orthogonal matrix Q. See Further Details.
    TAUP    (output) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors which
            represent the orthogonal matrix P. See Further Details.
    WORK    (workspace/output) DOUBLE_PRECISION 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 real scalars, and v and u are real 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 real scalars, and v and u are real 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).
    =====================================================================    */
    double c_neg_one = MAGMA_D_NEG_ONE;
    double c_one     = MAGMA_D_ONE;
    double *da, *dwork;
    magma_int_t ncol, nrow, jmax, nb, ldda;
    static magma_int_t i, j, nx;
    static double ws;
    static magma_int_t iinfo;
    magma_int_t minmn;
    magma_int_t ldwrkx, ldwrky, lwkopt;
    magma_int_t lquery;
    nb   = magma_get_dgebrd_nb(n);
    ldda = m;
    lwkopt = (m + n) * nb;
    work[0] = MAGMA_D_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_dmalloc( &da, n*ldda + (m + n)*nb )) {
        fprintf (stderr, "!!!! device memory allocation error in dgebrd\n" );
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info; 
    }
    dwork = da + (n)*ldda;
    MAGMA_D_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_dsetmatrix( 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_dgetmatrix( nrow, nb, dA(i, i), ldda, A( i, i), lda );
            magma_dgetmatrix( nb, ncol - nb,
                              dA(i, i+nb), ldda,
                              A( i, i+nb), lda );
        }
        magma_dlabrd_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_dsetmatrix( nrow, nb, work  + nb, ldwrkx, dwork + nb, ldwrkx );
        magma_dsetmatrix( ncol, nb,
                          work  + (ldwrkx+1)*nb, ldwrky,
                          dwork + (ldwrkx+1)*nb, ldwrky );
        magma_dgemm( MagmaNoTrans, MagmaTrans, 
                     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_dgemm( 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_D_MAKE( d[j], 0. );
                *A(j, j+1) = MAGMA_D_MAKE( e[j], 0. );
            }
        } else {
            jmax = i + nb;
            for (j = i; j < jmax; ++j) {
                *A(j,   j ) = MAGMA_D_MAKE( d[j], 0. );
                *A(j+1, j ) = MAGMA_D_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_dgetmatrix( nrow, ncol, dA(i, i), ldda, A( i, i), lda );
    lapackf77_dgebrd( &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;
} /* dgebrd_ */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeev	(	char	jobvl,
		char	jobvr,
		magma_int_t	n,
		double *	a,
		magma_int_t	lda,
		double *	wr,
		double *	wi,
		double *	vl,
		magma_int_t	ldvl,
		double *	vr,
		magma_int_t	ldvr,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 25 of file dgeev.cpp.

References __func__, cblas_dnrm2(), cblas_drot(), cblas_dscal(), cblas_idamax(), dT, lapackf77_dgebak(), lapackf77_dgebal(), lapackf77_dgehrd(), lapackf77_dhseqr(), lapackf77_dlabad, lapackf77_dlacpy(), lapackf77_dlamch, lapackf77_dlange(), lapackf77_dlapy2, lapackf77_dlartg(), lapackf77_dlascl(), lapackf77_dorghr(), lapackf77_dtrevc(), lapackf77_lsame, magma_dgehrd(), magma_dgehrd2(), magma_dmalloc(), magma_dorghr(), magma_dsqrt, MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgehrd_nb(), 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   
    =======   
    DGEEV computes for an N-by-N real 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)**T * A = lambda(j) * u(j)**T   
    where u(j)**T denotes the 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) DOUBLE PRECISION 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).   
    WR      (output) DOUBLE PRECISION array, dimension (N)   
    WI      (output) DOUBLE PRECISION array, dimension (N)   
            WR and WI contain the real and imaginary parts,
            respectively, of the computed eigenvalues.  Complex
            conjugate pairs of eigenvalues appear consecutively
            with the eigenvalue having the positive imaginary part
            first.
    VL      (output) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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.   
    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 c_n1 = -1;
    
    magma_int_t a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, 
            i__2, i__3;
    double d__1, d__2;
    magma_int_t i__, k, ihi, ilo;
    double      r__, cs, sn, scl;
    double dum[1], eps;
    magma_int_t ibal;
    double anrm;
    magma_int_t ierr, itau, iwrk, nout;
    magma_int_t scalea;
    double cscale;
    double bignum;
    magma_int_t minwrk;
    magma_int_t wantvl;
    double smlnum;
    magma_int_t lquery, wantvr, select[1];
    magma_int_t nb = 0;
    double *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 = -9;
    } else if ( (ldvr < 1) || (wantvr && (ldvr < n))) {
        *info = -11;
    }
    /*  Compute workspace   */
    if (*info == 0) {
        nb = magma_get_dgehrd_nb(n);
        minwrk = (2+nb)*n;
        work[0] = (double) minwrk;
        
        if (lwork < minwrk && ! lquery) {
            *info = -13;
        }
    }
    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_dmalloc( &dT, nb*n )) {
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
    }
#endif
    // subtract row and col for 1-based indexing
    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;
    /* Get machine constants */
    eps    = lapackf77_dlamch("P");
    smlnum = lapackf77_dlamch("S");
    bignum = 1. / smlnum;
    lapackf77_dlabad(&smlnum, &bignum);
    smlnum = magma_dsqrt(smlnum) / eps;
    bignum = 1. / smlnum;
    /* Scale A if max element outside range [SMLNUM,BIGNUM] */
    anrm = lapackf77_dlange("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_dlascl("G", &c__0, &c__0, &anrm, &cscale, &n, &n, 
                &a[a_offset], &lda, &ierr);
    }
    /* Balance the matrix   
       (Workspace: need N) */
    ibal = 1;
    lapackf77_dgebal("B", &n, &a[a_offset], &lda, &ilo, &ihi, &work[ibal], &ierr);
    /* Reduce to upper Hessenberg form   
       (Workspace: need 3*N, prefer 2*N+N*NB) */
    itau = ibal + n;
    iwrk = itau + n;
    i__1 = lwork - iwrk + 1;
    //start = get_current_time();
#if defined(VERSION1)
    /*
     * Version 1 - LAPACK
     */
    lapackf77_dgehrd(&n, &ilo, &ihi, &a[a_offset], &lda,
                     &work[itau], &work[iwrk], &i__1, &ierr);
#elif defined(VERSION2)
    /*
     *  Version 2 - LAPACK consistent HRD
     */
    magma_dgehrd2(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_dgehrd(n, ilo, ihi, &a[a_offset], lda,
                 &work[itau], &work[iwrk], i__1, dT, &ierr);
#endif
    //end = get_current_time();
    //printf("    Time for dgehrd = %5.2f sec\n", GetTimerValue(start,end)/1000.);
    if (wantvl) {
      /*        Want left eigenvectors   
                Copy Householder vectors to VL */
        side[0] = 'L';
        lapackf77_dlacpy(MagmaLowerStr, &n, &n, 
                         &a[a_offset], &lda, &vl[vl_offset], &ldvl);
        /* 
         * Generate orthogonal matrix in VL 
         *   (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) 
         */
        i__1 = lwork - iwrk + 1;
        //start = get_current_time();
#if defined(VERSION1) || defined(VERSION2)
        /*
         * Version 1 & 2 - LAPACK
         */
        lapackf77_dorghr(&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_dorghr(n, ilo, ihi, &vl[vl_offset], ldvl, &work[itau], 
                     dT, nb, &ierr);
#endif
        //end = get_current_time();
        //printf("    Time for dorghr = %5.2f sec\n", GetTimerValue(start,end)/1000.);
        /*
         * Perform QR iteration, accumulating Schur vectors in VL
         *   (Workspace: need N+1, prefer N+HSWORK (see comments) )
         */
        iwrk = itau;
        i__1 = lwork - iwrk + 1;
        lapackf77_dhseqr("S", "V", &n, &ilo, &ihi, &a[a_offset], &lda, WR, WI, 
                         &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_dlacpy("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_dlacpy("L", &n, &n, &a[a_offset], &lda, &vr[vr_offset], &ldvr);
        /*
         * Generate orthogonal matrix in VR
         *   (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) 
         */
        i__1 = lwork - iwrk + 1;
        //start = get_current_time();
#if defined(VERSION1) || defined(VERSION2)
        /*
         * Version 1 & 2 - LAPACK
         */
        lapackf77_dorghr(&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_dorghr(n, ilo, ihi, &vr[vr_offset], ldvr, 
                     &work[itau], dT, nb, &ierr);
#endif
        //end = get_current_time();
        //printf("    Time for dorghr = %5.2f sec\n", GetTimerValue(start,end)/1000.);
        /* 
         * Perform QR iteration, accumulating Schur vectors in VR   
         *   (Workspace: need N+1, prefer N+HSWORK (see comments) ) 
         */
        iwrk = itau;
        i__1 = lwork - iwrk + 1;
        lapackf77_dhseqr("S", "V", &n, &ilo, &ihi, &a[a_offset], &lda, WR, WI,
                &vr[vr_offset], &ldvr, &work[iwrk], &i__1, info);
    } else {
        /*  
         * Compute eigenvalues only   
         *   (Workspace: need N+1, prefer N+HSWORK (see comments) ) 
         */
        iwrk = itau;
        i__1 = lwork - iwrk + 1;
        lapackf77_dhseqr("E", "N", &n, &ilo, &ihi, &a[a_offset], &lda, WR, WI,
                &vr[vr_offset], &ldvr, &work[iwrk], &i__1, info);
    }
    /* If INFO > 0 from ZHSEQR, then quit */
    if (*info > 0) {
        fprintf(stderr, "ZHSEQR returned with info = %d\n", *info);
        goto L50;
    }
    if (wantvl || wantvr) {
        /*  
         * Compute left and/or right eigenvectors   
         *   (Workspace: need 4*N) 
         */
        lapackf77_dtrevc(side, "B", select, &n, &a[a_offset], &lda, &vl[vl_offset], &ldvl,
                &vr[vr_offset], &ldvr, &n, &nout, &work[iwrk], &ierr);
    }
    if (wantvl) {
        /*  
         * Undo balancing of left eigenvectors   
         *   (Workspace: need N) 
         */
        lapackf77_dgebak("B", "L", &n, &ilo, &ihi, 
                         &work[ibal], &n, &vl[vl_offset], &ldvl, &ierr);
        /* Normalize left eigenvectors and make largest component real */
        for (i__ = 1; i__ <= n; ++i__) {
            if ( WI[i__-1] == 0.) {
                scl = cblas_dnrm2(n, &vl[i__ * vl_dim1 + 1], 1);
                scl = 1. / scl;
                cblas_dscal(n, (scl), &vl[i__ * vl_dim1 + 1], 1);
            } else if (WI[i__-1] > 0.) {
                d__1 = cblas_dnrm2(n, &vl[ i__      * vl_dim1 + 1], 1);
                d__2 = cblas_dnrm2(n, &vl[(i__ + 1) * vl_dim1 + 1], 1);
                scl = lapackf77_dlapy2(&d__1, &d__2);
                scl = 1. / scl;
                cblas_dscal(n, (scl), &vl[ i__      * vl_dim1 + 1], 1);
                cblas_dscal(n, (scl), &vl[(i__ + 1) * vl_dim1 + 1], 1);
                i__2 = n;
                for (k = 1; k <= i__2; ++k) {
                    /* Computing 2nd power */
                    d__1 = vl[k + i__ * vl_dim1];
                    /* Computing 2nd power */
                    d__2 = vl[k + (i__ + 1) * vl_dim1];
                    work[iwrk + 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_idamax */ 
                k = cblas_idamax(n, &work[iwrk], 1)+1;
                lapackf77_dlartg(&vl[k +  i__      * vl_dim1], 
                                 &vl[k + (i__ + 1) * vl_dim1], &cs, &sn, &r__);
                cblas_drot(n, &vl[ i__      * vl_dim1 + 1], 1, 
                           &vl[(i__ + 1) * vl_dim1 + 1], 1, cs, (sn));
                vl[k + (i__ + 1) * vl_dim1] = 0.;
            }
        }
    }
    if (wantvr) {
        /*  
         * Undo balancing of right eigenvectors   
         *   (Workspace: need N) 
         */
        lapackf77_dgebak("B", "R", &n, &ilo, &ihi, &work[ibal], &n, 
                         &vr[vr_offset], &ldvr, &ierr);
        /* Normalize right eigenvectors and make largest component real */
        for (i__ = 1; i__ <= n; ++i__) {
            if (WI[i__-1] == 0.) {
                scl = 1. / cblas_dnrm2(n, &vr[i__ * vr_dim1 + 1], 1);
                cblas_dscal(n, (scl), &vr[i__ * vr_dim1 + 1], 1);
            } else if (WI[i__-1] > 0.) {
                d__1 = cblas_dnrm2(n, &vr[ i__      * vr_dim1 + 1], 1);
                d__2 = cblas_dnrm2(n, &vr[(i__ + 1) * vr_dim1 + 1], 1);
                scl = lapackf77_dlapy2(&d__1, &d__2);
                scl = 1. / scl;
                cblas_dscal(n, (scl), &vr[ i__      * vr_dim1 + 1], 1);
                cblas_dscal(n, (scl), &vr[(i__ + 1) * vr_dim1 + 1], 1);
                i__2 = n;
                for (k = 1; k <= i__2; ++k) {
                    /* Computing 2nd power */
                    d__1 = vr[k + i__ * vr_dim1];
                    /* Computing 2nd power */
                    d__2 = vr[k + (i__ + 1) * vr_dim1];
                    work[iwrk + 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_idamax */
                k = cblas_idamax(n, &work[iwrk], 1)+1;
                lapackf77_dlartg(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], 
                        &cs, &sn, &r__);
                cblas_drot(n, &vr[ i__      * vr_dim1 + 1], 1, 
                              &vr[(i__ + 1) * vr_dim1 + 1], 1, cs, (sn));
                vr[k + (i__ + 1) * vr_dim1] = 0.;
            }
        }
    }
    /*  Undo scaling if necessary */
L50:
    if (scalea) {
        i__1 = n - *info;
        /* Computing MAX */
        i__3 = n - *info;
        i__2 = max(i__3,1);
        lapackf77_dlascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, 
                         WR + (*info), &i__2, &ierr);
        i__1 = n - *info;
        /* Computing MAX */
        i__3 = n - *info;
        i__2 = max(i__3,1);
        lapackf77_dlascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, 
                WI + (*info), &i__2, &ierr);
        if (*info > 0) {
            i__1 = ilo - 1;
            lapackf77_dlascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, 
                    WR, &n, &ierr);
            i__1 = ilo - 1;
            lapackf77_dlascl("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1,
                    WI, &n, &ierr);
        }
    }
#if defined(VERSION3)
    magma_free( dT );
#endif
    return *info;
} /* magma_dgeev */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgehrd	(	magma_int_t	n,
		magma_int_t	ilo,
		magma_int_t	ihi,
		double *	A,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		double *	d_T,
		magma_int_t *	info
	)

Definition at line 14 of file dgehrd.cpp.

References __func__, dzero_nbxnb_block(), lapackf77_dgehd2(), MAGMA_D_ONE, MAGMA_D_SET2REAL, MAGMA_D_ZERO, magma_dgetmatrix(), magma_dlahr2(), magma_dlahru(), magma_dmalloc(), magma_dsetmatrix(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_dgehrd_nb(), MAGMA_SUCCESS, magma_xerbla(), max, min, and gbstrct_blg::N.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose   
    =======   
    DGEHRD reduces a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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)  DOUBLE_PRECISION 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 real scalar, and v is a real 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.
    =====================================================================    */
    double c_one = MAGMA_D_ONE;
    double c_zero = MAGMA_D_ZERO;
    magma_int_t nb = magma_get_dgehrd_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_D_SET2REAL( work[0], (double) 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;
    }
    double *da;
    if (MAGMA_SUCCESS != magma_dmalloc( &da, N*ldda + 2*N*nb + nb*nb )) {
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
    }
    
    double *d_A    = da;
    double *d_work = da + (N+nb)*ldda;
    magma_int_t i__;
    double *t, *d_t;
    t = (double*) malloc(nb*nb*sizeof(double));
    if ( t == NULL ) {
        magma_free( da );
        *info = MAGMA_ERR_HOST_ALLOC;
        return *info;
    }
    d_t = d_work + nb * ldda;
    dzero_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_dsetmatrix( 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_dgetmatrix( ihi-i__+1, ib,
                          d_A + (i__ - ilo)*ldda + i__ - 1, ldda,
                          a   + (i__ -  1 )*lda  + i__ - 1, lda );      
        
        magma_dlahr2(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_dsetmatrix( nb, nb, t, nb, d_t, nb );
        magma_dlahru(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_dgetmatrix( n, n-i__+1,
                          d_A+ (i__-ilo)*ldda, ldda,
                          a  + (i__-1)*(lda),  lda );
    lapackf77_dgehd2(&n, &i__, &ihi, a, &lda, &tau[1], work, &iinfo);
    MAGMA_D_SET2REAL( work[0], (double) iws );
    
    magma_free( da );
    free(t);
 
    return *info;
} /* magma_dgehrd */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgehrd2	(	magma_int_t	n,
		magma_int_t	ilo,
		magma_int_t	ihi,
		double *	A,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t *	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgehrd2.cpp.

References __func__, dzero_nbxnb_block(), lapackf77_dgehd2(), MAGMA_D_ONE, MAGMA_D_SET2REAL, MAGMA_D_ZERO, magma_dgetmatrix(), magma_dlahr2(), magma_dlahru(), magma_dmalloc(), magma_dsetmatrix(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_dgehrd_nb(), MAGMA_SUCCESS, magma_xerbla(), max, min, and gbstrct_blg::N.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose   
    =======   
    DGEHRD2 reduces a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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 real scalar, and v is a real 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.
    =====================================================================    */
    double c_one = MAGMA_D_ONE;
    double c_zero = MAGMA_D_ZERO;
    magma_int_t nb = magma_get_dgehrd_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_D_SET2REAL( work[0], (double) 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;
    }
    double *da;
    if (MAGMA_SUCCESS != magma_dmalloc( &da, N*ldda + 2*N*nb + nb*nb )) {
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
    }
    
    double *d_A    = da;
    double *d_work = da + (N+nb)*ldda;
    magma_int_t i__;
    double *t, *d_t;
    t = (double*) malloc( nb*nb * sizeof(double));
    if ( t == NULL ) {
        magma_free( da );
        *info = MAGMA_ERR_HOST_ALLOC;
        return *info;
    }
    d_t = d_work + nb * ldda;
    dzero_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_dsetmatrix( 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_dgetmatrix( ihi-i__+1, ib,
                          d_A + (i__ - ilo)*ldda + i__ - 1, ldda,
                          a   + (i__ -  1 )*lda  + i__ - 1, lda );      
        
        magma_dlahr2(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_dsetmatrix( nb, nb, t, nb, d_t, nb );
        magma_dlahru(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_dgetmatrix( n, n-i__+1,
                          d_A+ (i__-ilo)*ldda, ldda,
                          a  + (i__-1)*(lda),  lda );
    lapackf77_dgehd2(&n, &i__, &ihi, a, &lda, &tau[1], work, &iinfo);
    MAGMA_D_SET2REAL( work[0], (double) iws );
    
    magma_free( da );
    free(t);
 
    return *info;
} /* magma_dgehrd2 */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgelqf	(	magma_int_t	m,
		magma_int_t	n,
		double *	A,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgelqf.cpp.

References __func__, dA, MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf2_gpu(), magma_dgetmatrix(), magma_dmalloc(), magma_dsetmatrix(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgelqf_nb(), MAGMA_SUCCESS, magma_xerbla(), magmablas_dinplace_transpose(), magmablas_dtranspose2(), max, and min.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose
    =======
    DGELQF computes an LQ factorization of a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    WORK    (workspace/output) DOUBLE_PRECISION 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 real scalar, and v is a real 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))
    double *dA, *dAT;
    double c_one = MAGMA_D_ONE;
    magma_int_t maxm, maxn, maxdim, nb;
    magma_int_t iinfo, ldda;
    long int lquery;
    /* Function Body */
    *info = 0;
    nb = magma_get_dgelqf_nb(m);
    work[0] = MAGMA_D_MAKE( (double)(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_dmalloc( &dA, maxdim*maxdim )) {
                *info = MAGMA_ERR_DEVICE_ALLOC;
                return *info;
            }
            magma_dsetmatrix( m, n, a, lda, dA, ldda );
            dAT = dA;
            magmablas_dinplace_transpose( dAT, ldda, ldda );
        }
    else
        {
            ldda = maxn;
            if (MAGMA_SUCCESS != magma_dmalloc( &dA, 2*maxn*maxm )) {
                *info = MAGMA_ERR_DEVICE_ALLOC;
                return *info;
            }
            magma_dsetmatrix( m, n, a, lda, dA, maxm );
            dAT = dA + maxn * maxm;
            magmablas_dtranspose2( dAT, ldda, dA, maxm, m, n );
        }
    magma_dgeqrf2_gpu(n, m, dAT, ldda, tau, &iinfo);
    if (maxdim*maxdim< 2*maxm*maxn){
        magmablas_dinplace_transpose( dAT, ldda, ldda );
        magma_dgetmatrix( m, n, dA, ldda, a, lda );
    } else {
        magmablas_dtranspose2( dA, maxm, dAT, ldda, n, m );
        magma_dgetmatrix( m, n, dA, maxm, a, lda );
    }
    magma_free( dA );
    return *info;
} /* magma_dgelqf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgelqf_gpu	(	magma_int_t	m,
		magma_int_t	n,
		double *	dA,
		magma_int_t	ldda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgelqf_gpu.cpp.

References __func__, dA, MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf2_gpu(), magma_dmalloc(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgelqf_nb(), MAGMA_SUCCESS, magma_xerbla(), magmablas_dinplace_transpose(), magmablas_dtranspose2(), max, and min.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose
    =======
    DGELQF computes an LQ factorization of a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    WORK    (workspace/output) DOUBLE_PRECISION 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 real scalar, and v is a real 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))
    double *dAT;
    double c_one = MAGMA_D_ONE;
    magma_int_t maxm, maxn, maxdim, nb;
    magma_int_t iinfo;
    long int lquery;
    *info = 0;
    nb = magma_get_dgelqf_nb(m);
    work[0] = MAGMA_D_MAKE( (double)(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_dinplace_transpose( dAT, lda, maxm );
    }
    else {
      if (MAGMA_SUCCESS != magma_dmalloc( &dAT, maxm*maxn ) ){
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
      }
      
      magmablas_dtranspose2( dAT, ldat, dA, lda, m, n );
    }
    
    magma_dgeqrf2_gpu(n, m, dAT, ldat, tau, &iinfo);
    if ((m == n) && (m % 32 == 0) && (lda%32 == 0)){
      magmablas_dinplace_transpose( dAT, ldat, maxm );
    }
    else {
      magmablas_dtranspose2( dA, lda, dAT, ldat, n, m );
      magma_free( dAT );
    }
    return *info;
} /* magma_dgelqf_gpu */

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 14 of file dgels3_gpu.cpp.

References __func__, dT, MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf3_gpu(), magma_dgeqrs3_gpu(), magma_dmalloc(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_dgeqrf_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) DOUBLE_PRECISION 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 DGEQRF3.
    LDDA    (input) INTEGER
            The leading dimension of the array A, LDDA >= M.
    DB      (input/output) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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_dgeqrf_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))
    double *dT, *tau;
    magma_int_t k;
    magma_int_t nb     = magma_get_dgeqrf_nb(m);
    magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
    long int lquery = (lwork == -1);
    hwork[0] = MAGMA_D_MAKE( (double)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_D_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_dmalloc( &dT, ldtwork )) {
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
    }
    
    tau = (double*) malloc( k * sizeof(double) );
    if( tau == NULL ) {
        magma_free( dT );
        *info = MAGMA_ERR_HOST_ALLOC;
        return *info;
    }
    magma_dgeqrf3_gpu( m, n, dA, ldda, tau, dT, info );
    if ( *info == 0 ) {
        magma_dgeqrs3_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_dgels_gpu	(	char	trans,
		magma_int_t	m,
		magma_int_t	n,
		magma_int_t	nrhs,
		double *	dA,
		magma_int_t	ldda,
		double *	dB,
		magma_int_t	lddb,
		double *	hwork,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgels_gpu.cpp.

References __func__, dT, MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf_gpu(), magma_dgeqrs_gpu(), magma_dmalloc(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_get_dgeqrf_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) DOUBLE_PRECISION 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 DGEQRF.
    LDDA    (input) INTEGER
            The leading dimension of the array A, LDDA >= M.
    DB      (input/output) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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_dgeqrf_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))
    double *dT, *tau;
    magma_int_t k;
    magma_int_t nb     = magma_get_dgeqrf_nb(m);
    magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
    long int lquery = (lwork == -1);
    hwork[0] = MAGMA_D_MAKE( (double)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_D_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_dmalloc( &dT, ldtwork )) {
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
    }
    
    tau = (double*) malloc( k * sizeof(double) );
    if( tau == NULL ) {
        magma_free( dT );
        *info = MAGMA_ERR_HOST_ALLOC;
        return *info;
    }
    magma_dgeqrf_gpu( m, n, dA, ldda, tau, dT, info );
    if ( *info == 0 ) {
        magma_dgeqrs_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_dgeqlf	(	magma_int_t	m,
		magma_int_t	n,
		double *	A,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgeqlf.cpp.

References __func__, a_ref, da_ref, dpanel_to_q(), dq_to_panel(), dwork, lapackf77_dgeqlf(), lapackf77_dlarft(), MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgetmatrix(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc(), magma_dsetmatrix(), magma_dsetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgeqlf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaBackward, MagmaBackwardStr, MagmaColumnwise, MagmaColumnwiseStr, MagmaLeft, MagmaLower, MagmaTrans, 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 DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    WORK    (workspace/output) DOUBLE_PRECISION 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_dgeqlf_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 real scalar, and v is a real 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))
    double *da, *dwork;
    double c_one = MAGMA_D_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_dgeqlf_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_D_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_dmalloc( &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_dsetmatrix_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_dgetmatrix_async( rows, ib,
                                        da_ref(0, n-k+i), ldda,
                                        a_ref(0, n-k+i),  lda, stream[1] );
                magma_dgetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dgeqlf(&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_dlarft( MagmaBackwardStr, MagmaColumnwiseStr, 
                                  &rows, &ib, 
                                  a_ref(0, cols), &lda, tau + i, work, &ib);
                dpanel_to_q( MagmaLower, ib, a_ref(rows-ib,cols), lda, work+ib*ib);
                magma_dsetmatrix( rows, ib,
                                  a_ref(0,cols),  lda,
                                  da_ref(0,cols), ldda );
                dq_to_panel( MagmaLower, ib, a_ref(rows-ib,cols), lda, work+ib*ib);
                // Send the triangular part on the GPU
                magma_dsetmatrix( 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_dlarfb_gpu( MagmaLeft, MagmaTrans, MagmaBackward, MagmaColumnwise,
                                      rows, ib, ib,
                                      da_ref(0, cols),   ldda, dwork,    lddwork,
                                      da_ref(0,cols-ib), ldda, dwork+ib, lddwork);
                else{
                    magma_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dgetmatrix( 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_dgeqlf(&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_dgeqlf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqp3	(	magma_int_t *	m,
		magma_int_t *	n,
		double *	a,
		magma_int_t *	lda,
		magma_int_t *	jpvt,
		double *	tau,
		double *	work,
		magma_int_t *	lwork,
		magma_int_t *	info
	)

magma_int_t magma_dgeqrf	(	magma_int_t	m,
		magma_int_t	n,
		double *	A,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgeqrf.cpp.

References __func__, a_ref, da_ref, dpanel_to_q(), dq_to_panel(), dwork, lapackf77_dgeqrf(), lapackf77_dlarft(), MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf4(), magma_dgeqrf_ooc(), magma_dgetmatrix(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc(), magma_dsetmatrix(), magma_dsetmatrix_async(), magma_free(), magma_get_dgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaTrans, MagmaUpper, max, and min.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose
    =======
    DGEQRF computes a QR factorization of a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    WORK    (workspace/output) DOUBLE_PRECISION 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_dgeqrf_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 real scalar, and v is a real 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))
    double *da, *dwork;
    double c_one = MAGMA_D_ONE;
    int i, k, lddwork, old_i, old_ib;
    int ib, ldda;
    /* Function Body */
    *info = 0;
    int nb = magma_get_dgeqrf_nb(min(m, n));
    int lwkopt = n * nb;
    work[0] = MAGMA_D_MAKE( (double)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_dgeqrf4(num_gpus, m, n, a, lda, tau, work, lwork, info);
    }
    if (MAGMA_SUCCESS != magma_dmalloc( &da, (n)*ldda + nb*lddwork )) {
        /* Switch to the "out-of-core" (out of GPU-memory) version */
        return magma_dgeqrf_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_dsetmatrix_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_dgetmatrix_async( (m-i), ib,
                                        da_ref(i,i), ldda,
                                        a_ref(i,i),  lda, stream[1] );
                magma_dgetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dgeqrf(&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_dlarft( MagmaForwardStr, MagmaColumnwiseStr, 
                              &rows, &ib, a_ref(i,i), &lda, tau+i, work, &ib);
            dpanel_to_q(MagmaUpper, ib, a_ref(i,i), lda, work+ib*ib);
            magma_dsetmatrix( rows, ib, a_ref(i,i), lda, da_ref(i,i), ldda );
            dq_to_panel(MagmaUpper, ib, a_ref(i,i), lda, work+ib*ib);
            if (i + ib < n) {
                magma_dsetmatrix( 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_dlarfb_gpu( MagmaLeft, MagmaTrans, MagmaForward, MagmaColumnwise, 
                                      rows, ib, ib, 
                                      da_ref(i, i   ), ldda, dwork,    lddwork, 
                                      da_ref(i, i+ib), ldda, dwork+ib, lddwork);
                else
                    magma_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dgetmatrix( m, ib, da_ref(0,i), ldda, a_ref(0,i), lda );
        int rows = m-i;
        lapackf77_dgeqrf(&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_dgeqrf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqrf2_gpu	(	magma_int_t	m,
		magma_int_t	n,
		double *	dA,
		magma_int_t	ldda,
		double *	tau,
		magma_int_t *	info
	)

Definition at line 14 of file dgeqrf2_gpu.cpp.

References __func__, dpanel_to_q(), dq_to_panel(), dwork, hwork, lapackf77_dgeqrf(), lapackf77_dlarft(), magma_dgetmatrix(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc(), magma_dmalloc_host(), magma_dsetmatrix(), magma_dsetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_free(), magma_free_host(), magma_get_dgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaTrans, 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
    =======
    DGEQRF computes a QR factorization of a real 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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 real scalar, and v is a real 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))
    double *dwork;
    double *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_dgeqrf_nb(m);
    lwork  = (m+n) * nb;
    lhwork = lwork - (m)*nb;
    if (MAGMA_SUCCESS != magma_dmalloc( &dwork, (n)*nb )) {
        *info = MAGMA_ERR_DEVICE_ALLOC;
        return *info;
    }
    if (MAGMA_SUCCESS != magma_dmalloc_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_dgetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix_async( old_ib, old_ib,
                                        work_ref(old_i),  ldwork,
                                        dA(old_i, old_i), ldda, stream[0] );
            }
            magma_queue_sync( stream[1] );
            lapackf77_dgeqrf(&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_dlarft( MagmaForwardStr, MagmaColumnwiseStr, 
                              &rows, &ib, 
                              work_ref(i), &ldwork, tau+i, hwork, &ib);
            dpanel_to_q( MagmaUpper, ib, work_ref(i), ldwork, hwork+ib*ib );
            magma_dsetmatrix( rows, ib, work_ref(i), ldwork, dA(i,i), ldda );
            dq_to_panel( MagmaUpper, ib, work_ref(i), ldwork, hwork+ib*ib );
            if (i + ib < n) {
                magma_dsetmatrix( 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_dlarfb_gpu( MagmaLeft, MagmaTrans, MagmaForward, MagmaColumnwise,
                                      rows, ib, ib, 
                                      dA(i, i   ), ldda, dwork,    lddwork, 
                                      dA(i, i+ib), ldda, dwork+ib, lddwork);
                else {
                    magma_dlarfb_gpu( MagmaLeft, MagmaTrans, MagmaForward, MagmaColumnwise,
                                      rows, n-i-ib, ib, 
                                      dA(i, i   ), ldda, dwork,    lddwork, 
                                      dA(i, i+ib), ldda, dwork+ib, lddwork);
                    magma_dsetmatrix( 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_dgetmatrix( rows, ib, dA(i, i), ldda, work, rows );
        lhwork = lwork - rows*ib;
        lapackf77_dgeqrf(&rows, &ib, work, &rows, tau+i, work+ib*rows, &lhwork, info);
        
        magma_dsetmatrix( 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_dgeqrf2_gpu */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqrf2_mgpu	(	magma_int_t	num_gpus,
		magma_int_t	m,
		magma_int_t	n,
		double **	dlA,
		magma_int_t	ldda,
		double *	tau,
		magma_int_t *	info
	)

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

References __func__, core_cpu_event_end, core_cpu_event_start, core_gpu_event_end, core_gpu_event_start, core_log_event, dpanel_to_q(), dq_to_panel(), dump_trace(), dwork, get_current_cpu_time(), hwrk_ref, lapackf77_dgeqrf(), lapackf77_dlarft(), lhwrk, magma_device_sync(), magma_dgetmatrix(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc(), magma_dmalloc_host(), magma_dsetmatrix(), magma_dsetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, MAGMA_ERR_HOST_ALLOC, magma_event_create(), magma_event_record(), magma_free(), magma_get_dgeqrf_nb(), magma_getdevice(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), magma_setdevice(), MAGMA_SUCCESS, magma_xerbla(), magmablas_dgetmatrix_1D_bcyclic(), magmablas_dsetmatrix_1D_bcyclic(), MagmaColumnwise, MagmaColumnwiseStr, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaTrans, MagmaUpper, max, and min.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose
    =======
    DGEQRF2_MGPU computes a QR factorization of a real 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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 real scalar, and v is a real 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))
    double *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_dgeqrf_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_dmalloc( &(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_dmalloc_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_dgetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix_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_dgeqrf(&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_dlarft( MagmaForwardStr, MagmaColumnwiseStr,
                              &rows, &ib,
                              hwrk_ref(i), &ldwork, tau+i, lhwrk, &ib);
            dpanel_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_dsetmatrix_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);
            dq_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_dsetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix( 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_dgetmatrix_1D_bcyclic(m, n, dlA, ldda, lhwrk, m, num_gpus, nb);
        } else {
            magma_dgetmatrix( rows, ib,
                              dlA(panel_gpunum, i, i_loc), ldda,
                              lhwrk,                       rows );
        }
        lhwork = lwork - rows*ib;
        lapackf77_dgeqrf(&rows, &ib, lhwrk, &rows, tau+i, lhwrk+ib*rows, &lhwork, info);
        if (i == 0) {
            magmablas_dsetmatrix_1D_bcyclic(m, n, lhwrk, m, dlA, ldda, num_gpus, nb);
        } else {
            magma_dsetmatrix( 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_dgeqrf2_mgpu */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqrf3_gpu	(	magma_int_t	m,
		magma_int_t	n,
		double *	dA,
		magma_int_t	ldda,
		double *	tau,
		double *	dT,
		magma_int_t *	info
	)

Definition at line 38 of file dgeqrf3_gpu.cpp.

References __func__, a_ref, d_ref, dd_ref, dsplit_diag_block3(), hwork, lapackf77_dgeqrf(), lapackf77_dlarft(), magma_dgetmatrix(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc_host(), magma_dsetmatrix(), magma_dsetmatrix_async(), MAGMA_ERR_HOST_ALLOC, magma_free_host(), magma_get_dgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaTrans, 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
    =======
    DGEQRF3 computes a QR factorization of a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    dT      (workspace/output)  DOUBLE_PRECISION array on the GPU, 
            dimension (2*MIN(M, N) + (N+31)/32*32 )*NB,
            where NB can be obtained through magma_get_dgeqrf_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 real scalar, and v is a real 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;
    double *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_dgeqrf_nb(m);
    lwork  = (m + n + nb)*nb;
    lhwork = lwork - m*nb;
    if (MAGMA_SUCCESS != magma_dmalloc_host( &work, lwork )) {
        *info = MAGMA_ERR_HOST_ALLOC;
        return *info;
    }
    
    ut = hwork+nb*(n);
    memset( ut, 0, nb*nb*sizeof(double));
    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_dgetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix_async( old_ib, old_ib,
                                        ut,           old_ib,
                                        d_ref(old_i), old_ib, stream[0] );
            }
            magma_queue_sync( stream[1] );
            lapackf77_dgeqrf(&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_dlarft( 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] );
            dsplit_diag_block3(ib, work_ref(i), ldwork, ut);
            magma_dsetmatrix( rows, ib, work_ref(i), ldwork, a_ref(i,i), ldda );
            if (i + ib < n) {
                /* Send the triangular factor T to the GPU */
                magma_dsetmatrix( 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix( 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_dgetmatrix( rows, ib, a_ref(i, i), ldda, work, rows );
        lhwork = lwork - rows*ib;
        lapackf77_dgeqrf(&rows, &ib, work, &rows, tau+i, work+ib*rows, &lhwork, info);
        
        magma_dsetmatrix( 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_DGEQRF */
} /* magma_dgeqrf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqrf4	(	magma_int_t	num_gpus,
		magma_int_t	m,
		magma_int_t	n,
		double *	a,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

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

References __func__, lapackf77_dgeqrf(), MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf2_mgpu(), magma_dmalloc(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgeqrf_nb(), magma_setdevice(), MAGMA_SUCCESS, magma_xerbla(), magmablas_dgetmatrix_1D_bcyclic(), magmablas_dsetmatrix_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
    =======
    DGEQRF4 computes a QR factorization of a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    WORK    (workspace/output) DOUBLE_PRECISION 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_dgeqrf_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 real scalar, and v is a real 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).
    =====================================================================    */
    double *da[4];
    double c_one = MAGMA_D_ONE;
    int i, k, ldda;
    *info = 0;
    int nb = magma_get_dgeqrf_nb(min(m, n));
    int lwkopt = n * nb;
    work[0] = MAGMA_D_MAKE( (double)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_dmalloc( &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_dsetmatrix_1D_bcyclic(m, n, a, lda, da, ldda, num_gpus, nb);
        /* Factor using the GPU interface */
        magma_dgeqrf2_mgpu( num_gpus, m, n, da, ldda, tau, info);
        /* Copy the matrix back from the GPUs to the CPU */
        magmablas_dgetmatrix_1D_bcyclic(m, n, da, ldda, a, lda, num_gpus, nb);
    } else {
      lapackf77_dgeqrf(&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_dgeqrf4 */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqrf_gpu	(	magma_int_t	m,
		magma_int_t	n,
		double *	dA,
		magma_int_t	ldda,
		double *	tau,
		double *	dT,
		magma_int_t *	info
	)

Definition at line 41 of file dgeqrf_gpu.cpp.

References __func__, a_ref, d_ref, dd_ref, dsplit_diag_block(), hwork, lapackf77_dgeqrf(), lapackf77_dlarft(), magma_dgetmatrix(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc_host(), magma_dsetmatrix(), magma_dsetmatrix_async(), MAGMA_ERR_HOST_ALLOC, magma_free_host(), magma_get_dgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaTrans, 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
    =======
    DGEQRF computes a QR factorization of a DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    dT      (workspace/output)  DOUBLE_PRECISION array on the GPU, 
            dimension (2*MIN(M, N) + (N+31)/32*32 )*NB,
            where NB can be obtained through magma_get_dgeqrf_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 real scalar, and v is a real 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;
    double *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_dgeqrf_nb(m);
    lwork  = (m + n + nb)*nb;
    lhwork = lwork - m*nb;
    if (MAGMA_SUCCESS != magma_dmalloc_host( &work, lwork )) {
        *info = MAGMA_ERR_HOST_ALLOC;
        return *info;
    }
    
    ut = hwork+nb*(n);
    memset( ut, 0, nb*nb*sizeof(double));
    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_dgetmatrix_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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix_async( old_ib, old_ib,
                                        ut,           old_ib,
                                        d_ref(old_i), old_ib, stream[0] );
            }
            magma_queue_sync( stream[1] );
            lapackf77_dgeqrf(&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_dlarft( 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] );
            dsplit_diag_block(ib, work_ref(i), ldwork, ut);
            magma_dsetmatrix( rows, ib, work_ref(i), ldwork, a_ref(i,i), ldda );
            if (i + ib < n) {
                /* Send the triangular factor T to the GPU */
                magma_dsetmatrix( 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dlarfb_gpu( MagmaLeft, MagmaTrans, 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_dsetmatrix( 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_dgetmatrix( rows, ib, a_ref(i, i), ldda, work, rows );
        lhwork = lwork - rows*ib;
        lapackf77_dgeqrf(&rows, &ib, work, &rows, tau+i, work+ib*rows, &lhwork, info);
        
        magma_dsetmatrix( 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_DGEQRF */
} /* magma_dgeqrf */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgeqrf_ooc	(	magma_int_t	m,
		magma_int_t	n,
		double *	A,
		magma_int_t	lda,
		double *	tau,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgeqrf_ooc.cpp.

References __func__, a_ref, da_ref, dpanel_to_q(), dq_to_panel(), dwork, lapackf77_dlarft(), MAGMA_D_MAKE, MAGMA_D_ONE, magma_dgeqrf(), magma_dgeqrf2_gpu(), magma_dgetmatrix_async(), magma_dlarfb_gpu(), magma_dmalloc(), magma_dsetmatrix_async(), MAGMA_ERR_DEVICE_ALLOC, magma_free(), magma_get_dgeqrf_nb(), magma_queue_create(), magma_queue_destroy(), magma_queue_sync(), MAGMA_SUCCESS, magma_xerbla(), MagmaColumnwise, MagmaColumnwiseStr, MagmaForward, MagmaForwardStr, MagmaLeft, MagmaTrans, MagmaUpper, max, and min.

{
/*  -- MAGMA (version 1.2.0) --
       Univ. of Tennessee, Knoxville
       Univ. of California, Berkeley
       Univ. of Colorado, Denver
       May 2012
    Purpose
    =======
    DGEQRF_OOC computes a QR factorization of a DOUBLE_PRECISION 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_dgeqrf 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION array, dimension (min(M,N))
            The scalar factors of the elementary reflectors (see Further
            Details).
    WORK    (workspace/output) DOUBLE_PRECISION 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_dgeqrf_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 real scalar, and v is a real 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))
    double *da, *dwork;
    double c_one = MAGMA_D_ONE;
    int  k, lddwork, ldda;
    *info = 0;
    int nb = magma_get_dgeqrf_nb(min(m, n));
    int lwkopt = n * nb;
    work[0] = MAGMA_D_MAKE( (double)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(double);
    magma_int_t IB, NB = (magma_int_t)(0.8*totalMem/m);
    NB = (NB / nb) * nb;
    if (NB >= n)
      return magma_dgeqrf(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_dmalloc( &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]);
    double *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_dsetmatrix_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_dlarft( MagmaForwardStr, MagmaColumnwiseStr,
                              &rows, &ib, a_ref(j,j), &lda, tau+j, work, &ib);
            magma_dsetmatrix_async( ib, ib,
                                    work,  ib,
                                    dwork, lddwork, stream[1] );
            dpanel_to_q(MagmaUpper, ib, a_ref(j,j), lda, work+ib*ib);
            magma_dsetmatrix_async( rows, ib,
                                    a_ref(j,j), lda,
                                    ptr,        rows, stream[1] );
            magma_queue_sync( stream[1] );
            magma_dlarfb_gpu( MagmaLeft, MagmaTrans, MagmaForward, MagmaColumnwise,
                              rows, IB, ib,
                              ptr, rows, dwork,    lddwork,
                              da_ref(j, 0), ldda, dwork+ib, lddwork);
            dq_to_panel(MagmaUpper, ib, a_ref(j,j), lda, work+ib*ib);
          }
        /* 3. Do a QR on the current part */
        if (i<k)
          magma_dgeqrf2_gpu(m-i, IB, da_ref(i,0), ldda, tau+i, info);
        /* 4. Copy the current part back to the CPU */
        magma_dgetmatrix_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_dgeqrf_ooc */

Here is the call graph for this function:

Here is the caller graph for this function:

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

Definition at line 14 of file dgeqrs3_gpu.cpp.

References __func__, a_ref, d_ref, MAGMA_D_MAKE, MAGMA_D_ONE, magma_dormqr_gpu(), magma_dtrsm(), magma_dtrsv(), magma_get_dgeqrf_nb(), magma_xerbla(), magmablas_dswapdblk(), MagmaLeft, MagmaNonUnit, MagmaNoTrans, MagmaTrans, 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 DGEQRF3_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) DOUBLE_PRECISION 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
            DGEQRF3_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) DOUBLE_PRECISION array, dimension (N)
            TAU(i) must contain the scalar factor of the elementary
            reflector H(i), as returned by MAGMA_DGEQRF_GPU.
    DB      (input/output) DOUBLE_PRECISION 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) DOUBLE_PRECISION array that is the output (the 6th argument)
            of magma_dgeqrf_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) DOUBLE_PRECISION 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_dgeqrf_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)
    double c_one     = MAGMA_D_ONE;
    magma_int_t k, lddwork;
    magma_int_t nb     = magma_get_dgeqrf_nb(m);
    magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
    long int lquery = (lwork == -1);
    hwork[0] = MAGMA_D_MAKE( (double)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_dormqr_gpu( MagmaLeft, MagmaTrans, 
                      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_dswapdblk(k, nb, a_ref(0,0), ldda, 1, d_ref(0), nb, 0);
    if ( nrhs == 1 ) {
        magma_dtrsv(MagmaUpper, MagmaNoTrans, MagmaNonUnit,
                    n, a_ref(0,0), ldda, dB, 1);
    } else {
        magma_dtrsm(MagmaLeft, MagmaUpper, MagmaNoTrans, MagmaNonUnit,
                    n, nrhs, c_one, a_ref(0,0), ldda, dB, lddb);
    }
    magmablas_dswapdblk(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_dgeqrs_gpu	(	magma_int_t	m,
		magma_int_t	n,
		magma_int_t	nrhs,
		double *	dA,
		magma_int_t	ldda,
		double *	tau,
		double *	dT,
		double *	dB,
		magma_int_t	lddb,
		double *	hwork,
		magma_int_t	lhwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgeqrs_gpu.cpp.

References __func__, a_ref, blasf77_dtrsm(), blasf77_dtrsv(), d_ref, dwork, MAGMA_D_MAKE, MAGMA_D_NEG_ONE, MAGMA_D_ONE, MAGMA_D_ZERO, magma_dcopymatrix(), magma_dgemm(), magma_dgemv(), magma_dormqr_gpu(), magma_dsetmatrix(), magma_get_dgeqrf_nb(), magma_xerbla(), MagmaLeft, MagmaLeftStr, MagmaNonUnitStr, MagmaNoTrans, MagmaNoTransStr, MagmaTrans, 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 DGEQRF_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) DOUBLE_PRECISION 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
            DGEQRF_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) DOUBLE_PRECISION array, dimension (N)
            TAU(i) must contain the scalar factor of the elementary
            reflector H(i), as returned by MAGMA_DGEQRF_GPU.
    DB      (input/output) DOUBLE_PRECISION 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) DOUBLE_PRECISION array that is the output (the 6th argument)
            of magma_dgeqrf_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) DOUBLE_PRECISION 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_dgeqrf_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)
    double c_zero    = MAGMA_D_ZERO;
    double c_one     = MAGMA_D_ONE;
    double c_neg_one = MAGMA_D_NEG_ONE;
    double *dwork;
    magma_int_t i, k, lddwork, rows, ib;
    magma_int_t ione = 1;
    magma_int_t nb     = magma_get_dgeqrf_nb(m);
    magma_int_t lwkopt = (m-n+nb)*(nrhs+2*nb);
    long int lquery = (lwork == -1);
    hwork[0] = MAGMA_D_MAKE( (double)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_dormqr_gpu( MagmaLeft, MagmaTrans, 
                      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_dtrsv( MagmaUpperStr, MagmaNoTransStr, MagmaNonUnitStr, 
                       &ib, hwork,         &rows, 
                            hwork+rows*ib, &ione);
    } else {
        blasf77_dtrsm( MagmaLeftStr, MagmaUpperStr, MagmaNoTransStr, MagmaNonUnitStr, 
                       &ib, &nrhs, 
                       &c_one, hwork,         &rows, 
                               hwork+rows*ib, &rows);
    }
      
    // update the solution vector
    magma_dsetmatrix( ib, nrhs, hwork+rows*ib, rows, dwork+i, lddwork );
    // update c
    if (nrhs == 1)
        magma_dgemv( MagmaNoTrans, i, ib, 
                     c_neg_one, a_ref(0, i), ldda,
                                dwork + i,   1, 
                     c_one,     dB,           1);
    else
        magma_dgemm( 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_dgemv( MagmaNoTrans, ib, ib, 
                                     c_one,  d_ref(i), ib,
                                             dB+i,      1, 
                                     c_zero, dwork+i,  1);
                        magma_dgemv( MagmaNoTrans, i, ib, 
                                     c_neg_one, a_ref(0, i), ldda,
                                                dwork + i,   1, 
                                     c_one,     dB,           1);
                    }
                else
                    {
                        magma_dgemm( MagmaNoTrans, MagmaNoTrans, 
                                     ib, nrhs, ib, 
                                     c_one,  d_ref(i), ib,
                                             dB+i,      lddb, 
                                     c_zero, dwork+i,  lddwork);
                        magma_dgemm( MagmaNoTrans, MagmaNoTrans, 
                                     i, nrhs, ib, 
                                     c_neg_one, a_ref(0, i), ldda,
                                                dwork + i,   lddwork, 
                                     c_one,     dB,          lddb);
                    }
            }
        }
    }
    magma_dcopymatrix( (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_dgessm_gpu	(	char	storev,
		magma_int_t	m,
		magma_int_t	n,
		magma_int_t	k,
		magma_int_t	ib,
		magma_int_t *	ipiv,
		double *	dL1,
		magma_int_t	lddl1,
		double *	dL,
		magma_int_t	lddl,
		double *	dA,
		magma_int_t	ldda,
		magma_int_t *	info
	)

Definition at line 21 of file dgessm_gpu.cpp.

References __func__, AT, dA, L, MAGMA_D_NEG_ONE, MAGMA_D_ONE, magma_dgemm, magma_dtrmm(), magma_dtrsm(), magma_xerbla(), magmablas_dgetmo_in, magmablas_dlaswp(), 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)
    double c_one     = MAGMA_D_ONE;
    double c_neg_one = MAGMA_D_NEG_ONE;
    int i, s, sb;
    double *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_dgetmo_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_dlaswp( n, dAT, ldda, i+1, i+sb, ipiv, 1 );
#ifndef WITHOUTTRTRI
        magma_dtrmm( MagmaRight, MagmaLower, MagmaTrans, MagmaUnit, 
                     n, sb, 
                     c_one, dL1(i),   lddl1,
                            AT(i, 0), ldda);
#else
        magma_dtrsm( MagmaRight, MagmaLower, MagmaTrans, MagmaUnit, 
                     n, sb, 
                     c_one, L( i, i), lddl,
                            AT(i, 0), ldda);
#endif
        if ( (i+sb) < m) {
            magma_dgemm( 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_dgetmo_in( dA, dAT, ldda, m, n );
    }
    return *info;
    /* End of MAGMA_DGETRF_GPU */
}

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgesv	(	magma_int_t	n,
		magma_int_t	nrhs,
		double *	A,
		magma_int_t	lda,
		magma_int_t *	ipiv,
		double *	B,
		magma_int_t	ldb,
		magma_int_t *	info
	)

Definition at line 14 of file dgesv.cpp.

References __func__, lapackf77_dgetrs(), magma_dgetrf(), 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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_dgetrf( n, n, A, lda, ipiv, info );
    if ( *info == 0 ) {
        lapackf77_dgetrs( 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_dgesv_gpu	(	magma_int_t	n,
		magma_int_t	nrhs,
		double *	dA,
		magma_int_t	ldda,
		magma_int_t *	ipiv,
		double *	dB,
		magma_int_t	lddb,
		magma_int_t *	info
	)

Definition at line 21 of file dgesv_gpu.cpp.

References __func__, magma_dgetrf_gpu(), magma_dgetrs_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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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_dgetrf_gpu( n, n, dA, ldda, ipiv, info );
    if ( *info == 0 ) {
        magma_dgetrs_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_dgesvd	(	char	jobu,
		char	jobvt,
		magma_int_t	m,
		magma_int_t	n,
		double *	a,
		magma_int_t	lda,
		double *	s,
		double *	u,
		magma_int_t	ldu,
		double *	vt,
		magma_int_t	ldvt,
		double *	work,
		magma_int_t	lwork,
		magma_int_t *	info
	)

Definition at line 14 of file dgesvd.cpp.

References __func__, blasf77_dgemm(), lapackf77_dbdsqr(), lapackf77_dgelqf(), lapackf77_dgeqrf(), lapackf77_dgesvd(), lapackf77_dlacpy(), lapackf77_dlamch, lapackf77_dlange(), lapackf77_dlascl(), lapackf77_dlaset(), lapackf77_dorgbr(), lapackf77_dorglq(), lapackf77_dorgqr(), lapackf77_dormbr(), magma_dgebrd(), magma_dsqrt, magma_get_dgebrd_nb(), 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   
    =======   
    DGESVD 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 * conjugate-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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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) DOUBLE PRECISION array, dimension (MAX(1,LWORK))   
            On exit, if INFO = 0, WORK(1) returns the optimal LWORK.   
            if INFO > 0, WORK(2:MIN(M,N)) 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.
            
    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.   
    INFO    (output) INTEGER   
            = 0:  successful exit.   
            < 0:  if INFO = -i, the i-th argument had an illegal value.   
            > 0:  if DBDSQR 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.   
    ===================================================================== */
    /* Table of constant values */
    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 magma_int_t c__0 = 0;
    static magma_int_t c__1 = 1;
    static magma_int_t c_n1 = -1;
    static double c_b421 = 0.;
    static double c_b443 = 1.;
    magma_int_t nb;
    
    /* System generated locals */
    magma_int_t a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, 
        i__2, i__3, i__4;
    
    /* Local variables */
    magma_int_t i__, ie, ir, iu, blk, ncu;
    double dum[1], eps;
    magma_int_t nru, iscl;
    double anrm;
    magma_int_t ierr, itau, ncvt, nrvt;
    magma_int_t chunk, minmn, wrkbl, itaup, itauq, mnthr, iwork;
    magma_int_t wntua, wntva, wntun, wntuo, wntvn, wntvo, wntus, wntvs;
    magma_int_t bdspac;
    double bignum;
    magma_int_t ldwrkr, ldwrku, maxwrk, minwrk;
    double smlnum;
    magma_int_t lquery, wntuas, wntvas;
    
    /* Function Body */
    *info = 0;
    mnthr  = (magma_int_t)( (double)(min( m_, n_ )) * 1.6 );
    bdspac = 5*n_;
    minmn = min(*m,*n);
    wntua = lsame_(jobu_, "A");
    wntus = lsame_(jobu_, "S");
    wntuas = wntua || wntus;
    wntuo = lsame_(jobu_, "O");
    wntun = lsame_(jobu_, "N");
    wntva = lsame_(jobvt_, "A");
    wntvs = lsame_(jobvt_, "S");
    wntvas = wntva || wntvs;
    wntvo = lsame_(jobvt_, "O");
    wntvn = lsame_(jobvt_, "N");
    lquery = *lwork == -1;
  
    /* Test the input arguments */
    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_dgesvd(jobu_, jobvt_, m, n, a, lda, s, u, ldu,
                     vt, ldvt, work, &c_n1, info );
    maxwrk = (magma_int_t)work[0];
    if (*info == 0) {
        /* Return optimal workspace in WORK(1) */
        nb = magma_get_dgebrd_nb(*n);
        minwrk = ((*m)+(*n))*nb+(*n);
        work[0] = (double)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;
    }
    
    wrkbl  = maxwrk; /* Not optimal */
    /* Parameter adjustments */
    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;
  
    /* Get machine constants */
    eps = lapackf77_dlamch("P");
    smlnum = magma_dsqrt(lapackf77_dlamch("S")) / eps;
    bignum = 1. / smlnum;
    
    /* Scale A if max element outside range [SMLNUM,BIGNUM] */
    anrm = lapackf77_dlange("M", m, n, &a[a_offset], lda, dum);
    iscl = 0;
    if (anrm > 0. && anrm < smlnum) {
          iscl = 1;
          lapackf77_dlascl("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &
                  ierr);
    } else if (anrm > bignum) {
          iscl = 1;
          lapackf77_dlascl("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 */
                /* (Workspace: need 2*N, prefer N+N*NB) */
  
                  i__2 = *lwork - iwork + 1;
                  lapackf77_dgeqrf(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_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &a[a_dim1 + 2], 
                          lda);
                  ie = 1;
                  itauq = ie + *n;
                  itaup = itauq + *n;
                  iwork = itaup + *n;
  
                /* Bidiagonalize R in A */
                /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  
                  i__2 = *lwork - iwork + 1;
                  magma_dgebrd(*n, *n, &a[a_offset], *lda, &s[1], 
                             &work[ie], &work[itauq], &work[itaup], 
                             &work[iwork], i__2, &ierr);
                  ncvt = 0;
                  if (wntvo || wntvas) {
  
                    /* If right singular vectors desired, generate P'. */
                    /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &
                              work[iwork], &i__2, &ierr);
                      ncvt = *n;
                  }
                  iwork = ie + *n;
  
                /* Perform bidiagonal QR iteration, computing right */
                /* singular vectors of A in A if desired */
                /* (Workspace: need BDSPAC) */
  
                  lapackf77_dbdsqr("U", n, &ncvt, &c__0, &c__0, &s[1], &work[ie], 
                                 &a[a_offset], lda, dum, &c__1, dum, &c__1, &work[iwork], 
                                 info);
  
                /* If right singular vectors desired in VT, copy them there */
  
                  if (wntvas) {
                      lapackf77_dlacpy("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 */
  
                /* Computing MAX */
                  i__2 = *n << 2;
                  if (*lwork >= *n * *n + max(i__2,bdspac)) {
  
                    /* Sufficient workspace for a fast algorithm */
  
                      ir = 1;
                    /* Computing MAX */
                      i__2 = wrkbl, i__3 = *lda * *n + *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 + *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) / *n;
                              ldwrkr = *n;
                          }
                      }
                      itau = ir + ldwrkr * *n;
                      iwork = itau + *n;
  
                    /* Compute A=Q*R */
                    /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
                            , &i__2, &ierr);
  
                    /* Copy R to WORK(IR) and zero out below it */
  
                      lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr);
                      i__2 = *n - 1;
                      i__3 = *n - 1;
                      lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[ir + 1]
                            , &ldwrkr);
  
                    /* Generate Q in A */
                    /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[
                                iwork], &i__2, &ierr);
                      ie = itau;
                      itauq = ie + *n;
                      itaup = itauq + *n;
                      iwork = itaup + *n;
  
                    /* Bidiagonalize R in WORK(IR) */
                    /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      magma_dgebrd(*n, *n, &work[ir], ldwrkr, &s[1], 
                                 &work[ie], &work[itauq], &work[itaup], 
                                 &work[iwork], i__2, &ierr);
  
                    /* Generate left vectors bidiagonalizing R */
                    /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
                              work[iwork], &i__2, &ierr);
                      iwork = ie + *n;
  
                    /* Perform bidiagonal QR iteration, computing left */
                    /* singular vectors of R in WORK(IR) */
                    /* (Workspace: need N*N+BDSPAC) */
  
                      lapackf77_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], dum, &
                              c__1, &work[ir], &ldwrkr, dum, &c__1, &work[iwork]
                            , info);
                      iu = ie + *n;
  
                    /* Multiply Q in A by left singular vectors of R in */
                    /* WORK(IR), storing result in WORK(IU) and copying to A */
                    /* (Workspace: need N*N+2*N, prefer N*N+M*N+N) */
  
                      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_dgemm("N", "N", &chunk, n, n, &c_b443, &a[i__ + 
                                                                   a_dim1], lda, &work[ir], &ldwrkr, &c_b421, &
                               work[iu], &ldwrku);
                          lapackf77_dlacpy("F", &chunk, n, &work[iu], &ldwrku, &a[i__ + 
                                                                       a_dim1], lda);
                        /* L10: */
                      }
  
                  } else {
  
                    /* Insufficient workspace for a fast algorithm */
  
                      ie = 1;
                      itauq = ie + *n;
                      itaup = itauq + *n;
                      iwork = itaup + *n;
  
                    /* Bidiagonalize A */
                    /* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      magma_dgebrd(*m, *n, &a[a_offset], *lda, &s[1], 
                                 &work[ie], &work[itauq], &work[itaup], 
                                 &work[iwork], i__3, &ierr);
  
                    /* Generate left vectors bidiagonalizing A */
                    /* (Workspace: need 4*N, prefer 3*N+N*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      lapackf77_dorgbr("Q", m, n, n, &a[a_offset], lda, &work[itauq], &
                              work[iwork], &i__3, &ierr);
                      iwork = ie + *n;
  
                    /* Perform bidiagonal QR iteration, computing left */
                    /* singular vectors of A in A */
                    /* (Workspace: need BDSPAC) */
  
                      lapackf77_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], dum, &
                              c__1, &a[a_offset], lda, dum, &c__1, &work[iwork], 
                            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 */
  
                /* Computing MAX */
                  i__3 = *n << 2;
                  if (*lwork >= *n * *n + max(i__3,bdspac)) {
  
                    /* Sufficient workspace for a fast algorithm */
  
                      ir = 1;
                    /* Computing MAX */
                      i__3 = wrkbl, i__2 = *lda * *n + *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 + *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) / *n;
                              ldwrkr = *n;
                          }
                      }
                      itau = ir + ldwrkr * *n;
                      iwork = itau + *n;
  
                    /* Compute A=Q*R */
                    /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
                            , &i__3, &ierr);
  
                    /* Copy R to VT, zeroing out below it */
  
                      lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset], 
                              ldvt);
                      if (*n > 1) {
                          i__3 = *n - 1;
                          i__2 = *n - 1;
                          lapackf77_dlaset("L", &i__3, &i__2, &c_b421, &c_b421, &vt[
                                    vt_dim1 + 2], ldvt);
                      }
  
                    /* Generate Q in A */
                    /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      lapackf77_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[
                                iwork], &i__3, &ierr);
                      ie = itau;
                      itauq = ie + *n;
                      itaup = itauq + *n;
                      iwork = itaup + *n;
  
                    /* Bidiagonalize R in VT, copying result to WORK(IR) */
                    /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      magma_dgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], 
                                 &work[ie], &work[itauq], &work[itaup], 
                                 &work[iwork], i__3, &ierr);
                      lapackf77_dlacpy("L", n, n, &vt[vt_offset], ldvt, &work[ir], &
                              ldwrkr);
  
                    /* Generate left vectors bidiagonalizing R in WORK(IR) */
                    /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      lapackf77_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq], &
                              work[iwork], &i__3, &ierr);
  
                    /* Generate right vectors bidiagonalizing R in VT */
                    /* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB) */
  
                      i__3 = *lwork - iwork + 1;
                      lapackf77_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], 
                              &work[iwork], &i__3, &ierr);
                      iwork = ie + *n;
  
                    /* Perform bidiagonal QR iteration, computing left */
                    /* singular vectors of R in WORK(IR) and computing right */
                    /* singular vectors of R in VT */
                    /* (Workspace: need N*N+BDSPAC) */
  
                      lapackf77_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[
                                vt_offset], ldvt, &work[ir], &ldwrkr, dum, &c__1, 
                              &work[iwork], info);
                      iu = ie + *n;
  
                    /* Multiply Q in A by left singular vectors of R in */
                    /* WORK(IR), storing result in WORK(IU) and copying to A */
                    /* (Workspace: need N*N+2*N, prefer N*N+M*N+N) */
  
                      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_dgemm("N", "N", &chunk, n, n, &c_b443, &a[i__ + 
                                                                   a_dim1], lda, &work[ir], &ldwrkr, &c_b421, &
                               work[iu], &ldwrku);
                          lapackf77_dlacpy("F", &chunk, n, &work[iu], &ldwrku, &a[i__ + 
                                                                       a_dim1], lda);
                        /* L20: */
                      }
  
                  } else {
  
                    /* Insufficient workspace for a fast algorithm */
  
                      itau = 1;
                      iwork = itau + *n;
  
                    /* Compute A=Q*R */
                    /* (Workspace: need 2*N, prefer N+N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
                            , &i__2, &ierr);
  
                    /* Copy R to VT, zeroing out below it */
  
                      lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset], 
                              ldvt);
                      if (*n > 1) {
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &vt[
                                    vt_dim1 + 2], ldvt);
                      }
  
                    /* Generate Q in A */
                    /* (Workspace: need 2*N, prefer N+N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &work[
                                iwork], &i__2, &ierr);
                      ie = itau;
                      itauq = ie + *n;
                      itaup = itauq + *n;
                      iwork = itaup + *n;
  
                    /* Bidiagonalize R in VT */
                    /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      magma_dgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], 
                                 &work[ie], &work[itauq], &work[itaup], 
                                 &work[iwork], i__2, &ierr);
  
                    /* Multiply Q in A by left vectors bidiagonalizing R */
                    /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dormbr("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 */
                    /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  
                      i__2 = *lwork - iwork + 1;
                      lapackf77_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[itaup], 
                              &work[iwork], &i__2, &ierr);
                      iwork = ie + *n;
  
                    /* Perform bidiagonal QR iteration, computing left */
                    /* singular vectors of A in A and computing right */
                    /* singular vectors of A in VT */
                    /* (Workspace: need BDSPAC) */
  
                      lapackf77_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[
                                vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, &
                              work[iwork], 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 */
  
                    /* Computing MAX */
                      i__2 = *n << 2;
                      if (*lwork >= *n * *n + max(i__2,bdspac)) {
  
                        /* 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 */
                        /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
  
                        /* Copy R to WORK(IR), zeroing out below it */
  
                          lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[ir], &
                                  ldwrkr);
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[ir 
                                                                           + 1], &ldwrkr);
  
                        /* Generate Q in A */
                        /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Bidiagonalize R in WORK(IR) */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &work[ir], ldwrkr, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
  
                        /* Generate left vectors bidiagonalizing R in WORK(IR) */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of R in WORK(IR) */
                        /* (Workspace: need N*N+BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], 
                                  dum, &c__1, &work[ir], &ldwrkr, dum, &c__1, &
                                  work[iwork], info);
  
                        /* Multiply Q in A by left singular vectors of R in */
                        /* WORK(IR), storing result in U */
                        /* (Workspace: need N*N) */
  
                          blasf77_dgemm("N", "N", m, n, n, &c_b443, &a[a_offset], lda, 
                               &work[ir], &ldwrkr, &c_b421, &u[u_offset], 
                               ldu);
  
                      } else {
  
                        /* Insufficient workspace for a fast algorithm */
  
                          itau = 1;
                          iwork = itau + *n;
  
                        /* Compute A=Q*R, copying result to U */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Generate Q in U */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Zero out below R in A */
  
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &a[
                                    a_dim1 + 2], lda);
  
                        /* Bidiagonalize R in A */
                        /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &a[a_offset], *lda, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
  
                        /* Multiply Q in U by left vectors bidiagonalizing R */
                        /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, &
                                  work[itauq], &u[u_offset], ldu, &work[iwork], 
                                  &i__2, &ierr)
                            ;
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U */
                        /* (Workspace: need BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], 
                                  dum, &c__1, &u[u_offset], ldu, dum, &c__1, &
                                  work[iwork], 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 */
  
                    /* Computing MAX */
                      i__2 = *n << 2;
                      if (*lwork >= (*n << 1) * *n + max(i__2,bdspac)) {
  
                        /* 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 */
                        /* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
  
                        /* Copy R to WORK(IU), zeroing out below it */
  
                          lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[iu], &
                                  ldwrku);
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + 1], &ldwrku);
  
                        /* Generate Q in A */
                        /* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Bidiagonalize R in WORK(IU), copying result to */
                        /* WORK(IR) */
                        /* (Workspace: need 2*N*N+4*N, */
                        /* prefer 2*N*N+3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &work[iu], ldwrku, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
                          lapackf77_dlacpy("U", n, n, &work[iu], &ldwrku, &work[ir], &
                                  ldwrkr);
  
                        /* Generate left bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
  
                        /* Generate right bidiagonalizing vectors in WORK(IR) */
                        /* (Workspace: need 2*N*N+4*N-1, */
                        /* prefer 2*N*N+3*N+(N-1)*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
                          iwork = 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) */
                        /* (Workspace: need 2*N*N+BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &work[
                                    ir], &ldwrkr, &work[iu], &ldwrku, dum, &c__1, 
                                  &work[iwork], info);
  
                        /* Multiply Q in A by left singular vectors of R in */
                        /* WORK(IU), storing result in U */
                        /* (Workspace: need N*N) */
  
                          blasf77_dgemm("N", "N", m, n, n, &c_b443, &a[a_offset], lda, 
                               &work[iu], &ldwrku, &c_b421, &u[u_offset], 
                               ldu);
  
                        /* Copy right singular vectors of R to A */
                        /* (Workspace: need N*N) */
  
                          lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Generate Q in U */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Zero out below R in A */
  
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &a[
                                    a_dim1 + 2], lda);
  
                        /* Bidiagonalize R in A */
                        /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &a[a_offset], *lda, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
  
                        /* Multiply Q in U by left vectors bidiagonalizing R */
                        /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dormbr("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 */
                        /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], 
                                &work[iwork], &i__2, &ierr);
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U and computing right */
                        /* singular vectors of A in A */
                        /* (Workspace: need BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &a[
                                    a_offset], lda, &u[u_offset], ldu, dum, &c__1, 
                                &work[iwork], 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 */
  
                    /* Computing MAX */
                      i__2 = *n << 2;
                      if (*lwork >= *n * *n + max(i__2,bdspac)) {
  
                        /* 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 */
                        /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
  
                        /* Copy R to WORK(IU), zeroing out below it */
  
                          lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[iu], &
                                  ldwrku);
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + 1], &ldwrku);
  
                        /* Generate Q in A */
                        /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, n, n, &a[a_offset], lda, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Bidiagonalize R in WORK(IU), copying result to VT */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &work[iu], ldwrku, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
                          lapackf77_dlacpy("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], 
                                ldvt);
  
                        /* Generate left bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
  
                        /* Generate right bidiagonalizing vectors in VT */
                        /* (Workspace: need N*N+4*N-1, */
                        /* prefer N*N+3*N+(N-1)*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
                                    itaup], &work[iwork], &i__2, &ierr)
                            ;
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of R in WORK(IU) and computing */
                        /* right singular vectors of R in VT */
                        /* (Workspace: need N*N+BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &work[iu], &ldwrku, dum, &
                                  c__1, &work[iwork], info);
  
                        /* Multiply Q in A by left singular vectors of R in */
                        /* WORK(IU), storing result in U */
                        /* (Workspace: need N*N) */
  
                          blasf77_dgemm("N", "N", m, n, n, &c_b443, &a[a_offset], lda, 
                               &work[iu], &ldwrku, &c_b421, &u[u_offset], 
                               ldu);
  
                      } else {
  
                        /* Insufficient workspace for a fast algorithm */
  
                          itau = 1;
                          iwork = itau + *n;
  
                        /* Compute A=Q*R, copying result to U */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Generate Q in U */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, n, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
  
                        /* Copy R to VT, zeroing out below it */
  
                          lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset], 
                                  ldvt);
                          if (*n > 1) {
                              i__2 = *n - 1;
                              i__3 = *n - 1;
                              lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &vt[
                                        vt_dim1 + 2], ldvt);
                          }
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Bidiagonalize R in VT */
                        /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
  
                        /* Multiply Q in U by left bidiagonalizing vectors */
                        /* in VT */
                        /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dormbr("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 */
                        /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
                                    itaup], &work[iwork], &i__2, &ierr)
                            ;
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U and computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &u[u_offset], ldu, dum, &
                                  c__1, &work[iwork], 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 << 2, i__2 = max(i__2,i__3);
                      if (*lwork >= *n * *n + max(i__2,bdspac)) {
  
                        /* 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 */
                        /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Copy R to WORK(IR), zeroing out below it */
  
                          lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[ir], &
                                  ldwrkr);
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[ir 
                                                                           + 1], &ldwrkr);
  
                        /* Generate Q in U */
                        /* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Bidiagonalize R in WORK(IR) */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &work[ir], ldwrkr, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
  
                        /* Generate left bidiagonalizing vectors in WORK(IR) */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("Q", n, n, n, &work[ir], &ldwrkr, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of R in WORK(IR) */
                        /* (Workspace: need N*N+BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, &c__0, n, &c__0, &s[1], &work[ie], 
                                  dum, &c__1, &work[ir], &ldwrkr, dum, &c__1, &
                                  work[iwork], info);
  
                        /* Multiply Q in U by left singular vectors of R in */
                        /* WORK(IR), storing result in A */
                        /* (Workspace: need N*N) */
  
                          blasf77_dgemm("N", "N", m, n, n, &c_b443, &u[u_offset], ldu, 
                               &work[ir], &ldwrkr, &c_b421, &a[a_offset], 
                               lda);
  
                        /* Copy left singular vectors of A from A to U */
  
                          lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Generate Q in U */
                        /* (Workspace: need N+M, prefer N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Zero out below R in A */
  
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &a[
                                    a_dim1 + 2], lda);
  
                        /* Bidiagonalize R in A */
                        /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &a[a_offset], *lda, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
  
                        /* Multiply Q in U by left bidiagonalizing vectors */
                        /* in A */
                        /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dormbr("Q", "R", "N", m, n, n, &a[a_offset], lda, &
                                  work[itauq], &u[u_offset], ldu, &work[iwork], 
                                  &i__2, &ierr)
                            ;
                          iwork = ie + *n;
  
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U */
                        /* (Workspace: need BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, &c__0, m, &c__0, &s[1], &work[ie], 
                                  dum, &c__1, &u[u_offset], ldu, dum, &c__1, &
                                  work[iwork], 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 << 2, i__2 = max(i__2,i__3);
                      if (*lwork >= (*n << 1) * *n + max(i__2,bdspac)) {
  
                        /* 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 */
                        /* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Generate Q in U */
                        /* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
  
                        /* Copy R to WORK(IU), zeroing out below it */
  
                          lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[iu], &
                                  ldwrku);
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                          lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + 1], &ldwrku);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Bidiagonalize R in WORK(IU), copying result to */
                        /* WORK(IR) */
                        /* (Workspace: need 2*N*N+4*N, */
                        /* prefer 2*N*N+3*N+2*N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          magma_dgebrd(*n, *n, &work[iu], ldwrku, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
                          lapackf77_dlacpy("U", n, n, &work[iu], &ldwrku, &work[ir], &
                                  ldwrkr);
  
                        /* Generate left bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
  
                        /* Generate right bidiagonalizing vectors in WORK(IR) */
                        /* (Workspace: need 2*N*N+4*N-1, */
                        /* prefer 2*N*N+3*N+(N-1)*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgbr("P", n, n, n, &work[ir], &ldwrkr, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
                          iwork = 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) */
                        /* (Workspace: need 2*N*N+BDSPAC) */
  
                          lapackf77_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &work[
                                    ir], &ldwrkr, &work[iu], &ldwrku, dum, &c__1, 
                                  &work[iwork], info);
  
                        /* Multiply Q in U by left singular vectors of R in */
                        /* WORK(IU), storing result in A */
                        /* (Workspace: need N*N) */
  
                          blasf77_dgemm("N", "N", m, n, n, &c_b443, &u[u_offset], ldu, 
                               &work[iu], &ldwrku, &c_b421, &a[a_offset], 
                               lda);
  
                        /* Copy left singular vectors of A from A to U */
  
                          lapackf77_dlacpy("F", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Copy right singular vectors of R from WORK(IR) to A */
  
                          lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                          lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                  ldu);
  
                        /* Generate Q in U */
                        /* (Workspace: need N+M, prefer N+M*NB) */
  
                          i__2 = *lwork - iwork + 1;
                          lapackf77_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &
                                  work[iwork], &i__2, &ierr);
                          ie = itau;
                          itauq = ie + *n;
                          itaup = itauq + *n;
                          iwork = itaup + *n;
  
                        /* Zero out below R in A */
  
                          i__2 = *n - 1;
                          i__3 = *n - 1;
                         lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &a[
                                    a_dim1 + 2], lda);
 
                        /* Bidiagonalize R in A */
                        /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*n, *n, &a[a_offset], *lda, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
                        /* Multiply Q in U by left bidiagonalizing vectors */
                        /* in A */
                        /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("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 */
                        /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *n;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U and computing right */
                        /* singular vectors of A in A */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &a[
                                    a_offset], lda, &u[u_offset], ldu, dum, &c__1, 
                                &work[iwork], 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 << 2, i__2 = max(i__2,i__3);
                     if (*lwork >= *n * *n + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                 ldu);
 
                        /* Generate Q in U */
                        /* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgqr(m, m, n, &u[u_offset], ldu, &work[itau], &
                                 work[iwork], &i__2, &ierr);
 
                        /* Copy R to WORK(IU), zeroing out below it */
 
                         lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &work[iu], &
                                 ldwrku);
                         i__2 = *n - 1;
                         i__3 = *n - 1;
                         lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + 1], &ldwrku);
                         ie = itau;
                         itauq = ie + *n;
                         itaup = itauq + *n;
                         iwork = itaup + *n;
 
                        /* Bidiagonalize R in WORK(IU), copying result to VT */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*n, *n, &work[iu], ldwrku, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
                         lapackf77_dlacpy("U", n, n, &work[iu], &ldwrku, &vt[vt_offset], 
                                ldvt);
 
                        /* Generate left bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", n, n, n, &work[iu], &ldwrku, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
 
                        /* Generate right bidiagonalizing vectors in VT */
                        /* (Workspace: need N*N+4*N-1, */
                        /* prefer N*N+3*N+(N-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
                                    itaup], &work[iwork], &i__2, &ierr)
                            ;
                         iwork = ie + *n;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of R in WORK(IU) and computing */
                        /* right singular vectors of R in VT */
                        /* (Workspace: need N*N+BDSPAC) */
 
                         lapackf77_dbdsqr("U", n, n, n, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &work[iu], &ldwrku, dum, &
                                 c__1, &work[iwork], info);
 
                        /* Multiply Q in U by left singular vectors of R in */
                        /* WORK(IU), storing result in A */
                        /* (Workspace: need N*N) */
 
                         blasf77_dgemm("N", "N", m, n, n, &c_b443, &u[u_offset], ldu, 
                               &work[iu], &ldwrku, &c_b421, &a[a_offset], 
                               lda);
 
                        /* Copy left singular vectors of A from A to U */
 
                         lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*N, prefer N+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgeqrf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("L", m, n, &a[a_offset], lda, &u[u_offset], 
                                 ldu);
 
                        /* Generate Q in U */
                        /* (Workspace: need N+M, prefer N+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgqr(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_dlacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
                         if (*n > 1) {
                             i__2 = *n - 1;
                             i__3 = *n - 1;
                             lapackf77_dlaset("L", &i__2, &i__3, &c_b421, &c_b421, &vt[
                                        vt_dim1 + 2], ldvt);
                         }
                         ie = itau;
                         itauq = ie + *n;
                         itaup = itauq + *n;
                         iwork = itaup + *n;
 
                        /* Bidiagonalize R in VT */
                        /* (Workspace: need 4*N, prefer 3*N+2*N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*n, *n, &vt[vt_offset], *ldvt, &s[1], 
                                     &work[ie], &work[itauq], &work[itaup], 
                                     &work[iwork], i__2, &ierr);
 
                        /* Multiply Q in U by left bidiagonalizing vectors */
                        /* in VT */
                        /* (Workspace: need 3*N+M, prefer 3*N+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("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 */
                        /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", n, n, n, &vt[vt_offset], ldvt, &work[
                                    itaup], &work[iwork], &i__2, &ierr)
                            ;
                         iwork = ie + *n;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U and computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", n, n, m, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &u[u_offset], ldu, dum, &
                                 c__1, &work[iwork], 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 = ie + *n;
             itaup = itauq + *n;
             iwork = itaup + *n;
 
            /* Bidiagonalize A */
            /* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) */
 
             i__2 = *lwork - iwork + 1;
             magma_dgebrd(*m, *n, &a[a_offset], *lda, &s[1], 
                         &work[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 */
                /* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB) */
 
                 lapackf77_dlacpy("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_dorgbr("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 */
                /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
 
                 lapackf77_dlacpy("U", n, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("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 */
                /* (Workspace: need 4*N, prefer 3*N+N*NB) */
 
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("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 */
                /* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) */
 
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("P", n, n, n, &a[a_offset], lda, &work[itaup], &work[
                            iwork], &i__2, &ierr);
             }
             iwork = 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 */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
                            vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, &
                         work[iwork], info);
             } else if (! wntuo && wntvo) {
 
                /* Perform bidiagonal QR iteration, if desired, computing */
                /* left singular vectors in U and computing right singular */
                /* vectors in A */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[
                            a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[
                                iwork], info);
             } else {
 
                /* Perform bidiagonal QR iteration, if desired, computing */
                /* left singular vectors in A and computing right singular */
                /* vectors in VT */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("U", n, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
                            vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, &
                         work[iwork], 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 */
                /* (Workspace: need 2*M, prefer M+M*NB) */
 
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dgelqf(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_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &a[(a_dim1 << 1) 
                                                                + 1], lda);
                 ie = 1;
                 itauq = ie + *m;
                 itaup = itauq + *m;
                 iwork = itaup + *m;
 
                /* Bidiagonalize L in A */
                /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                 i__2 = *lwork - iwork + 1;
                 magma_dgebrd(*m, *m, &a[a_offset], *lda, &s[1], &work[ie], &work[
                            itauq], &work[itaup], &work[iwork], i__2, &ierr);
                 if (wntuo || wntuas) {
 
                    /* If left singular vectors desired, generate Q */
                    /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], &
                             work[iwork], &i__2, &ierr);
                 }
                 iwork = ie + *m;
                 nru = 0;
                 if (wntuo || wntuas) {
                     nru = *m;
                 }
 
                /* Perform bidiagonal QR iteration, computing left singular */
                /* vectors of A in A if desired */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("U", m, &c__0, &nru, &c__0, &s[1], &work[ie], dum, &
                         c__1, &a[a_offset], lda, dum, &c__1, &work[iwork], 
                         info);
 
                /* If left singular vectors desired in U, copy them there */
 
                 if (wntuas) {
                     lapackf77_dlacpy("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 */
 
                /* Computing MAX */
                 i__2 = *m << 2;
                 if (*lwork >= *m * *m + max(i__2,bdspac)) {
 
                    /* Sufficient workspace for a fast algorithm */
 
                     ir = 1;
                    /* Computing MAX */
                     i__2 = wrkbl, i__3 = *lda * *n + *m;
                     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 + *m;
                         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) / *m;
                             ldwrkr = *m;
                         }
                     }
                     itau = ir + ldwrkr * *m;
                     iwork = itau + *m;
 
                    /* Compute A=L*Q */
                    /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
                            , &i__2, &ierr);
 
                    /* Copy L to WORK(IR) and zero out above it */
 
                     lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[ir], &ldwrkr);
                     i__2 = *m - 1;
                     i__3 = *m - 1;
                     lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[ir + 
                                                                       ldwrkr], &ldwrkr);
 
                    /* Generate Q in A */
                    /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[
                                iwork], &i__2, &ierr);
                     ie = itau;
                     itauq = ie + *m;
                     itaup = itauq + *m;
                     iwork = itaup + *m;
 
                    /* Bidiagonalize L in WORK(IR) */
                    /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     magma_dgebrd(*m, *m, &work[ir], ldwrkr, &s[1], &work[ie], &work[
                                itauq], &work[itaup], &work[iwork], i__2, &ierr);
 
                    /* Generate right vectors bidiagonalizing L */
                    /* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
                             work[iwork], &i__2, &ierr);
                     iwork = ie + *m;
 
                    /* Perform bidiagonal QR iteration, computing right */
                    /* singular vectors of L in WORK(IR) */
                    /* (Workspace: need M*M+BDSPAC) */
 
                     lapackf77_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &work[
                                ir], &ldwrkr, dum, &c__1, dum, &c__1, &work[iwork]
                            , info);
                     iu = ie + *m;
 
                    /* Multiply right singular vectors of L in WORK(IR) by Q */
                    /* in A, storing result in WORK(IU) and copying to A */
                    /* (Workspace: need M*M+2*M, prefer M*M+M*N+M) */
 
                     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_dgemm("N", "N", m, &blk, m, &c_b443, &work[ir], &
                               ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b421, &
                               work[iu], &ldwrku);
                         lapackf77_dlacpy("F", m, &blk, &work[iu], &ldwrku, &a[i__ * 
                                                                     a_dim1 + 1], lda);
                        /* L30: */
                     }
 
                 } else {
 
                    /* Insufficient workspace for a fast algorithm */
 
                     ie = 1;
                     itauq = ie + *m;
                     itaup = itauq + *m;
                     iwork = itaup + *m;
 
                    /* Bidiagonalize A */
                    /* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     magma_dgebrd(*m, *n, &a[a_offset], *lda, &s[1], &work[ie], &work[
                                itauq], &work[itaup], &work[iwork], i__3, &ierr);
 
                    /* Generate right vectors bidiagonalizing A */
                    /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     lapackf77_dorgbr("P", m, n, m, &a[a_offset], lda, &work[itaup], &
                             work[iwork], &i__3, &ierr);
                     iwork = ie + *m;
 
                    /* Perform bidiagonal QR iteration, computing right */
                    /* singular vectors of A in A */
                    /* (Workspace: need BDSPAC) */
 
                     lapackf77_dbdsqr("L", m, n, &c__0, &c__0, &s[1], &work[ie], &a[
                                a_offset], lda, dum, &c__1, dum, &c__1, &work[
                                    iwork], 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 */
 
                /* Computing MAX */
                 i__3 = *m << 2;
                 if (*lwork >= *m * *m + max(i__3,bdspac)) {
 
                    /* Sufficient workspace for a fast algorithm */
 
                     ir = 1;
                    /* Computing MAX */
                     i__3 = wrkbl, i__2 = *lda * *n + *m;
                     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 + *m;
                         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) / *m;
                             ldwrkr = *m;
                         }
                     }
                     itau = ir + ldwrkr * *m;
                     iwork = itau + *m;
 
                    /* Compute A=L*Q */
                    /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
                            , &i__3, &ierr);
 
                    /* Copy L to U, zeroing about above it */
 
                     lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
                     i__3 = *m - 1;
                     i__2 = *m - 1;
                     lapackf77_dlaset("U", &i__3, &i__2, &c_b421, &c_b421, &u[(u_dim1 <<
                                                                     1) + 1], ldu);
 
                    /* Generate Q in A */
                    /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     lapackf77_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[
                                iwork], &i__3, &ierr);
                     ie = itau;
                     itauq = ie + *m;
                     itaup = itauq + *m;
                     iwork = itaup + *m;
 
                    /* Bidiagonalize L in U, copying result to WORK(IR) */
                    /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     magma_dgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &work[ie], &work[
                                itauq], &work[itaup], &work[iwork], i__3, &ierr);
                     lapackf77_dlacpy("U", m, m, &u[u_offset], ldu, &work[ir], &ldwrkr);
 
                    /* Generate right vectors bidiagonalizing L in WORK(IR) */
                    /* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     lapackf77_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup], &
                             work[iwork], &i__3, &ierr);
 
                    /* Generate left vectors bidiagonalizing L in U */
                    /* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */
 
                     i__3 = *lwork - iwork + 1;
                     lapackf77_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
                             work[iwork], &i__3, &ierr);
                     iwork = ie + *m;
 
                    /* Perform bidiagonal QR iteration, computing left */
                    /* singular vectors of L in U, and computing right */
                    /* singular vectors of L in WORK(IR) */
                    /* (Workspace: need M*M+BDSPAC) */
 
                     lapackf77_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[ir], 
                             &ldwrkr, &u[u_offset], ldu, dum, &c__1, &work[
                                iwork], info);
                     iu = ie + *m;
 
                    /* Multiply right singular vectors of L in WORK(IR) by Q */
                    /* in A, storing result in WORK(IU) and copying to A */
                    /* (Workspace: need M*M+2*M, prefer M*M+M*N+M)) */
 
                     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_dgemm("N", "N", m, &blk, m, &c_b443, &work[ir], &
                               ldwrkr, &a[i__ * a_dim1 + 1], lda, &c_b421, &
                               work[iu], &ldwrku);
                         lapackf77_dlacpy("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 */
                    /* (Workspace: need 2*M, prefer M+M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[iwork]
                            , &i__2, &ierr);
 
                    /* Copy L to U, zeroing out above it */
 
                     lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
                     i__2 = *m - 1;
                     i__3 = *m - 1;
                     lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &u[(u_dim1 <<
                                                                     1) + 1], ldu);
 
                    /* Generate Q in A */
                    /* (Workspace: need 2*M, prefer M+M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &work[
                                iwork], &i__2, &ierr);
                     ie = itau;
                     itauq = ie + *m;
                     itaup = itauq + *m;
                     iwork = itaup + *m;
 
                    /* Bidiagonalize L in U */
                    /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     magma_dgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &work[ie], &work[
                                itauq], &work[itaup], &work[iwork], i__2, &ierr);
 
                    /* Multiply right vectors bidiagonalizing L by Q in A */
                    /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dormbr("P", "L", "T", 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 */
                    /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                     i__2 = *lwork - iwork + 1;
                     lapackf77_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], &
                             work[iwork], &i__2, &ierr);
                     iwork = ie + *m;
 
                    /* Perform bidiagonal QR iteration, computing left */
                    /* singular vectors of A in U and computing right */
                    /* singular vectors of A in A */
                    /* (Workspace: need BDSPAC) */
 
                     lapackf77_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &a[
                                a_offset], lda, &u[u_offset], ldu, dum, &c__1, &
                             work[iwork], 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 */
 
                    /* Computing MAX */
                     i__2 = *m << 2;
                     if (*lwork >= *m * *m + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
 
                        /* Copy L to WORK(IR), zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[ir], &
                                 ldwrkr);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[ir 
                                                                           + ldwrkr], &ldwrkr);
 
                        /* Generate Q in A */
                        /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in WORK(IR) */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &work[ir], ldwrkr, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Generate right vectors bidiagonalizing L in */
                        /* WORK(IR) */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing right */
                        /* singular vectors of L in WORK(IR) */
                        /* (Workspace: need M*M+BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &
                                 work[ir], &ldwrkr, dum, &c__1, dum, &c__1, &
                                 work[iwork], info);
 
                        /* Multiply right singular vectors of L in WORK(IR) by */
                        /* Q in A, storing result in VT */
                        /* (Workspace: need M*M) */
 
                         blasf77_dgemm("N", "N", m, n, m, &c_b443, &work[ir], &ldwrkr, 
                               &a[a_offset], lda, &c_b421, &vt[vt_offset], 
                               ldvt);
 
                     } else {
 
                        /* Insufficient workspace for a fast algorithm */
 
                         itau = 1;
                         iwork = itau + *m;
 
                        /* Compute A=L*Q */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
 
                        /* Copy result to VT */
 
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Zero out above L in A */
 
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
                                        a_dim1 << 1) + 1], lda);
 
                        /* Bidiagonalize L in A */
                        /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &a[a_offset], *lda, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Multiply right vectors bidiagonalizing L by Q in VT */
                        /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, &
                                 work[itaup], &vt[vt_offset], ldvt, &work[
                                    iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, n, &c__0, &c__0, &s[1], &work[ie], &
                                 vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, &
                                 work[iwork], 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 */
 
                    /* Computing MAX */
                     i__2 = *m << 2;
                     if (*lwork >= (*m << 1) * *m + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
 
                        /* Copy L to WORK(IU), zeroing out below it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[iu], &
                                 ldwrku);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + ldwrku], &ldwrku);
 
                        /* Generate Q in A */
                        /* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in WORK(IU), copying result to */
                        /* WORK(IR) */
                        /* (Workspace: need 2*M*M+4*M, */
                        /* prefer 2*M*M+3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &work[iu], ldwrku, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
                         lapackf77_dlacpy("L", m, m, &work[iu], &ldwrku, &work[ir], &
                                 ldwrkr);
 
                        /* Generate right bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need 2*M*M+4*M-1, */
                        /* prefer 2*M*M+3*M+(M-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in WORK(IR) */
                        /* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
                         iwork = 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) */
                        /* (Workspace: need 2*M*M+BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[
                                    iu], &ldwrku, &work[ir], &ldwrkr, dum, &c__1, 
                                 &work[iwork], info);
 
                        /* Multiply right singular vectors of L in WORK(IU) by */
                        /* Q in A, storing result in VT */
                        /* (Workspace: need M*M) */
 
                         blasf77_dgemm("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku, 
                               &a[a_offset], lda, &c_b421, &vt[vt_offset], 
                               ldvt);
 
                        /* Copy left singular vectors of L to A */
                        /* (Workspace: need M*M) */
 
                         lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Zero out above L in A */
 
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
                                        a_dim1 << 1) + 1], lda);
 
                        /* Bidiagonalize L in A */
                        /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &a[a_offset], *lda, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Multiply right vectors bidiagonalizing L by Q in VT */
                        /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("P", "L", "T", 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 */
                        /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, compute left */
                        /* singular vectors of A in A and compute right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &a[a_offset], lda, dum, &
                                 c__1, &work[iwork], 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 */
 
                    /* Computing MAX */
                     i__2 = *m << 2;
                     if (*lwork >= *m * *m + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
 
                        /* Copy L to WORK(IU), zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[iu], &
                                 ldwrku);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + ldwrku], &ldwrku);
 
                        /* Generate Q in A */
                        /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(m, n, m, &a[a_offset], lda, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in WORK(IU), copying result to U */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &work[iu], ldwrku, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
                         lapackf77_dlacpy("L", m, m, &work[iu], &ldwrku, &u[u_offset], 
                                 ldu);
 
                        /* Generate right bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need M*M+4*M-1, */
                        /* prefer M*M+3*M+(M-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in U */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of L in U and computing right */
                        /* singular vectors of L in WORK(IU) */
                        /* (Workspace: need M*M+BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[
                                    iu], &ldwrku, &u[u_offset], ldu, dum, &c__1, &
                                 work[iwork], info);
 
                        /* Multiply right singular vectors of L in WORK(IU) by */
                        /* Q in A, storing result in VT */
                        /* (Workspace: need M*M) */
 
                         blasf77_dgemm("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku, 
                               &a[a_offset], lda, &c_b421, &vt[vt_offset], 
                               ldvt);
 
                     } else {
 
                        /* Insufficient workspace for a fast algorithm */
 
                         itau = 1;
                         iwork = itau + *m;
 
                        /* Compute A=L*Q, copying result to VT */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(m, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
 
                        /* Copy L to U, zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &u[u_offset], 
                                 ldu);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &u[(
                                        u_dim1 << 1) + 1], ldu);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in U */
                        /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Multiply right bidiagonalizing vectors in U by Q */
                        /* in VT */
                        /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, &
                                 work[itaup], &vt[vt_offset], ldvt, &work[
                                    iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in U */
                        /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U and computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &u[u_offset], ldu, dum, &
                                 c__1, &work[iwork], 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 << 2, i__2 = max(i__2,i__3);
                     if (*lwork >= *m * *m + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Copy L to WORK(IR), zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[ir], &
                                 ldwrkr);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[ir 
                                                                           + ldwrkr], &ldwrkr);
 
                        /* Generate Q in VT */
                        /* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in WORK(IR) */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &work[ir], ldwrkr, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Generate right bidiagonalizing vectors in WORK(IR) */
                        /* (Workspace: need M*M+4*M-1, */
                        /* prefer M*M+3*M+(M-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", m, m, m, &work[ir], &ldwrkr, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing right */
                        /* singular vectors of L in WORK(IR) */
                        /* (Workspace: need M*M+BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, m, &c__0, &c__0, &s[1], &work[ie], &
                                 work[ir], &ldwrkr, dum, &c__1, dum, &c__1, &
                                 work[iwork], info);
 
                        /* Multiply right singular vectors of L in WORK(IR) by */
                        /* Q in VT, storing result in A */
                        /* (Workspace: need M*M) */
 
                         blasf77_dgemm("N", "N", m, n, m, &c_b443, &work[ir], &ldwrkr, 
                               &vt[vt_offset], ldvt, &c_b421, &a[a_offset], 
                               lda);
 
                        /* Copy right singular vectors of A from A to VT */
 
                         lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need M+N, prefer M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Zero out above L in A */
 
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
                                        a_dim1 << 1) + 1], lda);
 
                        /* Bidiagonalize L in A */
                        /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &a[a_offset], *lda, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Multiply right bidiagonalizing vectors in A by Q */
                        /* in VT */
                        /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, &
                                 work[itaup], &vt[vt_offset], ldvt, &work[
                                    iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, n, &c__0, &c__0, &s[1], &work[ie], &
                                 vt[vt_offset], ldvt, dum, &c__1, dum, &c__1, &
                                 work[iwork], 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 << 2, i__2 = max(i__2,i__3);
                     if (*lwork >= (*m << 1) * *m + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
 
                        /* Copy L to WORK(IU), zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[iu], &
                                 ldwrku);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + ldwrku], &ldwrku);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in WORK(IU), copying result to */
                        /* WORK(IR) */
                        /* (Workspace: need 2*M*M+4*M, */
                        /* prefer 2*M*M+3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &work[iu], ldwrku, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
                         lapackf77_dlacpy("L", m, m, &work[iu], &ldwrku, &work[ir], &
                                 ldwrkr);
 
                        /* Generate right bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need 2*M*M+4*M-1, */
                        /* prefer 2*M*M+3*M+(M-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in WORK(IR) */
                        /* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &work[ir], &ldwrkr, &work[itauq]
                                , &work[iwork], &i__2, &ierr);
                         iwork = 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) */
                        /* (Workspace: need 2*M*M+BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[
                                    iu], &ldwrku, &work[ir], &ldwrkr, dum, &c__1, 
                                 &work[iwork], info);
 
                        /* Multiply right singular vectors of L in WORK(IU) by */
                        /* Q in VT, storing result in A */
                        /* (Workspace: need M*M) */
 
                         blasf77_dgemm("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku, 
                               &vt[vt_offset], ldvt, &c_b421, &a[a_offset], 
                               lda);
 
                        /* Copy right singular vectors of A from A to VT */
 
                         lapackf77_dlacpy("F", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Copy left singular vectors of A from WORK(IR) to A */
 
                         lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need M+N, prefer M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Zero out above L in A */
 
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &a[(
                                        a_dim1 << 1) + 1], lda);
 
                        /* Bidiagonalize L in A */
                        /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &a[a_offset], *lda, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Multiply right bidiagonalizing vectors in A by Q */
                        /* in VT */
                        /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("P", "L", "T", m, n, m, &a[a_offset], lda, &
                                 work[itaup], &vt[vt_offset], ldvt, &work[
                                    iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in A */
                        /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &a[a_offset], lda, &work[itauq], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in A and computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &a[a_offset], lda, dum, &
                                 c__1, &work[iwork], 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 << 2, i__2 = max(i__2,i__3);
                     if (*lwork >= *m * *m + max(i__2,bdspac)) {
 
                        /* 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 */
                        /* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
 
                        /* Copy L to WORK(IU), zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &work[iu], &
                                 ldwrku);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &work[iu 
                                                                           + ldwrku], &ldwrku);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in WORK(IU), copying result to U */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &work[iu], ldwrku, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
                         lapackf77_dlacpy("L", m, m, &work[iu], &ldwrku, &u[u_offset], 
                                 ldu);
 
                        /* Generate right bidiagonalizing vectors in WORK(IU) */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("P", m, m, m, &work[iu], &ldwrku, &work[itaup]
                                , &work[iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in U */
                        /* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of L in U and computing right */
                        /* singular vectors of L in WORK(IU) */
                        /* (Workspace: need M*M+BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, m, m, &c__0, &s[1], &work[ie], &work[
                                    iu], &ldwrku, &u[u_offset], ldu, dum, &c__1, &
                                 work[iwork], info);
 
                        /* Multiply right singular vectors of L in WORK(IU) by */
                        /* Q in VT, storing result in A */
                        /* (Workspace: need M*M) */
 
                         blasf77_dgemm("N", "N", m, n, m, &c_b443, &work[iu], &ldwrku, 
                               &vt[vt_offset], ldvt, &c_b421, &a[a_offset], 
                               lda);
 
                        /* Copy right singular vectors of A from A to VT */
 
                         lapackf77_dlacpy("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 */
                        /* (Workspace: need 2*M, prefer M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dgelqf(m, n, &a[a_offset], lda, &work[itau], &work[
                                    iwork], &i__2, &ierr);
                         lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], 
                                 ldvt);
 
                        /* Generate Q in VT */
                        /* (Workspace: need M+N, prefer M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorglq(n, n, m, &vt[vt_offset], ldvt, &work[itau], &
                                 work[iwork], &i__2, &ierr);
 
                        /* Copy L to U, zeroing out above it */
 
                         lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &u[u_offset], 
                                 ldu);
                         i__2 = *m - 1;
                         i__3 = *m - 1;
                         lapackf77_dlaset("U", &i__2, &i__3, &c_b421, &c_b421, &u[(
                                        u_dim1 << 1) + 1], ldu);
                         ie = itau;
                         itauq = ie + *m;
                         itaup = itauq + *m;
                         iwork = itaup + *m;
 
                        /* Bidiagonalize L in U */
                        /* (Workspace: need 4*M, prefer 3*M+2*M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         magma_dgebrd(*m, *m, &u[u_offset], *ldu, &s[1], &work[ie], &
                                 work[itauq], &work[itaup], &work[iwork], 
                                 i__2, &ierr);
 
                        /* Multiply right bidiagonalizing vectors in U by Q */
                        /* in VT */
                        /* (Workspace: need 3*M+N, prefer 3*M+N*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dormbr("P", "L", "T", m, n, m, &u[u_offset], ldu, &
                                 work[itaup], &vt[vt_offset], ldvt, &work[
                                    iwork], &i__2, &ierr);
 
                        /* Generate left bidiagonalizing vectors in U */
                        /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                         i__2 = *lwork - iwork + 1;
                         lapackf77_dorgbr("Q", m, m, m, &u[u_offset], ldu, &work[itauq], 
                                &work[iwork], &i__2, &ierr);
                         iwork = ie + *m;
 
                        /* Perform bidiagonal QR iteration, computing left */
                        /* singular vectors of A in U and computing right */
                        /* singular vectors of A in VT */
                        /* (Workspace: need BDSPAC) */
 
                         lapackf77_dbdsqr("U", m, n, m, &c__0, &s[1], &work[ie], &vt[
                                    vt_offset], ldvt, &u[u_offset], ldu, dum, &
                                 c__1, &work[iwork], info);
 
                     }
 
                 }
 
             }
 
         } else {
 
            /* N .LT. MNTHR */
 
            /* Path 10t(N greater than M, but not much larger) */
            /* Reduce to bidiagonal form without LQ decomposition */
 
             ie = 1;
             itauq = ie + *m;
             itaup = itauq + *m;
             iwork = itaup + *m;
 
            /* Bidiagonalize A */
            /* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) */
 
             i__2 = *lwork - iwork + 1;
             magma_dgebrd(*m, *n, &a[a_offset], *lda, &s[1], &work[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 */
                /* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) */
 
                 lapackf77_dlacpy("L", m, m, &a[a_offset], lda, &u[u_offset], ldu);
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("Q", m, m, 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 */
                /* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB) */
 
                 lapackf77_dlacpy("U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt);
                 if (wntva) {
                     nrvt = *n;
                 }
                 if (wntvs) {
                     nrvt = *m;
                 }
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("P", &nrvt, n, m, &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 */
                /* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) */
 
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("Q", m, m, 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 */
                /* (Workspace: need 4*M, prefer 3*M+M*NB) */
 
                 i__2 = *lwork - iwork + 1;
                 lapackf77_dorgbr("P", m, n, m, &a[a_offset], lda, &work[itaup], &work[
                            iwork], &i__2, &ierr);
             }
             iwork = ie + *m;
             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 */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
                            vt_offset], ldvt, &u[u_offset], ldu, dum, &c__1, &
                         work[iwork], info);
             } else if (! wntuo && wntvo) {
 
                /* Perform bidiagonal QR iteration, if desired, computing */
                /* left singular vectors in U and computing right singular */
                /* vectors in A */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &a[
                            a_offset], lda, &u[u_offset], ldu, dum, &c__1, &work[
                                iwork], info);
             } else {
 
                /* Perform bidiagonal QR iteration, if desired, computing */
                /* left singular vectors in A and computing right singular */
                /* vectors in VT */
                /* (Workspace: need BDSPAC) */
 
                 lapackf77_dbdsqr("L", m, &ncvt, &nru, &c__0, &s[1], &work[ie], &vt[
                            vt_offset], ldvt, &a[a_offset], lda, dum, &c__1, &
                         work[iwork], info);
             }
 
         }
 
    }
 
    /* If DBDSQR failed to converge, copy unconverged superdiagonals */
    /* to WORK( 2:MINMN ) */
 
    if (*info != 0) {
         if (ie > 2) {
             i__2 = minmn - 1;
             for (i__ = 1; i__ <= i__2; ++i__) {
                 work[i__ + 1] = work[i__ + ie - 1];
                /* L50: */
             }
         }
         if (ie < 2) {
             for (i__ = minmn - 1; i__ >= 1; --i__) {
                 work[i__ + 1] = work[i__ + ie - 1];
                /* L60: */
             }
         }
    }
 
    /* Undo scaling if necessary */
 
    if (iscl == 1) {
         if (anrm > bignum) {
             lapackf77_dlascl("G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &
                     minmn, &ierr);
         }
         if (*info != 0 && anrm > bignum) {
             i__2 = minmn - 1;
             lapackf77_dlascl("G", &c__0, &c__0, &bignum, &anrm, &i__2, &c__1, &work[2], 
                    &minmn, &ierr);
         }
         if (anrm < smlnum) {
             lapackf77_dlascl("G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &
                     minmn, &ierr);
         }
         if (*info != 0 && anrm < smlnum) {
             i__2 = minmn - 1;
             lapackf77_dlascl("G", &c__0, &c__0, &smlnum, &anrm, &i__2, &c__1, &work[2], 
                    &minmn, &ierr);
         }
    }
 
    return *info;
 } /* dgesvd_ */

Here is the call graph for this function:

Here is the caller graph for this function:

magma_int_t magma_dgetrf	(	magma_int_t	m,
		magma_int_t	n,
		double *	A,
		magma_int_t	lda,
		magma_int_t *	ipiv,
		magma_int_t *	info
	)

Definition at line 37 of file dgetrf.cpp.

References __func__, dA, inAT, lapackf77_dgetrf(), MAGMA_D_NEG_ONE, MAGMA_D_ONE, magma_device_sync(), magma_dgemm, magma_dgetmatrix(), magma_dgetrf2_piv(), magma_dgetrf3_ooc(), magma_dmalloc(), magma_dsetmatrix(), magma_dtrsm, magma_free(), magma_get_dgetrf_nb(), MAGMA_SUCCESS, magma_xerbla(), magmablas_dinplace_transpose(), magmablas_dpermute_long2(), magmablas_dtranspose(), magmablas_dtranspose2(), MagmaNoTrans, MagmaRight, MagmaUnit, MagmaUpper, 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
    =======
    DGETRF computes an LU factorization of a general M-by-N matrix A
    using partial pivoting with row interchanges.  This version does not
    require work space on the GPU passed as input. GPU memory is allocated
    in the routine.
    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) DOUBLE_PRECISION array, 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.
            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).
    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

Macros

Functions

Macro Definition Documentation

Function Documentation