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