97 REAL FUNCTION cqrt12( M, N, A, LDA, S, WORK, LWORK,
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
127 REAL CLANGE, SASUM, SLAMCH, SNRM2
128 EXTERNAL clange, sasum, slamch, snrm2
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 )
167 smlnum = slamch(
'S' ) / slamch(
'P' )
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 )
221 cqrt12 = sasum( mn, 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.
subroutine sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine xerbla(SRNAME, INFO)
XERBLA
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
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.