LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
zgebal.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine zgebal (JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
 ZGEBAL More...
 

Function/Subroutine Documentation

subroutine zgebal ( character  JOB,
integer  N,
complex*16, dimension( lda, * )  A,
integer  LDA,
integer  ILO,
integer  IHI,
double precision, dimension( * )  SCALE,
integer  INFO 
)

ZGEBAL

Download ZGEBAL + dependencies [TGZ] [ZIP] [TXT]

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
 
[out]IHI
          ILO and IHI are set to INTEGER 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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2013
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

Definition at line 162 of file zgebal.f.

162 *
163 * -- LAPACK computational routine (version 3.5.0) --
164 * -- LAPACK is a software package provided by Univ. of Tennessee, --
165 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
166 * November 2013
167 *
168 * .. Scalar Arguments ..
169  CHARACTER job
170  INTEGER ihi, ilo, info, lda, n
171 * ..
172 * .. Array Arguments ..
173  DOUBLE PRECISION scale( * )
174  COMPLEX*16 a( lda, * )
175 * ..
176 *
177 * =====================================================================
178 *
179 * .. Parameters ..
180  DOUBLE PRECISION zero, one
181  parameter( zero = 0.0d+0, one = 1.0d+0 )
182  DOUBLE PRECISION sclfac
183  parameter( sclfac = 2.0d+0 )
184  DOUBLE PRECISION factor
185  parameter( factor = 0.95d+0 )
186 * ..
187 * .. Local Scalars ..
188  LOGICAL noconv
189  INTEGER i, ica, iexc, ira, j, k, l, m
190  DOUBLE PRECISION c, ca, f, g, r, ra, s, sfmax1, sfmax2, sfmin1,
191  $ sfmin2
192  COMPLEX*16 cdum
193 * ..
194 * .. External Functions ..
195  LOGICAL disnan, lsame
196  INTEGER izamax
197  DOUBLE PRECISION dlamch, dznrm2
198  EXTERNAL disnan, lsame, izamax, dlamch, dznrm2
199 * ..
200 * .. External Subroutines ..
201  EXTERNAL xerbla, zdscal, zswap
202 * ..
203 * .. Intrinsic Functions ..
204  INTRINSIC abs, dble, dimag, max, min
205 * ..
206 * .. Statement Functions ..
207  DOUBLE PRECISION cabs1
208 * ..
209 * .. Statement Function definitions ..
210  cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
211 * ..
212 * .. Executable Statements ..
213 *
214 * Test the input parameters
215 *
216  info = 0
217  IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
218  $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
219  info = -1
220  ELSE IF( n.LT.0 ) THEN
221  info = -2
222  ELSE IF( lda.LT.max( 1, n ) ) THEN
223  info = -4
224  END IF
225  IF( info.NE.0 ) THEN
226  CALL xerbla( 'ZGEBAL', -info )
227  RETURN
228  END IF
229 *
230  k = 1
231  l = n
232 *
233  IF( n.EQ.0 )
234  $ GO TO 210
235 *
236  IF( lsame( job, 'N' ) ) THEN
237  DO 10 i = 1, n
238  scale( i ) = one
239  10 CONTINUE
240  GO TO 210
241  END IF
242 *
243  IF( lsame( job, 'S' ) )
244  $ GO TO 120
245 *
246 * Permutation to isolate eigenvalues if possible
247 *
248  GO TO 50
249 *
250 * Row and column exchange.
251 *
252  20 CONTINUE
253  scale( m ) = j
254  IF( j.EQ.m )
255  $ GO TO 30
256 *
257  CALL zswap( l, a( 1, j ), 1, a( 1, m ), 1 )
258  CALL zswap( n-k+1, a( j, k ), lda, a( m, k ), lda )
259 *
260  30 CONTINUE
261  GO TO ( 40, 80 )iexc
262 *
263 * Search for rows isolating an eigenvalue and push them down.
264 *
265  40 CONTINUE
266  IF( l.EQ.1 )
267  $ GO TO 210
268  l = l - 1
269 *
270  50 CONTINUE
271  DO 70 j = l, 1, -1
272 *
273  DO 60 i = 1, l
274  IF( i.EQ.j )
275  $ GO TO 60
276  IF( dble( a( j, i ) ).NE.zero .OR. dimag( a( j, i ) ).NE.
277  $ zero )GO TO 70
278  60 CONTINUE
279 *
280  m = l
281  iexc = 1
282  GO TO 20
283  70 CONTINUE
284 *
285  GO TO 90
286 *
287 * Search for columns isolating an eigenvalue and push them left.
288 *
289  80 CONTINUE
290  k = k + 1
291 *
292  90 CONTINUE
293  DO 110 j = k, l
294 *
295  DO 100 i = k, l
296  IF( i.EQ.j )
297  $ GO TO 100
298  IF( dble( a( i, j ) ).NE.zero .OR. dimag( a( i, j ) ).NE.
299  $ zero )GO TO 110
300  100 CONTINUE
301 *
302  m = k
303  iexc = 2
304  GO TO 20
305  110 CONTINUE
306 *
307  120 CONTINUE
308  DO 130 i = k, l
309  scale( i ) = one
310  130 CONTINUE
311 *
312  IF( lsame( job, 'P' ) )
313  $ GO TO 210
314 *
315 * Balance the submatrix in rows K to L.
316 *
317 * Iterative loop for norm reduction
318 *
319  sfmin1 = dlamch( 'S' ) / dlamch( 'P' )
320  sfmax1 = one / sfmin1
321  sfmin2 = sfmin1*sclfac
322  sfmax2 = one / sfmin2
323  140 CONTINUE
324  noconv = .false.
325 *
326  DO 200 i = k, l
327 *
328  c = dznrm2( l-k+1, a( k, i ), 1 )
329  r = dznrm2( l-k+1, a( i, k ), lda )
330  ica = izamax( l, a( 1, i ), 1 )
331  ca = abs( a( ica, i ) )
332  ira = izamax( n-k+1, a( i, k ), lda )
333  ra = abs( a( i, ira+k-1 ) )
334 *
335 * Guard against zero C or R due to underflow.
336 *
337  IF( c.EQ.zero .OR. r.EQ.zero )
338  $ GO TO 200
339  g = r / sclfac
340  f = one
341  s = c + r
342  160 CONTINUE
343  IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
344  $ min( r, g, ra ).LE.sfmin2 )GO TO 170
345  IF( disnan( c+f+ca+r+g+ra ) ) THEN
346 *
347 * Exit if NaN to avoid infinite loop
348 *
349  info = -3
350  CALL xerbla( 'ZGEBAL', -info )
351  RETURN
352  END IF
353  f = f*sclfac
354  c = c*sclfac
355  ca = ca*sclfac
356  r = r / sclfac
357  g = g / sclfac
358  ra = ra / sclfac
359  GO TO 160
360 *
361  170 CONTINUE
362  g = c / sclfac
363  180 CONTINUE
364  IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
365  $ min( f, c, g, ca ).LE.sfmin2 )GO TO 190
366  f = f / sclfac
367  c = c / sclfac
368  g = g / sclfac
369  ca = ca / sclfac
370  r = r*sclfac
371  ra = ra*sclfac
372  GO TO 180
373 *
374 * Now balance.
375 *
376  190 CONTINUE
377  IF( ( c+r ).GE.factor*s )
378  $ GO TO 200
379  IF( f.LT.one .AND. scale( i ).LT.one ) THEN
380  IF( f*scale( i ).LE.sfmin1 )
381  $ GO TO 200
382  END IF
383  IF( f.GT.one .AND. scale( i ).GT.one ) THEN
384  IF( scale( i ).GE.sfmax1 / f )
385  $ GO TO 200
386  END IF
387  g = one / f
388  scale( i ) = scale( i )*f
389  noconv = .true.
390 *
391  CALL zdscal( n-k+1, g, a( i, k ), lda )
392  CALL zdscal( l, f, a( 1, i ), 1 )
393 *
394  200 CONTINUE
395 *
396  IF( noconv )
397  $ GO TO 140
398 *
399  210 CONTINUE
400  ilo = k
401  ihi = l
402 *
403  RETURN
404 *
405 * End of ZGEBAL
406 *
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:52
integer function izamax(N, ZX, INCX)
IZAMAX
Definition: izamax.f:53
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:54
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
double precision function dznrm2(N, X, INCX)
DZNRM2
Definition: dznrm2.f:56
logical function disnan(DIN)
DISNAN tests input for NaN.
Definition: disnan.f:61

Here is the call graph for this function:

Here is the caller graph for this function: