129 SUBROUTINE claptm( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
139 INTEGER ldb, ldx, n, nrhs
144 COMPLEX b( ldb, * ), e( * ), x( ldx, * )
151 parameter( one = 1.0e+0, zero = 0.0e+0 )
168 IF( beta.EQ.zero )
THEN
174 ELSE IF( beta.EQ.-one )
THEN
177 b( i,
j ) = -
b( i,
j )
182 IF( alpha.EQ.one )
THEN
183 IF(
lsame( uplo,
'U' ) )
THEN
189 b( 1,
j ) =
b( 1,
j ) + d( 1 )*x( 1,
j )
191 b( 1,
j ) =
b( 1,
j ) + d( 1 )*x( 1,
j ) +
193 b( n,
j ) =
b( n,
j ) + conjg( e( n-1 ) )*
194 $ x( n-1,
j ) + d( n )*x( n,
j )
196 b( i,
j ) =
b( i,
j ) + conjg( e( i-1 ) )*
197 $ x( i-1,
j ) + d( i )*x( i,
j ) +
208 b( 1,
j ) =
b( 1,
j ) + d( 1 )*x( 1,
j )
210 b( 1,
j ) =
b( 1,
j ) + d( 1 )*x( 1,
j ) +
211 $ conjg( e( 1 ) )*x( 2,
j )
212 b( n,
j ) =
b( n,
j ) + e( n-1 )*x( n-1,
j ) +
215 b( i,
j ) =
b( i,
j ) + e( i-1 )*x( i-1,
j ) +
217 $ conjg( e( i ) )*x( i+1,
j )
222 ELSE IF( alpha.EQ.-one )
THEN
223 IF(
lsame( uplo,
'U' ) )
THEN
229 b( 1,
j ) =
b( 1,
j ) - d( 1 )*x( 1,
j )
231 b( 1,
j ) =
b( 1,
j ) - d( 1 )*x( 1,
j ) -
233 b( n,
j ) =
b( n,
j ) - conjg( e( n-1 ) )*
234 $ x( n-1,
j ) - d( n )*x( n,
j )
236 b( i,
j ) =
b( i,
j ) - conjg( e( i-1 ) )*
237 $ x( i-1,
j ) - d( i )*x( i,
j ) -
248 b( 1,
j ) =
b( 1,
j ) - d( 1 )*x( 1,
j )
250 b( 1,
j ) =
b( 1,
j ) - d( 1 )*x( 1,
j ) -
251 $ conjg( e( 1 ) )*x( 2,
j )
252 b( n,
j ) =
b( n,
j ) - e( n-1 )*x( n-1,
j ) -
255 b( i,
j ) =
b( i,
j ) - e( i-1 )*x( i-1,
j ) -
257 $ conjg( e( i ) )*x( i+1,
j )
subroutine claptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
CLAPTM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j