LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sorghr.f
Go to the documentation of this file.
1*> \brief \b SORGHR
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SORGHR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorghr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorghr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorghr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SORGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
22*
23* .. Scalar Arguments ..
24* INTEGER IHI, ILO, INFO, LDA, LWORK, N
25* ..
26* .. Array Arguments ..
27* REAL A( LDA, * ), TAU( * ), WORK( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
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
38*> SGEHRD:
39*>
40*> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
41*> \endverbatim
42*
43* Arguments:
44* ==========
45*
46*> \param[in] N
47*> \verbatim
48*> N is INTEGER
49*> The order of the matrix Q. N >= 0.
50*> \endverbatim
51*>
52*> \param[in] ILO
53*> \verbatim
54*> ILO is INTEGER
55*> \endverbatim
56*>
57*> \param[in] IHI
58*> \verbatim
59*> IHI is INTEGER
60*>
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.
65*> \endverbatim
66*>
67*> \param[in,out] A
68*> \verbatim
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.
73*> \endverbatim
74*>
75*> \param[in] LDA
76*> \verbatim
77*> LDA is INTEGER
78*> The leading dimension of the array A. LDA >= max(1,N).
79*> \endverbatim
80*>
81*> \param[in] TAU
82*> \verbatim
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.
86*> \endverbatim
87*>
88*> \param[out] WORK
89*> \verbatim
90*> WORK is REAL array, dimension (MAX(1,LWORK))
91*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
92*> \endverbatim
93*>
94*> \param[in] LWORK
95*> \verbatim
96*> LWORK is INTEGER
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.
100*>
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.
105*> \endverbatim
106*>
107*> \param[out] INFO
108*> \verbatim
109*> INFO is INTEGER
110*> = 0: successful exit
111*> < 0: if INFO = -i, the i-th argument had an illegal value
112*> \endverbatim
113*
114* Authors:
115* ========
116*
117*> \author Univ. of Tennessee
118*> \author Univ. of California Berkeley
119*> \author Univ. of Colorado Denver
120*> \author NAG Ltd.
121*
122*> \ingroup unghr
123*
124* =====================================================================
125 SUBROUTINE sorghr( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
126*
127* -- LAPACK computational routine --
128* -- LAPACK is a software package provided by Univ. of Tennessee, --
129* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130*
131* .. Scalar Arguments ..
132 INTEGER IHI, ILO, INFO, LDA, LWORK, N
133* ..
134* .. Array Arguments ..
135 REAL A( LDA, * ), TAU( * ), WORK( * )
136* ..
137*
138* =====================================================================
139*
140* .. Parameters ..
141 REAL ZERO, ONE
142 parameter( zero = 0.0e+0, one = 1.0e+0 )
143* ..
144* .. Local Scalars ..
145 LOGICAL LQUERY
146 INTEGER I, IINFO, J, LWKOPT, NB, NH
147* ..
148* .. External Subroutines ..
149 EXTERNAL sorgqr, xerbla
150* ..
151* .. External Functions ..
152 INTEGER ILAENV
153 REAL SROUNDUP_LWORK
154 EXTERNAL ilaenv, sroundup_lwork
155* ..
156* .. Intrinsic Functions ..
157 INTRINSIC max, min
158* ..
159* .. Executable Statements ..
160*
161* Test the input arguments
162*
163 info = 0
164 nh = ihi - ilo
165 lquery = ( lwork.EQ.-1 )
166 IF( n.LT.0 ) THEN
167 info = -1
168 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
169 info = -2
170 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
171 info = -3
172 ELSE IF( lda.LT.max( 1, n ) ) THEN
173 info = -5
174 ELSE IF( lwork.LT.max( 1, nh ) .AND. .NOT.lquery ) THEN
175 info = -8
176 END IF
177*
178 IF( info.EQ.0 ) THEN
179 nb = ilaenv( 1, 'SORGQR', ' ', nh, nh, nh, -1 )
180 lwkopt = max( 1, nh )*nb
181 work( 1 ) = sroundup_lwork(lwkopt)
182 END IF
183*
184 IF( info.NE.0 ) THEN
185 CALL xerbla( 'SORGHR', -info )
186 RETURN
187 ELSE IF( lquery ) THEN
188 RETURN
189 END IF
190*
191* Quick return if possible
192*
193 IF( n.EQ.0 ) THEN
194 work( 1 ) = 1
195 RETURN
196 END IF
197*
198* Shift the vectors which define the elementary reflectors one
199* column to the right, and set the first ilo and the last n-ihi
200* rows and columns to those of the unit matrix
201*
202 DO 40 j = ihi, ilo + 1, -1
203 DO 10 i = 1, j - 1
204 a( i, j ) = zero
205 10 CONTINUE
206 DO 20 i = j + 1, ihi
207 a( i, j ) = a( i, j-1 )
208 20 CONTINUE
209 DO 30 i = ihi + 1, n
210 a( i, j ) = zero
211 30 CONTINUE
212 40 CONTINUE
213 DO 60 j = 1, ilo
214 DO 50 i = 1, n
215 a( i, j ) = zero
216 50 CONTINUE
217 a( j, j ) = one
218 60 CONTINUE
219 DO 80 j = ihi + 1, n
220 DO 70 i = 1, n
221 a( i, j ) = zero
222 70 CONTINUE
223 a( j, j ) = one
224 80 CONTINUE
225*
226 IF( nh.GT.0 ) THEN
227*
228* Generate Q(ilo+1:ihi,ilo+1:ihi)
229*
230 CALL sorgqr( nh, nh, nh, a( ilo+1, ilo+1 ), lda, tau( ilo ),
231 $ work, lwork, iinfo )
232 END IF
233 work( 1 ) = sroundup_lwork(lwkopt)
234 RETURN
235*
236* End of SORGHR
237*
238 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine sorghr(n, ilo, ihi, a, lda, tau, work, lwork, info)
SORGHR
Definition sorghr.f:126
subroutine sorgqr(m, n, k, a, lda, tau, work, lwork, info)
SORGQR
Definition sorgqr.f:128