LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dorghr.f
Go to the documentation of this file.
1 *> \brief \b DORGHR
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DORGHR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorghr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorghr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorghr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DORGHR( 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 * DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> DORGHR 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 *> DGEHRD:
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 DGEHRD. 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 DOUBLE PRECISION array, dimension (LDA,N)
70 *> On entry, the vectors which define the elementary reflectors,
71 *> as returned by DGEHRD.
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 DOUBLE PRECISION array, dimension (N-1)
84 *> TAU(i) must contain the scalar factor of the elementary
85 *> reflector H(i), as returned by DGEHRD.
86 *> \endverbatim
87 *>
88 *> \param[out] WORK
89 *> \verbatim
90 *> WORK is DOUBLE PRECISION 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 *> \date November 2011
123 *
124 *> \ingroup doubleOTHERcomputational
125 *
126 * =====================================================================
127  SUBROUTINE dorghr( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
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 *
240  END