LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zgebal()

 subroutine zgebal ( character job, integer n, complex*16, dimension( lda, * ) a, integer lda, integer ilo, integer ihi, double precision, dimension( * ) scale, integer info )

ZGEBAL

Purpose:
``` ZGEBAL balances a general complex matrix A.  This involves, first,
permuting A by a similarity transformation to isolate eigenvalues
in the first 1 to ILO-1 and last IHI+1 to N elements on the
diagonal; and second, applying a diagonal similarity transformation
to rows and columns ILO to IHI to make the rows and columns as
close in norm as possible.  Both steps are optional.

Balancing may reduce the 1-norm of the matrix, and improve the
accuracy of the computed eigenvalues and/or eigenvectors.```
Parameters
 [in] JOB ``` JOB is CHARACTER*1 Specifies the operations to be performed on A: = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0 for i = 1,...,N; = 'P': permute only; = 'S': scale only; = 'B': both permute and scale.``` [in] N ``` N is INTEGER The order of the matrix A. N >= 0.``` [in,out] A ``` A is COMPLEX*16 array, dimension (LDA,N) On entry, the input matrix A. On exit, A is overwritten by the balanced matrix. If JOB = 'N', A is not referenced. See Further Details.``` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= max(1,N).``` [out] ILO ` ILO is INTEGER` [out] IHI ``` IHI is INTEGER ILO and IHI are set to integers such that on exit A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N. If JOB = 'N' or 'S', ILO = 1 and IHI = N.``` [out] SCALE ``` SCALE is DOUBLE PRECISION array, dimension (N) Details of the permutations and scaling factors applied to A. If P(j) is the index of the row and column interchanged with row and column j and D(j) is the scaling factor applied to row and column j, then SCALE(j) = P(j) for j = 1,...,ILO-1 = D(j) for j = ILO,...,IHI = P(j) for j = IHI+1,...,N. The order in which the interchanges are made is N to IHI+1, then 1 to ILO-1.``` [out] INFO ``` INFO is INTEGER = 0: successful exit. < 0: if INFO = -i, the i-th argument had an illegal value.```
Further Details:
```  The permutations consist of row and column interchanges which put
the matrix in the form

( T1   X   Y  )
P A P = (  0   B   Z  )
(  0   0   T2 )

where T1 and T2 are upper triangular matrices whose eigenvalues lie
along the diagonal.  The column indices ILO and IHI mark the starting
and ending columns of the submatrix B. Balancing consists of applying
a diagonal similarity transformation inv(D) * B * D to make the
1-norms of each row of B and its corresponding column nearly equal.
The output matrix is

( T1     X*D          Y    )
(  0  inv(D)*B*D  inv(D)*Z ).
(  0      0           T2   )

Information about the permutations P and the diagonal matrix D is
returned in the vector SCALE.

This subroutine is based on the EISPACK routine CBAL.

Modified by Tzu-Yi Chen, Computer Science Division, University of
California at Berkeley, USA

