!*==sgesvd.f90  processed by SPAG 7.51RB at 20:08 on  3 Mar 2022
!> \brief  SGESVD computes the singular value decomposition (SVD) for GE matrices
!
!  =========== DOCUMENTATION ===========
!
! Online html documentation available at
!            http://www.netlib.org/lapack/explore-html/
!
!> \htmlonly
!> Download SGESVD + dependencies
!>
!> [TGZ]
!>
!> [ZIP]
!>
!> [TXT]
!> \endhtmlonly
!
!  Definition:
!  ===========
!
!       SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT,
!                          WORK, LWORK, INFO )
!
!       .. Scalar Arguments ..
!       CHARACTER          JOBU, JOBVT
!       INTEGER            INFO, LDA, LDU, LDVT, LWORK, M, N
!       ..
!       .. Array Arguments ..
!       REAL               A( LDA, * ), S( * ), U( LDU, * ),
!      $                   VT( LDVT, * ), WORK( * )
!       ..
!
!
!> \par Purpose:
!  =============
!>
!> \verbatim
!>
!> SGESVD computes the singular value decomposition (SVD) of a real
!> M-by-N matrix A, optionally computing the left and/or right singular
!> vectors. The SVD is written
!>
!>      A = U * SIGMA * 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 orthogonal matrix, and
!> V is an N-by-N orthogonal 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**T, not V.
!> \endverbatim
!
!  Arguments:
!  ==========
!
!> \param[in] JOBU
!> \verbatim
!>          JOBU is 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.
!> \endverbatim
!>
!> \param[in] JOBVT
!> \verbatim
!>          JOBVT is CHARACTER*1
!>          Specifies options for computing all or part of the matrix
!>          V**T:
!>          = 'A':  all N rows of V**T are returned in the array VT;
!>          = 'S':  the first min(m,n) rows of V**T (the right singular
!>                  vectors) are returned in the array VT;
!>          = 'O':  the first min(m,n) rows of V**T (the right singular
!>                  vectors) are overwritten on the array A;
!>          = 'N':  no rows of V**T (no right singular vectors) are
!>                  computed.
!>
!>          JOBVT and JOBU cannot both be 'O'.
!> \endverbatim
!>
!> \param[in] M
!> \verbatim
!>          M is INTEGER
!>          The number of rows of the input matrix A.  M >= 0.
!> \endverbatim
!>
!> \param[in] N
!> \verbatim
!>          N is INTEGER
!>          The number of columns of the input matrix A.  N >= 0.
!> \endverbatim
!>
!> \param[in,out] A
!> \verbatim
!>          A is REAL 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**T (the right singular vectors,
!>                          stored rowwise);
!>          if JOBU .ne. 'O' and JOBVT .ne. 'O', the contents of A
!>                          are destroyed.
!> \endverbatim
!>
!> \param[in] LDA
!> \verbatim
!>          LDA is INTEGER
!>          The leading dimension of the array A.  LDA >= max(1,M).
!> \endverbatim
!>
!> \param[out] S
!> \verbatim
!>          S is REAL array, dimension (min(M,N))
!>          The singular values of A, sorted so that S(i) >= S(i+1).
!> \endverbatim
!>
!> \param[out] U
!> \verbatim
!>          U is REAL 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 orthogonal 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.
!> \endverbatim
!>
!> \param[in] LDU
!> \verbatim
!>          LDU is INTEGER
!>          The leading dimension of the array U.  LDU >= 1; if
!>          JOBU = 'S' or 'A', LDU >= M.
!> \endverbatim
!>
!> \param[out] VT
!> \verbatim
!>          VT is REAL array, dimension (LDVT,N)
!>          If JOBVT = 'A', VT contains the N-by-N orthogonal matrix
!>          V**T;
!>          if JOBVT = 'S', VT contains the first min(m,n) rows of
!>          V**T (the right singular vectors, stored rowwise);
!>          if JOBVT = 'N' or 'O', VT is not referenced.
!> \endverbatim
!>
!> \param[in] LDVT
!> \verbatim
!>          LDVT is INTEGER
!>          The leading dimension of the array VT.  LDVT >= 1; if
!>          JOBVT = 'A', LDVT >= N; if JOBVT = 'S', LDVT >= min(M,N).
!> \endverbatim
!>
!> \param[out] WORK
!> \verbatim
!>          WORK is REAL 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.
!> \endverbatim
!>
!> \param[in] LWORK
!> \verbatim
!>          LWORK is INTEGER
!>          The dimension of the array WORK.
!>          LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code):
!>             - PATH 1  (M much larger than N, JOBU='N')
!>             - PATH 1t (N much larger than M, JOBVT='N')
!>          LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) for the other paths
!>          For good performance, LWORK should generally be larger.
!>
!>          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.
!> \endverbatim
!>
!> \param[out] INFO
!> \verbatim
!>          INFO is INTEGER
!>          = 0:  successful exit.
!>          < 0:  if INFO = -i, the i-th argument had an illegal value.
!>          > 0:  if SBDSQR did not converge, INFO specifies how many
!>                superdiagonals of an intermediate bidiagonal form B
!>                did not converge to zero. See the description of WORK
!>                above for details.
!> \endverbatim
!
!  Authors:
!  ========
!
!> \author Univ. of Tennessee
!> \author Univ. of California Berkeley
!> \author Univ. of Colorado Denver
!> \author NAG Ltd.
!
!> \date April 2012
!
!> \ingroup realGEsing
!
!  =====================================================================
      SUBROUTINE SGESVD(Jobu,Jobvt,M,N,A,Lda,S,U,Ldu,Vt,Ldvt,Work,Lwork,&
     &                  Info)
      IMPLICIT NONE
!*--SGESVD215
!
!  -- LAPACK driver routine (version 3.7.0) --
!  -- LAPACK is a software package provided by Univ. of Tennessee,    --
!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
!     April 2012
!
!     .. Scalar Arguments ..
      CHARACTER Jobu , Jobvt
      INTEGER Info , Lda , Ldu , Ldvt , Lwork , M , N
!     ..
!     .. Array Arguments ..
      REAL A(Lda,*) , S(*) , U(Ldu,*) , Vt(Ldvt,*) , Work(*)
!     ..
!
!  =====================================================================
!
!     .. Parameters ..
      REAL ZERO , ONE
      PARAMETER (ZERO=0.0E0,ONE=1.0E0)
!     ..
!     .. Local Scalars ..
      LOGICAL lquery , wntua , wntuas , wntun , wntuo , wntus , wntva , &
     &        wntvas , wntvn , wntvo , wntvs
      INTEGER bdspac , blk , chunk , i , ie , ierr , ir , iscl , itau , &
     &        itaup , itauq , iu , iwork , ldwrkr , ldwrku , maxwrk ,   &
     &        minmn , minwrk , mnthr , ncu , ncvt , nru , nrvt , wrkbl
      INTEGER lwork_sgeqrf , lwork_sorgqr_n , lwork_sorgqr_m ,          &
     &        lwork_sgebrd , lwork_sorgbr_p , lwork_sorgbr_q ,          &
     &        lwork_sgelqf , lwork_sorglq_n , lwork_sorglq_m
      REAL anrm , bignum , eps , smlnum
!     ..
!     .. Local Arrays ..
      REAL dum(1)
!     ..
!     .. External Subroutines ..
      EXTERNAL SBDSQR , SGEBRD , SGELQF , SGEMM , SGEQRF , SLACPY ,     &
     &         SLASCL , SLASET , SORGBR , SORGLQ , SORGQR , SORMBR ,    &
     &         XERBLA
!     ..
!     .. External Functions ..
      LOGICAL LSAME
      INTEGER ILAENV
      REAL SLAMCH , SLANGE
      EXTERNAL LSAME , ILAENV , SLAMCH , SLANGE
!     ..
!     .. Intrinsic Functions ..
      INTRINSIC MAX , MIN , SQRT
!     ..
!     .. Executable Statements ..
!
!     Test the input arguments
!
      Info = 0
      minmn = MIN(M,N)
      wntua = LSAME(Jobu,'A')
      wntus = LSAME(Jobu,'S')
      wntuas = wntua .OR. wntus
      wntuo = LSAME(Jobu,'O')
      wntun = LSAME(Jobu,'N')
      wntva = LSAME(Jobvt,'A')
      wntvs = LSAME(Jobvt,'S')
      wntvas = wntva .OR. wntvs
      wntvo = LSAME(Jobvt,'O')
      wntvn = LSAME(Jobvt,'N')
      lquery = (Lwork==-1)
!
      IF ( .NOT.(wntua .OR. wntus .OR. wntuo .OR. wntun) ) THEN
         Info = -1
      ELSEIF ( .NOT.(wntva .OR. wntvs .OR. wntvo .OR. wntvn) .OR.       &
     &         (wntvo .AND. wntuo) ) THEN
         Info = -2
      ELSEIF ( M<0 ) THEN
         Info = -3
      ELSEIF ( N<0 ) THEN
         Info = -4
      ELSEIF ( Lda<MAX(1,M) ) THEN
         Info = -6
      ELSEIF ( Ldu<1 .OR. (wntuas .AND. Ldu<M) ) THEN
         Info = -9
      ELSEIF ( Ldvt<1 .OR. (wntva .AND. Ldvt<N) .OR.                    &
     &         (wntvs .AND. Ldvt<minmn) ) THEN
         Info = -11
      ENDIF
