98 INTEGER lda, lwork, m, n
101 REAL a( lda, * ), s( * ), work( lwork )
108 parameter ( zero = 0.0e0, one = 1.0e0 )
111 INTEGER i, info, iscl, j, mn
112 REAL anrm, bignum, nrmsvl, smlnum
123 INTRINSIC max, min, real
134 IF( lwork.LT.max( m*n+4*min( m, n )+max( m, n ),
135 $ m*n+2*min( m, n )+4*n) )
THEN
136 CALL xerbla(
'SQRT12', 7 )
146 nrmsvl =
snrm2( mn, s, 1 )
150 CALL slaset(
'Full', m, n, zero, zero, work, m )
152 DO 10 i = 1, min( j, m )
153 work( ( j-1 )*m+i ) = a( i, j )
160 bignum = one / smlnum
161 CALL slabad( smlnum, bignum )
165 anrm =
slange(
'M', m, n, work, m, dummy )
167 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
171 CALL slascl(
'G', 0, 0, anrm, smlnum, m, n, work, m, info )
173 ELSE IF( anrm.GT.bignum )
THEN
177 CALL slascl(
'G', 0, 0, anrm, bignum, m, n, work, m, info )
181 IF( anrm.NE.zero )
THEN
185 CALL sgebd2( m, n, work, m, work( m*n+1 ), work( m*n+mn+1 ),
186 $ work( m*n+2*mn+1 ), work( m*n+3*mn+1 ),
187 $ work( m*n+4*mn+1 ), info )
188 CALL sbdsqr(
'Upper', mn, 0, 0, 0, work( m*n+1 ),
189 $ work( m*n+mn+1 ), dummy, mn, dummy, 1, dummy, mn,
190 $ work( m*n+2*mn+1 ), info )
193 IF( anrm.GT.bignum )
THEN
194 CALL slascl(
'G', 0, 0, bignum, anrm, mn, 1,
195 $ work( m*n+1 ), mn, info )
197 IF( anrm.LT.smlnum )
THEN
198 CALL slascl(
'G', 0, 0, smlnum, anrm, mn, 1,
199 $ work( m*n+1 ), mn, info )
212 CALL saxpy( mn, -one, s, 1, work( m*n+1 ), 1 )
214 $ (
slamch(
'Epsilon' )*
REAL( MAX( M, N ) ) )
real function sqrt12(M, N, A, LDA, S, WORK, LWORK)
SQRT12
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine sgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
SGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
real function snrm2(N, X, INCX)
SNRM2
real function sasum(N, SX, INCX)
SASUM
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
real function slamch(CMACH)
SLAMCH