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 )
183 DOUBLE PRECISION DLAMCH, DLANGE
184 EXTERNAL lsame, dlamch, dlange
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 ) ) )
double precision function dqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
DQRT17
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.
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.