!
!     Compute workspace
!      (Note: Comments in the code beginning "Workspace:" describe the
!       minimal amount of workspace needed at that point in the code,
!       as well as the preferred amount for good performance.
!       NB refers to the optimal block size for the immediately
!       following subroutine, as returned by ILAENV.)
!
      IF ( Info==0 ) THEN
         minwrk = 1
         maxwrk = 1
         IF ( M>=N .AND. minmn>0 ) THEN
!
!           Compute space needed for SBDSQR
!
            mnthr = ILAENV(6,'SGESVD',Jobu//Jobvt,M,N,0,0)
            bdspac = 5*N
!           Compute space needed for SGEQRF
            CALL SGEQRF(M,N,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sgeqrf = INT(dum(1))
!           Compute space needed for SORGQR
            CALL SORGQR(M,N,N,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sorgqr_n = INT(dum(1))
            CALL SORGQR(M,M,N,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sorgqr_m = INT(dum(1))
!           Compute space needed for SGEBRD
            CALL SGEBRD(N,N,A,Lda,S,dum(1),dum(1),dum(1),dum(1),-1,ierr)
            lwork_sgebrd = INT(dum(1))
!           Compute space needed for SORGBR P
            CALL SORGBR('P',N,N,N,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sorgbr_p = INT(dum(1))
!           Compute space needed for SORGBR Q
            CALL SORGBR('Q',N,N,N,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sorgbr_q = INT(dum(1))
!
            IF ( M<mnthr ) THEN
!
!              Path 10 (M at least N, but not much larger)
!
               CALL SGEBRD(M,N,A,Lda,S,dum(1),dum(1),dum(1),dum(1),-1,  &
     &                     ierr)
               lwork_sgebrd = INT(dum(1))
               maxwrk = 3*N + lwork_sgebrd
               IF ( wntus .OR. wntuo ) THEN
                  CALL SORGBR('Q',M,N,N,A,Lda,dum(1),dum(1),-1,ierr)
                  lwork_sorgbr_q = INT(dum(1))
                  maxwrk = MAX(maxwrk,3*N+lwork_sorgbr_q)
               ENDIF
               IF ( wntua ) THEN
                  CALL SORGBR('Q',M,M,N,A,Lda,dum(1),dum(1),-1,ierr)
                  lwork_sorgbr_q = INT(dum(1))
                  maxwrk = MAX(maxwrk,3*N+lwork_sorgbr_q)
               ENDIF
               IF ( .NOT.wntvn ) maxwrk = MAX(maxwrk,3*N+lwork_sorgbr_p)
               maxwrk = MAX(maxwrk,bdspac)
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntun ) THEN
!
!                 Path 1 (M much larger than N, JOBU='N')
!
               maxwrk = N + lwork_sgeqrf
               maxwrk = MAX(maxwrk,3*N+lwork_sgebrd)
               IF ( wntvo .OR. wntvas )                                 &
     &              maxwrk = MAX(maxwrk,3*N+lwork_sorgbr_p)
               maxwrk = MAX(maxwrk,bdspac)
               minwrk = MAX(4*N,bdspac)
            ELSEIF ( wntuo .AND. wntvn ) THEN
!
!                 Path 2 (M much larger than N, JOBU='O', JOBVT='N')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_n)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = MAX(N*N+wrkbl,N*N+M*N+N)
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntuo .AND. wntvas ) THEN
!
!                 Path 3 (M much larger than N, JOBU='O', JOBVT='S' or
!                 'A')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_n)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = MAX(N*N+wrkbl,N*N+M*N+N)
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntus .AND. wntvn ) THEN
!
!                 Path 4 (M much larger than N, JOBU='S', JOBVT='N')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_n)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = N*N + wrkbl
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntus .AND. wntvo ) THEN
!
!                 Path 5 (M much larger than N, JOBU='S', JOBVT='O')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_n)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = 2*N*N + wrkbl
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntus .AND. wntvas ) THEN
!
!                 Path 6 (M much larger than N, JOBU='S', JOBVT='S' or
!                 'A')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_n)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = N*N + wrkbl
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntua .AND. wntvn ) THEN
!
!                 Path 7 (M much larger than N, JOBU='A', JOBVT='N')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_m)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = N*N + wrkbl
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntua .AND. wntvo ) THEN
!
!                 Path 8 (M much larger than N, JOBU='A', JOBVT='O')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_m)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = 2*N*N + wrkbl
               minwrk = MAX(3*N+M,bdspac)
            ELSEIF ( wntua .AND. wntvas ) THEN
!
!                 Path 9 (M much larger than N, JOBU='A', JOBVT='S' or
!                 'A')
!
               wrkbl = N + lwork_sgeqrf
               wrkbl = MAX(wrkbl,N+lwork_sorgqr_m)
               wrkbl = MAX(wrkbl,3*N+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,3*N+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = N*N + wrkbl
               minwrk = MAX(3*N+M,bdspac)
            ENDIF
         ELSEIF ( minmn>0 ) THEN
!
!           Compute space needed for SBDSQR
!
            mnthr = ILAENV(6,'SGESVD',Jobu//Jobvt,M,N,0,0)
            bdspac = 5*M
!           Compute space needed for SGELQF
            CALL SGELQF(M,N,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sgelqf = INT(dum(1))
!           Compute space needed for SORGLQ
            CALL SORGLQ(N,N,M,dum(1),N,dum(1),dum(1),-1,ierr)
            lwork_sorglq_n = INT(dum(1))
            CALL SORGLQ(M,N,M,A,Lda,dum(1),dum(1),-1,ierr)
            lwork_sorglq_m = INT(dum(1))
!           Compute space needed for SGEBRD
            CALL SGEBRD(M,M,A,Lda,S,dum(1),dum(1),dum(1),dum(1),-1,ierr)
            lwork_sgebrd = INT(dum(1))
!            Compute space needed for SORGBR P
            CALL SORGBR('P',M,M,M,A,N,dum(1),dum(1),-1,ierr)
            lwork_sorgbr_p = INT(dum(1))
!           Compute space needed for SORGBR Q
            CALL SORGBR('Q',M,M,M,A,N,dum(1),dum(1),-1,ierr)
            lwork_sorgbr_q = INT(dum(1))
            IF ( N<mnthr ) THEN
!
!              Path 10t(N greater than M, but not much larger)
!
               CALL SGEBRD(M,N,A,Lda,S,dum(1),dum(1),dum(1),dum(1),-1,  &
     &                     ierr)
               lwork_sgebrd = INT(dum(1))
               maxwrk = 3*M + lwork_sgebrd
               IF ( wntvs .OR. wntvo ) THEN
!                Compute space needed for SORGBR P
                  CALL SORGBR('P',M,N,M,A,N,dum(1),dum(1),-1,ierr)
                  lwork_sorgbr_p = INT(dum(1))
                  maxwrk = MAX(maxwrk,3*M+lwork_sorgbr_p)
               ENDIF
               IF ( wntva ) THEN
                  CALL SORGBR('P',N,N,M,A,N,dum(1),dum(1),-1,ierr)
                  lwork_sorgbr_p = INT(dum(1))
                  maxwrk = MAX(maxwrk,3*M+lwork_sorgbr_p)
               ENDIF
               IF ( .NOT.wntun ) maxwrk = MAX(maxwrk,3*M+lwork_sorgbr_q)
               maxwrk = MAX(maxwrk,bdspac)
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntvn ) THEN
!
!                 Path 1t(N much larger than M, JOBVT='N')
!
               maxwrk = M + lwork_sgelqf
               maxwrk = MAX(maxwrk,3*M+lwork_sgebrd)
               IF ( wntuo .OR. wntuas )                                 &
     &              maxwrk = MAX(maxwrk,3*M+lwork_sorgbr_q)
               maxwrk = MAX(maxwrk,bdspac)
               minwrk = MAX(4*M,bdspac)
            ELSEIF ( wntvo .AND. wntun ) THEN
!
!                 Path 2t(N much larger than M, JOBU='N', JOBVT='O')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_m)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = MAX(M*M+wrkbl,M*M+M*N+M)
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntvo .AND. wntuas ) THEN
!
!                 Path 3t(N much larger than M, JOBU='S' or 'A',
!                 JOBVT='O')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_m)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = MAX(M*M+wrkbl,M*M+M*N+M)
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntvs .AND. wntun ) THEN
!
!                 Path 4t(N much larger than M, JOBU='N', JOBVT='S')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_m)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = M*M + wrkbl
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntvs .AND. wntuo ) THEN
!
!                 Path 5t(N much larger than M, JOBU='O', JOBVT='S')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_m)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = 2*M*M + wrkbl
               minwrk = MAX(3*M+N,bdspac)
               maxwrk = MAX(maxwrk,minwrk)
            ELSEIF ( wntvs .AND. wntuas ) THEN
!
!                 Path 6t(N much larger than M, JOBU='S' or 'A',
!                 JOBVT='S')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_m)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = M*M + wrkbl
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntva .AND. wntun ) THEN
!
!                 Path 7t(N much larger than M, JOBU='N', JOBVT='A')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_n)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = M*M + wrkbl
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntva .AND. wntuo ) THEN
!
!                 Path 8t(N much larger than M, JOBU='O', JOBVT='A')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_n)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = 2*M*M + wrkbl
               minwrk = MAX(3*M+N,bdspac)
            ELSEIF ( wntva .AND. wntuas ) THEN
