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
247 DOUBLE PRECISION DLAMCH, ZLANGE
248 EXTERNAL izamax, dlamch, zlange
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 )
298 eps = dlamch(
'Epsilon' )
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 zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zlag2c(M, N, A, LDA, SA, LDSA, INFO)
ZLAG2C converts a complex double precision matrix to a complex single precision matrix.
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.
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine clag2z(M, N, SA, LDSA, A, LDA, INFO)
CLAG2Z converts a complex single precision matrix to a complex double precision matrix.
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine xerbla(SRNAME, INFO)
XERBLA
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