|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CLAGTM( 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 COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ), 00016 $ X( LDX, * ) 00017 * .. 00018 * 00019 * Purpose 00020 * ======= 00021 * 00022 * CLAGTM 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**T * X + beta * B 00037 * = 'C': Conjugate transpose, B := alpha * A**H * X + beta * B 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) COMPLEX array, dimension (N-1) 00051 * The (n-1) sub-diagonal elements of T. 00052 * 00053 * D (input) COMPLEX array, dimension (N) 00054 * The diagonal elements of T. 00055 * 00056 * DU (input) COMPLEX array, dimension (N-1) 00057 * The (n-1) super-diagonal elements of T. 00058 * 00059 * X (input) COMPLEX 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) COMPLEX 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 * .. Intrinsic Functions .. 00090 INTRINSIC CONJG 00091 * .. 00092 * .. Executable Statements .. 00093 * 00094 IF( N.EQ.0 ) 00095 $ RETURN 00096 * 00097 * Multiply B by BETA if BETA.NE.1. 00098 * 00099 IF( BETA.EQ.ZERO ) THEN 00100 DO 20 J = 1, NRHS 00101 DO 10 I = 1, N 00102 B( I, J ) = ZERO 00103 10 CONTINUE 00104 20 CONTINUE 00105 ELSE IF( BETA.EQ.-ONE ) THEN 00106 DO 40 J = 1, NRHS 00107 DO 30 I = 1, N 00108 B( I, J ) = -B( I, J ) 00109 30 CONTINUE 00110 40 CONTINUE 00111 END IF 00112 * 00113 IF( ALPHA.EQ.ONE ) THEN 00114 IF( LSAME( TRANS, 'N' ) ) THEN 00115 * 00116 * Compute B := B + A*X 00117 * 00118 DO 60 J = 1, NRHS 00119 IF( N.EQ.1 ) THEN 00120 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00121 ELSE 00122 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00123 $ DU( 1 )*X( 2, J ) 00124 B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) + 00125 $ D( N )*X( N, J ) 00126 DO 50 I = 2, N - 1 00127 B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) + 00128 $ D( I )*X( I, J ) + DU( I )*X( I+1, J ) 00129 50 CONTINUE 00130 END IF 00131 60 CONTINUE 00132 ELSE IF( LSAME( TRANS, 'T' ) ) THEN 00133 * 00134 * Compute B := B + A**T * X 00135 * 00136 DO 80 J = 1, NRHS 00137 IF( N.EQ.1 ) THEN 00138 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00139 ELSE 00140 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00141 $ DL( 1 )*X( 2, J ) 00142 B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) + 00143 $ D( N )*X( N, J ) 00144 DO 70 I = 2, N - 1 00145 B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) + 00146 $ D( I )*X( I, J ) + DL( I )*X( I+1, J ) 00147 70 CONTINUE 00148 END IF 00149 80 CONTINUE 00150 ELSE IF( LSAME( TRANS, 'C' ) ) THEN 00151 * 00152 * Compute B := B + A**H * X 00153 * 00154 DO 100 J = 1, NRHS 00155 IF( N.EQ.1 ) THEN 00156 B( 1, J ) = B( 1, J ) + CONJG( D( 1 ) )*X( 1, J ) 00157 ELSE 00158 B( 1, J ) = B( 1, J ) + CONJG( D( 1 ) )*X( 1, J ) + 00159 $ CONJG( DL( 1 ) )*X( 2, J ) 00160 B( N, J ) = B( N, J ) + CONJG( DU( N-1 ) )* 00161 $ X( N-1, J ) + CONJG( D( N ) )*X( N, J ) 00162 DO 90 I = 2, N - 1 00163 B( I, J ) = B( I, J ) + CONJG( DU( I-1 ) )* 00164 $ X( I-1, J ) + CONJG( D( I ) )* 00165 $ X( I, J ) + CONJG( DL( I ) )* 00166 $ X( I+1, J ) 00167 90 CONTINUE 00168 END IF 00169 100 CONTINUE 00170 END IF 00171 ELSE IF( ALPHA.EQ.-ONE ) THEN 00172 IF( LSAME( TRANS, 'N' ) ) THEN 00173 * 00174 * Compute B := B - A*X 00175 * 00176 DO 120 J = 1, NRHS 00177 IF( N.EQ.1 ) THEN 00178 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00179 ELSE 00180 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00181 $ DU( 1 )*X( 2, J ) 00182 B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) - 00183 $ D( N )*X( N, J ) 00184 DO 110 I = 2, N - 1 00185 B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) - 00186 $ D( I )*X( I, J ) - DU( I )*X( I+1, J ) 00187 110 CONTINUE 00188 END IF 00189 120 CONTINUE 00190 ELSE IF( LSAME( TRANS, 'T' ) ) THEN 00191 * 00192 * Compute B := B - A'*X 00193 * 00194 DO 140 J = 1, NRHS 00195 IF( N.EQ.1 ) THEN 00196 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00197 ELSE 00198 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00199 $ DL( 1 )*X( 2, J ) 00200 B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) - 00201 $ D( N )*X( N, J ) 00202 DO 130 I = 2, N - 1 00203 B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) - 00204 $ D( I )*X( I, J ) - DL( I )*X( I+1, J ) 00205 130 CONTINUE 00206 END IF 00207 140 CONTINUE 00208 ELSE IF( LSAME( TRANS, 'C' ) ) THEN 00209 * 00210 * Compute B := B - A'*X 00211 * 00212 DO 160 J = 1, NRHS 00213 IF( N.EQ.1 ) THEN 00214 B( 1, J ) = B( 1, J ) - CONJG( D( 1 ) )*X( 1, J ) 00215 ELSE 00216 B( 1, J ) = B( 1, J ) - CONJG( D( 1 ) )*X( 1, J ) - 00217 $ CONJG( DL( 1 ) )*X( 2, J ) 00218 B( N, J ) = B( N, J ) - CONJG( DU( N-1 ) )* 00219 $ X( N-1, J ) - CONJG( D( N ) )*X( N, J ) 00220 DO 150 I = 2, N - 1 00221 B( I, J ) = B( I, J ) - CONJG( DU( I-1 ) )* 00222 $ X( I-1, J ) - CONJG( D( I ) )* 00223 $ X( I, J ) - CONJG( DL( I ) )* 00224 $ X( I+1, J ) 00225 150 CONTINUE 00226 END IF 00227 160 CONTINUE 00228 END IF 00229 END IF 00230 RETURN 00231 * 00232 * End of CLAGTM 00233 * 00234 END
1.7.3 