!
!                 Path 9t(N much larger than M, JOBU='S' or 'A',
!                 JOBVT='A')
!
               wrkbl = M + lwork_sgelqf
               wrkbl = MAX(wrkbl,M+lwork_sorglq_n)
               wrkbl = MAX(wrkbl,3*M+lwork_sgebrd)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_p)
               wrkbl = MAX(wrkbl,3*M+lwork_sorgbr_q)
               wrkbl = MAX(wrkbl,bdspac)
               maxwrk = M*M + wrkbl
               minwrk = MAX(3*M+N,bdspac)
            ENDIF
         ENDIF
         maxwrk = MAX(maxwrk,minwrk)
         Work(1) = maxwrk
!
         IF ( Lwork<minwrk .AND. .NOT.lquery ) Info = -13
      ENDIF
!
      IF ( Info/=0 ) THEN
         CALL XERBLA('SGESVD',-Info)
         RETURN
      ELSEIF ( lquery ) THEN
         RETURN
      ENDIF
!
!     Quick return if possible
!
      IF ( M==0 .OR. N==0 ) RETURN
!
!     Get machine constants
!
      eps = SLAMCH('P')
      smlnum = SQRT(SLAMCH('S'))/eps
      bignum = ONE/smlnum
!
!     Scale A if max element outside range [SMLNUM,BIGNUM]
!
      anrm = SLANGE('M',M,N,A,Lda,dum)
      iscl = 0
      IF ( anrm>ZERO .AND. anrm<smlnum ) THEN
         iscl = 1
         CALL SLASCL('G',0,0,anrm,smlnum,M,N,A,Lda,ierr)
      ELSEIF ( anrm>bignum ) THEN
         iscl = 1
         CALL SLASCL('G',0,0,anrm,bignum,M,N,A,Lda,ierr)
      ENDIF
!
      IF ( M>=N ) THEN
!
!        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 ) THEN
!
!           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)
!
            CALL SGEBRD(M,N,A,Lda,S,Work(ie),Work(itauq),Work(itaup),   &
     &                  Work(iwork),Lwork-iwork+1,ierr)
            IF ( wntuas ) THEN
!
!              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)
!
               CALL SLACPY('L',M,N,A,Lda,U,Ldu)
               IF ( wntus ) ncu = N
               IF ( wntua ) ncu = M
               CALL SORGBR('Q',M,ncu,N,U,Ldu,Work(itauq),Work(iwork),   &
     &                     Lwork-iwork+1,ierr)
            ENDIF
            IF ( wntvas ) THEN
!
!              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)
!
               CALL SLACPY('U',N,N,A,Lda,Vt,Ldvt)
               CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),   &
     &                     Lwork-iwork+1,ierr)
            ENDIF
!
!              If left singular vectors desired in A, generate left
!              bidiagonalizing vectors in A
!              (Workspace: need 4*N, prefer 3*N+N*NB)
!
            IF ( wntuo ) CALL SORGBR('Q',M,N,N,A,Lda,Work(itauq),       &
     &                               Work(iwork),Lwork-iwork+1,ierr)
!
!              If right singular vectors desired in A, generate right
!              bidiagonalizing vectors in A
!              (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
            IF ( wntvo ) CALL SORGBR('P',N,N,N,A,Lda,Work(itaup),       &
     &                               Work(iwork),Lwork-iwork+1,ierr)
            iwork = ie + N
            IF ( wntuas .OR. wntuo ) nru = M
            IF ( wntun ) nru = 0
            IF ( wntvas .OR. wntvo ) ncvt = N
            IF ( wntvn ) ncvt = 0
            IF ( (.NOT.wntuo) .AND. (.NOT.wntvo) ) THEN
!
!              Perform bidiagonal QR iteration, if desired, computing
!              left singular vectors in U and computing right singular
!              vectors in VT
!              (Workspace: need BDSPAC)
!
               CALL SBDSQR('U',N,ncvt,nru,0,S,Work(ie),Vt,Ldvt,U,Ldu,   &
     &                     dum,1,Work(iwork),Info)
            ELSEIF ( (.NOT.wntuo) .AND. wntvo ) THEN
!
!              Perform bidiagonal QR iteration, if desired, computing
!              left singular vectors in U and computing right singular
!              vectors in A
!              (Workspace: need BDSPAC)
!
               CALL SBDSQR('U',N,ncvt,nru,0,S,Work(ie),A,Lda,U,Ldu,dum, &
     &                     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)
!
               CALL SBDSQR('U',N,ncvt,nru,0,S,Work(ie),Vt,Ldvt,A,Lda,   &
     &                     dum,1,Work(iwork),Info)
            ENDIF
!
         ELSEIF ( wntun ) THEN
!
!              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)
!
            CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),Lwork-iwork+1, &
     &                  ierr)
!
!              Zero out below R
!
            IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,A(2,1),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)
!
            CALL SGEBRD(N,N,A,Lda,S,Work(ie),Work(itauq),Work(itaup),   &
     &                  Work(iwork),Lwork-iwork+1,ierr)
            ncvt = 0
            IF ( wntvo .OR. wntvas ) THEN
!
!                 If right singular vectors desired, generate P'.
!                 (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
               CALL SORGBR('P',N,N,N,A,Lda,Work(itaup),Work(iwork),     &
     &                     Lwork-iwork+1,ierr)
               ncvt = N
            ENDIF
            iwork = ie + N
!
!              Perform bidiagonal QR iteration, computing right
!              singular vectors of A in A if desired
!              (Workspace: need BDSPAC)
!
            CALL SBDSQR('U',N,ncvt,0,0,S,Work(ie),A,Lda,dum,1,dum,1,    &
     &                  Work(iwork),Info)
!
!              If right singular vectors desired in VT, copy them there
!
            IF ( wntvas ) CALL SLACPY('F',N,N,A,Lda,Vt,Ldvt)
!
         ELSEIF ( wntuo .AND. wntvn ) THEN
!
!              Path 2 (M much larger than N, JOBU='O', JOBVT='N')
!              N left singular vectors to be overwritten on A and
!              no right singular vectors to be computed
!
            IF ( Lwork>=N*N+MAX(4*N,bdspac) ) THEN
!
!                 Sufficient workspace for a fast algorithm
!
               ir = 1
               IF ( Lwork>=MAX(wrkbl,Lda*N+N)+Lda*N ) THEN
!
!                    WORK(IU) is LDA by N, WORK(IR) is LDA by N
!
                  ldwrku = Lda
                  ldwrkr = Lda
               ELSEIF ( Lwork>=MAX(wrkbl,Lda*N+N)+N*N ) THEN
!
!                    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
               ENDIF
               itau = ir + ldwrkr*N
               iwork = itau + N
!
!                 Compute A=Q*R
!                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
               CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),            &
     &                     Lwork-iwork+1,ierr)
!
!                 Copy R to WORK(IR) and zero out below it
!
               CALL SLACPY('U',N,N,A,Lda,Work(ir),ldwrkr)
               CALL SLASET('L',N-1,N-1,ZERO,ZERO,Work(ir+1),ldwrkr)
!
!                 Generate Q in A
!                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
               CALL SORGQR(M,N,N,A,Lda,Work(itau),Work(iwork),          &
     &                     Lwork-iwork+1,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)
!
               CALL SGEBRD(N,N,Work(ir),ldwrkr,S,Work(ie),Work(itauq),  &
     &                     Work(itaup),Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate left vectors bidiagonalizing R
!                 (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
!
               CALL SORGBR('Q',N,N,N,Work(ir),ldwrkr,Work(itauq),       &
     &                     Work(iwork),Lwork-iwork+1,ierr)
               iwork = ie + N
!
!                 Perform bidiagonal QR iteration, computing left
!                 singular vectors of R in WORK(IR)
!                 (Workspace: need N*N+BDSPAC)
!
               CALL SBDSQR('U',N,0,N,0,S,Work(ie),dum,1,Work(ir),ldwrkr,&
     &                     dum,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)
!
               DO i = 1 , M , ldwrku
                  chunk = MIN(M-i+1,ldwrku)
                  CALL SGEMM('N','N',chunk,N,N,ONE,A(i,1),Lda,Work(ir), &
     &                       ldwrkr,ZERO,Work(iu),ldwrku)
                  CALL SLACPY('F',chunk,N,Work(iu),ldwrku,A(i,1),Lda)
               ENDDO
!
            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)
!
               CALL SGEBRD(M,N,A,Lda,S,Work(ie),Work(itauq),Work(itaup),&
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate left vectors bidiagonalizing A
!                 (Workspace: need 4*N, prefer 3*N+N*NB)
!
               CALL SORGBR('Q',M,N,N,A,Lda,Work(itauq),Work(iwork),     &
     &                     Lwork-iwork+1,ierr)
               iwork = ie + N
!
!                 Perform bidiagonal QR iteration, computing left
!                 singular vectors of A in A
!                 (Workspace: need BDSPAC)
!
               CALL SBDSQR('U',N,0,M,0,S,Work(ie),dum,1,A,Lda,dum,1,    &
     &                     Work(iwork),Info)
!
            ENDIF
!
         ELSEIF ( wntuo .AND. wntvas ) THEN
!
!              Path 3 (M much larger than N, JOBU='O', JOBVT='S' or 'A')
!              N left singular vectors to be overwritten on A and
!              N right singular vectors to be computed in VT
!
            IF ( Lwork>=N*N+MAX(4*N,bdspac) ) THEN
!
!                 Sufficient workspace for a fast algorithm
!
               ir = 1
               IF ( Lwork>=MAX(wrkbl,Lda*N+N)+Lda*N ) THEN
!
!                    WORK(IU) is LDA by N and WORK(IR) is LDA by N
!
                  ldwrku = Lda
                  ldwrkr = Lda
               ELSEIF ( Lwork>=MAX(wrkbl,Lda*N+N)+N*N ) THEN
!
!                    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
               ENDIF
               itau = ir + ldwrkr*N
               iwork = itau + N
!
!                 Compute A=Q*R
!                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
               CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),            &
     &                     Lwork-iwork+1,ierr)
