LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
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 *> \date December 2016
168 *
169 *> \ingroup realOTHERcomputational
170 *
171 * =====================================================================
172  SUBROUTINE sormtr( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
173  $ WORK, LWORK, INFO )
174 *
175 * -- LAPACK computational routine (version 3.7.0) --
176 * -- LAPACK is a software package provided by Univ. of Tennessee, --
177 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178 * December 2016
179 *
180 * .. Scalar Arguments ..
181  CHARACTER SIDE, TRANS, UPLO
182  INTEGER INFO, LDA, LDC, LWORK, M, N
183 * ..
184 * .. Array Arguments ..
185  REAL A( lda, * ), C( ldc, * ), TAU( * ),
186  $ work( * )
187 * ..
188 *
189 * =====================================================================
190 *
191 * .. Local Scalars ..
192  LOGICAL LEFT, LQUERY, UPPER
193  INTEGER I1, I2, IINFO, LWKOPT, MI, NI, NB, NQ, NW
194 * ..
195 * .. External Functions ..
196  LOGICAL LSAME
197  INTEGER ILAENV
198  EXTERNAL ilaenv, lsame
199 * ..
200 * .. External Subroutines ..
201  EXTERNAL sormql, sormqr, xerbla
202 * ..
203 * .. Intrinsic Functions ..
204  INTRINSIC max
205 * ..
206 * .. Executable Statements ..
207 *
208 * Test the input arguments
209 *
210  info = 0
211  left = lsame( side, 'L' )
212  upper = lsame( uplo, 'U' )
213  lquery = ( lwork.EQ.-1 )
214 *
215 * NQ is the order of Q and NW is the minimum dimension of WORK
216 *
217  IF( left ) THEN
218  nq = m
219  nw = n
220  ELSE
221  nq = n
222  nw = m
223  END IF
224  IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
225  info = -1
226  ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
227  info = -2
228  ELSE IF( .NOT.lsame( trans, 'N' ) .AND. .NOT.lsame( trans, 'T' ) )
229  $ THEN
230  info = -3
231  ELSE IF( m.LT.0 ) THEN
232  info = -4
233  ELSE IF( n.LT.0 ) THEN
234  info = -5
235  ELSE IF( lda.LT.max( 1, nq ) ) THEN
236  info = -7
237  ELSE IF( ldc.LT.max( 1, m ) ) THEN
238  info = -10
239  ELSE IF( lwork.LT.max( 1, nw ) .AND. .NOT.lquery ) THEN
240  info = -12
241  END IF
242 *
243  IF( info.EQ.0 ) THEN
244  IF( upper ) THEN
245  IF( left ) THEN
246  nb = ilaenv( 1, 'SORMQL', side // trans, m-1, n, m-1,
247  $ -1 )
248  ELSE
249  nb = ilaenv( 1, 'SORMQL', side // trans, m, n-1, n-1,
250  $ -1 )
251  END IF
252  ELSE
253  IF( left ) THEN
254  nb = ilaenv( 1, 'SORMQR', side // trans, m-1, n, m-1,
255  $ -1 )
256  ELSE
257  nb = ilaenv( 1, 'SORMQR', side // trans, m, n-1, n-1,
258  $ -1 )
259  END IF
260  END IF
261  lwkopt = max( 1, nw )*nb
262  work( 1 ) = lwkopt
263  END IF
264 *
265  IF( info.NE.0 ) THEN
266  CALL xerbla( 'SORMTR', -info )
267  RETURN
268  ELSE IF( lquery ) THEN
269  RETURN
270  END IF
271 *
272 * Quick return if possible
273 *
274  IF( m.EQ.0 .OR. n.EQ.0 .OR. nq.EQ.1 ) THEN
275  work( 1 ) = 1
276  RETURN
277  END IF
278 *
279  IF( left ) THEN
280  mi = m - 1
281  ni = n
282  ELSE
283  mi = m
284  ni = n - 1
285  END IF
286 *
287  IF( upper ) THEN
288 *
289 * Q was determined by a call to SSYTRD with UPLO = 'U'
290 *
291  CALL sormql( side, trans, mi, ni, nq-1, a( 1, 2 ), lda, tau, c,
292  $ ldc, work, lwork, iinfo )
293  ELSE
294 *
295 * Q was determined by a call to SSYTRD with UPLO = 'L'
296 *
297  IF( left ) THEN
298  i1 = 2
299  i2 = 1
300  ELSE
301  i1 = 1
302  i2 = 2
303  END IF
304  CALL sormqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
305  $ c( i1, i2 ), ldc, work, lwork, iinfo )
306  END IF
307  work( 1 ) = lwkopt
308  RETURN
309 *
310 * End of SORMTR
311 *
312  END
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
Definition: sormtr.f:174
subroutine sormql(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQL
Definition: sormql.f:170
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
Definition: sormqr.f:170
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62