LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dorghr ( integer  N,
integer  ILO,
integer  IHI,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  TAU,
double precision, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

DORGHR

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

Purpose: 
 DORGHR generates a real orthogonal matrix Q which is defined as the
 product of IHI-ILO elementary reflectors of order N, as returned by
 DGEHRD:

 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 DGEHRD. 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 DOUBLE PRECISION array, dimension (LDA,N)
          On entry, the vectors which define the elementary reflectors,
          as returned by DGEHRD.
          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 DOUBLE PRECISION array, dimension (N-1)
          TAU(i) must contain the scalar factor of the elementary
          reflector H(i), as returned by DGEHRD.
[out]WORK
          WORK is DOUBLE PRECISION 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.
Date
November 2011

Definition at line 128 of file dorghr.f.

128 *
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..--
132 * November 2011
133 *
134 * .. Scalar Arguments ..
135  INTEGER ihi, ilo, info, lda, lwork, n
136 * ..
137 * .. Array Arguments ..
138  DOUBLE PRECISION a( lda, * ), tau( * ), work( * )
139 * ..
140 *
141 * =====================================================================
142 *
143 * .. Parameters ..
144  DOUBLE PRECISION zero, one
145  parameter ( zero = 0.0d+0, one = 1.0d+0 )
146 * ..
147 * .. Local Scalars ..
148  LOGICAL lquery
149  INTEGER i, iinfo, j, lwkopt, nb, nh
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL dorgqr, xerbla
153 * ..
154 * .. External Functions ..
155  INTEGER ilaenv
156  EXTERNAL ilaenv
157 * ..
158 * .. Intrinsic Functions ..
159  INTRINSIC max, min
160 * ..
161 * .. Executable Statements ..
162 *
163 * Test the input arguments
164 *
165  info = 0
166  nh = ihi - ilo
167  lquery = ( lwork.EQ.-1 )
168  IF( n.LT.0 ) THEN
169  info = -1
170  ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
171  info = -2
172  ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
173  info = -3
174  ELSE IF( lda.LT.max( 1, n ) ) THEN
175  info = -5
176  ELSE IF( lwork.LT.max( 1, nh ) .AND. .NOT.lquery ) THEN
177  info = -8
178  END IF
179 *
180  IF( info.EQ.0 ) THEN
181  nb = ilaenv( 1, 'DORGQR', ' ', nh, nh, nh, -1 )
182  lwkopt = max( 1, nh )*nb
183  work( 1 ) = lwkopt
184  END IF
185 *
186  IF( info.NE.0 ) THEN
187  CALL xerbla( 'DORGHR', -info )
188  RETURN
189  ELSE IF( lquery ) THEN
190  RETURN
191  END IF
192 *
193 * Quick return if possible
194 *
195  IF( n.EQ.0 ) THEN
196  work( 1 ) = 1
197  RETURN
198  END IF
199 *
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
203 *
204  DO 40 j = ihi, ilo + 1, -1
205  DO 10 i = 1, j - 1
206  a( i, j ) = zero
207  10 CONTINUE
208  DO 20 i = j + 1, ihi
209  a( i, j ) = a( i, j-1 )
210  20 CONTINUE
211  DO 30 i = ihi + 1, n
212  a( i, j ) = zero
213  30 CONTINUE
214  40 CONTINUE
215  DO 60 j = 1, ilo
216  DO 50 i = 1, n
217  a( i, j ) = zero
218  50 CONTINUE
219  a( j, j ) = one
220  60 CONTINUE
221  DO 80 j = ihi + 1, n
222  DO 70 i = 1, n
223  a( i, j ) = zero
224  70 CONTINUE
225  a( j, j ) = one
226  80 CONTINUE
227 *
228  IF( nh.GT.0 ) THEN
229 *
230 * Generate Q(ilo+1:ihi,ilo+1:ihi)
231 *
232  CALL dorgqr( nh, nh, nh, a( ilo+1, ilo+1 ), lda, tau( ilo ),
233  $ work, lwork, iinfo )
234  END IF
235  work( 1 ) = lwkopt
236  RETURN
237 *
238 * End of DORGHR
239 *
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
ilaenv
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
Definition: tstiee.f:83
dorgqr
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:130

Here is the call graph for this function:

Here is the caller graph for this function: