209 SUBROUTINE zcposv( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK,
210 $ swork, rwork, iter, info )
219 INTEGER info, iter, lda, ldb, ldx, n, nrhs
222 DOUBLE PRECISION rwork( * )
224 COMPLEX*16 a( lda, * ),
b( ldb, * ), work( n, * ),
232 parameter( doitref = .true. )
235 parameter( itermax = 30 )
237 DOUBLE PRECISION bwdmax
238 parameter( bwdmax = 1.0e+00 )
240 COMPLEX*16 negone, one
241 parameter( negone = ( -1.0d+00, 0.0d+00 ),
242 $ one = ( 1.0d+00, 0.0d+00 ) )
245 INTEGER i, iiter, ptsa, ptsx
246 DOUBLE PRECISION anrm, cte, eps, rnrm, xnrm
260 INTRINSIC abs, dble, max, sqrt
262 DOUBLE PRECISION cabs1
265 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
274 IF( .NOT.
lsame( uplo,
'U' ) .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
276 ELSE IF( n.LT.0 )
THEN
278 ELSE IF( nrhs.LT.0 )
THEN
280 ELSE IF( lda.LT.max( 1, n ) )
THEN
282 ELSE IF( ldb.LT.max( 1, n ) )
THEN
284 ELSE IF( ldx.LT.max( 1, n ) )
THEN
288 CALL
xerbla(
'ZCPOSV', -info )
300 IF( .NOT.doitref )
THEN
307 anrm =
zlanhe(
'I', uplo, n, a, lda, rwork )
309 cte = anrm*eps*sqrt( dble( n ) )*bwdmax
319 CALL
zlag2c( n, nrhs,
b, ldb, swork( ptsx ), n, info )
329 CALL
zlat2c( uplo, n, a, lda, swork( ptsa ), n, info )
338 CALL
cpotrf( uplo, n, swork( ptsa ), n, info )
347 CALL
cpotrs( uplo, n, nrhs, swork( ptsa ), n, swork( ptsx ), n,
352 CALL
clag2z( n, nrhs, swork( ptsx ), n, x, ldx, info )
356 CALL
zlacpy(
'All', n, nrhs,
b, ldb, work, n )
358 CALL
zhemm(
'Left', uplo, n, nrhs, negone, a, lda, x, ldx, one,
365 xnrm = cabs1( x(
izamax( n, x( 1, i ), 1 ), i ) )
366 rnrm = cabs1( work(
izamax( n, work( 1, i ), 1 ), i ) )
367 IF( rnrm.GT.xnrm*cte )
379 DO 30 iiter = 1, itermax
384 CALL
zlag2c( n, nrhs, work, n, swork( ptsx ), n, info )
393 CALL
cpotrs( uplo, n, nrhs, swork( ptsa ), n, swork( ptsx ), n,
399 CALL
clag2z( n, nrhs, swork( ptsx ), n, work, n, info )
402 CALL
zaxpy( n, one, work( 1, i ), 1, x( 1, i ), 1 )
407 CALL
zlacpy(
'All', n, nrhs,
b, ldb, work, n )
409 CALL
zhemm(
'L', uplo, n, nrhs, negone, a, lda, x, ldx, one,
416 xnrm = cabs1( x(
izamax( n, x( 1, i ), 1 ), i ) )
417 rnrm = cabs1( work(
izamax( n, work( 1, i ), 1 ), i ) )
418 IF( rnrm.GT.xnrm*cte )
445 CALL
zpotrf( uplo, n, a, lda, info )
450 CALL
zlacpy(
'All', n, nrhs,
b, ldb, x, ldx )
451 CALL
zpotrs( uplo, n, nrhs, a, lda, x, ldx, info )
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
integer function izamax(N, ZX, INCX)
IZAMAX
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zlat2c(UPLO, N, A, LDA, SA, LDSA, INFO)
ZLAT2C converts a double complex triangular matrix to a complex triangular matrix.
subroutine zcposv(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, SWORK, RWORK, ITER, INFO)
ZCPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
double precision function dlamch(CMACH)
DLAMCH
subroutine zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHEMM
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
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 cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS