LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
slaptm.f
Go to the documentation of this file.
00001 *> \brief \b SLAPTM
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            LDB, LDX, N, NRHS
00015 *       REAL               ALPHA, BETA
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       REAL               B( LDB, * ), D( * ), E( * ), X( LDX, * )
00019 *       ..
00020 *  
00021 *
00022 *> \par Purpose:
00023 *  =============
00024 *>
00025 *> \verbatim
00026 *>
00027 *> SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal
00028 *> matrix A and stores the result in a matrix B.  The operation has the
00029 *> form
00030 *>
00031 *>    B := alpha * A * X + beta * B
00032 *>
00033 *> where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] N
00040 *> \verbatim
00041 *>          N is INTEGER
00042 *>          The order of the matrix A.  N >= 0.
00043 *> \endverbatim
00044 *>
00045 *> \param[in] NRHS
00046 *> \verbatim
00047 *>          NRHS is INTEGER
00048 *>          The number of right hand sides, i.e., the number of columns
00049 *>          of the matrices X and B.
00050 *> \endverbatim
00051 *>
00052 *> \param[in] ALPHA
00053 *> \verbatim
00054 *>          ALPHA is REAL
00055 *>          The scalar alpha.  ALPHA must be 1. or -1.; otherwise,
00056 *>          it is assumed to be 0.
00057 *> \endverbatim
00058 *>
00059 *> \param[in] D
00060 *> \verbatim
00061 *>          D is REAL array, dimension (N)
00062 *>          The n diagonal elements of the tridiagonal matrix A.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] E
00066 *> \verbatim
00067 *>          E is REAL array, dimension (N-1)
00068 *>          The (n-1) subdiagonal or superdiagonal elements of A.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] X
00072 *> \verbatim
00073 *>          X is REAL array, dimension (LDX,NRHS)
00074 *>          The N by NRHS matrix X.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] LDX
00078 *> \verbatim
00079 *>          LDX is INTEGER
00080 *>          The leading dimension of the array X.  LDX >= max(N,1).
00081 *> \endverbatim
00082 *>
00083 *> \param[in] BETA
00084 *> \verbatim
00085 *>          BETA is REAL
00086 *>          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
00087 *>          it is assumed to be 1.
00088 *> \endverbatim
00089 *>
00090 *> \param[in,out] B
00091 *> \verbatim
00092 *>          B is REAL array, dimension (LDB,NRHS)
00093 *>          On entry, the N by NRHS matrix B.
00094 *>          On exit, B is overwritten by the matrix expression
00095 *>          B := alpha * A * X + beta * B.
00096 *> \endverbatim
00097 *>
00098 *> \param[in] LDB
00099 *> \verbatim
00100 *>          LDB is INTEGER
00101 *>          The leading dimension of the array B.  LDB >= max(N,1).
00102 *> \endverbatim
00103 *
00104 *  Authors:
00105 *  ========
00106 *
00107 *> \author Univ. of Tennessee 
00108 *> \author Univ. of California Berkeley 
00109 *> \author Univ. of Colorado Denver 
00110 *> \author NAG Ltd. 
00111 *
00112 *> \date November 2011
00113 *
00114 *> \ingroup single_lin
00115 *
00116 *  =====================================================================
00117       SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
00118 *
00119 *  -- LAPACK test routine (version 3.4.0) --
00120 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00121 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00122 *     November 2011
00123 *
00124 *     .. Scalar Arguments ..
00125       INTEGER            LDB, LDX, N, NRHS
00126       REAL               ALPHA, BETA
00127 *     ..
00128 *     .. Array Arguments ..
00129       REAL               B( LDB, * ), D( * ), E( * ), X( LDX, * )
00130 *     ..
00131 *
00132 *  =====================================================================
00133 *
00134 *     .. Parameters ..
00135       REAL               ONE, ZERO
00136       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00137 *     ..
00138 *     .. Local Scalars ..
00139       INTEGER            I, J
00140 *     ..
00141 *     .. Executable Statements ..
00142 *
00143       IF( N.EQ.0 )
00144      $   RETURN
00145 *
00146 *     Multiply B by BETA if BETA.NE.1.
00147 *
00148       IF( BETA.EQ.ZERO ) THEN
00149          DO 20 J = 1, NRHS
00150             DO 10 I = 1, N
00151                B( I, J ) = ZERO
00152    10       CONTINUE
00153    20    CONTINUE
00154       ELSE IF( BETA.EQ.-ONE ) THEN
00155          DO 40 J = 1, NRHS
00156             DO 30 I = 1, N
00157                B( I, J ) = -B( I, J )
00158    30       CONTINUE
00159    40    CONTINUE
00160       END IF
00161 *
00162       IF( ALPHA.EQ.ONE ) THEN
00163 *
00164 *        Compute B := B + A*X
00165 *
00166          DO 60 J = 1, NRHS
00167             IF( N.EQ.1 ) THEN
00168                B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
00169             ELSE
00170                B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
00171      $                     E( 1 )*X( 2, J )
00172                B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) +
00173      $                     D( N )*X( N, J )
00174                DO 50 I = 2, N - 1
00175                   B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) +
00176      $                        D( I )*X( I, J ) + E( I )*X( I+1, J )
00177    50          CONTINUE
00178             END IF
00179    60    CONTINUE
00180       ELSE IF( ALPHA.EQ.-ONE ) THEN
00181 *
00182 *        Compute B := B - A*X
00183 *
00184          DO 80 J = 1, NRHS
00185             IF( N.EQ.1 ) THEN
00186                B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
00187             ELSE
00188                B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
00189      $                     E( 1 )*X( 2, J )
00190                B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) -
00191      $                     D( N )*X( N, J )
00192                DO 70 I = 2, N - 1
00193                   B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) -
00194      $                        D( I )*X( I, J ) - E( I )*X( I+1, J )
00195    70          CONTINUE
00196             END IF
00197    80    CONTINUE
00198       END IF
00199       RETURN
00200 *
00201 *     End of SLAPTM
00202 *
00203       END
 All Files Functions