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
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 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...