LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cgebal ( character  JOB,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
integer  ILO,
integer  IHI,
real, dimension( * )  SCALE,
integer  INFO 
)

CGEBAL

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

Purpose:
 CGEBAL 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 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 REAL 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 2015
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 163 of file cgebal.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: