LAPACK  3.10.0 LAPACK: Linear Algebra PACKage
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
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 *> \ingroup doubleOTHERcomputational
123 *
124 * =====================================================================
125  SUBROUTINE dorghr( 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  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 *
237  END
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
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
Definition: dorghr.f:126