LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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: