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
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 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 slamch(CMACH)
SLAMCH
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 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 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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slabad(SMALL, LARGE)
SLABAD
REAL function sasum(N, SX, INCX)
SASUM
REAL function cqrt12(M, N, A, LDA, S, WORK, LWORK, RWORK)
CQRT12
REAL function snrm2(N, X, INCX)
SNRM2