151 REAL function
sqrt17( trans, iresid, m, n, nrhs, a,
152 $ 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 err, norma, normb, normrs, smlnum
195 IF(
lsame( trans,
'N' ) )
THEN
198 ELSE IF(
lsame( trans,
'T' ) )
THEN
202 CALL xerbla(
'SQRT17', 1 )
206 IF( lwork.LT.ncols*nrhs )
THEN
207 CALL xerbla(
'SQRT17', 13 )
211 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.LE.0 )
THEN
215 norma =
slange(
'One-norm', m, n, a, lda, rwork )
216 smlnum =
slamch(
'Safe minimum' ) /
slamch(
'Precision' )
221 CALL slacpy(
'All', nrows, nrhs, b, ldb, c, ldb )
222 CALL sgemm( trans,
'No transpose', nrows, nrhs, ncols, -one, a,
223 $ lda, x, ldx, one, c, ldb )
224 normrs =
slange(
'Max', nrows, nrhs, c, ldb, rwork )
225 IF( normrs.GT.smlnum )
THEN
227 CALL slascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
233 CALL sgemm(
'Transpose', trans, nrhs, ncols, nrows, one, c, ldb,
234 $ a, lda, zero, work, nrhs )
238 err =
slange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
245 IF( iresid.EQ.1 )
THEN
246 normb =
slange(
'One-norm', nrows, nrhs, b, ldb, rwork )
254 sqrt17 = err / (
slamch(
'Epsilon' )*real( max( m, n, nrhs ) ) )
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 xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
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
real function sqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
SQRT17
real function slamch(CMACH)
SLAMCH