1*> \brief \b CGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CGEHD2 + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgehd2.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgehd2.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgehd2.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) 22* 23* .. Scalar Arguments .. 24* INTEGER IHI, ILO, INFO, LDA, N 25* .. 26* .. Array Arguments .. 27* COMPLEX A( LDA, * ), TAU( * ), WORK( * ) 28* .. 29* 30* 31*> \par Purpose: 32* ============= 33*> 34*> \verbatim 35*> 36*> CGEHD2 reduces a complex general matrix A to upper Hessenberg form H 37*> by a unitary similarity transformation: Q**H * A * Q = H . 38*> \endverbatim 39* 40* Arguments: 41* ========== 42* 43*> \param[in] N 44*> \verbatim 45*> N is INTEGER 46*> The order of the matrix A. N >= 0. 47*> \endverbatim 48*> 49*> \param[in] ILO 50*> \verbatim 51*> ILO is INTEGER 52*> \endverbatim 53*> 54*> \param[in] IHI 55*> \verbatim 56*> IHI is INTEGER 57*> 58*> It is assumed that A is already upper triangular in rows 59*> and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally 60*> set by a previous call to CGEBAL; otherwise they should be 61*> set to 1 and N respectively. See Further Details. 62*> 1 <= ILO <= IHI <= max(1,N). 63*> \endverbatim 64*> 65*> \param[in,out] A 66*> \verbatim 67*> A is COMPLEX array, dimension (LDA,N) 68*> On entry, the n by n general matrix to be reduced. 69*> On exit, the upper triangle and the first subdiagonal of A 70*> are overwritten with the upper Hessenberg matrix H, and the 71*> elements below the first subdiagonal, with the array TAU, 72*> represent the unitary matrix Q as a product of elementary 73*> reflectors. See Further Details. 74*> \endverbatim 75*> 76*> \param[in] LDA 77*> \verbatim 78*> LDA is INTEGER 79*> The leading dimension of the array A. LDA >= max(1,N). 80*> \endverbatim 81*> 82*> \param[out] TAU 83*> \verbatim 84*> TAU is COMPLEX array, dimension (N-1) 85*> The scalar factors of the elementary reflectors (see Further 86*> Details). 87*> \endverbatim 88*> 89*> \param[out] WORK 90*> \verbatim 91*> WORK is COMPLEX array, dimension (N) 92*> \endverbatim 93*> 94*> \param[out] INFO 95*> \verbatim 96*> INFO is INTEGER 97*> = 0: successful exit 98*> < 0: if INFO = -i, the i-th argument had an illegal value. 99*> \endverbatim 100* 101* Authors: 102* ======== 103* 104*> \author Univ. of Tennessee 105*> \author Univ. of California Berkeley 106*> \author Univ. of Colorado Denver 107*> \author NAG Ltd. 108* 109*> \ingroup complexGEcomputational 110* 111*> \par Further Details: 112* ===================== 113*> 114*> \verbatim 115*> 116*> The matrix Q is represented as a product of (ihi-ilo) elementary 117*> reflectors 118*> 119*> Q = H(ilo) H(ilo+1) . . . H(ihi-1). 120*> 121*> Each H(i) has the form 122*> 123*> H(i) = I - tau * v * v**H 124*> 125*> where tau is a complex scalar, and v is a complex vector with 126*> v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on 127*> exit in A(i+2:ihi,i), and tau in TAU(i). 128*> 129*> The contents of A are illustrated by the following example, with 130*> n = 7, ilo = 2 and ihi = 6: 131*> 132*> on entry, on exit, 133*> 134*> ( a a a a a a a ) ( a a h h h h a ) 135*> ( a a a a a a ) ( a h h h h a ) 136*> ( a a a a a a ) ( h h h h h h ) 137*> ( a a a a a a ) ( v2 h h h h h ) 138*> ( a a a a a a ) ( v2 v3 h h h h ) 139*> ( a a a a a a ) ( v2 v3 v4 h h h ) 140*> ( a ) ( a ) 141*> 142*> where a denotes an element of the original matrix A, h denotes a 143*> modified element of the upper Hessenberg matrix H, and vi denotes an 144*> element of the vector defining H(i). 145*> \endverbatim 146*> 147* ===================================================================== 148 SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO ) 149* 150* -- LAPACK computational routine -- 151* -- LAPACK is a software package provided by Univ. of Tennessee, -- 152* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 153* 154* .. Scalar Arguments .. 155 INTEGER IHI, ILO, INFO, LDA, N 156* .. 157* .. Array Arguments .. 158 COMPLEX A( LDA, * ), TAU( * ), WORK( * ) 159* .. 160* 161* ===================================================================== 162* 163* .. Parameters .. 164 COMPLEX ONE 165 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) 166* .. 167* .. Local Scalars .. 168 INTEGER I 169 COMPLEX ALPHA 170* .. 171* .. External Subroutines .. 172 EXTERNAL CLARF, CLARFG, XERBLA 173* .. 174* .. Intrinsic Functions .. 175 INTRINSIC CONJG, MAX, MIN 176* .. 177* .. Executable Statements .. 178* 179* Test the input parameters 180* 181 INFO = 0 182 IF( N.LT.0 ) THEN 183 INFO = -1 184 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN 185 INFO = -2 186 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN 187 INFO = -3 188 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 189 INFO = -5 190 END IF 191 IF( INFO.NE.0 ) THEN 192 CALL XERBLA( 'CGEHD2', -INFO ) 193 RETURN 194 END IF 195* 196 DO 10 I = ILO, IHI - 1 197* 198* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) 199* 200 ALPHA = A( I+1, I ) 201 CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) ) 202 A( I+1, I ) = ONE 203* 204* Apply H(i) to A(1:ihi,i+1:ihi) from the right 205* 206 CALL CLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ), 207 $ A( 1, I+1 ), LDA, WORK ) 208* 209* Apply H(i)**H to A(i+1:ihi,i+1:n) from the left 210* 211 CALL CLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, 212 $ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK ) 213* 214 A( I+1, I ) = ALPHA 215 10 CONTINUE 216* 217 RETURN 218* 219* End of CGEHD2 220* 221 END 222