150 REAL FUNCTION cqrt17( TRANS, IRESID, M, N, NRHS, A,
151 $ lda, x, ldx,
b, ldb, c, work, lwork )
160 INTEGER iresid, lda, ldb, ldx, lwork, m, n, nrhs
163 COMPLEX a( lda, * ),
b( ldb, * ), c( ldb, * ),
164 $ work( lwork ), x( ldx, * )
171 parameter( zero = 0.0e0, one = 1.0e0 )
174 INTEGER info, iscl, ncols, nrows
175 REAL bignum, err, norma, normb, normrs, normx,
190 INTRINSIC cmplx, max, real
196 IF(
lsame( trans,
'N' ) )
THEN
199 ELSE IF(
lsame( trans,
'C' ) )
THEN
203 CALL
xerbla(
'CQRT17', 1 )
207 IF( lwork.LT.ncols*nrhs )
THEN
208 CALL
xerbla(
'CQRT17', 13 )
212 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.LE.0 )
215 norma =
clange(
'One-norm', m, n, a, lda, rwork )
216 smlnum =
slamch(
'Safe minimum' ) /
slamch(
'Precision' )
217 bignum = one / smlnum
222 CALL
clacpy(
'All', nrows, nrhs,
b, ldb, c, ldb )
223 CALL
cgemm( trans,
'No transpose', nrows, nrhs, ncols,
224 $ cmplx( -one ), a, lda, x, ldx, cmplx( one ), c, ldb )
225 normrs =
clange(
'Max', nrows, nrhs, c, ldb, rwork )
226 IF( normrs.GT.smlnum )
THEN
228 CALL
clascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
234 CALL
cgemm(
'Conjugate transpose', trans, nrhs, ncols, nrows,
235 $ cmplx( one ), c, ldb, a, lda, cmplx( zero ), work,
240 err =
clange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
247 IF( iresid.EQ.1 )
THEN
248 normb =
clange(
'One-norm', nrows, nrhs,
b, ldb, rwork )
252 normx =
clange(
'One-norm', ncols, nrhs, x, ldx, rwork )
257 cqrt17 = err / (
slamch(
'Epsilon' )*
REAL( MAX( M, N, NRHS ) ) )
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 xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
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 cqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
CQRT17
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM