149 SUBROUTINE claein( RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK,
150 $ eps3, smlnum, info )
158 LOGICAL NOINIT, RIGHTV
159 INTEGER INFO, LDB, LDH, N
165 COMPLEX B( ldb, * ), H( ldh, * ), V( * )
172 parameter ( one = 1.0e+0, tenth = 1.0e-1 )
174 parameter ( zero = ( 0.0e+0, 0.0e+0 ) )
177 CHARACTER NORMIN, TRANS
178 INTEGER I, IERR, ITS, J
179 REAL GROWTO, NRMSML, ROOTN, RTEMP, SCALE, VNORM
180 COMPLEX CDUM, EI, EJ, TEMP, X
186 EXTERNAL icamax, scasum, scnrm2, cladiv
192 INTRINSIC abs, aimag, max,
REAL, SQRT
198 cabs1( cdum ) = abs(
REAL( CDUM ) ) + abs( AIMAG( cdum ) )
207 rootn = sqrt(
REAL( 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
232 vnorm = scnrm2( n, v, 1 )
233 CALL csscal( n, ( eps3*rootn ) / max( vnorm, nrmsml ), v, 1 )
243 IF( cabs1( b( i, i ) ).LT.cabs1( ei ) )
THEN
247 x = cladiv( b( i, i ), ei )
251 b( i+1, j ) = b( i, j ) - x*temp
258 IF( b( i, i ).EQ.zero )
260 x = cladiv( ei, b( i, i ) )
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
284 x = cladiv( b( j, j ), ej )
288 b( i, j-1 ) = b( i, j ) - x*temp
295 IF( b( j, j ).EQ.zero )
297 x = cladiv( ej, b( j, j ) )
300 b( i, j-1 ) = b( i, j-1 ) - x*b( i, j )
305 IF( b( 1, 1 ).EQ.zero )
319 CALL clatrs(
'Upper', trans,
'Nonunit', normin, n, b, ldb, v,
320 $ scale, rwork, ierr )
325 vnorm = scasum( n, v, 1 )
326 IF( vnorm.GE.growto*scale )
331 rtemp = eps3 / ( rootn+one )
336 v( n-its+1 ) = v( n-its+1 ) - eps3*rootn
347 i = icamax( n, v, 1 )
348 CALL csscal( n, one / cabs1( v( i ) ), v, 1 )
subroutine clatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine claein(RIGHTV, NOINIT, N, H, LDH, W, V, B, LDB, RWORK, EPS3, SMLNUM, INFO)
CLAEIN computes a specified right or left eigenvector of an upper Hessenberg matrix by inverse iterat...
subroutine csscal(N, SA, CX, INCX)
CSSCAL