|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, 00002 $ B, LDB ) 00003 * 00004 * -- LAPACK auxiliary routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER TRANS 00011 INTEGER LDB, LDX, N, NRHS 00012 REAL ALPHA, BETA 00013 * .. 00014 * .. Array Arguments .. 00015 REAL B( LDB, * ), D( * ), DL( * ), DU( * ), 00016 $ X( LDX, * ) 00017 * .. 00018 * 00019 * Purpose 00020 * ======= 00021 * 00022 * SLAGTM performs a matrix-vector product of the form 00023 * 00024 * B := alpha * A * X + beta * B 00025 * 00026 * where A is a tridiagonal matrix of order N, B and X are N by NRHS 00027 * matrices, and alpha and beta are real scalars, each of which may be 00028 * 0., 1., or -1. 00029 * 00030 * Arguments 00031 * ========= 00032 * 00033 * TRANS (input) CHARACTER*1 00034 * Specifies the operation applied to A. 00035 * = 'N': No transpose, B := alpha * A * X + beta * B 00036 * = 'T': Transpose, B := alpha * A'* X + beta * B 00037 * = 'C': Conjugate transpose = Transpose 00038 * 00039 * N (input) INTEGER 00040 * The order of the matrix A. N >= 0. 00041 * 00042 * NRHS (input) INTEGER 00043 * The number of right hand sides, i.e., the number of columns 00044 * of the matrices X and B. 00045 * 00046 * ALPHA (input) REAL 00047 * The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise, 00048 * it is assumed to be 0. 00049 * 00050 * DL (input) REAL array, dimension (N-1) 00051 * The (n-1) sub-diagonal elements of T. 00052 * 00053 * D (input) REAL array, dimension (N) 00054 * The diagonal elements of T. 00055 * 00056 * DU (input) REAL array, dimension (N-1) 00057 * The (n-1) super-diagonal elements of T. 00058 * 00059 * X (input) REAL array, dimension (LDX,NRHS) 00060 * The N by NRHS matrix X. 00061 * LDX (input) INTEGER 00062 * The leading dimension of the array X. LDX >= max(N,1). 00063 * 00064 * BETA (input) REAL 00065 * The scalar beta. BETA must be 0., 1., or -1.; otherwise, 00066 * it is assumed to be 1. 00067 * 00068 * B (input/output) REAL array, dimension (LDB,NRHS) 00069 * On entry, the N by NRHS matrix B. 00070 * On exit, B is overwritten by the matrix expression 00071 * B := alpha * A * X + beta * B. 00072 * 00073 * LDB (input) INTEGER 00074 * The leading dimension of the array B. LDB >= max(N,1). 00075 * 00076 * ===================================================================== 00077 * 00078 * .. Parameters .. 00079 REAL ONE, ZERO 00080 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00081 * .. 00082 * .. Local Scalars .. 00083 INTEGER I, J 00084 * .. 00085 * .. External Functions .. 00086 LOGICAL LSAME 00087 EXTERNAL LSAME 00088 * .. 00089 * .. Executable Statements .. 00090 * 00091 IF( N.EQ.0 ) 00092 $ RETURN 00093 * 00094 * Multiply B by BETA if BETA.NE.1. 00095 * 00096 IF( BETA.EQ.ZERO ) THEN 00097 DO 20 J = 1, NRHS 00098 DO 10 I = 1, N 00099 B( I, J ) = ZERO 00100 10 CONTINUE 00101 20 CONTINUE 00102 ELSE IF( BETA.EQ.-ONE ) THEN 00103 DO 40 J = 1, NRHS 00104 DO 30 I = 1, N 00105 B( I, J ) = -B( I, J ) 00106 30 CONTINUE 00107 40 CONTINUE 00108 END IF 00109 * 00110 IF( ALPHA.EQ.ONE ) THEN 00111 IF( LSAME( TRANS, 'N' ) ) THEN 00112 * 00113 * Compute B := B + A*X 00114 * 00115 DO 60 J = 1, NRHS 00116 IF( N.EQ.1 ) THEN 00117 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00118 ELSE 00119 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00120 $ DU( 1 )*X( 2, J ) 00121 B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) + 00122 $ D( N )*X( N, J ) 00123 DO 50 I = 2, N - 1 00124 B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) + 00125 $ D( I )*X( I, J ) + DU( I )*X( I+1, J ) 00126 50 CONTINUE 00127 END IF 00128 60 CONTINUE 00129 ELSE 00130 * 00131 * Compute B := B + A'*X 00132 * 00133 DO 80 J = 1, NRHS 00134 IF( N.EQ.1 ) THEN 00135 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00136 ELSE 00137 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00138 $ DL( 1 )*X( 2, J ) 00139 B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) + 00140 $ D( N )*X( N, J ) 00141 DO 70 I = 2, N - 1 00142 B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) + 00143 $ D( I )*X( I, J ) + DL( I )*X( I+1, J ) 00144 70 CONTINUE 00145 END IF 00146 80 CONTINUE 00147 END IF 00148 ELSE IF( ALPHA.EQ.-ONE ) THEN 00149 IF( LSAME( TRANS, 'N' ) ) THEN 00150 * 00151 * Compute B := B - A*X 00152 * 00153 DO 100 J = 1, NRHS 00154 IF( N.EQ.1 ) THEN 00155 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00156 ELSE 00157 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00158 $ DU( 1 )*X( 2, J ) 00159 B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) - 00160 $ D( N )*X( N, J ) 00161 DO 90 I = 2, N - 1 00162 B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) - 00163 $ D( I )*X( I, J ) - DU( I )*X( I+1, J ) 00164 90 CONTINUE 00165 END IF 00166 100 CONTINUE 00167 ELSE 00168 * 00169 * Compute B := B - A'*X 00170 * 00171 DO 120 J = 1, NRHS 00172 IF( N.EQ.1 ) THEN 00173 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00174 ELSE 00175 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00176 $ DL( 1 )*X( 2, J ) 00177 B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) - 00178 $ D( N )*X( N, J ) 00179 DO 110 I = 2, N - 1 00180 B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) - 00181 $ D( I )*X( I, J ) - DL( I )*X( I+1, J ) 00182 110 CONTINUE 00183 END IF 00184 120 CONTINUE 00185 END IF 00186 END IF 00187 RETURN 00188 * 00189 * End of SLAGTM 00190 * 00191 END
1.7.3 
