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 zgghrd(COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, LDQ, Z, LDZ, INFO)
ZGGHRD
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 xerbla(SRNAME, INFO)
XERBLA
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...
subroutine zlartg(F, G, CS, SN, R)
ZLARTG generates a plane rotation with real cosine and complex sine.