136 SUBROUTINE zpst01( UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM,
137 $ piv, rwork, resid, rank )
145 DOUBLE PRECISION resid
146 INTEGER lda, ldafac, ldperm, n, rank
150 COMPLEX*16 a( lda, * ), afac( ldafac, * ),
152 DOUBLE PRECISION rwork( * )
159 DOUBLE PRECISION zero, one
160 parameter( zero = 0.0d+0, one = 1.0d+0 )
162 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
166 DOUBLE PRECISION anorm, eps, tr
179 INTRINSIC dble, dconjg, dimag
193 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
194 IF( anorm.LE.zero )
THEN
203 IF( dimag( afac(
j,
j ) ).NE.zero )
THEN
211 IF(
lsame( uplo,
'U' ) )
THEN
214 DO 120
j = rank + 1, n
215 DO 110 i = rank + 1,
j
225 tr =
zdotc( k, afac( 1, k ), 1, afac( 1, k ), 1 )
230 CALL
ztrmv(
'Upper',
'Conjugate',
'Non-unit', k-1, afac,
231 $ ldafac, afac( 1, k ), 1 )
240 DO 150
j = rank + 1, n
252 $ CALL
zher(
'Lower', n-k, one, afac( k+1, k ), 1,
253 $ afac( k+1, k+1 ), ldafac )
258 CALL
zscal( n-k+1, tc, afac( k, k ), 1 )
265 IF(
lsame( uplo,
'U' ) )
THEN
269 IF( piv( i ).LE.piv(
j ) )
THEN
271 perm( piv( i ), piv(
j ) ) = afac( i,
j )
273 perm( piv( i ), piv(
j ) ) = dconjg( afac(
j, i ) )
284 IF( piv( i ).GE.piv(
j ) )
THEN
286 perm( piv( i ), piv(
j ) ) = afac( i,
j )
288 perm( piv( i ), piv(
j ) ) = dconjg( afac(
j, i ) )
298 IF(
lsame( uplo,
'U' ) )
THEN
301 perm( i,
j ) = perm( i,
j ) - a( i,
j )
303 perm(
j,
j ) = perm(
j,
j ) - dble( a(
j,
j ) )
307 perm(
j,
j ) = perm(
j,
j ) - dble( a(
j,
j ) )
309 perm( i,
j ) = perm( i,
j ) - a( i,
j )
317 resid =
zlanhe(
'1', uplo, n, perm, ldafac, rwork )
319 resid = ( ( resid / dble( n ) ) / anorm ) / eps
LOGICAL function lsame(CA, CB)
LSAME
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zpst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
ZPST01
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zher(UPLO, N, ALPHA, X, INCX, A, LDA)
ZHER
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL