![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLAPTM 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 CLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, 00012 * LDB ) 00013 * 00014 * .. Scalar Arguments .. 00015 * CHARACTER UPLO 00016 * INTEGER LDB, LDX, N, NRHS 00017 * REAL ALPHA, BETA 00018 * .. 00019 * .. Array Arguments .. 00020 * REAL D( * ) 00021 * COMPLEX B( LDB, * ), E( * ), X( LDX, * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> CLAPTM multiplies an N by NRHS matrix X by a Hermitian tridiagonal 00031 *> matrix A and stores the result in a matrix B. The operation has the 00032 *> form 00033 *> 00034 *> B := alpha * A * X + beta * B 00035 *> 00036 *> where alpha may be either 1. or -1. and beta may be 0., 1., or -1. 00037 *> \endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 *> \param[in] UPLO 00043 *> \verbatim 00044 *> UPLO is CHARACTER 00045 *> Specifies whether the superdiagonal or the subdiagonal of the 00046 *> tridiagonal matrix A is stored. 00047 *> = 'U': Upper, E is the superdiagonal of A. 00048 *> = 'L': Lower, E is the subdiagonal of A. 00049 *> \endverbatim 00050 *> 00051 *> \param[in] N 00052 *> \verbatim 00053 *> N is INTEGER 00054 *> The order of the matrix A. N >= 0. 00055 *> \endverbatim 00056 *> 00057 *> \param[in] NRHS 00058 *> \verbatim 00059 *> NRHS is INTEGER 00060 *> The number of right hand sides, i.e., the number of columns 00061 *> of the matrices X and B. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] ALPHA 00065 *> \verbatim 00066 *> ALPHA is REAL 00067 *> The scalar alpha. ALPHA must be 1. or -1.; otherwise, 00068 *> it is assumed to be 0. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] D 00072 *> \verbatim 00073 *> D is REAL array, dimension (N) 00074 *> The n diagonal elements of the tridiagonal matrix A. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] E 00078 *> \verbatim 00079 *> E is COMPLEX array, dimension (N-1) 00080 *> The (n-1) subdiagonal or superdiagonal elements of A. 00081 *> \endverbatim 00082 *> 00083 *> \param[in] X 00084 *> \verbatim 00085 *> X is COMPLEX array, dimension (LDX,NRHS) 00086 *> The N by NRHS matrix X. 00087 *> \endverbatim 00088 *> 00089 *> \param[in] LDX 00090 *> \verbatim 00091 *> LDX is INTEGER 00092 *> The leading dimension of the array X. LDX >= max(N,1). 00093 *> \endverbatim 00094 *> 00095 *> \param[in] BETA 00096 *> \verbatim 00097 *> BETA is REAL 00098 *> The scalar beta. BETA must be 0., 1., or -1.; otherwise, 00099 *> it is assumed to be 1. 00100 *> \endverbatim 00101 *> 00102 *> \param[in,out] B 00103 *> \verbatim 00104 *> B is COMPLEX array, dimension (LDB,NRHS) 00105 *> On entry, the N by NRHS matrix B. 00106 *> On exit, B is overwritten by the matrix expression 00107 *> B := alpha * A * X + beta * B. 00108 *> \endverbatim 00109 *> 00110 *> \param[in] LDB 00111 *> \verbatim 00112 *> LDB is INTEGER 00113 *> The leading dimension of the array B. LDB >= max(N,1). 00114 *> \endverbatim 00115 * 00116 * Authors: 00117 * ======== 00118 * 00119 *> \author Univ. of Tennessee 00120 *> \author Univ. of California Berkeley 00121 *> \author Univ. of Colorado Denver 00122 *> \author NAG Ltd. 00123 * 00124 *> \date November 2011 00125 * 00126 *> \ingroup complex_lin 00127 * 00128 * ===================================================================== 00129 SUBROUTINE CLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, 00130 $ LDB ) 00131 * 00132 * -- LAPACK test routine (version 3.4.0) -- 00133 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00134 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00135 * November 2011 00136 * 00137 * .. Scalar Arguments .. 00138 CHARACTER UPLO 00139 INTEGER LDB, LDX, N, NRHS 00140 REAL ALPHA, BETA 00141 * .. 00142 * .. Array Arguments .. 00143 REAL D( * ) 00144 COMPLEX B( LDB, * ), E( * ), X( LDX, * ) 00145 * .. 00146 * 00147 * ===================================================================== 00148 * 00149 * .. Parameters .. 00150 REAL ONE, ZERO 00151 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00152 * .. 00153 * .. Local Scalars .. 00154 INTEGER I, J 00155 * .. 00156 * .. External Functions .. 00157 LOGICAL LSAME 00158 EXTERNAL LSAME 00159 * .. 00160 * .. Intrinsic Functions .. 00161 INTRINSIC CONJG 00162 * .. 00163 * .. Executable Statements .. 00164 * 00165 IF( N.EQ.0 ) 00166 $ RETURN 00167 * 00168 IF( BETA.EQ.ZERO ) THEN 00169 DO 20 J = 1, NRHS 00170 DO 10 I = 1, N 00171 B( I, J ) = ZERO 00172 10 CONTINUE 00173 20 CONTINUE 00174 ELSE IF( BETA.EQ.-ONE ) THEN 00175 DO 40 J = 1, NRHS 00176 DO 30 I = 1, N 00177 B( I, J ) = -B( I, J ) 00178 30 CONTINUE 00179 40 CONTINUE 00180 END IF 00181 * 00182 IF( ALPHA.EQ.ONE ) THEN 00183 IF( LSAME( UPLO, 'U' ) ) THEN 00184 * 00185 * Compute B := B + A*X, where E is the superdiagonal of A. 00186 * 00187 DO 60 J = 1, NRHS 00188 IF( N.EQ.1 ) THEN 00189 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00190 ELSE 00191 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00192 $ E( 1 )*X( 2, J ) 00193 B( N, J ) = B( N, J ) + CONJG( E( N-1 ) )* 00194 $ X( N-1, J ) + D( N )*X( N, J ) 00195 DO 50 I = 2, N - 1 00196 B( I, J ) = B( I, J ) + CONJG( E( I-1 ) )* 00197 $ X( I-1, J ) + D( I )*X( I, J ) + 00198 $ E( I )*X( I+1, J ) 00199 50 CONTINUE 00200 END IF 00201 60 CONTINUE 00202 ELSE 00203 * 00204 * Compute B := B + A*X, where E is the subdiagonal of A. 00205 * 00206 DO 80 J = 1, NRHS 00207 IF( N.EQ.1 ) THEN 00208 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00209 ELSE 00210 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00211 $ CONJG( E( 1 ) )*X( 2, J ) 00212 B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) + 00213 $ D( N )*X( N, J ) 00214 DO 70 I = 2, N - 1 00215 B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) + 00216 $ D( I )*X( I, J ) + 00217 $ CONJG( E( I ) )*X( I+1, J ) 00218 70 CONTINUE 00219 END IF 00220 80 CONTINUE 00221 END IF 00222 ELSE IF( ALPHA.EQ.-ONE ) THEN 00223 IF( LSAME( UPLO, 'U' ) ) THEN 00224 * 00225 * Compute B := B - A*X, where E is the superdiagonal of A. 00226 * 00227 DO 100 J = 1, NRHS 00228 IF( N.EQ.1 ) THEN 00229 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00230 ELSE 00231 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00232 $ E( 1 )*X( 2, J ) 00233 B( N, J ) = B( N, J ) - CONJG( E( N-1 ) )* 00234 $ X( N-1, J ) - D( N )*X( N, J ) 00235 DO 90 I = 2, N - 1 00236 B( I, J ) = B( I, J ) - CONJG( E( I-1 ) )* 00237 $ X( I-1, J ) - D( I )*X( I, J ) - 00238 $ E( I )*X( I+1, J ) 00239 90 CONTINUE 00240 END IF 00241 100 CONTINUE 00242 ELSE 00243 * 00244 * Compute B := B - A*X, where E is the subdiagonal of A. 00245 * 00246 DO 120 J = 1, NRHS 00247 IF( N.EQ.1 ) THEN 00248 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00249 ELSE 00250 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00251 $ CONJG( E( 1 ) )*X( 2, J ) 00252 B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) - 00253 $ D( N )*X( N, J ) 00254 DO 110 I = 2, N - 1 00255 B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) - 00256 $ D( I )*X( I, J ) - 00257 $ CONJG( E( I ) )*X( I+1, J ) 00258 110 CONTINUE 00259 END IF 00260 120 CONTINUE 00261 END IF 00262 END IF 00263 RETURN 00264 * 00265 * End of CLAPTM 00266 * 00267 END