*> \brief \b SORGHR * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly *> Download SORGHR + dependencies *> *> [TGZ] *> *> [ZIP] *> *> [TXT] *> \endhtmlonly * * Definition: * =========== * * SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * .. Scalar Arguments .. * INTEGER IHI, ILO, INFO, LDA, LWORK, N * .. * .. Array Arguments .. * REAL A( LDA, * ), TAU( * ), WORK( * ) * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> SORGHR generates a real orthogonal matrix Q which is defined as the *> product of IHI-ILO elementary reflectors of order N, as returned by *> SGEHRD: *> *> Q = H(ilo) H(ilo+1) . . . H(ihi-1). *> \endverbatim * * Arguments: * ========== * *> \param[in] N *> \verbatim *> N is INTEGER *> The order of the matrix Q. N >= 0. *> \endverbatim *> *> \param[in] ILO *> \verbatim *> ILO is INTEGER *> \endverbatim *> *> \param[in] IHI *> \verbatim *> IHI is INTEGER *> *> ILO and IHI must have the same values as in the previous call *> of SGEHRD. Q is equal to the unit matrix except in the *> submatrix Q(ilo+1:ihi,ilo+1:ihi). *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is REAL array, dimension (LDA,N) *> On entry, the vectors which define the elementary reflectors, *> as returned by SGEHRD. *> On exit, the N-by-N orthogonal matrix Q. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER *> The leading dimension of the array A. LDA >= max(1,N). *> \endverbatim *> *> \param[in] TAU *> \verbatim *> TAU is REAL array, dimension (N-1) *> TAU(i) must contain the scalar factor of the elementary *> reflector H(i), as returned by SGEHRD. *> \endverbatim *> *> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= IHI-ILO. *> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is *> the optimal blocksize. *> *> If LWORK = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns *> this value as the first entry of the WORK array, and no error *> message related to LWORK is issued by XERBLA. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date November 2011 * *> \ingroup realOTHERcomputational * * ===================================================================== SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.4.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2011 * * .. Scalar Arguments .. INTEGER IHI, ILO, INFO, LDA, LWORK, N * .. * .. Array Arguments .. REAL A( LDA, * ), TAU( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. REAL ZERO, ONE PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * .. * .. Local Scalars .. LOGICAL LQUERY INTEGER I, IINFO, J, LWKOPT, NB, NH * .. * .. External Subroutines .. EXTERNAL SORGQR, XERBLA * .. * .. External Functions .. INTEGER ILAENV EXTERNAL ILAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * .. Executable Statements .. * * Test the input arguments * INFO = 0 NH = IHI - ILO LQUERY = ( LWORK.EQ.-1 ) IF( N.LT.0 ) THEN INFO = -1 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN INFO = -2 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN INFO = -3 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN INFO = -5 ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN INFO = -8 END IF * IF( INFO.EQ.0 ) THEN NB = ILAENV( 1, 'SORGQR', ' ', NH, NH, NH, -1 ) LWKOPT = MAX( 1, NH )*NB WORK( 1 ) = LWKOPT END IF * IF( INFO.NE.0 ) THEN CALL XERBLA( 'SORGHR', -INFO ) RETURN ELSE IF( LQUERY ) THEN RETURN END IF * * Quick return if possible * IF( N.EQ.0 ) THEN WORK( 1 ) = 1 RETURN END IF * * Shift the vectors which define the elementary reflectors one * column to the right, and set the first ilo and the last n-ihi * rows and columns to those of the unit matrix * DO 40 J = IHI, ILO + 1, -1 DO 10 I = 1, J - 1 A( I, J ) = ZERO 10 CONTINUE DO 20 I = J + 1, IHI A( I, J ) = A( I, J-1 ) 20 CONTINUE DO 30 I = IHI + 1, N A( I, J ) = ZERO 30 CONTINUE 40 CONTINUE DO 60 J = 1, ILO DO 50 I = 1, N A( I, J ) = ZERO 50 CONTINUE A( J, J ) = ONE 60 CONTINUE DO 80 J = IHI + 1, N DO 70 I = 1, N A( I, J ) = ZERO 70 CONTINUE A( J, J ) = ONE 80 CONTINUE * IF( NH.GT.0 ) THEN * * Generate Q(ilo+1:ihi,ilo+1:ihi) * CALL SORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ), $ WORK, LWORK, IINFO ) END IF WORK( 1 ) = LWKOPT RETURN * * End of SORGHR * END