KTH framework for Nek5000 toolboxes; testing version  0.0.1
dlarf.f
Go to the documentation of this file.
1  SUBROUTINE dlarf( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
2 *
3 * -- LAPACK auxiliary routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * Courant Institute, Argonne National Lab, and Rice University
6 * February 29, 1992
7 *
8 * .. Scalar Arguments ..
9  CHARACTER SIDE
10  INTEGER INCV, LDC, M, N
11  DOUBLE PRECISION TAU
12 * ..
13 * .. Array Arguments ..
14  DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * DLARF applies a real elementary reflector H to a real m by n matrix
21 * C, from either the left or the right. H is represented in the form
22 *
23 * H = I - tau * v * v'
24 *
25 * where tau is a real scalar and v is a real vector.
26 *
27 * If tau = 0, then H is taken to be the unit matrix.
28 *
29 * Arguments
30 * =========
31 *
32 * SIDE (input) CHARACTER*1
33 * = 'L': form H * C
34 * = 'R': form C * H
35 *
36 * M (input) INTEGER
37 * The number of rows of the matrix C.
38 *
39 * N (input) INTEGER
40 * The number of columns of the matrix C.
41 *
42 * V (input) DOUBLE PRECISION array, dimension
43 * (1 + (M-1)*abs(INCV)) if SIDE = 'L'
44 * or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
45 * The vector v in the representation of H. V is not used if
46 * TAU = 0.
47 *
48 * INCV (input) INTEGER
49 * The increment between elements of v. INCV <> 0.
50 *
51 * TAU (input) DOUBLE PRECISION
52 * The value tau in the representation of H.
53 *
54 * C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
55 * On entry, the m by n matrix C.
56 * On exit, C is overwritten by the matrix H * C if SIDE = 'L',
57 * or C * H if SIDE = 'R'.
58 *
59 * LDC (input) INTEGER
60 * The leading dimension of the array C. LDC >= max(1,M).
61 *
62 * WORK (workspace) DOUBLE PRECISION array, dimension
63 * (N) if SIDE = 'L'
64 * or (M) if SIDE = 'R'
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69  DOUBLE PRECISION ONE, ZERO
70  parameter( one = 1.0d+0, zero = 0.0d+0 )
71 * ..
72 * .. External Subroutines ..
73  EXTERNAL dgemv, dger
74 * ..
75 * .. External Functions ..
76  LOGICAL LSAME
77  EXTERNAL lsame
78 * ..
79 * .. Executable Statements ..
80 *
81  IF( lsame( side, 'L' ) ) THEN
82 *
83 * Form H * C
84 *
85  IF( tau.NE.zero ) THEN
86 *
87 * w := C' * v
88 *
89  CALL dgemv( 'Transpose', m, n, one, c, ldc, v, incv, zero,
90  $ work, 1 )
91 *
92 * C := C - v * w'
93 *
94  CALL dger( m, n, -tau, v, incv, work, 1, c, ldc )
95  END IF
96  ELSE
97 *
98 * Form C * H
99 *
100  IF( tau.NE.zero ) THEN
101 *
102 * w := C * v
103 *
104  CALL dgemv( 'No transpose', m, n, one, c, ldc, v, incv,
105  $ zero, work, 1 )
106 *
107 * C := C - w * v'
108 *
109  CALL dger( m, n, -tau, work, 1, v, incv, c, ldc )
110  END IF
111  END IF
112  RETURN
113 *
114 * End of DLARF
115 *
116  END
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
Definition: dgemv.f:3
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
Definition: dger.f:2
subroutine dlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
Definition: dlarf.f:2