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
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
233 CALL
csscal( 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
clatrs(
'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
csscal( n, one / cabs1( v( i ) ), v, 1 )
real function scasum(N, CX, INCX)
SCASUM
integer function icamax(N, CX, INCX)
ICAMAX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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...
real function scnrm2(N, X, INCX)
SCNRM2
complex function cladiv(X, Y)
CLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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