LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ cgebal()

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.
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 160 of file cgebal.f.

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