LAPACK  3.8.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.
Date
June 2017
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.7.1) --
164 * -- LAPACK is a software package provided by Univ. of Tennessee, --
165 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
166 * June 2017
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 * Test the input parameters
205 *
206  info = 0
207  IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
208  $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
209  info = -1
210  ELSE IF( n.LT.0 ) THEN
211  info = -2
212  ELSE IF( lda.LT.max( 1, n ) ) THEN
213  info = -4
214  END IF
215  IF( info.NE.0 ) THEN
216  CALL xerbla( 'DGEBAL', -info )
217  RETURN
218  END IF
219 *
220  k = 1
221  l = n
222 *
223  IF( n.EQ.0 )
224  $ GO TO 210
225 *
226  IF( lsame( job, 'N' ) ) THEN
227  DO 10 i = 1, n
228  scale( i ) = one
229  10 CONTINUE
230  GO TO 210
231  END IF
232 *
233  IF( lsame( job, 'S' ) )
234  $ GO TO 120
235 *
236 * Permutation to isolate eigenvalues if possible
237 *
238  GO TO 50
239 *
240 * Row and column exchange.
241 *
242  20 CONTINUE
243  scale( m ) = j
244  IF( j.EQ.m )
245  $ GO TO 30
246 *
247  CALL dswap( l, a( 1, j ), 1, a( 1, m ), 1 )
248  CALL dswap( n-k+1, a( j, k ), lda, a( m, k ), lda )
249 *
250  30 CONTINUE
251  GO TO ( 40, 80 )iexc
252 *
253 * Search for rows isolating an eigenvalue and push them down.
254 *
255  40 CONTINUE
256  IF( l.EQ.1 )
257  $ GO TO 210
258  l = l - 1
259 *
260  50 CONTINUE
261  DO 70 j = l, 1, -1
262 *
263  DO 60 i = 1, l
264  IF( i.EQ.j )
265  $ GO TO 60
266  IF( a( j, i ).NE.zero )
267  $ GO TO 70
268  60 CONTINUE
269 *
270  m = l
271  iexc = 1
272  GO TO 20
273  70 CONTINUE
274 *
275  GO TO 90
276 *
277 * Search for columns isolating an eigenvalue and push them left.
278 *
279  80 CONTINUE
280  k = k + 1
281 *
282  90 CONTINUE
283  DO 110 j = k, l
284 *
285  DO 100 i = k, l
286  IF( i.EQ.j )
287  $ GO TO 100
288  IF( a( i, j ).NE.zero )
289  $ GO TO 110
290  100 CONTINUE
291 *
292  m = k
293  iexc = 2
294  GO TO 20
295  110 CONTINUE
296 *
297  120 CONTINUE
298  DO 130 i = k, l
299  scale( i ) = one
300  130 CONTINUE
301 *
302  IF( lsame( job, 'P' ) )
303  $ GO TO 210
304 *
305 * Balance the submatrix in rows K to L.
306 *
307 * Iterative loop for norm reduction
308 *
309  sfmin1 = dlamch( 'S' ) / dlamch( 'P' )
310  sfmax1 = one / sfmin1
311  sfmin2 = sfmin1*sclfac
312  sfmax2 = one / sfmin2
313 *
314  140 CONTINUE
315  noconv = .false.
316 *
317  DO 200 i = k, l
318 *
319  c = dnrm2( l-k+1, a( k, i ), 1 )
320  r = dnrm2( l-k+1, a( i, k ), lda )
321  ica = idamax( l, a( 1, i ), 1 )
322  ca = abs( a( ica, i ) )
323  ira = idamax( n-k+1, a( i, k ), lda )
324  ra = abs( a( i, ira+k-1 ) )
325 *
326 * Guard against zero C or R due to underflow.
327 *
328  IF( c.EQ.zero .OR. r.EQ.zero )
329  $ GO TO 200
330  g = r / sclfac
331  f = one
332  s = c + r
333  160 CONTINUE
334  IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
335  $ min( r, g, ra ).LE.sfmin2 )GO TO 170
336  IF( disnan( c+f+ca+r+g+ra ) ) THEN
337 *
338 * Exit if NaN to avoid infinite loop
339 *
340  info = -3
341  CALL xerbla( 'DGEBAL', -info )
342  RETURN
343  END IF
344  f = f*sclfac
345  c = c*sclfac
346  ca = ca*sclfac
347  r = r / sclfac
348  g = g / sclfac
349  ra = ra / sclfac
350  GO TO 160
351 *
352  170 CONTINUE
353  g = c / sclfac
354  180 CONTINUE
355  IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
356  $ min( f, c, g, ca ).LE.sfmin2 )GO TO 190
357  f = f / sclfac
358  c = c / sclfac
359  g = g / sclfac
360  ca = ca / sclfac
361  r = r*sclfac
362  ra = ra*sclfac
363  GO TO 180
364 *
365 * Now balance.
366 *
367  190 CONTINUE
368  IF( ( c+r ).GE.factor*s )
369  $ GO TO 200
370  IF( f.LT.one .AND. scale( i ).LT.one ) THEN
371  IF( f*scale( i ).LE.sfmin1 )
372  $ GO TO 200
373  END IF
374  IF( f.GT.one .AND. scale( i ).GT.one ) THEN
375  IF( scale( i ).GE.sfmax1 / f )
376  $ GO TO 200
377  END IF
378  g = one / f
379  scale( i ) = scale( i )*f
380  noconv = .true.
381 *
382  CALL dscal( n-k+1, g, a( i, k ), lda )
383  CALL dscal( l, f, a( 1, i ), 1 )
384 *
385  200 CONTINUE
386 *
387  IF( noconv )
388  $ GO TO 140
389 *
390  210 CONTINUE
391  ilo = k
392  ihi = l
393 *
394  RETURN
395 *
396 * End of DGEBAL
397 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:73
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
Definition: dswap.f:84
double precision function dnrm2(N, X, INCX)
DNRM2
Definition: dnrm2.f:76
logical function disnan(DIN)
DISNAN tests input for NaN.
Definition: disnan.f:61
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:81
Here is the call graph for this function:
Here is the caller graph for this function: