LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zgebal.f
Go to the documentation of this file.
1*> \brief \b ZGEBAL
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZGEBAL + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgebal.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgebal.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgebal.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER JOB
25* INTEGER IHI, ILO, INFO, LDA, N
26* ..
27* .. Array Arguments ..
28* DOUBLE PRECISION SCALE( * )
29* COMPLEX*16 A( LDA, * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> ZGEBAL balances a general complex matrix A. This involves, first,
39*> permuting A by a similarity transformation to isolate eigenvalues
40*> in the first 1 to ILO-1 and last IHI+1 to N elements on the
41*> diagonal; and second, applying a diagonal similarity transformation
42*> to rows and columns ILO to IHI to make the rows and columns as
43*> close in norm as possible. Both steps are optional.
44*>
45*> Balancing may reduce the 1-norm of the matrix, and improve the
46*> accuracy of the computed eigenvalues and/or eigenvectors.
47*> \endverbatim
48*
49* Arguments:
50* ==========
51*
52*> \param[in] JOB
53*> \verbatim
54*> JOB is CHARACTER*1
55*> Specifies the operations to be performed on A:
56*> = 'N': none: simply set ILO = 1, IHI = N, SCALE(I) = 1.0
57*> for i = 1,...,N;
58*> = 'P': permute only;
59*> = 'S': scale only;
60*> = 'B': both permute and scale.
61*> \endverbatim
62*>
63*> \param[in] N
64*> \verbatim
65*> N is INTEGER
66*> The order of the matrix A. N >= 0.
67*> \endverbatim
68*>
69*> \param[in,out] A
70*> \verbatim
71*> A is COMPLEX*16 array, dimension (LDA,N)
72*> On entry, the input matrix A.
73*> On exit, A is overwritten by the balanced matrix.
74*> If JOB = 'N', A is not referenced.
75*> See Further Details.
76*> \endverbatim
77*>
78*> \param[in] LDA
79*> \verbatim
80*> LDA is INTEGER
81*> The leading dimension of the array A. LDA >= max(1,N).
82*> \endverbatim
83*>
84*> \param[out] ILO
85*> \verbatim
86*> ILO is INTEGER
87*> \endverbatim
88*>
89*> \param[out] IHI
90*> \verbatim
91*> IHI is INTEGER
92*> ILO and IHI are set to INTEGER such that on exit
93*> A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
94*> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
95*> \endverbatim
96*>
97*> \param[out] SCALE
98*> \verbatim
99*> SCALE is DOUBLE PRECISION array, dimension (N)
100*> Details of the permutations and scaling factors applied to
101*> A. If P(j) is the index of the row and column interchanged
102*> with row and column j and D(j) is the scaling factor
103*> applied to row and column j, then
104*> SCALE(j) = P(j) for j = 1,...,ILO-1
105*> = D(j) for j = ILO,...,IHI
106*> = P(j) for j = IHI+1,...,N.
107*> The order in which the interchanges are made is N to IHI+1,
108*> then 1 to ILO-1.
109*> \endverbatim
110*>
111*> \param[out] INFO
112*> \verbatim
113*> INFO is INTEGER
114*> = 0: successful exit.
115*> < 0: if INFO = -i, the i-th argument had an illegal value.
116*> \endverbatim
117*
118* Authors:
119* ========
120*
121*> \author Univ. of Tennessee
122*> \author Univ. of California Berkeley
123*> \author Univ. of Colorado Denver
124*> \author NAG Ltd.
125*
126*> \ingroup complex16GEcomputational
127*
128*> \par Further Details:
129* =====================
130*>
131*> \verbatim
132*>
133*> The permutations consist of row and column interchanges which put
134*> the matrix in the form
135*>
136*> ( T1 X Y )
137*> P A P = ( 0 B Z )
138*> ( 0 0 T2 )
139*>
140*> where T1 and T2 are upper triangular matrices whose eigenvalues lie
141*> along the diagonal. The column indices ILO and IHI mark the starting
142*> and ending columns of the submatrix B. Balancing consists of applying
143*> a diagonal similarity transformation inv(D) * B * D to make the
144*> 1-norms of each row of B and its corresponding column nearly equal.
145*> The output matrix is
146*>
147*> ( T1 X*D Y )
148*> ( 0 inv(D)*B*D inv(D)*Z ).
149*> ( 0 0 T2 )
150*>
151*> Information about the permutations P and the diagonal matrix D is
152*> returned in the vector SCALE.
153*>
154*> This subroutine is based on the EISPACK routine CBAL.
155*>
156*> Modified by Tzu-Yi Chen, Computer Science Division, University of
157*> California at Berkeley, USA
158*> \endverbatim
159*>
160* =====================================================================
161 SUBROUTINE zgebal( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
162*
163* -- LAPACK computational routine --
164* -- LAPACK is a software package provided by Univ. of Tennessee, --
165* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
166*
167* .. Scalar Arguments ..
168 CHARACTER JOB
169 INTEGER IHI, ILO, INFO, LDA, N
170* ..
171* .. Array Arguments ..
172 DOUBLE PRECISION SCALE( * )
173 COMPLEX*16 A( LDA, * )
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 IZAMAX
195 DOUBLE PRECISION DLAMCH, DZNRM2
196 EXTERNAL disnan, lsame, izamax, dlamch, dznrm2
197* ..
198* .. External Subroutines ..
199 EXTERNAL xerbla, zdscal, zswap
200* ..
201* .. Intrinsic Functions ..
202 INTRINSIC abs, dble, dimag, 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( 'ZGEBAL', -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 zswap( l, a( 1, j ), 1, a( 1, m ), 1 )
248 CALL zswap( 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( dble( a( j, i ) ).NE.zero .OR. dimag( a( j, i ) ).NE.
267 $ zero )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( dble( a( i, j ) ).NE.zero .OR. dimag( a( i, j ) ).NE.
289 $ zero )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 140 CONTINUE
314 noconv = .false.
315*
316 DO 200 i = k, l
317*
318 c = dznrm2( l-k+1, a( k, i ), 1 )
319 r = dznrm2( l-k+1, a( i, k ), lda )
320 ica = izamax( l, a( 1, i ), 1 )
321 ca = abs( a( ica, i ) )
322 ira = izamax( n-k+1, a( i, k ), lda )
323 ra = abs( a( i, ira+k-1 ) )
324*
325* Guard against zero C or R due to underflow.
326*
327 IF( c.EQ.zero .OR. r.EQ.zero )
328 $ GO TO 200
329 g = r / sclfac
330 f = one
331 s = c + r
332 160 CONTINUE
333 IF( c.GE.g .OR. max( f, c, ca ).GE.sfmax2 .OR.
334 $ min( r, g, ra ).LE.sfmin2 )GO TO 170
335 IF( disnan( c+f+ca+r+g+ra ) ) THEN
336*
337* Exit if NaN to avoid infinite loop
338*
339 info = -3
340 CALL xerbla( 'ZGEBAL', -info )
341 RETURN
342 END IF
343 f = f*sclfac
344 c = c*sclfac
345 ca = ca*sclfac
346 r = r / sclfac
347 g = g / sclfac
348 ra = ra / sclfac
349 GO TO 160
350*
351 170 CONTINUE
352 g = c / sclfac
353 180 CONTINUE
354 IF( g.LT.r .OR. max( r, ra ).GE.sfmax2 .OR.
355 $ min( f, c, g, ca ).LE.sfmin2 )GO TO 190
356 f = f / sclfac
357 c = c / sclfac
358 g = g / sclfac
359 ca = ca / sclfac
360 r = r*sclfac
361 ra = ra*sclfac
362 GO TO 180
363*
364* Now balance.
365*
366 190 CONTINUE
367 IF( ( c+r ).GE.factor*s )
368 $ GO TO 200
369 IF( f.LT.one .AND. scale( i ).LT.one ) THEN
370 IF( f*scale( i ).LE.sfmin1 )
371 $ GO TO 200
372 END IF
373 IF( f.GT.one .AND. scale( i ).GT.one ) THEN
374 IF( scale( i ).GE.sfmax1 / f )
375 $ GO TO 200
376 END IF
377 g = one / f
378 scale( i ) = scale( i )*f
379 noconv = .true.
380*
381 CALL zdscal( n-k+1, g, a( i, k ), lda )
382 CALL zdscal( l, f, a( 1, i ), 1 )
383*
384 200 CONTINUE
385*
386 IF( noconv )
387 $ GO TO 140
388*
389 210 CONTINUE
390 ilo = k
391 ihi = l
392*
393 RETURN
394*
395* End of ZGEBAL
396*
397 END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:81
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:78
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
Definition: zgebal.f:162