204 SUBROUTINE zgghrd( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
205 $ ldq, z, ldz, info )
213 CHARACTER compq, compz
214 INTEGER ihi, ilo, info, lda, ldb, ldq, ldz, n
217 COMPLEX*16 a( lda, * ),
b( ldb, * ), q( ldq, * ),
224 COMPLEX*16 cone, czero
225 parameter( cone = ( 1.0d+0, 0.0d+0 ),
226 $ czero = ( 0.0d+0, 0.0d+0 ) )
230 INTEGER icompq, icompz, jcol, jrow
242 INTRINSIC dconjg, max
248 IF(
lsame( compq,
'N' ) )
THEN
251 ELSE IF(
lsame( compq,
'V' ) )
THEN
254 ELSE IF(
lsame( compq,
'I' ) )
THEN
263 IF(
lsame( compz,
'N' ) )
THEN
266 ELSE IF(
lsame( compz,
'V' ) )
THEN
269 ELSE IF(
lsame( compz,
'I' ) )
THEN
279 IF( icompq.LE.0 )
THEN
281 ELSE IF( icompz.LE.0 )
THEN
283 ELSE IF( n.LT.0 )
THEN
285 ELSE IF( ilo.LT.1 )
THEN
287 ELSE IF( ihi.GT.n .OR. ihi.LT.ilo-1 )
THEN
289 ELSE IF( lda.LT.max( 1, n ) )
THEN
291 ELSE IF( ldb.LT.max( 1, n ) )
THEN
293 ELSE IF( ( ilq .AND. ldq.LT.n ) .OR. ldq.LT.1 )
THEN
295 ELSE IF( ( ilz .AND. ldz.LT.n ) .OR. ldz.LT.1 )
THEN
299 CALL
xerbla(
'ZGGHRD', -info )
306 $ CALL
zlaset(
'Full', n, n, czero, cone, q, ldq )
308 $ CALL
zlaset(
'Full', n, n, czero, cone, z, ldz )
317 DO 20 jcol = 1, n - 1
318 DO 10 jrow = jcol + 1, n
319 b( jrow, jcol ) = czero
325 DO 40 jcol = ilo, ihi - 2
327 DO 30 jrow = ihi, jcol + 2, -1
331 ctemp = a( jrow-1, jcol )
332 CALL
zlartg( ctemp, a( jrow, jcol ), c, s,
333 $ a( jrow-1, jcol ) )
334 a( jrow, jcol ) = czero
335 CALL
zrot( n-jcol, a( jrow-1, jcol+1 ), lda,
336 $ a( jrow, jcol+1 ), lda, c, s )
337 CALL
zrot( n+2-jrow,
b( jrow-1, jrow-1 ), ldb,
338 $
b( jrow, jrow-1 ), ldb, c, s )
340 $ CALL
zrot( n, q( 1, jrow-1 ), 1, q( 1, jrow ), 1, c,
345 ctemp =
b( jrow, jrow )
346 CALL
zlartg( ctemp,
b( jrow, jrow-1 ), c, s,
348 b( jrow, jrow-1 ) = czero
349 CALL
zrot( ihi, a( 1, jrow ), 1, a( 1, jrow-1 ), 1, c, s )
350 CALL
zrot( jrow-1,
b( 1, jrow ), 1,
b( 1, jrow-1 ), 1, c,
353 $ CALL
zrot( n, z( 1, jrow ), 1, z( 1, jrow-1 ), 1, c, s )
subroutine zlartg(F, G, CS, SN, R)
ZLARTG generates a plane rotation with real cosine and complex sine.
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
ZGGHRD
logical function lsame(CA, CB)
LSAME
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zrot(N, CX, INCX, CY, INCY, C, S)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...