150 REAL FUNCTION sqrt17( 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 REAL 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,
196 IF(
lsame( trans,
'N' ) )
THEN
199 ELSE IF(
lsame( trans,
'T' ) )
THEN
203 CALL
xerbla(
'SQRT17', 1 )
207 IF( lwork.LT.ncols*nrhs )
THEN
208 CALL
xerbla(
'SQRT17', 13 )
212 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.LE.0 )
THEN
216 norma =
slange(
'One-norm', m, n, a, lda, rwork )
217 smlnum =
slamch(
'Safe minimum' ) /
slamch(
'Precision' )
218 bignum = one / smlnum
223 CALL
slacpy(
'All', nrows, nrhs,
b, ldb, c, ldb )
224 CALL
sgemm( trans,
'No transpose', nrows, nrhs, ncols, -one, a,
225 $ lda,
x, ldx, one, c, ldb )
226 normrs =
slange(
'Max', nrows, nrhs, c, ldb, rwork )
227 IF( normrs.GT.smlnum )
THEN
229 CALL
slascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
235 CALL
sgemm(
'Transpose', trans, nrhs, ncols, nrows, one, c, ldb,
236 $ a, lda, zero, work, nrhs )
240 err =
slange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
247 IF( iresid.EQ.1 )
THEN
248 normb =
slange(
'One-norm', nrows, nrhs,
b, ldb, rwork )
252 normx =
slange(
'One-norm', ncols, nrhs,
x, ldx, rwork )
257 sqrt17 = err / (
slamch(
'Epsilon' )*
REAL( MAX( M, N, NRHS ) ) )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
REAL function sqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
SQRT17
REAL function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM