106 INTEGER lda, lwork, m, n
109 REAL rwork( * ), s( * )
110 COMPLEX a( lda, * ), work( lwork )
117 parameter ( zero = 0.0e0, one = 1.0e0 )
120 INTEGER i, info, iscl, j, mn
121 REAL anrm, bignum, nrmsvl, smlnum
135 INTRINSIC cmplx, max, min, real
143 IF( lwork.LT.m*n+2*min( m, n )+max( m, n ) )
THEN
144 CALL xerbla(
'CQRT12', 7 )
154 nrmsvl =
snrm2( mn, s, 1 )
158 CALL claset(
'Full', m, n, cmplx( zero ), cmplx( zero ), work, m )
160 DO 10 i = 1, min( j, m )
161 work( ( j-1 )*m+i ) = a( i, j )
168 bignum = one / smlnum
169 CALL slabad( smlnum, bignum )
173 anrm =
clange(
'M', m, n, work, m, dummy )
175 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
179 CALL clascl(
'G', 0, 0, anrm, smlnum, m, n, work, m, info )
181 ELSE IF( anrm.GT.bignum )
THEN
185 CALL clascl(
'G', 0, 0, anrm, bignum, m, n, work, m, info )
189 IF( anrm.NE.zero )
THEN
193 CALL cgebd2( m, n, work, m, rwork( 1 ), rwork( mn+1 ),
194 $ work( m*n+1 ), work( m*n+mn+1 ),
195 $ work( m*n+2*mn+1 ), info )
196 CALL sbdsqr(
'Upper', mn, 0, 0, 0, rwork( 1 ), rwork( mn+1 ),
197 $ dummy, mn, dummy, 1, dummy, mn, rwork( 2*mn+1 ),
201 IF( anrm.GT.bignum )
THEN
202 CALL slascl(
'G', 0, 0, bignum, anrm, mn, 1, rwork( 1 ),
205 IF( anrm.LT.smlnum )
THEN
206 CALL slascl(
'G', 0, 0, smlnum, anrm, mn, 1, rwork( 1 ),
220 CALL saxpy( mn, -one, s, 1, rwork( 1 ), 1 )
222 $ (
slamch(
'Epsilon' )*
REAL( MAX( M, N ) ) )
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
real function snrm2(N, X, INCX)
SNRM2
subroutine xerbla(SRNAME, INFO)
XERBLA
real function sasum(N, SX, INCX)
SASUM
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 saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
real function slamch(CMACH)
SLAMCH
subroutine slabad(SMALL, LARGE)
SLABAD
real function cqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
CQRT12
subroutine cgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
CGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.