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