129 SUBROUTINE zlaptm( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B,
139 INTEGER ldb, ldx, n, nrhs
140 DOUBLE PRECISION alpha, beta
143 DOUBLE PRECISION d( * )
144 COMPLEX*16 b( ldb, * ), e( * ), x( ldx, * )
150 DOUBLE PRECISION one, zero
151 parameter( one = 1.0d+0, zero = 0.0d+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 ) + dconjg( e( n-1 ) )*
194 $ x( n-1,
j ) + d( n )*x( n,
j )
196 b( i,
j ) =
b( i,
j ) + dconjg( 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 $ dconjg( 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 $ dconjg( 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 ) - dconjg( e( n-1 ) )*
234 $ x( n-1,
j ) - d( n )*x( n,
j )
236 b( i,
j ) =
b( i,
j ) - dconjg( 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 $ dconjg( 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 $ dconjg( e( i ) )*x( i+1,
j )
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
subroutine zlaptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
ZLAPTM