201 SUBROUTINE zcgesv( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK,
202 $ swork, rwork, iter, info )
210 INTEGER info, iter, lda, ldb, ldx, n, nrhs
214 DOUBLE PRECISION rwork( * )
216 COMPLEX*16 a( lda, * ),
b( ldb, * ), work( n, * ),
224 parameter( doitref = .true. )
227 parameter( itermax = 30 )
229 DOUBLE PRECISION bwdmax
230 parameter( bwdmax = 1.0e+00 )
232 COMPLEX*16 negone, one
233 parameter( negone = ( -1.0d+00, 0.0d+00 ),
234 $ one = ( 1.0d+00, 0.0d+00 ) )
237 INTEGER i, iiter, ptsa, ptsx
238 DOUBLE PRECISION anrm, cte, eps, rnrm, xnrm
251 INTRINSIC abs, dble, max, sqrt
254 DOUBLE PRECISION cabs1
257 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
268 ELSE IF( nrhs.LT.0 )
THEN
270 ELSE IF( lda.LT.max( 1, n ) )
THEN
272 ELSE IF( ldb.LT.max( 1, n ) )
THEN
274 ELSE IF( ldx.LT.max( 1, n ) )
THEN
278 CALL
xerbla(
'ZCGESV', -info )
290 IF( .NOT.doitref )
THEN
297 anrm =
zlange(
'I', n, n, a, lda, rwork )
299 cte = anrm*eps*sqrt( dble( n ) )*bwdmax
309 CALL
zlag2c( n, nrhs,
b, ldb, swork( ptsx ), n, info )
319 CALL
zlag2c( n, n, a, lda, swork( ptsa ), n, info )
328 CALL
cgetrf( n, n, swork( ptsa ), n, ipiv, info )
337 CALL
cgetrs(
'No transpose', n, nrhs, swork( ptsa ), n, ipiv,
338 $ swork( ptsx ), n, info )
342 CALL
clag2z( n, nrhs, swork( ptsx ), n,
x, ldx, info )
346 CALL
zlacpy(
'All', n, nrhs,
b, ldb, work, n )
348 CALL
zgemm(
'No Transpose',
'No Transpose', n, nrhs, n, negone, a,
349 $ lda,
x, ldx, one, work, n )
355 xnrm = cabs1(
x(
izamax( n,
x( 1, i ), 1 ), i ) )
356 rnrm = cabs1( work(
izamax( n, work( 1, i ), 1 ), i ) )
357 IF( rnrm.GT.xnrm*cte )
369 DO 30 iiter = 1, itermax
374 CALL
zlag2c( n, nrhs, work, n, swork( ptsx ), n, info )
383 CALL
cgetrs(
'No transpose', n, nrhs, swork( ptsa ), n, ipiv,
384 $ swork( ptsx ), n, info )
389 CALL
clag2z( n, nrhs, swork( ptsx ), n, work, n, info )
392 CALL
zaxpy( n, one, work( 1, i ), 1,
x( 1, i ), 1 )
397 CALL
zlacpy(
'All', n, nrhs,
b, ldb, work, n )
399 CALL
zgemm(
'No Transpose',
'No Transpose', n, nrhs, n, negone,
400 $ a, lda,
x, ldx, one, work, n )
406 xnrm = cabs1(
x(
izamax( n,
x( 1, i ), 1 ), i ) )
407 rnrm = cabs1( work(
izamax( n, work( 1, i ), 1 ), i ) )
408 IF( rnrm.GT.xnrm*cte )
435 CALL
zgetrf( n, n, a, lda, ipiv, info )
440 CALL
zlacpy(
'All', n, nrhs,
b, ldb,
x, ldx )
441 CALL
zgetrs(
'No transpose', n, nrhs, a, lda, ipiv,
x, ldx,
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
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 cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
subroutine zcgesv(N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, SWORK, RWORK, ITER, INFO)
ZCGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precisio...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine clag2z(M, N, SA, LDSA, A, LDA, INFO)
CLAG2Z converts a complex single precision matrix to a complex double precision matrix.
subroutine zlag2c(M, N, A, LDA, SA, LDSA, INFO)
ZLAG2C converts a complex double precision matrix to a complex single precision matrix.
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
INTEGER function izamax(N, ZX, INCX)
IZAMAX