SUBROUTINE CGGHRD( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, INFO ) * * -- LAPACK routine (version 3.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2006 * * .. Scalar Arguments .. CHARACTER COMPQ, COMPZ INTEGER IHI, ILO, INFO, LDA, LDB, LDQ, LDZ, N * .. * .. Array Arguments .. COMPLEX A( LDA, * ), B( LDB, * ), Q( LDQ, * ), $ Z( LDZ, * ) * .. * * Purpose * ======= * * CGGHRD reduces a pair of complex matrices (A,B) to generalized upper * Hessenberg form using unitary transformations, where A is a * general matrix and B is upper triangular. The form of the generalized * eigenvalue problem is * A*x = lambda*B*x, * and B is typically made upper triangular by computing its QR * factorization and moving the unitary matrix Q to the left side * of the equation. * * This subroutine simultaneously reduces A to a Hessenberg matrix H: * Q**H*A*Z = H * and transforms B to another upper triangular matrix T: * Q**H*B*Z = T * in order to reduce the problem to its standard form * H*y = lambda*T*y * where y = Z**H*x. * * The unitary matrices Q and Z are determined as products of Givens * rotations. They may either be formed explicitly, or they may be * postmultiplied into input matrices Q1 and Z1, so that * Q1 * A * Z1**H = (Q1*Q) * H * (Z1*Z)**H * Q1 * B * Z1**H = (Q1*Q) * T * (Z1*Z)**H * If Q1 is the unitary matrix from the QR factorization of B in the * original equation A*x = lambda*B*x, then CGGHRD reduces the original * problem to generalized Hessenberg form. * * Arguments * ========= * * COMPQ (input) CHARACTER*1 * = 'N': do not compute Q; * = 'I': Q is initialized to the unit matrix, and the * unitary matrix Q is returned; * = 'V': Q must contain a unitary matrix Q1 on entry, * and the product Q1*Q is returned. * * COMPZ (input) CHARACTER*1 * = 'N': do not compute Q; * = 'I': Q is initialized to the unit matrix, and the * unitary matrix Q is returned; * = 'V': Q must contain a unitary matrix Q1 on entry, * and the product Q1*Q is returned. * * N (input) INTEGER * The order of the matrices A and B. N >= 0. * * ILO (input) INTEGER * IHI (input) INTEGER * ILO and IHI mark the rows and columns of A which are to be * reduced. It is assumed that A is already upper triangular * in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are * normally set by a previous call to CGGBAL; otherwise they * should be set to 1 and N respectively. * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. * * A (input/output) COMPLEX array, dimension (LDA, N) * On entry, the N-by-N general matrix to be reduced. * On exit, the upper triangle and the first subdiagonal of A * are overwritten with the upper Hessenberg matrix H, and the * rest is set to zero. * * LDA (input) INTEGER * The leading dimension of the array A. LDA >= max(1,N). * * B (input/output) COMPLEX array, dimension (LDB, N) * On entry, the N-by-N upper triangular matrix B. * On exit, the upper triangular matrix T = Q**H B Z. The * elements below the diagonal are set to zero. * * LDB (input) INTEGER * The leading dimension of the array B. LDB >= max(1,N). * * Q (input/output) COMPLEX array, dimension (LDQ, N) * On entry, if COMPQ = 'V', the unitary matrix Q1, typically * from the QR factorization of B. * On exit, if COMPQ='I', the unitary matrix Q, and if * COMPQ = 'V', the product Q1*Q. * Not referenced if COMPQ='N'. * * LDQ (input) INTEGER * The leading dimension of the array Q. * LDQ >= N if COMPQ='V' or 'I'; LDQ >= 1 otherwise. * * Z (input/output) COMPLEX array, dimension (LDZ, N) * On entry, if COMPZ = 'V', the unitary matrix Z1. * On exit, if COMPZ='I', the unitary matrix Z, and if * COMPZ = 'V', the product Z1*Z. * Not referenced if COMPZ='N'. * * LDZ (input) INTEGER * The leading dimension of the array Z. * LDZ >= N if COMPZ='V' or 'I'; LDZ >= 1 otherwise. * * INFO (output) INTEGER * = 0: successful exit. * < 0: if INFO = -i, the i-th argument had an illegal value. * * Further Details * =============== * * This routine reduces A to Hessenberg and B to triangular form by * an unblocked reduction, as described in _Matrix_Computations_, * by Golub and van Loan (Johns Hopkins Press). * * ===================================================================== * * .. Parameters .. COMPLEX CONE, CZERO PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ), $ CZERO = ( 0.0E+0, 0.0E+0 ) ) * .. * .. Local Scalars .. LOGICAL ILQ, ILZ INTEGER ICOMPQ, ICOMPZ, JCOL, JROW REAL C COMPLEX CTEMP, S * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. * .. External Subroutines .. EXTERNAL CLARTG, CLASET, CROT, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC CONJG, MAX * .. * .. Executable Statements .. * * Decode COMPQ * IF( LSAME( COMPQ, 'N' ) ) THEN ILQ = .FALSE. ICOMPQ = 1 ELSE IF( LSAME( COMPQ, 'V' ) ) THEN ILQ = .TRUE. ICOMPQ = 2 ELSE IF( LSAME( COMPQ, 'I' ) ) THEN ILQ = .TRUE. ICOMPQ = 3 ELSE ICOMPQ = 0 END IF * * Decode COMPZ * IF( LSAME( COMPZ, 'N' ) ) THEN ILZ = .FALSE. ICOMPZ = 1 ELSE IF( LSAME( COMPZ, 'V' ) ) THEN ILZ = .TRUE. ICOMPZ = 2 ELSE IF( LSAME( COMPZ, 'I' ) ) THEN ILZ = .TRUE. ICOMPZ = 3 ELSE ICOMPZ = 0 END IF * * Test the input parameters. * INFO = 0 IF( ICOMPQ.LE.0 ) THEN INFO = -1 ELSE IF( ICOMPZ.LE.0 ) THEN INFO = -2 ELSE IF( N.LT.0 ) THEN INFO = -3 ELSE IF( ILO.LT.1 ) THEN INFO = -4 ELSE IF( IHI.GT.N .OR. IHI.LT.ILO-1 ) THEN INFO = -5 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -7 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN INFO = -9 ELSE IF( ( ILQ .AND. LDQ.LT.N ) .OR. LDQ.LT.1 ) THEN INFO = -11 ELSE IF( ( ILZ .AND. LDZ.LT.N ) .OR. LDZ.LT.1 ) THEN INFO = -13 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'CGGHRD', -INFO ) RETURN END IF * * Initialize Q and Z if desired. * IF( ICOMPQ.EQ.3 ) $ CALL CLASET( 'Full', N, N, CZERO, CONE, Q, LDQ ) IF( ICOMPZ.EQ.3 ) $ CALL CLASET( 'Full', N, N, CZERO, CONE, Z, LDZ ) * * Quick return if possible * IF( N.LE.1 ) $ RETURN * * Zero out lower triangle of B * DO 20 JCOL = 1, N - 1 DO 10 JROW = JCOL + 1, N B( JROW, JCOL ) = CZERO 10 CONTINUE 20 CONTINUE * * Reduce A and B * DO 40 JCOL = ILO, IHI - 2 * DO 30 JROW = IHI, JCOL + 2, -1 * * Step 1: rotate rows JROW-1, JROW to kill A(JROW,JCOL) * CTEMP = A( JROW-1, JCOL ) CALL CLARTG( CTEMP, A( JROW, JCOL ), C, S, $ A( JROW-1, JCOL ) ) A( JROW, JCOL ) = CZERO CALL CROT( N-JCOL, A( JROW-1, JCOL+1 ), LDA, $ A( JROW, JCOL+1 ), LDA, C, S ) CALL CROT( N+2-JROW, B( JROW-1, JROW-1 ), LDB, $ B( JROW, JROW-1 ), LDB, C, S ) IF( ILQ ) $ CALL CROT( N, Q( 1, JROW-1 ), 1, Q( 1, JROW ), 1, C, $ CONJG( S ) ) * * Step 2: rotate columns JROW, JROW-1 to kill B(JROW,JROW-1) * CTEMP = B( JROW, JROW ) CALL CLARTG( CTEMP, B( JROW, JROW-1 ), C, S, $ B( JROW, JROW ) ) B( JROW, JROW-1 ) = CZERO CALL CROT( IHI, A( 1, JROW ), 1, A( 1, JROW-1 ), 1, C, S ) CALL CROT( JROW-1, B( 1, JROW ), 1, B( 1, JROW-1 ), 1, C, $ S ) IF( ILZ ) $ CALL CROT( N, Z( 1, JROW ), 1, Z( 1, JROW-1 ), 1, C, S ) 30 CONTINUE 40 CONTINUE * RETURN * * End of CGGHRD * END