LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ slaptm()

subroutine slaptm ( integer  N,
integer  NRHS,
real  ALPHA,
real, dimension( * )  D,
real, dimension( * )  E,
real, dimension( ldx, * )  X,
integer  LDX,
real  BETA,
real, dimension( ldb, * )  B,
integer  LDB 
)

SLAPTM

Purpose:
 SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal
 matrix A and stores the result in a matrix B.  The operation has the
 form

    B := alpha * A * X + beta * B

 where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
Parameters
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.
[in]NRHS
          NRHS is INTEGER
          The number of right hand sides, i.e., the number of columns
          of the matrices X and B.
[in]ALPHA
          ALPHA is REAL
          The scalar alpha.  ALPHA must be 1. or -1.; otherwise,
          it is assumed to be 0.
[in]D
          D is REAL array, dimension (N)
          The n diagonal elements of the tridiagonal matrix A.
[in]E
          E is REAL array, dimension (N-1)
          The (n-1) subdiagonal or superdiagonal elements of A.
[in]X
          X is REAL array, dimension (LDX,NRHS)
          The N by NRHS matrix X.
[in]LDX
          LDX is INTEGER
          The leading dimension of the array X.  LDX >= max(N,1).
[in]BETA
          BETA is REAL
          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
          it is assumed to be 1.
[in,out]B
          B is REAL array, dimension (LDB,NRHS)
          On entry, the N by NRHS matrix B.
          On exit, B is overwritten by the matrix expression
          B := alpha * A * X + beta * B.
[in]LDB
          LDB is INTEGER
          The leading dimension of the array B.  LDB >= max(N,1).
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 115 of file slaptm.f.

116 *
117 * -- LAPACK test routine --
118 * -- LAPACK is a software package provided by Univ. of Tennessee, --
119 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
120 *
121 * .. Scalar Arguments ..
122  INTEGER LDB, LDX, N, NRHS
123  REAL ALPHA, BETA
124 * ..
125 * .. Array Arguments ..
126  REAL B( LDB, * ), D( * ), E( * ), X( LDX, * )
127 * ..
128 *
129 * =====================================================================
130 *
131 * .. Parameters ..
132  REAL ONE, ZERO
133  parameter( one = 1.0e+0, zero = 0.0e+0 )
134 * ..
135 * .. Local Scalars ..
136  INTEGER I, J
137 * ..
138 * .. Executable Statements ..
139 *
140  IF( n.EQ.0 )
141  $ RETURN
142 *
143 * Multiply B by BETA if BETA.NE.1.
144 *
145  IF( beta.EQ.zero ) THEN
146  DO 20 j = 1, nrhs
147  DO 10 i = 1, n
148  b( i, j ) = zero
149  10 CONTINUE
150  20 CONTINUE
151  ELSE IF( beta.EQ.-one ) THEN
152  DO 40 j = 1, nrhs
153  DO 30 i = 1, n
154  b( i, j ) = -b( i, j )
155  30 CONTINUE
156  40 CONTINUE
157  END IF
158 *
159  IF( alpha.EQ.one ) THEN
160 *
161 * Compute B := B + A*X
162 *
163  DO 60 j = 1, nrhs
164  IF( n.EQ.1 ) THEN
165  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j )
166  ELSE
167  b( 1, j ) = b( 1, j ) + d( 1 )*x( 1, j ) +
168  $ e( 1 )*x( 2, j )
169  b( n, j ) = b( n, j ) + e( n-1 )*x( n-1, j ) +
170  $ d( n )*x( n, j )
171  DO 50 i = 2, n - 1
172  b( i, j ) = b( i, j ) + e( i-1 )*x( i-1, j ) +
173  $ d( i )*x( i, j ) + e( i )*x( i+1, j )
174  50 CONTINUE
175  END IF
176  60 CONTINUE
177  ELSE IF( alpha.EQ.-one ) THEN
178 *
179 * Compute B := B - A*X
180 *
181  DO 80 j = 1, nrhs
182  IF( n.EQ.1 ) THEN
183  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j )
184  ELSE
185  b( 1, j ) = b( 1, j ) - d( 1 )*x( 1, j ) -
186  $ e( 1 )*x( 2, j )
187  b( n, j ) = b( n, j ) - e( n-1 )*x( n-1, j ) -
188  $ d( n )*x( n, j )
189  DO 70 i = 2, n - 1
190  b( i, j ) = b( i, j ) - e( i-1 )*x( i-1, j ) -
191  $ d( i )*x( i, j ) - e( i )*x( i+1, j )
192  70 CONTINUE
193  END IF
194  80 CONTINUE
195  END IF
196  RETURN
197 *
198 * End of SLAPTM
199 *
Here is the caller graph for this function: