LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slaptm.f
Go to the documentation of this file.
1 *> \brief \b SLAPTM
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER LDB, LDX, N, NRHS
15 * REAL ALPHA, BETA
16 * ..
17 * .. Array Arguments ..
18 * REAL B( LDB, * ), D( * ), E( * ), X( LDX, * )
19 * ..
20 *
21 *
22 *> \par Purpose:
23 * =============
24 *>
25 *> \verbatim
26 *>
27 *> SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal
28 *> matrix A and stores the result in a matrix B. The operation has the
29 *> form
30 *>
31 *> B := alpha * A * X + beta * B
32 *>
33 *> where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] N
40 *> \verbatim
41 *> N is INTEGER
42 *> The order of the matrix A. N >= 0.
43 *> \endverbatim
44 *>
45 *> \param[in] NRHS
46 *> \verbatim
47 *> NRHS is INTEGER
48 *> The number of right hand sides, i.e., the number of columns
49 *> of the matrices X and B.
50 *> \endverbatim
51 *>
52 *> \param[in] ALPHA
53 *> \verbatim
54 *> ALPHA is REAL
55 *> The scalar alpha. ALPHA must be 1. or -1.; otherwise,
56 *> it is assumed to be 0.
57 *> \endverbatim
58 *>
59 *> \param[in] D
60 *> \verbatim
61 *> D is REAL array, dimension (N)
62 *> The n diagonal elements of the tridiagonal matrix A.
63 *> \endverbatim
64 *>
65 *> \param[in] E
66 *> \verbatim
67 *> E is REAL array, dimension (N-1)
68 *> The (n-1) subdiagonal or superdiagonal elements of A.
69 *> \endverbatim
70 *>
71 *> \param[in] X
72 *> \verbatim
73 *> X is REAL array, dimension (LDX,NRHS)
74 *> The N by NRHS matrix X.
75 *> \endverbatim
76 *>
77 *> \param[in] LDX
78 *> \verbatim
79 *> LDX is INTEGER
80 *> The leading dimension of the array X. LDX >= max(N,1).
81 *> \endverbatim
82 *>
83 *> \param[in] BETA
84 *> \verbatim
85 *> BETA is REAL
86 *> The scalar beta. BETA must be 0., 1., or -1.; otherwise,
87 *> it is assumed to be 1.
88 *> \endverbatim
89 *>
90 *> \param[in,out] B
91 *> \verbatim
92 *> B is REAL array, dimension (LDB,NRHS)
93 *> On entry, the N by NRHS matrix B.
94 *> On exit, B is overwritten by the matrix expression
95 *> B := alpha * A * X + beta * B.
96 *> \endverbatim
97 *>
98 *> \param[in] LDB
99 *> \verbatim
100 *> LDB is INTEGER
101 *> The leading dimension of the array B. LDB >= max(N,1).
102 *> \endverbatim
103 *
104 * Authors:
105 * ========
106 *
107 *> \author Univ. of Tennessee
108 *> \author Univ. of California Berkeley
109 *> \author Univ. of Colorado Denver
110 *> \author NAG Ltd.
111 *
112 *> \date November 2011
113 *
114 *> \ingroup single_lin
115 *
116 * =====================================================================
117  SUBROUTINE slaptm( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
118 *
119 * -- LAPACK test routine (version 3.4.0) --
120 * -- LAPACK is a software package provided by Univ. of Tennessee, --
121 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
122 * November 2011
123 *
124 * .. Scalar Arguments ..
125  INTEGER ldb, ldx, n, nrhs
126  REAL alpha, beta
127 * ..
128 * .. Array Arguments ..
129  REAL b( ldb, * ), d( * ), e( * ), x( ldx, * )
130 * ..
131 *
132 * =====================================================================
133 *
134 * .. Parameters ..
135  REAL one, zero
136  parameter( one = 1.0e+0, zero = 0.0e+0 )
137 * ..
138 * .. Local Scalars ..
139  INTEGER i, j
140 * ..
141 * .. Executable Statements ..
142 *
143  IF( n.EQ.0 )
144  $ return
145 *
146 * Multiply B by BETA if BETA.NE.1.
147 *
148  IF( beta.EQ.zero ) THEN
149  DO 20 j = 1, nrhs
150  DO 10 i = 1, n
151  b( i, j ) = zero
152  10 continue
153  20 continue
154  ELSE IF( beta.EQ.-one ) THEN
155  DO 40 j = 1, nrhs
156  DO 30 i = 1, n
157  b( i, j ) = -b( i, j )
158  30 continue
159  40 continue
160  END IF
161 *
162  IF( alpha.EQ.one ) THEN
163 *
164 * Compute B := B + A*X
165 *
166  DO 60 j = 1, nrhs
167  IF( n.EQ.1 ) THEN
168  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
169  ELSE
170  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
171  $ e( 1 )*x( 2, j )
172  b( n, j ) = b( n, j ) + e( n-1 )*x( n-1, j ) +
173  $ d( n )*x( n, j )
174  DO 50 i = 2, n - 1
175  b( i, j ) = b( i, j ) + e( i-1 )*x( i-1, j ) +
176  $ d( i )*x( i, j ) + e( i )*x( i+1, j )
177  50 continue
178  END IF
179  60 continue
180  ELSE IF( alpha.EQ.-one ) THEN
181 *
182 * Compute B := B - A*X
183 *
184  DO 80 j = 1, nrhs
185  IF( n.EQ.1 ) THEN
186  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
187  ELSE
188  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
189  $ e( 1 )*x( 2, j )
190  b( n, j ) = b( n, j ) - e( n-1 )*x( n-1, j ) -
191  $ d( n )*x( n, j )
192  DO 70 i = 2, n - 1
193  b( i, j ) = b( i, j ) - e( i-1 )*x( i-1, j ) -
194  $ d( i )*x( i, j ) - e( i )*x( i+1, j )
195  70 continue
196  END IF
197  80 continue
198  END IF
199  return
200 *
201 * End of SLAPTM
202 *
203  END