!
!                 Copy R to VT, zeroing out below it
!
               CALL SLACPY('U',N,N,A,Lda,Vt,Ldvt)
               IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,Vt(2,1),    &
     &                                Ldvt)
!
!                 Generate Q in A
!                 (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
               CALL SORGQR(M,N,N,A,Lda,Work(itau),Work(iwork),          &
     &                     Lwork-iwork+1,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)
!
               CALL SGEBRD(N,N,Vt,Ldvt,S,Work(ie),Work(itauq),          &
     &                     Work(itaup),Work(iwork),Lwork-iwork+1,ierr)
               CALL SLACPY('L',N,N,Vt,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)
!
               CALL SORGBR('Q',N,N,N,Work(ir),ldwrkr,Work(itauq),       &
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate right vectors bidiagonalizing R in VT
!                 (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB)
!
               CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),   &
     &                     Lwork-iwork+1,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)
!
               CALL SBDSQR('U',N,N,N,0,S,Work(ie),Vt,Ldvt,Work(ir),     &
     &                     ldwrkr,dum,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)
!
               DO i = 1 , M , ldwrku
                  chunk = MIN(M-i+1,ldwrku)
                  CALL SGEMM('N','N',chunk,N,N,ONE,A(i,1),Lda,Work(ir), &
     &                       ldwrkr,ZERO,Work(iu),ldwrku)
                  CALL SLACPY('F',chunk,N,Work(iu),ldwrku,A(i,1),Lda)
               ENDDO
!
            ELSE
!
!                 Insufficient workspace for a fast algorithm
!
               itau = 1
               iwork = itau + N
!
!                 Compute A=Q*R
!                 (Workspace: need 2*N, prefer N+N*NB)
!
               CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),            &
     &                     Lwork-iwork+1,ierr)
!
!                 Copy R to VT, zeroing out below it
!
               CALL SLACPY('U',N,N,A,Lda,Vt,Ldvt)
               IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,Vt(2,1),    &
     &                                Ldvt)
!
!                 Generate Q in A
!                 (Workspace: need 2*N, prefer N+N*NB)
!
               CALL SORGQR(M,N,N,A,Lda,Work(itau),Work(iwork),          &
     &                     Lwork-iwork+1,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)
!
               CALL SGEBRD(N,N,Vt,Ldvt,S,Work(ie),Work(itauq),          &
     &                     Work(itaup),Work(iwork),Lwork-iwork+1,ierr)
!
!                 Multiply Q in A by left vectors bidiagonalizing R
!                 (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
               CALL SORMBR('Q','R','N',M,N,N,Vt,Ldvt,Work(itauq),A,Lda, &
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate right vectors bidiagonalizing R in VT
!                 (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
               CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),   &
     &                     Lwork-iwork+1,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)
!
               CALL SBDSQR('U',N,N,M,0,S,Work(ie),Vt,Ldvt,A,Lda,dum,1,  &
     &                     Work(iwork),Info)
!
            ENDIF
!
         ELSEIF ( wntus ) THEN
!
            IF ( wntvn ) THEN
!
!                 Path 4 (M much larger than N, JOBU='S', JOBVT='N')
!                 N left singular vectors to be computed in U and
!                 no right singular vectors to be computed
!
               IF ( Lwork>=N*N+MAX(4*N,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  ir = 1
                  IF ( Lwork>=wrkbl+Lda*N ) THEN
!
!                       WORK(IR) is LDA by N
!
                     ldwrkr = Lda
                  ELSE
!
!                       WORK(IR) is N by N
!
                     ldwrkr = N
                  ENDIF
                  itau = ir + ldwrkr*N
                  iwork = itau + N
!
!                    Compute A=Q*R
!                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R to WORK(IR), zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Work(ir),ldwrkr)
                  CALL SLASET('L',N-1,N-1,ZERO,ZERO,Work(ir+1),ldwrkr)
!
!                    Generate Q in A
!                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
                  CALL SORGQR(M,N,N,A,Lda,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(N,N,Work(ir),ldwrkr,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
!
!                    Generate left vectors bidiagonalizing R in WORK(IR)
!                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
!
                  CALL SORGBR('Q',N,N,N,Work(ir),ldwrkr,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + N
!
!                    Perform bidiagonal QR iteration, computing left
!                    singular vectors of R in WORK(IR)
!                    (Workspace: need N*N+BDSPAC)
!
                  CALL SBDSQR('U',N,0,N,0,S,Work(ie),dum,1,Work(ir),    &
     &                        ldwrkr,dum,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)
!
                  CALL SGEMM('N','N',M,N,N,ONE,A,Lda,Work(ir),ldwrkr,   &
     &                       ZERO,U,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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need 2*N, prefer N+N*NB)
!
                  CALL SORGQR(M,N,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + N
                  itaup = itauq + N
                  iwork = itaup + N
!
!                    Zero out below R in A
!
                  IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,A(2,1),  &
     &                 Lda)
!
!                    Bidiagonalize R in A
!                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
!
                  CALL SGEBRD(N,N,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply Q in U by left vectors bidiagonalizing R
!                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
                  CALL SORMBR('Q','R','N',M,N,N,A,Lda,Work(itauq),U,Ldu,&
     &                        Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + N
!
!                    Perform bidiagonal QR iteration, computing left
!                    singular vectors of A in U
!                    (Workspace: need BDSPAC)
!
                  CALL SBDSQR('U',N,0,M,0,S,Work(ie),dum,1,U,Ldu,dum,1, &
     &                        Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntvo ) THEN
!
!                 Path 5 (M much larger than N, JOBU='S', JOBVT='O')
!                 N left singular vectors to be computed in U and
!                 N right singular vectors to be overwritten on A
!
               IF ( Lwork>=2*N*N+MAX(4*N,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+2*Lda*N ) THEN
!
!                       WORK(IU) is LDA by N and WORK(IR) is LDA by N
!
                     ldwrku = Lda
                     ir = iu + ldwrku*N
                     ldwrkr = Lda
                  ELSEIF ( Lwork>=wrkbl+(Lda+N)*N ) THEN
!
!                       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
                  ENDIF
                  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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R to WORK(IU), zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('L',N-1,N-1,ZERO,ZERO,Work(iu+1),ldwrku)
!
!                    Generate Q in A
!                    (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB)
!
                  CALL SORGQR(M,N,N,A,Lda,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(N,N,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('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)
!
                  CALL SORGBR('Q',N,N,N,Work(iu),ldwrku,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,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)
!
                  CALL SORGBR('P',N,N,N,Work(ir),ldwrkr,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,N,0,S,Work(ie),Work(ir),ldwrkr,   &
     &                        Work(iu),ldwrku,dum,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)
!
                  CALL SGEMM('N','N',M,N,N,ONE,A,Lda,Work(iu),ldwrku,   &
     &                       ZERO,U,Ldu)
!
!                    Copy right singular vectors of R to A
!                    (Workspace: need N*N)
!
                  CALL SLACPY('F',N,N,Work(ir),ldwrkr,A,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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need 2*N, prefer N+N*NB)
!
                  CALL SORGQR(M,N,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + N
                  itaup = itauq + N
                  iwork = itaup + N
!
!                    Zero out below R in A
!
                  IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,A(2,1),  &
     &                 Lda)
!
!                    Bidiagonalize R in A
!                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
!
                  CALL SGEBRD(N,N,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply Q in U by left vectors bidiagonalizing R
!                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
                  CALL SORMBR('Q','R','N',M,N,N,A,Lda,Work(itauq),U,Ldu,&
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate right vectors bidiagonalizing R in A
!                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
                  CALL SORGBR('P',N,N,N,A,Lda,Work(itaup),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,M,0,S,Work(ie),A,Lda,U,Ldu,dum,1, &
     &                        Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntvas ) THEN
!
!                 Path 6 (M much larger than N, JOBU='S', JOBVT='S'
!                         or 'A')
!                 N left singular vectors to be computed in U and
!                 N right singular vectors to be computed in VT
!
               IF ( Lwork>=N*N+MAX(4*N,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+Lda*N ) THEN
!
!                       WORK(IU) is LDA by N
!
                     ldwrku = Lda
                  ELSE
!
!                       WORK(IU) is N by N
!
                     ldwrku = N
                  ENDIF
                  itau = iu + ldwrku*N
                  iwork = itau + N
!
!                    Compute A=Q*R
!                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R to WORK(IU), zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('L',N-1,N-1,ZERO,ZERO,Work(iu+1),ldwrku)
!
!                    Generate Q in A
!                    (Workspace: need N*N+2*N, prefer N*N+N+N*NB)
!
                  CALL SORGQR(M,N,N,A,Lda,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(N,N,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('U',N,N,Work(iu),ldwrku,Vt,Ldvt)
!
!                    Generate left bidiagonalizing vectors in WORK(IU)
!                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
!
                  CALL SORGBR('Q',N,N,N,Work(iu),ldwrku,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate right bidiagonalizing vectors in VT
!                    (Workspace: need N*N+4*N-1,
!                                prefer N*N+3*N+(N-1)*NB)
!
                  CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),&
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,N,0,S,Work(ie),Vt,Ldvt,Work(iu),  &
     &                        ldwrku,dum,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)
!
                  CALL SGEMM('N','N',M,N,N,ONE,A,Lda,Work(iu),ldwrku,   &
     &                       ZERO,U,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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need 2*N, prefer N+N*NB)
!
                  CALL SORGQR(M,N,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R to VT, zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Vt,Ldvt)
                  IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,Vt(2,1), &
     &                 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)
!
                  CALL SGEBRD(N,N,Vt,Ldvt,S,Work(ie),Work(itauq),       &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply Q in U by left bidiagonalizing vectors
!                    in VT
!                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
                  CALL SORMBR('Q','R','N',M,N,N,Vt,Ldvt,Work(itauq),U,  &
     &                        Ldu,Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate right bidiagonalizing vectors in VT
!                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
                  CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),&
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,M,0,S,Work(ie),Vt,Ldvt,U,Ldu,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ENDIF
!
         ELSEIF ( wntua ) THEN
!
            IF ( wntvn ) THEN
!
!                 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
!
               IF ( Lwork>=N*N+MAX(N+M,4*N,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  ir = 1
                  IF ( Lwork>=wrkbl+Lda*N ) THEN
!
!                       WORK(IR) is LDA by N
!
                     ldwrkr = Lda
                  ELSE
!
!                       WORK(IR) is N by N
!
                     ldwrkr = N
                  ENDIF
                  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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Copy R to WORK(IR), zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Work(ir),ldwrkr)
                  CALL SLASET('L',N-1,N-1,ZERO,ZERO,Work(ir+1),ldwrkr)
!
!                    Generate Q in U
!                    (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
!
                  CALL SORGQR(M,M,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(N,N,Work(ir),ldwrkr,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
!
!                    Generate left bidiagonalizing vectors in WORK(IR)
!                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
!
                  CALL SORGBR('Q',N,N,N,Work(ir),ldwrkr,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + N
!
!                    Perform bidiagonal QR iteration, computing left
!                    singular vectors of R in WORK(IR)
!                    (Workspace: need N*N+BDSPAC)
!
                  CALL SBDSQR('U',N,0,N,0,S,Work(ie),dum,1,Work(ir),    &
     &                        ldwrkr,dum,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)
!
                  CALL SGEMM('N','N',M,N,N,ONE,U,Ldu,Work(ir),ldwrkr,   &
     &                       ZERO,A,Lda)
!
!                    Copy left singular vectors of A from A to U
!
                  CALL SLACPY('F',M,N,A,Lda,U,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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need N+M, prefer N+M*NB)
!
                  CALL SORGQR(M,M,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + N
                  itaup = itauq + N
                  iwork = itaup + N
!
!                    Zero out below R in A
!
                  IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,A(2,1),  &
     &                 Lda)
!
!                    Bidiagonalize R in A
!                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
!
                  CALL SGEBRD(N,N,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply Q in U by left bidiagonalizing vectors
!                    in A
!                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
                  CALL SORMBR('Q','R','N',M,N,N,A,Lda,Work(itauq),U,Ldu,&
     &                        Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + N
!
!                    Perform bidiagonal QR iteration, computing left
!                    singular vectors of A in U
!                    (Workspace: need BDSPAC)
!
                  CALL SBDSQR('U',N,0,M,0,S,Work(ie),dum,1,U,Ldu,dum,1, &
     &                        Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntvo ) THEN
!
!                 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
!
               IF ( Lwork>=2*N*N+MAX(N+M,4*N,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+2*Lda*N ) THEN
!
!                       WORK(IU) is LDA by N and WORK(IR) is LDA by N
!
                     ldwrku = Lda
                     ir = iu + ldwrku*N
                     ldwrkr = Lda
                  ELSEIF ( Lwork>=wrkbl+(Lda+N)*N ) THEN
!
!                       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
                  ENDIF
                  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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB)
!
                  CALL SORGQR(M,M,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R to WORK(IU), zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('L',N-1,N-1,ZERO,ZERO,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)
!
                  CALL SGEBRD(N,N,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('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)
!
                  CALL SORGBR('Q',N,N,N,Work(iu),ldwrku,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,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)
!
                  CALL SORGBR('P',N,N,N,Work(ir),ldwrkr,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,N,0,S,Work(ie),Work(ir),ldwrkr,   &
     &                        Work(iu),ldwrku,dum,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)
!
                  CALL SGEMM('N','N',M,N,N,ONE,U,Ldu,Work(iu),ldwrku,   &
     &                       ZERO,A,Lda)
!
!                    Copy left singular vectors of A from A to U
!
                  CALL SLACPY('F',M,N,A,Lda,U,Ldu)
!
!                    Copy right singular vectors of R from WORK(IR) to A
!
                  CALL SLACPY('F',N,N,Work(ir),ldwrkr,A,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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need N+M, prefer N+M*NB)
!
                  CALL SORGQR(M,M,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + N
                  itaup = itauq + N
                  iwork = itaup + N
!
!                    Zero out below R in A
!
                  IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,A(2,1),  &
     &                 Lda)
!
!                    Bidiagonalize R in A
!                    (Workspace: need 4*N, prefer 3*N+2*N*NB)
!
                  CALL SGEBRD(N,N,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply Q in U by left bidiagonalizing vectors
!                    in A
!                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
                  CALL SORMBR('Q','R','N',M,N,N,A,Lda,Work(itauq),U,Ldu,&
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate right bidiagonalizing vectors in A
!                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
                  CALL SORGBR('P',N,N,N,A,Lda,Work(itaup),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,M,0,S,Work(ie),A,Lda,U,Ldu,dum,1, &
     &                        Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntvas ) THEN
!
!                 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
!
               IF ( Lwork>=N*N+MAX(N+M,4*N,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+Lda*N ) THEN
!
!                       WORK(IU) is LDA by N
!
                     ldwrku = Lda
                  ELSE
!
!                       WORK(IU) is N by N
!
                     ldwrku = N
                  ENDIF
                  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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need N*N+N+M, prefer N*N+N+M*NB)
!
                  CALL SORGQR(M,M,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R to WORK(IU), zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('L',N-1,N-1,ZERO,ZERO,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)
!
                  CALL SGEBRD(N,N,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('U',N,N,Work(iu),ldwrku,Vt,Ldvt)
!
!                    Generate left bidiagonalizing vectors in WORK(IU)
!                    (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB)
!
                  CALL SORGBR('Q',N,N,N,Work(iu),ldwrku,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate right bidiagonalizing vectors in VT
!                    (Workspace: need N*N+4*N-1,
!                                prefer N*N+3*N+(N-1)*NB)
!
                  CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),&
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,N,0,S,Work(ie),Vt,Ldvt,Work(iu),  &
     &                        ldwrku,dum,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)
!
                  CALL SGEMM('N','N',M,N,N,ONE,U,Ldu,Work(iu),ldwrku,   &
     &                       ZERO,A,Lda)
!
!                    Copy left singular vectors of A from A to U
!
                  CALL SLACPY('F',M,N,A,Lda,U,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)
!
                  CALL SGEQRF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('L',M,N,A,Lda,U,Ldu)
!
!                    Generate Q in U
!                    (Workspace: need N+M, prefer N+M*NB)
!
                  CALL SORGQR(M,M,N,U,Ldu,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy R from A to VT, zeroing out below it
!
                  CALL SLACPY('U',N,N,A,Lda,Vt,Ldvt)
                  IF ( N>1 ) CALL SLASET('L',N-1,N-1,ZERO,ZERO,Vt(2,1), &
     &                 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)
!
                  CALL SGEBRD(N,N,Vt,Ldvt,S,Work(ie),Work(itauq),       &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply Q in U by left bidiagonalizing vectors
!                    in VT
!                    (Workspace: need 3*N+M, prefer 3*N+M*NB)
!
                  CALL SORMBR('Q','R','N',M,N,N,Vt,Ldvt,Work(itauq),U,  &
     &                        Ldu,Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate right bidiagonalizing vectors in VT
!                    (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB)
!
                  CALL SORGBR('P',N,N,N,Vt,Ldvt,Work(itaup),Work(iwork),&
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',N,N,M,0,S,Work(ie),Vt,Ldvt,U,Ldu,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ENDIF
!
         ENDIF
!
!
!        A has more columns than rows. If A has sufficiently more
!        columns than rows, first reduce using the LQ decomposition (if
!        sufficient workspace available)
!
      ELSEIF ( N>=mnthr ) THEN
!
         IF ( wntvn ) THEN
!
!              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)
!
            CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),Lwork-iwork+1, &
     &                  ierr)
!
!              Zero out above L
!
            CALL SLASET('U',M-1,M-1,ZERO,ZERO,A(1,2),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)
!
            CALL SGEBRD(M,M,A,Lda,S,Work(ie),Work(itauq),Work(itaup),   &
     &                  Work(iwork),Lwork-iwork+1,ierr)
!
!                 If left singular vectors desired, generate Q
!                 (Workspace: need 4*M, prefer 3*M+M*NB)
!
            IF ( wntuo .OR. wntuas )                                    &
     &           CALL SORGBR('Q',M,M,M,A,Lda,Work(itauq),Work(iwork),   &
     &           Lwork-iwork+1,ierr)
            iwork = ie + M
            nru = 0
            IF ( wntuo .OR. wntuas ) nru = M
!
!              Perform bidiagonal QR iteration, computing left singular
!              vectors of A in A if desired
!              (Workspace: need BDSPAC)
!
            CALL SBDSQR('U',M,0,nru,0,S,Work(ie),dum,1,A,Lda,dum,1,     &
     &                  Work(iwork),Info)
!
!              If left singular vectors desired in U, copy them there
!
            IF ( wntuas ) CALL SLACPY('F',M,M,A,Lda,U,Ldu)
!
         ELSEIF ( wntvo .AND. wntun ) THEN
!
!              Path 2t(N much larger than M, JOBU='N', JOBVT='O')
!              M right singular vectors to be overwritten on A and
!              no left singular vectors to be computed
!
            IF ( Lwork>=M*M+MAX(4*M,bdspac) ) THEN
!
!                 Sufficient workspace for a fast algorithm
!
               ir = 1
               IF ( Lwork>=MAX(wrkbl,Lda*N+M)+Lda*M ) THEN
!
!                    WORK(IU) is LDA by N and WORK(IR) is LDA by M
!
                  ldwrku = Lda
                  chunk = N
                  ldwrkr = Lda
               ELSEIF ( Lwork>=MAX(wrkbl,Lda*N+M)+M*M ) THEN
!
!                    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
               ENDIF
               itau = ir + ldwrkr*M
               iwork = itau + M
!
!                 Compute A=L*Q
!                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
               CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),            &
     &                     Lwork-iwork+1,ierr)
!
!                 Copy L to WORK(IR) and zero out above it
!
               CALL SLACPY('L',M,M,A,Lda,Work(ir),ldwrkr)
               CALL SLASET('U',M-1,M-1,ZERO,ZERO,Work(ir+ldwrkr),ldwrkr)
!
!                 Generate Q in A
!                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
               CALL SORGLQ(M,N,M,A,Lda,Work(itau),Work(iwork),          &
     &                     Lwork-iwork+1,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)
!
               CALL SGEBRD(M,M,Work(ir),ldwrkr,S,Work(ie),Work(itauq),  &
     &                     Work(itaup),Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate right vectors bidiagonalizing L
!                 (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB)
!
               CALL SORGBR('P',M,M,M,Work(ir),ldwrkr,Work(itaup),       &
     &                     Work(iwork),Lwork-iwork+1,ierr)
               iwork = ie + M
!
!                 Perform bidiagonal QR iteration, computing right
!                 singular vectors of L in WORK(IR)
!                 (Workspace: need M*M+BDSPAC)
!
               CALL SBDSQR('U',M,M,0,0,S,Work(ie),Work(ir),ldwrkr,dum,1,&
     &                     dum,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)
!
               DO i = 1 , N , chunk
                  blk = MIN(N-i+1,chunk)
                  CALL SGEMM('N','N',M,blk,M,ONE,Work(ir),ldwrkr,A(1,i),&
     &                       Lda,ZERO,Work(iu),ldwrku)
                  CALL SLACPY('F',M,blk,Work(iu),ldwrku,A(1,i),Lda)
               ENDDO
!
            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)
!
               CALL SGEBRD(M,N,A,Lda,S,Work(ie),Work(itauq),Work(itaup),&
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate right vectors bidiagonalizing A
!                 (Workspace: need 4*M, prefer 3*M+M*NB)
!
               CALL SORGBR('P',M,N,M,A,Lda,Work(itaup),Work(iwork),     &
     &                     Lwork-iwork+1,ierr)
               iwork = ie + M
!
!                 Perform bidiagonal QR iteration, computing right
!                 singular vectors of A in A
!                 (Workspace: need BDSPAC)
!
               CALL SBDSQR('L',M,N,0,0,S,Work(ie),A,Lda,dum,1,dum,1,    &
     &                     Work(iwork),Info)
!
            ENDIF
!
         ELSEIF ( wntvo .AND. wntuas ) THEN
!
!              Path 3t(N much larger than M, JOBU='S' or 'A', JOBVT='O')
!              M right singular vectors to be overwritten on A and
!              M left singular vectors to be computed in U
!
            IF ( Lwork>=M*M+MAX(4*M,bdspac) ) THEN
!
!                 Sufficient workspace for a fast algorithm
!
               ir = 1
               IF ( Lwork>=MAX(wrkbl,Lda*N+M)+Lda*M ) THEN
!
!                    WORK(IU) is LDA by N and WORK(IR) is LDA by M
!
                  ldwrku = Lda
                  chunk = N
                  ldwrkr = Lda
               ELSEIF ( Lwork>=MAX(wrkbl,Lda*N+M)+M*M ) THEN
!
!                    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
               ENDIF
               itau = ir + ldwrkr*M
               iwork = itau + M
!
!                 Compute A=L*Q
!                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
               CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),            &
     &                     Lwork-iwork+1,ierr)
!
!                 Copy L to U, zeroing about above it
!
               CALL SLACPY('L',M,M,A,Lda,U,Ldu)
               CALL SLASET('U',M-1,M-1,ZERO,ZERO,U(1,2),Ldu)
!
!                 Generate Q in A
!                 (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
               CALL SORGLQ(M,N,M,A,Lda,Work(itau),Work(iwork),          &
     &                     Lwork-iwork+1,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)
!
               CALL SGEBRD(M,M,U,Ldu,S,Work(ie),Work(itauq),Work(itaup),&
     &                     Work(iwork),Lwork-iwork+1,ierr)
               CALL SLACPY('U',M,M,U,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)
!
               CALL SORGBR('P',M,M,M,Work(ir),ldwrkr,Work(itaup),       &
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate left vectors bidiagonalizing L in U
!                 (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
!
               CALL SORGBR('Q',M,M,M,U,Ldu,Work(itauq),Work(iwork),     &
     &                     Lwork-iwork+1,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)
!
               CALL SBDSQR('U',M,M,M,0,S,Work(ie),Work(ir),ldwrkr,U,Ldu,&
     &                     dum,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))
!
               DO i = 1 , N , chunk
                  blk = MIN(N-i+1,chunk)
                  CALL SGEMM('N','N',M,blk,M,ONE,Work(ir),ldwrkr,A(1,i),&
     &                       Lda,ZERO,Work(iu),ldwrku)
                  CALL SLACPY('F',M,blk,Work(iu),ldwrku,A(1,i),Lda)
               ENDDO
!
            ELSE
!
!                 Insufficient workspace for a fast algorithm
!
               itau = 1
               iwork = itau + M
!
!                 Compute A=L*Q
!                 (Workspace: need 2*M, prefer M+M*NB)
!
               CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),            &
     &                     Lwork-iwork+1,ierr)
!
!                 Copy L to U, zeroing out above it
!
               CALL SLACPY('L',M,M,A,Lda,U,Ldu)
               CALL SLASET('U',M-1,M-1,ZERO,ZERO,U(1,2),Ldu)
!
!                 Generate Q in A
!                 (Workspace: need 2*M, prefer M+M*NB)
!
               CALL SORGLQ(M,N,M,A,Lda,Work(itau),Work(iwork),          &
     &                     Lwork-iwork+1,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)
!
               CALL SGEBRD(M,M,U,Ldu,S,Work(ie),Work(itauq),Work(itaup),&
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Multiply right vectors bidiagonalizing L by Q in A
!                 (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
               CALL SORMBR('P','L','T',M,N,M,U,Ldu,Work(itaup),A,Lda,   &
     &                     Work(iwork),Lwork-iwork+1,ierr)
!
!                 Generate left vectors bidiagonalizing L in U
!                 (Workspace: need 4*M, prefer 3*M+M*NB)
!
               CALL SORGBR('Q',M,M,M,U,Ldu,Work(itauq),Work(iwork),     &
     &                     Lwork-iwork+1,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)
!
               CALL SBDSQR('U',M,N,M,0,S,Work(ie),A,Lda,U,Ldu,dum,1,    &
     &                     Work(iwork),Info)
!
            ENDIF
!
         ELSEIF ( wntvs ) THEN
!
            IF ( wntun ) THEN
!
!                 Path 4t(N much larger than M, JOBU='N', JOBVT='S')
!                 M right singular vectors to be computed in VT and
!                 no left singular vectors to be computed
!
               IF ( Lwork>=M*M+MAX(4*M,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  ir = 1
                  IF ( Lwork>=wrkbl+Lda*M ) THEN
!
!                       WORK(IR) is LDA by M
!
                     ldwrkr = Lda
                  ELSE
!
!                       WORK(IR) is M by M
!
                     ldwrkr = M
                  ENDIF
                  itau = ir + ldwrkr*M
                  iwork = itau + M
!
!                    Compute A=L*Q
!                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to WORK(IR), zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,Work(ir),ldwrkr)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,Work(ir+ldwrkr),    &
     &                        ldwrkr)
!
!                    Generate Q in A
!                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
                  CALL SORGLQ(M,N,M,A,Lda,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(M,M,Work(ir),ldwrkr,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
!
!                    Generate right vectors bidiagonalizing L in
!                    WORK(IR)
!                    (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
!
                  CALL SORGBR('P',M,M,M,Work(ir),ldwrkr,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + M
!
!                    Perform bidiagonal QR iteration, computing right
!                    singular vectors of L in WORK(IR)
!                    (Workspace: need M*M+BDSPAC)
!
                  CALL SBDSQR('U',M,M,0,0,S,Work(ie),Work(ir),ldwrkr,   &
     &                        dum,1,dum,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)
!
                  CALL SGEMM('N','N',M,N,M,ONE,Work(ir),ldwrkr,A,Lda,   &
     &                       ZERO,Vt,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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy result to VT
!
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need 2*M, prefer M+M*NB)
!
                  CALL SORGLQ(M,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + M
                  itaup = itauq + M
                  iwork = itaup + M
!
!                    Zero out above L in A
!
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,A(1,2),Lda)
!
!                    Bidiagonalize L in A
!                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
!
                  CALL SGEBRD(M,M,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply right vectors bidiagonalizing L by Q in VT
!                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
                  CALL SORMBR('P','L','T',M,N,M,A,Lda,Work(itaup),Vt,   &
     &                        Ldvt,Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + M
!
!                    Perform bidiagonal QR iteration, computing right
!                    singular vectors of A in VT
!                    (Workspace: need BDSPAC)
!
                  CALL SBDSQR('U',M,N,0,0,S,Work(ie),Vt,Ldvt,dum,1,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntuo ) THEN
!
!                 Path 5t(N much larger than M, JOBU='O', JOBVT='S')
!                 M right singular vectors to be computed in VT and
!                 M left singular vectors to be overwritten on A
!
               IF ( Lwork>=2*M*M+MAX(4*M,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+2*Lda*M ) THEN
!
!                       WORK(IU) is LDA by M and WORK(IR) is LDA by M
!
                     ldwrku = Lda
                     ir = iu + ldwrku*M
                     ldwrkr = Lda
                  ELSEIF ( Lwork>=wrkbl+(Lda+M)*M ) THEN
!
!                       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
                  ENDIF
                  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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to WORK(IU), zeroing out below it
!
                  CALL SLACPY('L',M,M,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,Work(iu+ldwrku),    &
     &                        ldwrku)
!
!                    Generate Q in A
!                    (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB)
!
                  CALL SORGLQ(M,N,M,A,Lda,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(M,M,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('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)
!
                  CALL SORGBR('P',M,M,M,Work(iu),ldwrku,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in WORK(IR)
!                    (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,Work(ir),ldwrkr,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,M,M,0,S,Work(ie),Work(iu),ldwrku,   &
     &                        Work(ir),ldwrkr,dum,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)
!
                  CALL SGEMM('N','N',M,N,M,ONE,Work(iu),ldwrku,A,Lda,   &
     &                       ZERO,Vt,Ldvt)
!
!                    Copy left singular vectors of L to A
!                    (Workspace: need M*M)
!
                  CALL SLACPY('F',M,M,Work(ir),ldwrkr,A,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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need 2*M, prefer M+M*NB)
!
                  CALL SORGLQ(M,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + M
                  itaup = itauq + M
                  iwork = itaup + M
!
!                    Zero out above L in A
!
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,A(1,2),Lda)
!
!                    Bidiagonalize L in A
!                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
!
                  CALL SGEBRD(M,M,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply right vectors bidiagonalizing L by Q in VT
!                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
                  CALL SORMBR('P','L','T',M,N,M,A,Lda,Work(itaup),Vt,   &
     &                        Ldvt,Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors of L in A
!                    (Workspace: need 4*M, prefer 3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,A,Lda,Work(itauq),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,N,M,0,S,Work(ie),Vt,Ldvt,A,Lda,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntuas ) THEN
!
!                 Path 6t(N much larger than M, JOBU='S' or 'A',
!                         JOBVT='S')
!                 M right singular vectors to be computed in VT and
!                 M left singular vectors to be computed in U
!
               IF ( Lwork>=M*M+MAX(4*M,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+Lda*M ) THEN
!
!                       WORK(IU) is LDA by N
!
                     ldwrku = Lda
                  ELSE
!
!                       WORK(IU) is LDA by M
!
                     ldwrku = M
                  ENDIF
                  itau = iu + ldwrku*M
                  iwork = itau + M
!
!                    Compute A=L*Q
!                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to WORK(IU), zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,Work(iu+ldwrku),    &
     &                        ldwrku)
!
!                    Generate Q in A
!                    (Workspace: need M*M+2*M, prefer M*M+M+M*NB)
!
                  CALL SORGLQ(M,N,M,A,Lda,Work(itau),Work(iwork),       &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(M,M,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('L',M,M,Work(iu),ldwrku,U,Ldu)
!
!                    Generate right bidiagonalizing vectors in WORK(IU)
!                    (Workspace: need M*M+4*M-1,
!                                prefer M*M+3*M+(M-1)*NB)
!
                  CALL SORGBR('P',M,M,M,Work(iu),ldwrku,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in U
!                    (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,U,Ldu,Work(itauq),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,M,M,0,S,Work(ie),Work(iu),ldwrku,U, &
     &                        Ldu,dum,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)
!
                  CALL SGEMM('N','N',M,N,M,ONE,Work(iu),ldwrku,A,Lda,   &
     &                       ZERO,Vt,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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need 2*M, prefer M+M*NB)
!
                  CALL SORGLQ(M,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to U, zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,U,Ldu)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,U(1,2),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)
!
                  CALL SGEBRD(M,M,U,Ldu,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply right bidiagonalizing vectors in U by Q
!                    in VT
!                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
                  CALL SORMBR('P','L','T',M,N,M,U,Ldu,Work(itaup),Vt,   &
     &                        Ldvt,Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in U
!                    (Workspace: need 4*M, prefer 3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,U,Ldu,Work(itauq),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,N,M,0,S,Work(ie),Vt,Ldvt,U,Ldu,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ENDIF
!
         ELSEIF ( wntva ) THEN
!
            IF ( wntun ) THEN
!
!                 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
!
               IF ( Lwork>=M*M+MAX(N+M,4*M,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  ir = 1
                  IF ( Lwork>=wrkbl+Lda*M ) THEN
!
!                       WORK(IR) is LDA by M
!
                     ldwrkr = Lda
                  ELSE
!
!                       WORK(IR) is M by M
!
                     ldwrkr = M
                  ENDIF
                  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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Copy L to WORK(IR), zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,Work(ir),ldwrkr)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,Work(ir+ldwrkr),    &
     &                        ldwrkr)
!
!                    Generate Q in VT
!                    (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
!
                  CALL SORGLQ(N,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,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)
!
                  CALL SGEBRD(M,M,Work(ir),ldwrkr,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
!
!                    Generate right bidiagonalizing vectors in WORK(IR)
!                    (Workspace: need M*M+4*M-1,
!                                prefer M*M+3*M+(M-1)*NB)
!
                  CALL SORGBR('P',M,M,M,Work(ir),ldwrkr,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + M
!
!                    Perform bidiagonal QR iteration, computing right
!                    singular vectors of L in WORK(IR)
!                    (Workspace: need M*M+BDSPAC)
!
                  CALL SBDSQR('U',M,M,0,0,S,Work(ie),Work(ir),ldwrkr,   &
     &                        dum,1,dum,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)
!
                  CALL SGEMM('N','N',M,N,M,ONE,Work(ir),ldwrkr,Vt,Ldvt, &
     &                       ZERO,A,Lda)
!
!                    Copy right singular vectors of A from A to VT
!
                  CALL SLACPY('F',M,N,A,Lda,Vt,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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need M+N, prefer M+N*NB)
!
                  CALL SORGLQ(N,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + M
                  itaup = itauq + M
                  iwork = itaup + M
!
!                    Zero out above L in A
!
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,A(1,2),Lda)
!
!                    Bidiagonalize L in A
!                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
!
                  CALL SGEBRD(M,M,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply right bidiagonalizing vectors in A by Q
!                    in VT
!                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
                  CALL SORMBR('P','L','T',M,N,M,A,Lda,Work(itaup),Vt,   &
     &                        Ldvt,Work(iwork),Lwork-iwork+1,ierr)
                  iwork = ie + M
!
!                    Perform bidiagonal QR iteration, computing right
!                    singular vectors of A in VT
!                    (Workspace: need BDSPAC)
!
                  CALL SBDSQR('U',M,N,0,0,S,Work(ie),Vt,Ldvt,dum,1,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntuo ) THEN
!
!                 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
!
               IF ( Lwork>=2*M*M+MAX(N+M,4*M,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+2*Lda*M ) THEN
!
!                       WORK(IU) is LDA by M and WORK(IR) is LDA by M
!
                     ldwrku = Lda
                     ir = iu + ldwrku*M
                     ldwrkr = Lda
                  ELSEIF ( Lwork>=wrkbl+(Lda+M)*M ) THEN
!
!                       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
                  ENDIF
                  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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB)
!
                  CALL SORGLQ(N,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to WORK(IU), zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,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)
!
                  CALL SGEBRD(M,M,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('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)
!
                  CALL SORGBR('P',M,M,M,Work(iu),ldwrku,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in WORK(IR)
!                    (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,Work(ir),ldwrkr,Work(itauq),    &
     &                        Work(iwork),Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,M,M,0,S,Work(ie),Work(iu),ldwrku,   &
     &                        Work(ir),ldwrkr,dum,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)
!
                  CALL SGEMM('N','N',M,N,M,ONE,Work(iu),ldwrku,Vt,Ldvt, &
     &                       ZERO,A,Lda)
!
!                    Copy right singular vectors of A from A to VT
!
                  CALL SLACPY('F',M,N,A,Lda,Vt,Ldvt)
!
!                    Copy left singular vectors of A from WORK(IR) to A
!
                  CALL SLACPY('F',M,M,Work(ir),ldwrkr,A,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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need M+N, prefer M+N*NB)
!
                  CALL SORGLQ(N,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
                  ie = itau
                  itauq = ie + M
                  itaup = itauq + M
                  iwork = itaup + M
!
!                    Zero out above L in A
!
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,A(1,2),Lda)
!
!                    Bidiagonalize L in A
!                    (Workspace: need 4*M, prefer 3*M+2*M*NB)
!
                  CALL SGEBRD(M,M,A,Lda,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply right bidiagonalizing vectors in A by Q
!                    in VT
!                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
                  CALL SORMBR('P','L','T',M,N,M,A,Lda,Work(itaup),Vt,   &
     &                        Ldvt,Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in A
!                    (Workspace: need 4*M, prefer 3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,A,Lda,Work(itauq),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,N,M,0,S,Work(ie),Vt,Ldvt,A,Lda,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ELSEIF ( wntuas ) THEN
!
!                 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
!
               IF ( Lwork>=M*M+MAX(N+M,4*M,bdspac) ) THEN
!
!                    Sufficient workspace for a fast algorithm
!
                  iu = 1
                  IF ( Lwork>=wrkbl+Lda*M ) THEN
!
!                       WORK(IU) is LDA by M
!
                     ldwrku = Lda
                  ELSE
!
!                       WORK(IU) is M by M
!
                     ldwrku = M
                  ENDIF
                  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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need M*M+M+N, prefer M*M+M+N*NB)
!
                  CALL SORGLQ(N,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to WORK(IU), zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,Work(iu),ldwrku)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,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)
!
                  CALL SGEBRD(M,M,Work(iu),ldwrku,S,Work(ie),Work(itauq)&
     &                        ,Work(itaup),Work(iwork),Lwork-iwork+1,   &
     &                        ierr)
                  CALL SLACPY('L',M,M,Work(iu),ldwrku,U,Ldu)
!
!                    Generate right bidiagonalizing vectors in WORK(IU)
!                    (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB)
!
                  CALL SORGBR('P',M,M,M,Work(iu),ldwrku,Work(itaup),    &
     &                        Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in U
!                    (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,U,Ldu,Work(itauq),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,M,M,0,S,Work(ie),Work(iu),ldwrku,U, &
     &                        Ldu,dum,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)
!
                  CALL SGEMM('N','N',M,N,M,ONE,Work(iu),ldwrku,Vt,Ldvt, &
     &                       ZERO,A,Lda)
!
!                    Copy right singular vectors of A from A to VT
!
                  CALL SLACPY('F',M,N,A,Lda,Vt,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)
!
                  CALL SGELQF(M,N,A,Lda,Work(itau),Work(iwork),         &
     &                        Lwork-iwork+1,ierr)
                  CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
!
!                    Generate Q in VT
!                    (Workspace: need M+N, prefer M+N*NB)
!
                  CALL SORGLQ(N,N,M,Vt,Ldvt,Work(itau),Work(iwork),     &
     &                        Lwork-iwork+1,ierr)
!
!                    Copy L to U, zeroing out above it
!
                  CALL SLACPY('L',M,M,A,Lda,U,Ldu)
                  CALL SLASET('U',M-1,M-1,ZERO,ZERO,U(1,2),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)
!
                  CALL SGEBRD(M,M,U,Ldu,S,Work(ie),Work(itauq),         &
     &                        Work(itaup),Work(iwork),Lwork-iwork+1,    &
     &                        ierr)
!
!                    Multiply right bidiagonalizing vectors in U by Q
!                    in VT
!                    (Workspace: need 3*M+N, prefer 3*M+N*NB)
!
                  CALL SORMBR('P','L','T',M,N,M,U,Ldu,Work(itaup),Vt,   &
     &                        Ldvt,Work(iwork),Lwork-iwork+1,ierr)
!
!                    Generate left bidiagonalizing vectors in U
!                    (Workspace: need 4*M, prefer 3*M+M*NB)
!
                  CALL SORGBR('Q',M,M,M,U,Ldu,Work(itauq),Work(iwork),  &
     &                        Lwork-iwork+1,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)
!
                  CALL SBDSQR('U',M,N,M,0,S,Work(ie),Vt,Ldvt,U,Ldu,dum, &
     &                        1,Work(iwork),Info)
!
               ENDIF
!
            ENDIF
!
         ENDIF
!
      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)
!
         CALL SGEBRD(M,N,A,Lda,S,Work(ie),Work(itauq),Work(itaup),      &
     &               Work(iwork),Lwork-iwork+1,ierr)
         IF ( wntuas ) THEN
!
!              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)
!
            CALL SLACPY('L',M,M,A,Lda,U,Ldu)
            CALL SORGBR('Q',M,M,N,U,Ldu,Work(itauq),Work(iwork),        &
     &                  Lwork-iwork+1,ierr)
         ENDIF
         IF ( wntvas ) THEN
!
!              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)
!
            CALL SLACPY('U',M,N,A,Lda,Vt,Ldvt)
            IF ( wntva ) nrvt = N
            IF ( wntvs ) nrvt = M
            CALL SORGBR('P',nrvt,N,M,Vt,Ldvt,Work(itaup),Work(iwork),   &
     &                  Lwork-iwork+1,ierr)
         ENDIF
!
!              If left singular vectors desired in A, generate left
!              bidiagonalizing vectors in A
!              (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB)
!
         IF ( wntuo ) CALL SORGBR('Q',M,M,N,A,Lda,Work(itauq),          &
     &                            Work(iwork),Lwork-iwork+1,ierr)
!
!              If right singular vectors desired in A, generate right
!              bidiagonalizing vectors in A
!              (Workspace: need 4*M, prefer 3*M+M*NB)
!
         IF ( wntvo ) CALL SORGBR('P',M,N,M,A,Lda,Work(itaup),          &
     &                            Work(iwork),Lwork-iwork+1,ierr)
         iwork = ie + M
         IF ( wntuas .OR. wntuo ) nru = M
         IF ( wntun ) nru = 0
         IF ( wntvas .OR. wntvo ) ncvt = N
         IF ( wntvn ) ncvt = 0
         IF ( (.NOT.wntuo) .AND. (.NOT.wntvo) ) THEN
!
!              Perform bidiagonal QR iteration, if desired, computing
!              left singular vectors in U and computing right singular
!              vectors in VT
!              (Workspace: need BDSPAC)
!
            CALL SBDSQR('L',M,ncvt,nru,0,S,Work(ie),Vt,Ldvt,U,Ldu,dum,1,&
     &                  Work(iwork),Info)
         ELSEIF ( (.NOT.wntuo) .AND. wntvo ) THEN
!
!              Perform bidiagonal QR iteration, if desired, computing
!              left singular vectors in U and computing right singular
!              vectors in A
!              (Workspace: need BDSPAC)
!
            CALL SBDSQR('L',M,ncvt,nru,0,S,Work(ie),A,Lda,U,Ldu,dum,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)
!
            CALL SBDSQR('L',M,ncvt,nru,0,S,Work(ie),Vt,Ldvt,A,Lda,dum,1,&
     &                  Work(iwork),Info)
         ENDIF
!
!
      ENDIF
!
!     If SBDSQR failed to converge, copy unconverged superdiagonals
!     to WORK( 2:MINMN )
!
      IF ( Info/=0 ) THEN
         IF ( ie>2 ) THEN
            DO i = 1 , minmn - 1
               Work(i+1) = Work(i+ie-1)
            ENDDO
         ENDIF
         IF ( ie<2 ) THEN
            DO i = minmn - 1 , 1 , -1
               Work(i+1) = Work(i+ie-1)
            ENDDO
         ENDIF
      ENDIF
!
!     Undo scaling if necessary
!
      IF ( iscl==1 ) THEN
         IF ( anrm>bignum ) CALL SLASCL('G',0,0,bignum,anrm,minmn,1,S,  &
     &                                  minmn,ierr)
         IF ( Info/=0 .AND. anrm>bignum )                               &
     &        CALL SLASCL('G',0,0,bignum,anrm,minmn-1,1,Work(2),minmn,  &
     &        ierr)
         IF ( anrm<smlnum ) CALL SLASCL('G',0,0,smlnum,anrm,minmn,1,S,  &
     &                                  minmn,ierr)
         IF ( Info/=0 .AND. anrm<smlnum )                               &
     &        CALL SLASCL('G',0,0,smlnum,anrm,minmn-1,1,Work(2),minmn,  &
     &        ierr)
      ENDIF
!
!     Return optimal workspace in WORK(1)
!
      Work(1) = maxwrk
!
!
!     End of SGESVD
!
      END SUBROUTINE SGESVD