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, SMLNUM
183 EXTERNAL lsame, slamch, slange
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' )
217 bignum = one / smlnum
222 CALL slacpy(
'All', nrows, nrhs, b, ldb, c, ldb )
223 CALL sgemm( trans,
'No transpose', nrows, nrhs, ncols, -one, a,
224 $ lda, x, ldx, one, c, ldb )
225 normrs = slange(
'Max', nrows, nrhs, c, ldb, rwork )
226 IF( normrs.GT.smlnum )
THEN
228 CALL slascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
234 CALL sgemm(
'Transpose', trans, nrhs, ncols, nrows, one, c, ldb,
235 $ a, lda, zero, work, nrhs )
239 err = slange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
246 IF( iresid.EQ.1 )
THEN
247 normb = slange(
'One-norm', nrows, nrhs, b, ldb, rwork )
255 sqrt17 = err / ( slamch(
'Epsilon' )*
REAL( MAX( M, N, NRHS ) ) )
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
subroutine xerbla(SRNAME, INFO)
XERBLA
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.