LAPACK 3.12.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 unmtr
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 REAL SROUNDUP_LWORK
196 EXTERNAL ilaenv, lsame, sroundup_lwork
197* ..
198* .. External Subroutines ..
199 EXTERNAL sormql, sormqr, xerbla
200* ..
201* .. Intrinsic Functions ..
202 INTRINSIC max
203* ..
204* .. Executable Statements ..
205*
206* Test the input arguments
207*
208 info = 0
209 left = lsame( side, 'L' )
210 upper = lsame( uplo, 'U' )
211 lquery = ( lwork.EQ.-1 )
212*
213* NQ is the order of Q and NW is the minimum dimension of WORK
214*
215 IF( left ) THEN
216 nq = m
217 nw = max( 1, n )
218 ELSE
219 nq = n
220 nw = max( 1, m )
221 END IF
222 IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
223 info = -1
224 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
225 info = -2
226 ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.lsame( trans, 'T' ) )
227 $ THEN
228 info = -3
229 ELSE IF( m.LT.0 ) THEN
230 info = -4
231 ELSE IF( n.LT.0 ) THEN
232 info = -5
233 ELSE IF( lda.LT.max( 1, nq ) ) THEN
234 info = -7
235 ELSE IF( ldc.LT.max( 1, m ) ) THEN
236 info = -10
237 ELSE IF( lwork.LT.nw .AND. .NOT.lquery ) THEN
238 info = -12
239 END IF
240*
241 IF( info.EQ.0 ) THEN
242 IF( upper ) THEN
243 IF( left ) THEN
244 nb = ilaenv( 1, 'SORMQL', side // trans, m-1, n, m-1,
245 $ -1 )
246 ELSE
247 nb = ilaenv( 1, 'SORMQL', side // trans, m, n-1, n-1,
248 $ -1 )
249 END IF
250 ELSE
251 IF( left ) THEN
252 nb = ilaenv( 1, 'SORMQR', side // trans, m-1, n, m-1,
253 $ -1 )
254 ELSE
255 nb = ilaenv( 1, 'SORMQR', side // trans, m, n-1, n-1,
256 $ -1 )
257 END IF
258 END IF
259 lwkopt = nw*nb
260 work( 1 ) = sroundup_lwork(lwkopt)
261 END IF
262*
263 IF( info.NE.0 ) THEN
264 CALL xerbla( 'SORMTR', -info )
265 RETURN
266 ELSE IF( lquery ) THEN
267 RETURN
268 END IF
269*
270* Quick return if possible
271*
272 IF( m.EQ.0 .OR. n.EQ.0 .OR. nq.EQ.1 ) THEN
273 work( 1 ) = 1
274 RETURN
275 END IF
276*
277 IF( left ) THEN
278 mi = m - 1
279 ni = n
280 ELSE
281 mi = m
282 ni = n - 1
283 END IF
284*
285 IF( upper ) THEN
286*
287* Q was determined by a call to SSYTRD with UPLO = 'U'
288*
289 CALL sormql( side, trans, mi, ni, nq-1, a( 1, 2 ), lda, tau, c,
290 $ ldc, work, lwork, iinfo )
291 ELSE
292*
293* Q was determined by a call to SSYTRD with UPLO = 'L'
294*
295 IF( left ) THEN
296 i1 = 2
297 i2 = 1
298 ELSE
299 i1 = 1
300 i2 = 2
301 END IF
302 CALL sormqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
303 $ c( i1, i2 ), ldc, work, lwork, iinfo )
304 END IF
305 work( 1 ) = sroundup_lwork(lwkopt)
306 RETURN
307*
308* End of SORMTR
309*
310 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
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
subroutine sormtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
SORMTR
Definition sormtr.f:172