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 )