150 DOUBLE PRECISION FUNCTION dqrt17( 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 DOUBLE PRECISION a( lda, * ),
b( ldb, * ), c( ldb, * ),
164 $ work( lwork ),
x( ldx, * )
170 DOUBLE PRECISION zero, one
171 parameter( zero = 0.0d0, one = 1.0d0 )
174 INTEGER info, iscl, ncols, nrows
175 DOUBLE PRECISION bignum, err, norma, normb, normrs, normx,
179 DOUBLE PRECISION rwork( 1 )
196 IF(
lsame( trans,
'N' ) )
THEN
199 ELSE IF(
lsame( trans,
'T' ) )
THEN
203 CALL
xerbla(
'DQRT17', 1 )
207 IF( lwork.LT.ncols*nrhs )
THEN
208 CALL
xerbla(
'DQRT17', 13 )
212 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.LE.0 )
THEN
216 norma =
dlange(
'One-norm', m, n, a, lda, rwork )
217 smlnum =
dlamch(
'Safe minimum' ) /
dlamch(
'Precision' )
218 bignum = one / smlnum
223 CALL
dlacpy(
'All', nrows, nrhs,
b, ldb, c, ldb )
224 CALL
dgemm( trans,
'No transpose', nrows, nrhs, ncols, -one, a,
225 $ lda,
x, ldx, one, c, ldb )
226 normrs =
dlange(
'Max', nrows, nrhs, c, ldb, rwork )
227 IF( normrs.GT.smlnum )
THEN
229 CALL
dlascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
235 CALL
dgemm(
'Transpose', trans, nrhs, ncols, nrows, one, c, ldb,
236 $ a, lda, zero, work, nrhs )
240 err =
dlange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
247 IF( iresid.EQ.1 )
THEN
248 normb =
dlange(
'One-norm', nrows, nrhs,
b, ldb, rwork )
252 normx =
dlange(
'One-norm', ncols, nrhs,
x, ldx, rwork )
257 dqrt17 = err / (
dlamch(
'Epsilon' )*dble( max( m, n, nrhs ) ) )
LOGICAL function lsame(CA, CB)
LSAME
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
DOUBLE PRECISION function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
DQRT17
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH