149 SUBROUTINE zlaein( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK,
150 $ eps3, smlnum, info )
158 LOGICAL noinit, rightv
159 INTEGER info, ldb, ldh, n
160 DOUBLE PRECISION eps3, smlnum
164 DOUBLE PRECISION rwork( * )
165 COMPLEX*16 b( ldb, * ), h( ldh, * ), v( * )
171 DOUBLE PRECISION one, tenth
172 parameter( one = 1.0d+0, tenth = 1.0d-1 )
174 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
177 CHARACTER normin, trans
178 INTEGER i, ierr, its,
j
179 DOUBLE PRECISION growto, nrmsml, rootn, rtemp, scale, vnorm
180 COMPLEX*16 cdum, ei, ej, temp, x
192 INTRINSIC abs, dble, dimag, max, sqrt
195 DOUBLE PRECISION cabs1
198 cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
207 rootn = sqrt( dble( n ) )
208 growto = tenth / rootn
209 nrmsml = max( one, eps3*rootn )*smlnum
216 b( i,
j ) = h( i,
j )
218 b(
j,
j ) = h(
j,
j ) - w
233 CALL
zdscal( n, ( eps3*rootn ) / max( vnorm, nrmsml ), v, 1 )
243 IF( cabs1(
b( i, i ) ).LT.cabs1( ei ) )
THEN
251 b( i+1,
j ) =
b( i,
j ) - x*temp
258 IF(
b( i, i ).EQ.zero )
263 b( i+1,
j ) =
b( i+1,
j ) - x*
b( i,
j )
268 IF(
b( n, n ).EQ.zero )
280 IF( cabs1(
b(
j,
j ) ).LT.cabs1( ej ) )
THEN
288 b( i,
j-1 ) =
b( i,
j ) - x*temp
295 IF(
b(
j,
j ).EQ.zero )
300 b( i,
j-1 ) =
b( i,
j-1 ) - x*
b( i,
j )
305 IF(
b( 1, 1 ).EQ.zero )
319 CALL
zlatrs(
'Upper', trans,
'Nonunit', normin, n,
b, ldb, v,
320 $ scale, rwork, ierr )
326 IF( vnorm.GE.growto*scale )
331 rtemp = eps3 / ( rootn+one )
336 v( n-its+1 ) = v( n-its+1 ) - eps3*rootn
348 CALL
zdscal( n, one / cabs1( v( i ) ), v, 1 )
integer function izamax(N, ZX, INCX)
IZAMAX
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zlatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
ZLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
complex *16 function zladiv(X, Y)
ZLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
double precision function dzasum(N, ZX, INCX)
DZASUM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
double precision function dznrm2(N, X, INCX)
DZNRM2
subroutine zlaein(RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, EPS3, SMLNUM, INFO)
ZLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iterat...