106 INTEGER lda, lwork, m, n
109 DOUBLE PRECISION rwork( * ), s( * )
110 COMPLEX*16 a( lda, * ), work( lwork )
116 DOUBLE PRECISION zero, one
117 parameter ( zero = 0.0d0, one = 1.0d0 )
120 INTEGER i, info, iscl, j, mn
121 DOUBLE PRECISION anrm, bignum, nrmsvl, smlnum
124 DOUBLE PRECISION dummy( 1 )
135 INTRINSIC dble, dcmplx, max, min
143 IF( lwork.LT.m*n+2*min( m, n )+max( m, n ) )
THEN
144 CALL xerbla(
'ZQRT12', 7 )
154 nrmsvl =
dnrm2( mn, s, 1 )
158 CALL zlaset(
'Full', m, n, dcmplx( zero ), dcmplx( zero ), work,
161 DO 10 i = 1, min( j, m )
162 work( ( j-1 )*m+i ) = a( i, j )
169 bignum = one / smlnum
170 CALL dlabad( smlnum, bignum )
174 anrm =
zlange(
'M', m, n, work, m, dummy )
176 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
180 CALL zlascl(
'G', 0, 0, anrm, smlnum, m, n, work, m, info )
182 ELSE IF( anrm.GT.bignum )
THEN
186 CALL zlascl(
'G', 0, 0, anrm, bignum, m, n, work, m, info )
190 IF( anrm.NE.zero )
THEN
194 CALL zgebd2( m, n, work, m, rwork( 1 ), rwork( mn+1 ),
195 $ work( m*n+1 ), work( m*n+mn+1 ),
196 $ work( m*n+2*mn+1 ), info )
197 CALL dbdsqr(
'Upper', mn, 0, 0, 0, rwork( 1 ), rwork( mn+1 ),
198 $ dummy, mn, dummy, 1, dummy, mn, rwork( 2*mn+1 ),
202 IF( anrm.GT.bignum )
THEN
203 CALL dlascl(
'G', 0, 0, bignum, anrm, mn, 1, rwork( 1 ),
206 IF( anrm.LT.smlnum )
THEN
207 CALL dlascl(
'G', 0, 0, smlnum, anrm, mn, 1, rwork( 1 ),
221 CALL daxpy( mn, -one, s, 1, rwork( 1 ), 1 )
223 $ (
dlamch(
'Epsilon' )*dble( max( m, n ) ) )
double precision function dlamch(CMACH)
DLAMCH
double precision function zqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
ZQRT12
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dnrm2(N, X, INCX)
DNRM2
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
ZGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dlabad(SMALL, LARGE)
DLABAD
double precision function dasum(N, DX, INCX)
DASUM
subroutine dbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DBDSQR