LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dgebal()

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

DGEBAL

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

Purpose:
 DGEBAL balances a general real 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 DOUBLE PRECISION 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.
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 BALANC.

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

Definition at line 159 of file dgebal.f.

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