LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
sormhr.f
Go to the documentation of this file.
1 *> \brief \b SORMHR
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SORMHR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormhr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormhr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormhr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
22 * LDC, WORK, LWORK, INFO )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER SIDE, TRANS
26 * INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
27 * ..
28 * .. Array Arguments ..
29 * REAL A( LDA, * ), C( LDC, * ), TAU( * ),
30 * $ WORK( * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> SORMHR overwrites the general real M-by-N matrix C with
40 *>
41 *> SIDE = 'L' SIDE = 'R'
42 *> TRANS = 'N': Q * C C * Q
43 *> TRANS = 'T': Q**T * C C * Q**T
44 *>
45 *> where Q is a real orthogonal matrix of order nq, with nq = m if
46 *> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
47 *> IHI-ILO elementary reflectors, as returned by SGEHRD:
48 *>
49 *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
50 *> \endverbatim
51 *
52 * Arguments:
53 * ==========
54 *
55 *> \param[in] SIDE
56 *> \verbatim
57 *> SIDE is CHARACTER*1
58 *> = 'L': apply Q or Q**T from the Left;
59 *> = 'R': apply Q or Q**T from the Right.
60 *> \endverbatim
61 *>
62 *> \param[in] TRANS
63 *> \verbatim
64 *> TRANS is CHARACTER*1
65 *> = 'N': No transpose, apply Q;
66 *> = 'T': Transpose, apply Q**T.
67 *> \endverbatim
68 *>
69 *> \param[in] M
70 *> \verbatim
71 *> M is INTEGER
72 *> The number of rows of the matrix C. M >= 0.
73 *> \endverbatim
74 *>
75 *> \param[in] N
76 *> \verbatim
77 *> N is INTEGER
78 *> The number of columns of the matrix C. N >= 0.
79 *> \endverbatim
80 *>
81 *> \param[in] ILO
82 *> \verbatim
83 *> ILO is INTEGER
84 *> \endverbatim
85 *>
86 *> \param[in] IHI
87 *> \verbatim
88 *> IHI is INTEGER
89 *>
90 *> ILO and IHI must have the same values as in the previous call
91 *> of SGEHRD. Q is equal to the unit matrix except in the
92 *> submatrix Q(ilo+1:ihi,ilo+1:ihi).
93 *> If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
94 *> ILO = 1 and IHI = 0, if M = 0;
95 *> if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
96 *> ILO = 1 and IHI = 0, if N = 0.
97 *> \endverbatim
98 *>
99 *> \param[in] A
100 *> \verbatim
101 *> A is REAL array, dimension
102 *> (LDA,M) if SIDE = 'L'
103 *> (LDA,N) if SIDE = 'R'
104 *> The vectors which define the elementary reflectors, as
105 *> returned by SGEHRD.
106 *> \endverbatim
107 *>
108 *> \param[in] LDA
109 *> \verbatim
110 *> LDA is INTEGER
111 *> The leading dimension of the array A.
112 *> LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
113 *> \endverbatim
114 *>
115 *> \param[in] TAU
116 *> \verbatim
117 *> TAU is REAL array, dimension
118 *> (M-1) if SIDE = 'L'
119 *> (N-1) if SIDE = 'R'
120 *> TAU(i) must contain the scalar factor of the elementary
121 *> reflector H(i), as returned by SGEHRD.
122 *> \endverbatim
123 *>
124 *> \param[in,out] C
125 *> \verbatim
126 *> C is REAL array, dimension (LDC,N)
127 *> On entry, the M-by-N matrix C.
128 *> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
129 *> \endverbatim
130 *>
131 *> \param[in] LDC
132 *> \verbatim
133 *> LDC is INTEGER
134 *> The leading dimension of the array C. LDC >= max(1,M).
135 *> \endverbatim
136 *>
137 *> \param[out] WORK
138 *> \verbatim
139 *> WORK is REAL array, dimension (MAX(1,LWORK))
140 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
141 *> \endverbatim
142 *>
143 *> \param[in] LWORK
144 *> \verbatim
145 *> LWORK is INTEGER
146 *> The dimension of the array WORK.
147 *> If SIDE = 'L', LWORK >= max(1,N);
148 *> if SIDE = 'R', LWORK >= max(1,M).
149 *> For optimum performance LWORK >= N*NB if SIDE = 'L', and
150 *> LWORK >= M*NB if SIDE = 'R', where NB is the optimal
151 *> blocksize.
152 *>
153 *> If LWORK = -1, then a workspace query is assumed; the routine
154 *> only calculates the optimal size of the WORK array, returns
155 *> this value as the first entry of the WORK array, and no error
156 *> message related to LWORK is issued by XERBLA.
157 *> \endverbatim
158 *>
159 *> \param[out] INFO
160 *> \verbatim
161 *> INFO is INTEGER
162 *> = 0: successful exit
163 *> < 0: if INFO = -i, the i-th argument had an illegal value
164 *> \endverbatim
165 *
166 * Authors:
167 * ========
168 *
169 *> \author Univ. of Tennessee
170 *> \author Univ. of California Berkeley
171 *> \author Univ. of Colorado Denver
172 *> \author NAG Ltd.
173 *
174 *> \date November 2011
175 *
176 *> \ingroup realOTHERcomputational
177 *
178 * =====================================================================
179  SUBROUTINE sormhr( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
180  $ ldc, work, lwork, info )
181 *
182 * -- LAPACK computational routine (version 3.4.0) --
183 * -- LAPACK is a software package provided by Univ. of Tennessee, --
184 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
185 * November 2011
186 *
187 * .. Scalar Arguments ..
188  CHARACTER side, trans
189  INTEGER ihi, ilo, info, lda, ldc, lwork, m, n
190 * ..
191 * .. Array Arguments ..
192  REAL a( lda, * ), c( ldc, * ), tau( * ),
193  $ work( * )
194 * ..
195 *
196 * =====================================================================
197 *
198 * .. Local Scalars ..
199  LOGICAL left, lquery
200  INTEGER i1, i2, iinfo, lwkopt, mi, nb, nh, ni, nq, nw
201 * ..
202 * .. External Functions ..
203  LOGICAL lsame
204  INTEGER ilaenv
205  EXTERNAL ilaenv, lsame
206 * ..
207 * .. External Subroutines ..
208  EXTERNAL sormqr, xerbla
209 * ..
210 * .. Intrinsic Functions ..
211  INTRINSIC max, min
212 * ..
213 * .. Executable Statements ..
214 *
215 * Test the input arguments
216 *
217  info = 0
218  nh = ihi - ilo
219  left = lsame( side, 'L' )
220  lquery = ( lwork.EQ.-1 )
221 *
222 * NQ is the order of Q and NW is the minimum dimension of WORK
223 *
224  IF( left ) THEN
225  nq = m
226  nw = n
227  ELSE
228  nq = n
229  nw = m
230  END IF
231  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
232  info = -1
233  ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.lsame( trans, 'T' ) )
234  $ THEN
235  info = -2
236  ELSE IF( m.LT.0 ) THEN
237  info = -3
238  ELSE IF( n.LT.0 ) THEN
239  info = -4
240  ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, nq ) ) THEN
241  info = -5
242  ELSE IF( ihi.LT.min( ilo, nq ) .OR. ihi.GT.nq ) THEN
243  info = -6
244  ELSE IF( lda.LT.max( 1, nq ) ) THEN
245  info = -8
246  ELSE IF( ldc.LT.max( 1, m ) ) THEN
247  info = -11
248  ELSE IF( lwork.LT.max( 1, nw ) .AND. .NOT.lquery ) THEN
249  info = -13
250  END IF
251 *
252  IF( info.EQ.0 ) THEN
253  IF( left ) THEN
254  nb = ilaenv( 1, 'SORMQR', side // trans, nh, n, nh, -1 )
255  ELSE
256  nb = ilaenv( 1, 'SORMQR', side // trans, m, nh, nh, -1 )
257  END IF
258  lwkopt = max( 1, nw )*nb
259  work( 1 ) = lwkopt
260  END IF
261 *
262  IF( info.NE.0 ) THEN
263  CALL xerbla( 'SORMHR', -info )
264  return
265  ELSE IF( lquery ) THEN
266  return
267  END IF
268 *
269 * Quick return if possible
270 *
271  IF( m.EQ.0 .OR. n.EQ.0 .OR. nh.EQ.0 ) THEN
272  work( 1 ) = 1
273  return
274  END IF
275 *
276  IF( left ) THEN
277  mi = nh
278  ni = n
279  i1 = ilo + 1
280  i2 = 1
281  ELSE
282  mi = m
283  ni = nh
284  i1 = 1
285  i2 = ilo + 1
286  END IF
287 *
288  CALL sormqr( side, trans, mi, ni, nh, a( ilo+1, ilo ), lda,
289  $ tau( ilo ), c( i1, i2 ), ldc, work, lwork, iinfo )
290 *
291  work( 1 ) = lwkopt
292  return
293 *
294 * End of SORMHR
295 *
296  END