LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sorghr()

subroutine sorghr ( integer  n,
integer  ilo,
integer  ihi,
real, dimension( lda, * )  a,
integer  lda,
real, dimension( * )  tau,
real, dimension( * )  work,
integer  lwork,
integer  info 
)

SORGHR

Download SORGHR + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 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).
Parameters
[in]N
          N is INTEGER
          The order of the matrix Q. N >= 0.
[in]ILO
          ILO is INTEGER
[in]IHI
          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.
[in,out]A
          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.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A. LDA >= max(1,N).
[in]TAU
          TAU is REAL array, dimension (N-1)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by SGEHRD.
[out]WORK
          WORK is REAL array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          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.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 125 of file sorghr.f.

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*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
subroutine sorgqr(m, n, k, a, lda, tau, work, lwork, info)
SORGQR
Definition sorgqr.f:128
Here is the call graph for this function:
Here is the caller graph for this function: