150 DOUBLE PRECISION FUNCTION zqrt17( 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 COMPLEX*16 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, SMLNUM
178 DOUBLE PRECISION RWORK( 1 )
182 DOUBLE PRECISION DLAMCH, ZLANGE
183 EXTERNAL lsame, dlamch, zlange
189 INTRINSIC dble, dcmplx, max
195 IF( lsame( trans,
'N' ) )
THEN
198 ELSE IF( lsame( trans,
'C' ) )
THEN
202 CALL xerbla(
'ZQRT17', 1 )
206 IF( lwork.LT.ncols*nrhs )
THEN
207 CALL xerbla(
'ZQRT17', 13 )
211 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.LE.0 )
214 norma = zlange(
'One-norm', m, n, a, lda, rwork )
215 smlnum = dlamch(
'Safe minimum' ) / dlamch(
'Precision' )
216 bignum = one / smlnum
221 CALL zlacpy(
'All', nrows, nrhs, b, ldb, c, ldb )
222 CALL zgemm( trans,
'No transpose', nrows, nrhs, ncols,
223 $ dcmplx( -one ), a, lda, x, ldx, dcmplx( one ), c,
225 normrs = zlange(
'Max', nrows, nrhs, c, ldb, rwork )
226 IF( normrs.GT.smlnum )
THEN
228 CALL zlascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
234 CALL zgemm(
'Conjugate transpose', trans, nrhs, ncols, nrows,
235 $ dcmplx( one ), c, ldb, a, lda, dcmplx( zero ), work,
240 err = zlange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
247 IF( iresid.EQ.1 )
THEN
248 normb = zlange(
'One-norm', nrows, nrhs, b, ldb, rwork )
256 zqrt17 = err / ( dlamch(
'Epsilon' )*dble( max( m, n, nrhs ) ) )
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
double precision function zqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
ZQRT17