LAPACK 3.3.0

slaptm.f

Go to the documentation of this file.
00001       SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            LDB, LDX, N, NRHS
00009       REAL               ALPHA, BETA
00010 *     ..
00011 *     .. Array Arguments ..
00012       REAL               B( LDB, * ), D( * ), E( * ), X( LDX, * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal
00019 *  matrix A and stores the result in a matrix B.  The operation has the
00020 *  form
00021 *
00022 *     B := alpha * A * X + beta * B
00023 *
00024 *  where alpha may be either 1. or -1. and beta may be 0., 1., or -1.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  N       (input) INTEGER
00030 *          The order of the matrix A.  N >= 0.
00031 *
00032 *  NRHS    (input) INTEGER
00033 *          The number of right hand sides, i.e., the number of columns
00034 *          of the matrices X and B.
00035 *
00036 *  ALPHA   (input) REAL
00037 *          The scalar alpha.  ALPHA must be 1. or -1.; otherwise,
00038 *          it is assumed to be 0.
00039 *
00040 *  D       (input) REAL array, dimension (N)
00041 *          The n diagonal elements of the tridiagonal matrix A.
00042 *
00043 *  E       (input) REAL array, dimension (N-1)
00044 *          The (n-1) subdiagonal or superdiagonal elements of A.
00045 *
00046 *  X       (input) REAL array, dimension (LDX,NRHS)
00047 *          The N by NRHS matrix X.
00048 *
00049 *  LDX     (input) INTEGER
00050 *          The leading dimension of the array X.  LDX >= max(N,1).
00051 *
00052 *  BETA    (input) REAL
00053 *          The scalar beta.  BETA must be 0., 1., or -1.; otherwise,
00054 *          it is assumed to be 1.
00055 *
00056 *  B       (input/output) REAL array, dimension (LDB,NRHS)
00057 *          On entry, the N by NRHS matrix B.
00058 *          On exit, B is overwritten by the matrix expression
00059 *          B := alpha * A * X + beta * B.
00060 *
00061 *  LDB     (input) INTEGER
00062 *          The leading dimension of the array B.  LDB >= max(N,1).
00063 *
00064 *  =====================================================================
00065 *
00066 *     .. Parameters ..
00067       REAL               ONE, ZERO
00068       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00069 *     ..
00070 *     .. Local Scalars ..
00071       INTEGER            I, J
00072 *     ..
00073 *     .. Executable Statements ..
00074 *
00075       IF( N.EQ.0 )
00076      $   RETURN
00077 *
00078 *     Multiply B by BETA if BETA.NE.1.
00079 *
00080       IF( BETA.EQ.ZERO ) THEN
00081          DO 20 J = 1, NRHS
00082             DO 10 I = 1, N
00083                B( I, J ) = ZERO
00084    10       CONTINUE
00085    20    CONTINUE
00086       ELSE IF( BETA.EQ.-ONE ) THEN
00087          DO 40 J = 1, NRHS
00088             DO 30 I = 1, N
00089                B( I, J ) = -B( I, J )
00090    30       CONTINUE
00091    40    CONTINUE
00092       END IF
00093 *
00094       IF( ALPHA.EQ.ONE ) THEN
00095 *
00096 *        Compute B := B + A*X
00097 *
00098          DO 60 J = 1, NRHS
00099             IF( N.EQ.1 ) THEN
00100                B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J )
00101             ELSE
00102                B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) +
00103      $                     E( 1 )*X( 2, J )
00104                B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) +
00105      $                     D( N )*X( N, J )
00106                DO 50 I = 2, N - 1
00107                   B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) +
00108      $                        D( I )*X( I, J ) + E( I )*X( I+1, J )
00109    50          CONTINUE
00110             END IF
00111    60    CONTINUE
00112       ELSE IF( ALPHA.EQ.-ONE ) THEN
00113 *
00114 *        Compute B := B - A*X
00115 *
00116          DO 80 J = 1, NRHS
00117             IF( N.EQ.1 ) THEN
00118                B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J )
00119             ELSE
00120                B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) -
00121      $                     E( 1 )*X( 2, J )
00122                B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) -
00123      $                     D( N )*X( N, J )
00124                DO 70 I = 2, N - 1
00125                   B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) -
00126      $                        D( I )*X( I, J ) - E( I )*X( I+1, J )
00127    70          CONTINUE
00128             END IF
00129    80    CONTINUE
00130       END IF
00131       RETURN
00132 *
00133 *     End of SLAPTM
00134 *
00135       END
 All Files Functions