97 DOUBLE PRECISION FUNCTION zqrt12( M, N, A, LDA, S, WORK, LWORK,
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 zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine xerbla(SRNAME, INFO)
XERBLA
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 dlabad(SMALL, LARGE)
DLABAD
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 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 zgebd2(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO)
ZGEBD2 reduces a general matrix to bidiagonal form using an unblocked algorithm.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
DOUBLE PRECISION function dnrm2(N, X, INCX)
DNRM2
DOUBLE PRECISION function zqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
ZQRT12
subroutine dbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DBDSQR
DOUBLE PRECISION function dasum(N, DX, INCX)
DASUM