LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dopmtr()

subroutine dopmtr ( character side,
character uplo,
character trans,
integer m,
integer n,
double precision, dimension( * ) ap,
double precision, dimension( * ) tau,
double precision, dimension( ldc, * ) c,
integer ldc,
double precision, dimension( * ) work,
integer info )

DOPMTR

Download DOPMTR + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> DOPMTR overwrites the general real M-by-N matrix C with
!>
!>                 SIDE = 'L'     SIDE = 'R'
!> TRANS = 'N':      Q * C          C * Q
!> TRANS = 'T':      Q**T * C       C * Q**T
!>
!> where Q is a real orthogonal matrix of order nq, with nq = m if
!> SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
!> nq-1 elementary reflectors, as returned by DSPTRD using packed
!> storage:
!>
!> if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
!>
!> if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
!>
Parameters
[in]SIDE
!>          SIDE is CHARACTER*1
!>          = 'L': apply Q or Q**T from the Left;
!>          = 'R': apply Q or Q**T from the Right.
!>
[in]UPLO
!>          UPLO is CHARACTER*1
!>          = 'U': Upper triangular packed storage used in previous
!>                 call to DSPTRD;
!>          = 'L': Lower triangular packed storage used in previous
!>                 call to DSPTRD.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>          = 'N':  No transpose, apply Q;
!>          = 'T':  Transpose, apply Q**T.
!>
[in]M
!>          M is INTEGER
!>          The number of rows of the matrix C. M >= 0.
!>
[in]N
!>          N is INTEGER
!>          The number of columns of the matrix C. N >= 0.
!>
[in]AP
!>          AP is DOUBLE PRECISION array, dimension
!>                               (M*(M+1)/2) if SIDE = 'L'
!>                               (N*(N+1)/2) if SIDE = 'R'
!>          The vectors which define the elementary reflectors, as
!>          returned by DSPTRD.  AP is modified by the routine but
!>          restored on exit.
!>
[in]TAU
!>          TAU is DOUBLE PRECISION array, dimension (M-1) if SIDE = 'L'
!>                                     or (N-1) if SIDE = 'R'
!>          TAU(i) must contain the scalar factor of the elementary
!>          reflector H(i), as returned by DSPTRD.
!>
[in,out]C
!>          C is DOUBLE PRECISION array, dimension (LDC,N)
!>          On entry, the M-by-N matrix C.
!>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
!>
[in]LDC
!>          LDC is INTEGER
!>          The leading dimension of the array C. LDC >= max(1,M).
!>
[out]WORK
!>          WORK is DOUBLE PRECISION array, dimension
!>                                   (N) if SIDE = 'L'
!>                                   (M) if SIDE = 'R'
!>
[out]INFO
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          < 0:  if INFO = -i, the i-th argument had an illegal value
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 146 of file dopmtr.f.

149*
150* -- LAPACK computational routine --
151* -- LAPACK is a software package provided by Univ. of Tennessee, --
152* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153*
154* .. Scalar Arguments ..
155 CHARACTER SIDE, TRANS, UPLO
156 INTEGER INFO, LDC, M, N
157* ..
158* .. Array Arguments ..
159 DOUBLE PRECISION AP( * ), C( LDC, * ), TAU( * ), WORK( * )
160* ..
161*
162* =====================================================================
163*
164* .. Parameters ..
165 DOUBLE PRECISION ONE
166 parameter( one = 1.0d+0 )
167* ..
168* .. Local Scalars ..
169 LOGICAL FORWRD, LEFT, NOTRAN, UPPER
170 INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ
171 DOUBLE PRECISION AII
172* ..
173* .. External Functions ..
174 LOGICAL LSAME
175 EXTERNAL lsame
176* ..
177* .. External Subroutines ..
178 EXTERNAL dlarf, xerbla
179* ..
180* .. Intrinsic Functions ..
181 INTRINSIC max
182* ..
183* .. Executable Statements ..
184*
185* Test the input arguments
186*
187 info = 0
188 left = lsame( side, 'L' )
189 notran = lsame( trans, 'N' )
190 upper = lsame( uplo, 'U' )
191*
192* NQ is the order of Q
193*
194 IF( left ) THEN
195 nq = m
196 ELSE
197 nq = n
198 END IF
199 IF( .NOT.left .AND. .NOT.lsame( side, 'R' ) ) THEN
200 info = -1
201 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
202 info = -2
203 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) ) THEN
204 info = -3
205 ELSE IF( m.LT.0 ) THEN
206 info = -4
207 ELSE IF( n.LT.0 ) THEN
208 info = -5
209 ELSE IF( ldc.LT.max( 1, m ) ) THEN
210 info = -9
211 END IF
212 IF( info.NE.0 ) THEN
213 CALL xerbla( 'DOPMTR', -info )
214 RETURN
215 END IF
216*
217* Quick return if possible
218*
219 IF( m.EQ.0 .OR. n.EQ.0 )
220 $ RETURN
221*
222 IF( upper ) THEN
223*
224* Q was determined by a call to DSPTRD with UPLO = 'U'
225*
226 forwrd = ( left .AND. notran ) .OR.
227 $ ( .NOT.left .AND. .NOT.notran )
228*
229 IF( forwrd ) THEN
230 i1 = 1
231 i2 = nq - 1
232 i3 = 1
233 ii = 2
234 ELSE
235 i1 = nq - 1
236 i2 = 1
237 i3 = -1
238 ii = nq*( nq+1 ) / 2 - 1
239 END IF
240*
241 IF( left ) THEN
242 ni = n
243 ELSE
244 mi = m
245 END IF
246*
247 DO 10 i = i1, i2, i3
248 IF( left ) THEN
249*
250* H(i) is applied to C(1:i,1:n)
251*
252 mi = i
253 ELSE
254*
255* H(i) is applied to C(1:m,1:i)
256*
257 ni = i
258 END IF
259*
260* Apply H(i)
261*
262 CALL dlarf1l( side, mi, ni, ap( ii-i+1 ), 1, tau( i ), c,
263 $ ldc,
264 $ work )
265*
266 IF( forwrd ) THEN
267 ii = ii + i + 2
268 ELSE
269 ii = ii - i - 1
270 END IF
271 10 CONTINUE
272 ELSE
273*
274* Q was determined by a call to DSPTRD with UPLO = 'L'.
275*
276 forwrd = ( left .AND. .NOT.notran ) .OR.
277 $ ( .NOT.left .AND. notran )
278*
279 IF( forwrd ) THEN
280 i1 = 1
281 i2 = nq - 1
282 i3 = 1
283 ii = 2
284 ELSE
285 i1 = nq - 1
286 i2 = 1
287 i3 = -1
288 ii = nq*( nq+1 ) / 2 - 1
289 END IF
290*
291 IF( left ) THEN
292 ni = n
293 jc = 1
294 ELSE
295 mi = m
296 ic = 1
297 END IF
298*
299 DO 20 i = i1, i2, i3
300 aii = ap( ii )
301 ap( ii ) = one
302 IF( left ) THEN
303*
304* H(i) is applied to C(i+1:m,1:n)
305*
306 mi = m - i
307 ic = i + 1
308 ELSE
309*
310* H(i) is applied to C(1:m,i+1:n)
311*
312 ni = n - i
313 jc = i + 1
314 END IF
315*
316* Apply H(i)
317*
318 CALL dlarf( side, mi, ni, ap( ii ), 1, tau( i ),
319 $ c( ic, jc ), ldc, work )
320 ap( ii ) = aii
321*
322 IF( forwrd ) THEN
323 ii = ii + nq - i + 1
324 ELSE
325 ii = ii - nq + i - 2
326 END IF
327 20 CONTINUE
328 END IF
329 RETURN
330*
331* End of DOPMTR
332*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
dlarf1l
subroutine dlarf1l(side, m, n, v, incv, tau, c, ldc, work)
DLARF1L applies an elementary reflector to a general rectangular
Definition dlarf1l.f:124
dlarf
subroutine dlarf(side, m, n, v, incv, tau, c, ldc, work)
DLARF applies an elementary reflector to a general rectangular matrix.
Definition dlarf.f:122
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: