3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download SORGHR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorghr.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorghr.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorghr.f">
21 * SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
23 * .. Scalar Arguments ..
24 * INTEGER IHI, ILO, INFO, LDA, LWORK, N
26 * .. Array Arguments ..
27 * REAL A( LDA, * ), TAU( * ), WORK( * )
36 *> SORGHR generates a real orthogonal matrix Q which is defined as the
37 *> product of IHI-ILO elementary reflectors of order N, as returned by
40 *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
49 *> The order of the matrix Q. N >= 0.
61 *> ILO and IHI must have the same values as in the previous call
62 *> of SGEHRD. Q is equal to the unit matrix except in the
63 *> submatrix Q(ilo+1:ihi,ilo+1:ihi).
64 *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
69 *> A is REAL array, dimension (LDA,N)
70 *> On entry, the vectors which define the elementary reflectors,
71 *> as returned by SGEHRD.
72 *> On exit, the N-by-N orthogonal matrix Q.
78 *> The leading dimension of the array A. LDA >= max(1,N).
83 *> TAU is REAL array, dimension (N-1)
84 *> TAU(i) must contain the scalar factor of the elementary
85 *> reflector H(i), as returned by SGEHRD.
90 *> WORK is REAL array, dimension (MAX(1,LWORK))
91 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
97 *> The dimension of the array WORK. LWORK >= IHI-ILO.
98 *> For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
99 *> the optimal blocksize.
101 *> If LWORK = -1, then a workspace query is assumed; the routine
102 *> only calculates the optimal size of the WORK array, returns
103 *> this value as the first entry of the WORK array, and no error
104 *> message related to LWORK is issued by XERBLA.
110 *> = 0: successful exit
111 *> < 0: if INFO = -i, the i-th argument had an illegal value
117 *> \author Univ. of Tennessee
118 *> \author Univ. of California Berkeley
119 *> \author Univ. of Colorado Denver
122 *> \date November 2011
124 *> \ingroup realOTHERcomputational
126 * =====================================================================
127 SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
129 * -- LAPACK computational routine (version 3.4.0) --
130 * -- LAPACK is a software package provided by Univ. of Tennessee, --
131 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134 * .. Scalar Arguments ..
135 INTEGER IHI, ILO, INFO, LDA, LWORK, N
137 * .. Array Arguments ..
138 REAL A( LDA, * ), TAU( * ), WORK( * )
141 * =====================================================================
145 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
147 * .. Local Scalars ..
149 INTEGER I, IINFO, J, LWKOPT, NB, NH
151 * .. External Subroutines ..
152 EXTERNAL SORGQR, XERBLA
154 * .. External Functions ..
158 * .. Intrinsic Functions ..
161 * .. Executable Statements ..
163 * Test the input arguments
167 LQUERY = ( LWORK.EQ.-1 )
170 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
172 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
174 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
176 ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
181 NB = ILAENV( 1, 'SORGQR', ' ', NH, NH, NH, -1 )
182 LWKOPT = MAX( 1, NH )*NB
187 CALL XERBLA( 'SORGHR', -INFO )
189 ELSE IF( LQUERY ) THEN
193 * Quick return if possible
200 * Shift the vectors which define the elementary reflectors one
201 * column to the right, and set the first ilo and the last n-ihi
202 * rows and columns to those of the unit matrix
204 DO 40 J = IHI, ILO + 1, -1
209 A( I, J ) = A( I, J-1 )
230 * Generate Q(ilo+1:ihi,ilo+1:ihi)
232 CALL SORGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
233 $ WORK, LWORK, IINFO )