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, normx,
179 DOUBLE PRECISION rwork( 1 )
190 INTRINSIC dble, dcmplx, max
196 IF(
lsame( trans,
'N' ) )
THEN
199 ELSE IF(
lsame( trans,
'C' ) )
THEN
203 CALL
xerbla(
'ZQRT17', 1 )
207 IF( lwork.LT.ncols*nrhs )
THEN
208 CALL
xerbla(
'ZQRT17', 13 )
212 IF( m.LE.0 .OR. n.LE.0 .OR. nrhs.LE.0 )
215 norma =
zlange(
'One-norm', m, n, a, lda, rwork )
216 smlnum =
dlamch(
'Safe minimum' ) /
dlamch(
'Precision' )
217 bignum = one / smlnum
222 CALL
zlacpy(
'All', nrows, nrhs,
b, ldb, c, ldb )
223 CALL
zgemm( trans,
'No transpose', nrows, nrhs, ncols,
224 $ dcmplx( -one ), a, lda,
x, ldx, dcmplx( one ), c,
226 normrs =
zlange(
'Max', nrows, nrhs, c, ldb, rwork )
227 IF( normrs.GT.smlnum )
THEN
229 CALL
zlascl(
'General', 0, 0, normrs, one, nrows, nrhs, c, ldb,
235 CALL
zgemm(
'Conjugate transpose', trans, nrhs, ncols, nrows,
236 $ dcmplx( one ), c, ldb, a, lda, dcmplx( zero ), work,
241 err =
zlange(
'One-norm', nrhs, ncols, work, nrhs, rwork )
248 IF( iresid.EQ.1 )
THEN
249 normb =
zlange(
'One-norm', nrows, nrhs,
b, ldb, rwork )
253 normx =
zlange(
'One-norm', ncols, nrhs,
x, ldx, rwork )
258 zqrt17 = err / (
dlamch(
'Epsilon' )*dble( max( m, n, nrhs ) ) )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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.
DOUBLE PRECISION function zqrt17(TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
ZQRT17
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH