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 ) ) )
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 xerbla(SRNAME, INFO)
XERBLA
real function sqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
SQRT17
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
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.
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
real function slamch(CMACH)
SLAMCH