LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dorghr()

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.

Definition at line 125 of file dorghr.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  DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
136 * ..
137 *
138 * =====================================================================
139 *
140 * .. Parameters ..
141  DOUBLE PRECISION ZERO, ONE
142  parameter( zero = 0.0d+0, one = 1.0d+0 )
143 * ..
144 * .. Local Scalars ..
145  LOGICAL LQUERY
146  INTEGER I, IINFO, J, LWKOPT, NB, NH
147 * ..
148 * .. External Subroutines ..
149  EXTERNAL dorgqr, xerbla
150 * ..
151 * .. External Functions ..
152  INTEGER ILAENV
153  EXTERNAL ilaenv
154 * ..
155 * .. Intrinsic Functions ..
156  INTRINSIC max, min
157 * ..
158 * .. Executable Statements ..
159 *
160 * Test the input arguments
161 *
162  info = 0
163  nh = ihi - ilo
164  lquery = ( lwork.EQ.-1 )
165  IF( n.LT.0 ) THEN
166  info = -1
167  ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
168  info = -2
169  ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
170  info = -3
171  ELSE IF( lda.LT.max( 1, n ) ) THEN
172  info = -5
173  ELSE IF( lwork.LT.max( 1, nh ) .AND. .NOT.lquery ) THEN
174  info = -8
175  END IF
176 *
177  IF( info.EQ.0 ) THEN
178  nb = ilaenv( 1, 'DORGQR', ' ', nh, nh, nh, -1 )
179  lwkopt = max( 1, nh )*nb
180  work( 1 ) = lwkopt
181  END IF
182 *
183  IF( info.NE.0 ) THEN
184  CALL xerbla( 'DORGHR', -info )
185  RETURN
186  ELSE IF( lquery ) THEN
187  RETURN
188  END IF
189 *
190 * Quick return if possible
191 *
192  IF( n.EQ.0 ) THEN
193  work( 1 ) = 1
194  RETURN
195  END IF
196 *
197 * Shift the vectors which define the elementary reflectors one
198 * column to the right, and set the first ilo and the last n-ihi
199 * rows and columns to those of the unit matrix
200 *
201  DO 40 j = ihi, ilo + 1, -1
202  DO 10 i = 1, j - 1
203  a( i, j ) = zero
204  10 CONTINUE
205  DO 20 i = j + 1, ihi
206  a( i, j ) = a( i, j-1 )
207  20 CONTINUE
208  DO 30 i = ihi + 1, n
209  a( i, j ) = zero
210  30 CONTINUE
211  40 CONTINUE
212  DO 60 j = 1, ilo
213  DO 50 i = 1, n
214  a( i, j ) = zero
215  50 CONTINUE
216  a( j, j ) = one
217  60 CONTINUE
218  DO 80 j = ihi + 1, n
219  DO 70 i = 1, n
220  a( i, j ) = zero
221  70 CONTINUE
222  a( j, j ) = one
223  80 CONTINUE
224 *
225  IF( nh.GT.0 ) THEN
226 *
227 * Generate Q(ilo+1:ihi,ilo+1:ihi)
228 *
229  CALL dorgqr( nh, nh, nh, a( ilo+1, ilo+1 ), lda, tau( ilo ),
230  $ work, lwork, iinfo )
231  END IF
232  work( 1 ) = lwkopt
233  RETURN
234 *
235 * End of DORGHR
236 *
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine dorgqr(M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
DORGQR
Definition: dorgqr.f:128
Here is the call graph for this function:
Here is the caller graph for this function: