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...
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 cgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
CGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
real function sasum(N, SX, INCX)
SASUM
real function cqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
CQRT12
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
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.
real function slamch(CMACH)
SLAMCH
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 snrm2(N, X, INCX)
SNRM2
subroutine slabad(SMALL, LARGE)
SLABAD