Refactored by Evert Provoost, Department of Computer Science,
KU Leuven, Belgium```

Definition at line 164 of file zgebal.f.

165*
166* -- LAPACK computational routine --
167* -- LAPACK is a software package provided by Univ. of Tennessee, --
168* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
169*
170* .. Scalar Arguments ..
171 CHARACTER JOB
172 INTEGER IHI, ILO, INFO, LDA, N
173* ..
174* .. Array Arguments ..
175 DOUBLE PRECISION SCALE( * )
176 COMPLEX*16 A( LDA, * )
177* ..
178*
179* =====================================================================
180*
181* .. Parameters ..
182 DOUBLE PRECISION ZERO, ONE
183 parameter( zero = 0.0d+0, one = 1.0d+0 )
184 DOUBLE PRECISION SCLFAC
185 parameter( sclfac = 2.0d+0 )
186 DOUBLE PRECISION FACTOR
187 parameter( factor = 0.95d+0 )
188* ..
189* .. Local Scalars ..
190 LOGICAL NOCONV, CANSWAP
191 INTEGER I, ICA, IRA, J, K, L
192 DOUBLE PRECISION C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
193 \$ SFMIN2
194* ..
195* .. External Functions ..
196 LOGICAL DISNAN, LSAME
197 INTEGER IZAMAX
198 DOUBLE PRECISION DLAMCH, DZNRM2
199 EXTERNAL disnan, lsame, izamax, dlamch, dznrm2
200* ..
201* .. External Subroutines ..
202 EXTERNAL xerbla, zdscal, zswap
203* ..
204* .. Intrinsic Functions ..
205 INTRINSIC abs, dble, dimag, max, min
206*
207* Test the input parameters
208*
209 info = 0
210 IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
211 \$ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
212 info = -1
213 ELSE IF( n.LT.0 ) THEN
214 info = -2
215 ELSE IF( lda.LT.max( 1, n ) ) THEN
216 info = -4
217 END IF
218 IF( info.NE.0 ) THEN
219 CALL xerbla( 'ZGEBAL', -info )
220 RETURN
221 END IF
222*
223* Quick returns.
224*
225 IF( n.EQ.0 ) THEN
226 ilo = 1
227 ihi = 0
228 RETURN
229 END IF
230*
231 IF( lsame( job, 'N' ) ) THEN
232 DO i = 1, n
233 scale( i ) = one
234 END DO
235 ilo = 1
236 ihi = n
237 RETURN
238 END IF
239*
240* Permutation to isolate eigenvalues if possible.
241*
242 k = 1
243 l = n
244*
245 IF( .NOT.lsame( job, 'S' ) ) THEN
246*
247* Row and column exchange.
248*
249 noconv = .true.
250 DO WHILE( noconv )
251*
252* Search for rows isolating an eigenvalue and push them down.
253*
254 noconv = .false.
255 DO i = l, 1, -1
256 canswap = .true.
257 DO j = 1, l
258 IF( i.NE.j .AND. ( dble( a( i, j ) ).NE.zero .OR.
259 \$ dimag( a( i, j ) ).NE.zero ) ) THEN
260 canswap = .false.
261 EXIT
262 END IF
263 END DO
264*
265 IF( canswap ) THEN
266 scale( l ) = i
267 IF( i.NE.l ) THEN
268 CALL zswap( l, a( 1, i ), 1, a( 1, l ), 1 )
269 CALL zswap( n-k+1, a( i, k ), lda, a( l, k ), lda )
270 END IF
271 noconv = .true.
272*
273 IF( l.EQ.1 ) THEN
274 ilo = 1
275 ihi = 1
276 RETURN
277 END IF
278*
279 l = l - 1
280 END IF
281 END DO
282*
283 END DO
284
285 noconv = .true.
286 DO WHILE( noconv )
287*
288* Search for columns isolating an eigenvalue and push them left.
289*
290 noconv = .false.
291 DO j = k, l
292 canswap = .true.
293 DO i = k, l
294 IF( i.NE.j .AND. ( dble( a( i, j ) ).NE.zero .OR.
295 \$ dimag( a( i, j ) ).NE.zero ) ) THEN
296 canswap = .false.
297 EXIT
298 END IF
299 END DO
300*
301 IF( canswap ) THEN
302 scale( k ) = j
303 IF( j.NE.k ) THEN
304 CALL zswap( l, a( 1, j ), 1, a( 1, k ), 1 )
305 CALL zswap( n-k+1, a( j, k ), lda, a( k, k ), lda )
306 END IF
307 noconv = .true.
308*
309 k = k + 1
310 END IF
311 END DO
312*
313 END DO
314*
315 END IF
316*
317* Initialize SCALE for non-permuted submatrix.
318*
319 DO i = k, l
320 scale( i ) = one
321 END DO
322*
323* If we only had to permute, we are done.
324*
325 IF( lsame( job, 'P' ) ) THEN
326 ilo = k
327 ihi = l
328 RETURN
329 END IF
330*
331* Balance the submatrix in rows K to L.
332*
333* Iterative loop for norm reduction.
334*
335 sfmin1 = dlamch( 'S' ) / dlamch( 'P' )
336 sfmax1 = one / sfmin1
337 sfmin2 = sfmin1*sclfac
338 sfmax2 = one / sfmin2
339*
340 noconv = .true.
341 DO WHILE( noconv )
342 noconv = .false.
343*
344 DO i = k, l
345*
346 c = dznrm2( l-k+1, a( k, i ), 1 )
347 r = dznrm2( l-k+1, a( i, k ), lda )
348 ica = izamax( l, a( 1, i ), 1 )
349 ca = abs( a( ica, i ) )
350 ira = izamax( n-k+1, a( i, k ), lda )
351 ra = abs( a( i, ira+k-1 ) )
352*
353* Guard against zero C or R due to underflow.
354*
355 IF( c.EQ.zero .OR. r.EQ.zero ) cycle
356*
357* Exit if NaN to avoid infinite loop
358*
359 IF( disnan( c+ca+r+ra ) ) THEN
360 info = -3
361 CALL xerbla( 'ZGEBAL', -info )
362 RETURN
363 END IF
364*
365 g = r / sclfac
366 f = one
367 s = c + r
368*
369 DO WHILE( c.LT.g .AND. max( f, c, ca ).LT.sfmax2 .AND.
370 \$ min( r, g, ra ).GT.sfmin2 )
371 f = f*sclfac
372 c = c*sclfac
373 ca = ca*sclfac
374 r = r / sclfac
375 g = g / sclfac
376 ra = ra / sclfac
377 END DO
378*
379 g = c / sclfac
380*
381 DO WHILE( g.GE.r .AND. max( r, ra ).LT.sfmax2 .AND.
382 \$ min( f, c, g, ca ).GT.sfmin2 )
383 f = f / sclfac
384 c = c / sclfac
385 g = g / sclfac
386 ca = ca / sclfac
387 r = r*sclfac
388 ra = ra*sclfac
389 END DO
390*
391* Now balance.
392*
393 IF( ( c+r ).GE.factor*s ) cycle
394 IF( f.LT.one .AND. scale( i ).LT.one ) THEN
395 IF( f*scale( i ).LE.sfmin1 ) cycle
396 END IF
397 IF( f.GT.one .AND. scale( i ).GT.one ) THEN
398 IF( scale( i ).GE.sfmax1 / f ) cycle
399 END IF
400 g = one / f
401 scale( i ) = scale( i )*f
402 noconv = .true.
403*
404 CALL zdscal( n-k+1, g, a( i, k ), lda )
405 CALL zdscal( l, f, a( 1, i ), 1 )
406*
407 END DO
408*
409 END DO
410*
411 ilo = k
412 ihi = l
413*
414 RETURN
415*
416* End of ZGEBAL
417*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
integer function izamax(n, zx, incx)
IZAMAX
Definition izamax.f:71
logical function disnan(din)
DISNAN tests input for NaN.
Definition disnan.f:59
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
real(wp) function dznrm2(n, x, incx)
DZNRM2
Definition dznrm2.f90:90
subroutine zdscal(n, da, zx, incx)
ZDSCAL
Definition zdscal.f:78
subroutine zswap(n, zx, incx, zy, incy)
ZSWAP
Definition zswap.f:81
Here is the call graph for this function:
Here is the caller graph for this function: