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

Go to the source code of this file.

Functions/Subroutines

subroutine dgebal (JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
 DGEBAL More...
 

Function/Subroutine Documentation

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 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 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 BALANC.

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

Definition at line 162 of file dgebal.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 a( lda, * ), scale( * )
174 * ..
175 *
176 * =====================================================================
177 *
178 * .. Parameters ..
179  DOUBLE PRECISION zero, one
180  parameter( zero = 0.0d+0, one = 1.0d+0 )
181  DOUBLE PRECISION sclfac
182  parameter( sclfac = 2.0d+0 )
183  DOUBLE PRECISION factor
184  parameter( factor = 0.95d+0 )
185 * ..
186 * .. Local Scalars ..
187  LOGICAL noconv
188  INTEGER i, ica, iexc, ira, j, k, l, m
189  DOUBLE PRECISION c, ca, f, g, r, ra, s, sfmax1, sfmax2, sfmin1,
190  $ sfmin2
191 * ..
192 * .. External Functions ..
193  LOGICAL disnan, lsame
194  INTEGER idamax
195  DOUBLE PRECISION dlamch, dnrm2
196  EXTERNAL disnan, lsame, idamax, dlamch, dnrm2
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL dscal, dswap, xerbla
200 * ..
201 * .. Intrinsic Functions ..
202  INTRINSIC abs, max, min
203 * ..
204 * .. Executable Statements ..
205 *
206 * Test the input parameters
207 *
208  info = 0
209  IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
210  $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
211  info = -1
212  ELSE IF( n.LT.0 ) THEN
213  info = -2
214  ELSE IF( lda.LT.max( 1, n ) ) THEN
215  info = -4
216  END IF
217  IF( info.NE.0 ) THEN
218  CALL xerbla( 'DGEBAL', -info )
219  RETURN
220  END IF
221 *
222  k = 1
223  l = n
224 *
225  IF( n.EQ.0 )
226  $ GO TO 210
227 *
228  IF( lsame( job, 'N' ) ) THEN
229  DO 10 i = 1, n
230  scale( i ) = one
231  10 CONTINUE
232  GO TO 210
233  END IF
234 *
235  IF( lsame( job, 'S' ) )
236  $ GO TO 120
237 *
238 * Permutation to isolate eigenvalues if possible
239 *
240  GO TO 50
241 *
242 * Row and column exchange.
243 *
244  20 CONTINUE
245  scale( m ) = j
246  IF( j.EQ.m )
247  $ GO TO 30
248 *
249  CALL dswap( l, a( 1, j ), 1, a( 1, m ), 1 )
250  CALL dswap( n-k+1, a( j, k ), lda, a( m, k ), lda )
251 *
252  30 CONTINUE
253  GO TO ( 40, 80 )iexc
254 *
255 * Search for rows isolating an eigenvalue and push them down.
256 *
257  40 CONTINUE
258  IF( l.EQ.1 )
259  $ GO TO 210
260  l = l - 1
261 *
262  50 CONTINUE
263  DO 70 j = l, 1, -1
264 *
265  DO 60 i = 1, l
266  IF( i.EQ.j )
267  $ GO TO 60
268  IF( a( j, i ).NE.zero )
269  $ GO TO 70
270  60 CONTINUE
271 *
272  m = l
273  iexc = 1
274  GO TO 20
275  70 CONTINUE
276 *
277  GO TO 90
278 *
279 * Search for columns isolating an eigenvalue and push them left.
280 *
281  80 CONTINUE
282  k = k + 1
283 *
284  90 CONTINUE
285  DO 110 j = k, l
286 *
287  DO 100 i = k, l
288  IF( i.EQ.j )
289  $ GO TO 100
290  IF( a( i, j ).NE.zero )
291  $ GO TO 110
292  100 CONTINUE
293 *
294  m = k
295  iexc = 2
296  GO TO 20
297  110 CONTINUE
298 *
299  120 CONTINUE
300  DO 130 i = k, l
301  scale( i ) = one
302  130 CONTINUE
303 *
304  IF( lsame( job, 'P' ) )
305  $ GO TO 210
306 *
307 * Balance the submatrix in rows K to L.
308 *
309 * Iterative loop for norm reduction
310 *
311  sfmin1 = dlamch( 'S' ) / dlamch( 'P' )
312  sfmax1 = one / sfmin1
313  sfmin2 = sfmin1*sclfac
314  sfmax2 = one / sfmin2
315 *
316  140 CONTINUE
317  noconv = .false.
318 *
319  DO 200 i = k, l
320 *
321  c = dnrm2( l-k+1, a( k, i ), 1 )
322  r = dnrm2( l-k+1, a( i, k ), lda )
323  ica = idamax( l, a( 1, i ), 1 )
324  ca = abs( a( ica, i ) )
325  ira = idamax( 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( disnan( c+f+ca+r+g+ra ) ) THEN
339 *
340 * Exit if NaN to avoid infinite loop
341 *
342  info = -3
343  CALL xerbla( 'DGEBAL', -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 dscal( n-k+1, g, a( i, k ), lda )
385  CALL dscal( 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 DGEBAL
399 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine dscal(N, DA, DX, INCX)
DSCAL
Definition: dscal.f:55
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:53
double precision function dnrm2(N, X, INCX)
DNRM2
Definition: dnrm2.f:56
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:53
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: