114 SUBROUTINE zhpgst( ITYPE, UPLO, N, AP, BP, INFO )
123 INTEGER info, itype, n
126 COMPLEX*16 ap( * ), bp( * )
132 DOUBLE PRECISION one, half
133 parameter( one = 1.0d+0, half = 0.5d+0 )
135 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
139 INTEGER j, j1, j1j1, jj, k, k1, k1k1, kk
140 DOUBLE PRECISION ajj, akk, bjj, bkk
160 upper =
lsame( uplo,
'U' )
161 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
163 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
165 ELSE IF( n.LT.0 )
THEN
169 CALL
xerbla(
'ZHPGST', -info )
173 IF( itype.EQ.1 )
THEN
187 ap( jj ) = dble( ap( jj ) )
189 CALL
ztpsv( uplo,
'Conjugate transpose',
'Non-unit',
j,
191 CALL
zhpmv( uplo,
j-1, -cone, ap, bp( j1 ), 1, cone,
193 CALL
zdscal(
j-1, one / bjj, ap( j1 ), 1 )
194 ap( jj ) = ( ap( jj )-
zdotc(
j-1, ap( j1 ), 1, bp( j1 ),
205 k1k1 = kk + n - k + 1
214 CALL
zdscal( n-k, one / bkk, ap( kk+1 ), 1 )
216 CALL
zaxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
217 CALL
zhpr2( uplo, n-k, -cone, ap( kk+1 ), 1,
218 $ bp( kk+1 ), 1, ap( k1k1 ) )
219 CALL
zaxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
220 CALL
ztpsv( uplo,
'No transpose',
'Non-unit', n-k,
221 $ bp( k1k1 ), ap( kk+1 ), 1 )
242 CALL
ztpmv( uplo,
'No transpose',
'Non-unit', k-1, bp,
245 CALL
zaxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
246 CALL
zhpr2( uplo, k-1, cone, ap( k1 ), 1, bp( k1 ), 1,
248 CALL
zaxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
249 CALL
zdscal( k-1, bkk, ap( k1 ), 1 )
250 ap( kk ) = akk*bkk**2
260 j1j1 = jj + n -
j + 1
266 ap( jj ) = ajj*bjj +
zdotc( n-
j, ap( jj+1 ), 1,
268 CALL
zdscal( n-
j, bjj, ap( jj+1 ), 1 )
269 CALL
zhpmv( uplo, n-
j, cone, ap( j1j1 ), bp( jj+1 ), 1,
270 $ cone, ap( jj+1 ), 1 )
271 CALL
ztpmv( uplo,
'Conjugate transpose',
'Non-unit',
272 $ n-
j+1, bp( jj ), ap( jj ), 1 )
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine ztpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
ZTPMV
complex *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine ztpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
ZTPSV
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zhpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
ZHPR2
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zhpgst(ITYPE, UPLO, N, AP, BP, INFO)
ZHPGST
subroutine zhpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
ZHPMV