136 SUBROUTINE cpst01( UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM,
137 $ piv, rwork, resid, rank )
146 INTEGER lda, ldafac, ldperm, n, rank
150 COMPLEX a( lda, * ), afac( ldafac, * ),
160 parameter( zero = 0.0e+0, one = 1.0e+0 )
162 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
179 INTRINSIC aimag, conjg, real
193 anorm =
clanhe(
'1', uplo, n, a, lda, rwork )
194 IF( anorm.LE.zero )
THEN
203 IF( aimag( 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 =
cdotc( k, afac( 1, k ), 1, afac( 1, k ), 1 )
230 CALL
ctrmv(
'Upper',
'Conjugate',
'Non-unit', k-1, afac,
231 $ ldafac, afac( 1, k ), 1 )
240 DO 150
j = rank + 1, n
252 $ CALL
cher(
'Lower', n-k, one, afac( k+1, k ), 1,
253 $ afac( k+1, k+1 ), ldafac )
258 CALL
cscal( 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 ) ) = conjg( 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 ) ) = conjg( 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 ) -
REAL( A( J, J ) )
307 perm(
j,
j ) = perm(
j,
j ) -
REAL( A( J, J ) )
309 perm( i,
j ) = perm( i,
j ) - a( i,
j )
317 resid =
clanhe(
'1', uplo, n, perm, ldafac, rwork )
319 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE 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 cscal(N, CA, CX, INCX)
CSCAL
complex function cdotc(N, CX, INCX, CY, INCY)
CDOTC
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
CHER
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine cpst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
CPST01
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV