200      SUBROUTINE sgelsd( M, N, NRHS, A, LDA, B, LDB, S, RCOND,
 
  201     $                   RANK, WORK, LWORK, IWORK, INFO )
 
  208      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
 
  213      REAL               A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
 
  220      parameter( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
 
  224      INTEGER            IASCL, IBSCL, IE, IL, ITAU, ITAUP, ITAUQ,
 
  225     $                   ldwork, liwork, maxmn, maxwrk, minmn, minwrk,
 
  226     $                   mm, mnthr, nlvl, nwork, smlsiz, wlalsd
 
  227      REAL               ANRM, BIGNUM, BNRM, EPS, SFMIN, SMLNUM
 
  236      REAL               SLAMCH, SLANGE, SROUNDUP_LWORK
 
  237      EXTERNAL           slamch, slange, ilaenv,
 
  241      INTRINSIC          int, log, max, min, real
 
  250      lquery = ( lwork.EQ.-1 )
 
  253      ELSE IF( n.LT.0 ) 
THEN 
  255      ELSE IF( nrhs.LT.0 ) 
THEN 
  257      ELSE IF( lda.LT.max( 1, m ) ) 
THEN 
  259      ELSE IF( ldb.LT.max( 1, maxmn ) ) 
THEN 
  274         IF( minmn.GT.0 ) 
THEN 
  275            smlsiz = ilaenv( 9, 
'SGELSD', 
' ', 0, 0, 0, 0 )
 
  276            mnthr = ilaenv( 6, 
'SGELSD', 
' ', m, n, nrhs, -1 )
 
  277            nlvl = max( int( log( real( minmn ) / real( smlsiz + 1 ) ) /
 
  278     $                  log( two ) ) + 1, 0 )
 
  279            liwork = 3*minmn*nlvl + 11*minmn
 
  281            IF( m.GE.n .AND. m.GE.mnthr ) 
THEN 
  287               maxwrk = max( maxwrk, n + n*ilaenv( 1, 
'SGEQRF', 
' ',
 
  290               maxwrk = max( maxwrk, n + nrhs*ilaenv( 1, 
'SORMQR',
 
  298               maxwrk = max( maxwrk, 3*n + ( mm + n )*ilaenv( 1,
 
  299     $                       
'SGEBRD', 
' ', mm, n, -1, -1 ) )
 
  300               maxwrk = max( maxwrk, 3*n + nrhs*ilaenv( 1, 
'SORMBR',
 
  301     $                       
'QLT', mm, nrhs, n, -1 ) )
 
  302               maxwrk = max( maxwrk, 3*n + ( n - 1 )*ilaenv( 1,
 
  303     $                       
'SORMBR', 
'PLN', n, nrhs, n, -1 ) )
 
  304               wlalsd = 9*n + 2*n*smlsiz + 8*n*nlvl + n*nrhs +
 
  306               maxwrk = max( maxwrk, 3*n + wlalsd )
 
  307               minwrk = max( 3*n + mm, 3*n + nrhs, 3*n + wlalsd )
 
  310               wlalsd = 9*m + 2*m*smlsiz + 8*m*nlvl + m*nrhs +
 
  312               IF( n.GE.mnthr ) 
THEN 
  317                  maxwrk = m + m*ilaenv( 1, 
'SGELQF', 
' ', m, n, -1,
 
  319                  maxwrk = max( maxwrk, m*m + 4*m + 2*m*ilaenv( 1,
 
  320     $                          
'SGEBRD', 
' ', m, m, -1, -1 ) )
 
  321                  maxwrk = max( maxwrk, m*m + 4*m + nrhs*ilaenv( 1,
 
  322     $                          
'SORMBR', 
'QLT', m, nrhs, m, -1 ) )
 
  323                  maxwrk = max( maxwrk,
 
  324     $                          m*m + 4*m + ( m - 1 )*ilaenv( 1,
 
  325     $                          
'SORMBR', 
'PLN', m, nrhs, m, -1 ) )
 
  327                     maxwrk = max( maxwrk, m*m + m + m*nrhs )
 
  329                     maxwrk = max( maxwrk, m*m + 2*m )
 
  331                  maxwrk = max( maxwrk, m + nrhs*ilaenv( 1, 
'SORMLQ',
 
  332     $                          
'LT', n, nrhs, m, -1 ) )
 
  333                  maxwrk = max( maxwrk, m*m + 4*m + wlalsd )
 
  336                  maxwrk = max( maxwrk,
 
  337     $                 4*m+m*m+max( m, 2*m-4, nrhs, n-3*m ) )
 
  342                  maxwrk = 3*m + ( n + m )*ilaenv( 1, 
'SGEBRD', 
' ',
 
  345                  maxwrk = max( maxwrk, 3*m + nrhs*ilaenv( 1,
 
  347     $                          
'QLT', m, nrhs, n, -1 ) )
 
  348                  maxwrk = max( maxwrk, 3*m + m*ilaenv( 1, 
'SORMBR',
 
  349     $                          
'PLN', n, nrhs, m, -1 ) )
 
  350                  maxwrk = max( maxwrk, 3*m + wlalsd )
 
  352               minwrk = max( 3*m + nrhs, 3*m + m, 3*m + wlalsd )
 
  355         minwrk = min( minwrk, maxwrk )
 
  356         work( 1 ) = sroundup_lwork(maxwrk)
 
  359         IF( lwork.LT.minwrk .AND. .NOT.lquery ) 
THEN 
  365         CALL xerbla( 
'SGELSD', -info )
 
  367      ELSE IF( lquery ) 
THEN 
  373      IF( m.EQ.0 .OR. n.EQ.0 ) 
THEN 
  381      sfmin = slamch( 
'S' )
 
  383      bignum = one / smlnum
 
  387      anrm = slange( 
'M', m, n, a, lda, work )
 
  389      IF( anrm.GT.zero .AND. anrm.LT.smlnum ) 
THEN 
  393         CALL slascl( 
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
 
  395      ELSE IF( anrm.GT.bignum ) 
THEN 
  399         CALL slascl( 
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
 
  401      ELSE IF( anrm.EQ.zero ) 
THEN 
  405         CALL slaset( 
'F', max( m, n ), nrhs, zero, zero, b, ldb )
 
  406         CALL slaset( 
'F', minmn, 1, zero, zero, s, 1 )
 
  413      bnrm = slange( 
'M', m, nrhs, b, ldb, work )
 
  415      IF( bnrm.GT.zero .AND. bnrm.LT.smlnum ) 
THEN 
  419         CALL slascl( 
'G', 0, 0, bnrm, smlnum, m, nrhs, b, ldb,
 
  422      ELSE IF( bnrm.GT.bignum ) 
THEN 
  426         CALL slascl( 
'G', 0, 0, bnrm, bignum, m, nrhs, b, ldb,
 
  434     $   
CALL slaset( 
'F', n-m, nrhs, zero, zero, b( m+1, 1 ), ldb )
 
  443         IF( m.GE.mnthr ) 
THEN 
  454            CALL sgeqrf( m, n, a, lda, work( itau ), work( nwork ),
 
  455     $                   lwork-nwork+1, info )
 
  460            CALL sormqr( 
'L', 
'T', m, nrhs, n, a, lda, work( itau ),
 
  462     $                   ldb, work( nwork ), lwork-nwork+1, info )
 
  467               CALL slaset( 
'L', n-1, n-1, zero, zero, a( 2, 1 ),
 
  480         CALL sgebrd( mm, n, a, lda, s, work( ie ), work( itauq ),
 
  481     $                work( itaup ), work( nwork ), lwork-nwork+1,
 
  487         CALL sormbr( 
'Q', 
'L', 
'T', mm, nrhs, n, a, lda,
 
  489     $                b, ldb, work( nwork ), lwork-nwork+1, info )
 
  493         CALL slalsd( 
'U', smlsiz, n, nrhs, s, work( ie ), b, ldb,
 
  494     $                rcond, rank, work( nwork ), iwork, info )
 
  501         CALL sormbr( 
'P', 
'L', 
'N', n, nrhs, n, a, lda,
 
  503     $                b, ldb, work( nwork ), lwork-nwork+1, info )
 
  505      ELSE IF( n.GE.mnthr .AND. lwork.GE.4*m+m*m+
 
  506     $         max( m, 2*m-4, nrhs, n-3*m, wlalsd ) ) 
THEN 
  512         IF( lwork.GE.max( 4*m+m*lda+max( m, 2*m-4, nrhs, n-3*m ),
 
  513     $       m*lda+m+m*nrhs, 4*m+m*lda+wlalsd ) )ldwork = lda
 
  520         CALL sgelqf( m, n, a, lda, work( itau ), work( nwork ),
 
  521     $                lwork-nwork+1, info )
 
  526         CALL slacpy( 
'L', m, m, a, lda, work( il ), ldwork )
 
  527         CALL slaset( 
'U', m-1, m-1, zero, zero, work( il+ldwork ),
 
  537         CALL sgebrd( m, m, work( il ), ldwork, s, work( ie ),
 
  538     $                work( itauq ), work( itaup ), work( nwork ),
 
  539     $                lwork-nwork+1, info )
 
  544         CALL sormbr( 
'Q', 
'L', 
'T', m, nrhs, m, work( il ), ldwork,
 
  545     $                work( itauq ), b, ldb, work( nwork ),
 
  546     $                lwork-nwork+1, info )
 
  550         CALL slalsd( 
'U', smlsiz, m, nrhs, s, work( ie ), b, ldb,
 
  551     $                rcond, rank, work( nwork ), iwork, info )
 
  558         CALL sormbr( 
'P', 
'L', 
'N', m, nrhs, m, work( il ), ldwork,
 
  559     $                work( itaup ), b, ldb, work( nwork ),
 
  560     $                lwork-nwork+1, info )
 
  564         CALL slaset( 
'F', n-m, nrhs, zero, zero, b( m+1, 1 ), ldb )
 
  570         CALL sormlq( 
'L', 
'T', n, nrhs, m, a, lda, work( itau ), b,
 
  571     $                ldb, work( nwork ), lwork-nwork+1, info )
 
  585         CALL sgebrd( m, n, a, lda, s, work( ie ), work( itauq ),
 
  586     $                work( itaup ), work( nwork ), lwork-nwork+1,
 
  592         CALL sormbr( 
'Q', 
'L', 
'T', m, nrhs, n, a, lda,
 
  594     $                b, ldb, work( nwork ), lwork-nwork+1, info )
 
  598         CALL slalsd( 
'L', smlsiz, m, nrhs, s, work( ie ), b, ldb,
 
  599     $                rcond, rank, work( nwork ), iwork, info )
 
  606         CALL sormbr( 
'P', 
'L', 
'N', n, nrhs, m, a, lda,
 
  608     $                b, ldb, work( nwork ), lwork-nwork+1, info )
 
  614      IF( iascl.EQ.1 ) 
THEN 
  615         CALL slascl( 
'G', 0, 0, anrm, smlnum, n, nrhs, b, ldb,
 
  617         CALL slascl( 
'G', 0, 0, smlnum, anrm, minmn, 1, s, minmn,
 
  619      ELSE IF( iascl.EQ.2 ) 
THEN 
  620         CALL slascl( 
'G', 0, 0, anrm, bignum, n, nrhs, b, ldb,
 
  622         CALL slascl( 
'G', 0, 0, bignum, anrm, minmn, 1, s, minmn,
 
  625      IF( ibscl.EQ.1 ) 
THEN 
  626         CALL slascl( 
'G', 0, 0, smlnum, bnrm, n, nrhs, b, ldb,
 
  628      ELSE IF( ibscl.EQ.2 ) 
THEN 
  629         CALL slascl( 
'G', 0, 0, bignum, bnrm, n, nrhs, b, ldb,
 
  634      work( 1 ) = sroundup_lwork(maxwrk)