114 SUBROUTINE chpgst( ITYPE, UPLO, N, AP, BP, INFO )
123 INTEGER INFO, ITYPE, N
126 COMPLEX AP( * ), BP( * )
133 parameter( one = 1.0e+0, half = 0.5e+0 )
135 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
139 INTEGER J, J1, J1J1, JJ, K, K1, K1K1, KK
140 REAL AJJ, AKK, BJJ, BKK
153 EXTERNAL lsame, cdotc
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(
'CHPGST', -info )
173 IF( itype.EQ.1 )
THEN
187 ap( jj ) =
REAL( AP( JJ ) )
189 CALL
ctpsv( uplo,
'Conjugate transpose',
'Non-unit', j,
191 CALL
chpmv( uplo, j-1, -cone, ap, bp( j1 ), 1, cone,
193 CALL
csscal( j-1, one / bjj, ap( j1 ), 1 )
194 ap( jj ) = ( ap( jj )-cdotc( j-1, ap( j1 ), 1, bp( j1 ),
205 k1k1 = kk + n - k + 1
214 CALL
csscal( n-k, one / bkk, ap( kk+1 ), 1 )
216 CALL
caxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
217 CALL
chpr2( uplo, n-k, -cone, ap( kk+1 ), 1,
218 $ bp( kk+1 ), 1, ap( k1k1 ) )
219 CALL
caxpy( n-k, ct, bp( kk+1 ), 1, ap( kk+1 ), 1 )
220 CALL
ctpsv( uplo,
'No transpose',
'Non-unit', n-k,
221 $ bp( k1k1 ), ap( kk+1 ), 1 )
242 CALL
ctpmv( uplo,
'No transpose',
'Non-unit', k-1, bp,
245 CALL
caxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
246 CALL
chpr2( uplo, k-1, cone, ap( k1 ), 1, bp( k1 ), 1,
248 CALL
caxpy( k-1, ct, bp( k1 ), 1, ap( k1 ), 1 )
249 CALL
csscal( k-1, bkk, ap( k1 ), 1 )
250 ap( kk ) = akk*bkk**2
260 j1j1 = jj + n - j + 1
266 ap( jj ) = ajj*bjj + cdotc( n-j, ap( jj+1 ), 1,
268 CALL
csscal( n-j, bjj, ap( jj+1 ), 1 )
269 CALL
chpmv( uplo, n-j, cone, ap( j1j1 ), bp( jj+1 ), 1,
270 $ cone, ap( jj+1 ), 1 )
271 CALL
ctpmv( uplo,
'Conjugate transpose',
'Non-unit',
272 $ n-j+1, bp( jj ), ap( jj ), 1 )
subroutine ctpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
CTPMV
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
CHPR2
subroutine chpgst(ITYPE, UPLO, N, AP, BP, INFO)
CHPGST
subroutine ctpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
CTPSV
subroutine chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CHPMV
subroutine csscal(N, SA, CX, INCX)
CSSCAL