Annotation of rpl/lapack/lapack/zgebal.f, revision 1.17
1.9 bertrand 1: *> \brief \b ZGEBAL
2: *
3: * =========== DOCUMENTATION ===========
4: *
1.17 ! bertrand 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
1.9 bertrand 7: *
8: *> \htmlonly
1.17 ! bertrand 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">
1.9 bertrand 15: *> [TXT]</a>
1.17 ! bertrand 16: *> \endhtmlonly
1.9 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
1.17 ! bertrand 22: *
1.9 bertrand 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: * ..
1.17 ! bertrand 31: *
1.9 bertrand 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: *> \endverbatim
87: *>
88: *> \param[out] IHI
89: *> \verbatim
90: *> ILO and IHI are set to INTEGER such that on exit
91: *> A(i,j) = 0 if i > j and j = 1,...,ILO-1 or I = IHI+1,...,N.
92: *> If JOB = 'N' or 'S', ILO = 1 and IHI = N.
93: *> \endverbatim
94: *>
95: *> \param[out] SCALE
96: *> \verbatim
97: *> SCALE is DOUBLE PRECISION array, dimension (N)
98: *> Details of the permutations and scaling factors applied to
99: *> A. If P(j) is the index of the row and column interchanged
100: *> with row and column j and D(j) is the scaling factor
101: *> applied to row and column j, then
102: *> SCALE(j) = P(j) for j = 1,...,ILO-1
103: *> = D(j) for j = ILO,...,IHI
104: *> = P(j) for j = IHI+1,...,N.
105: *> The order in which the interchanges are made is N to IHI+1,
106: *> then 1 to ILO-1.
107: *> \endverbatim
108: *>
109: *> \param[out] INFO
110: *> \verbatim
111: *> INFO is INTEGER
112: *> = 0: successful exit.
113: *> < 0: if INFO = -i, the i-th argument had an illegal value.
114: *> \endverbatim
115: *
116: * Authors:
117: * ========
118: *
1.17 ! bertrand 119: *> \author Univ. of Tennessee
! 120: *> \author Univ. of California Berkeley
! 121: *> \author Univ. of Colorado Denver
! 122: *> \author NAG Ltd.
1.9 bertrand 123: *
1.17 ! bertrand 124: *> \date December 2016
1.9 bertrand 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: * =====================================================================
1.1 bertrand 161: SUBROUTINE ZGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
162: *
1.17 ! bertrand 163: * -- LAPACK computational routine (version 3.7.0) --
1.1 bertrand 164: * -- LAPACK is a software package provided by Univ. of Tennessee, --
165: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.17 ! bertrand 166: * December 2016
1.1 bertrand 167: *
168: * .. Scalar Arguments ..
169: CHARACTER JOB
170: INTEGER IHI, ILO, INFO, LDA, N
171: * ..
172: * .. Array Arguments ..
173: DOUBLE PRECISION SCALE( * )
174: COMPLEX*16 A( LDA, * )
175: * ..
176: *
177: * =====================================================================
178: *
179: * .. Parameters ..
180: DOUBLE PRECISION ZERO, ONE
181: PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
182: DOUBLE PRECISION SCLFAC
183: PARAMETER ( SCLFAC = 2.0D+0 )
184: DOUBLE PRECISION FACTOR
185: PARAMETER ( FACTOR = 0.95D+0 )
186: * ..
187: * .. Local Scalars ..
188: LOGICAL NOCONV
189: INTEGER I, ICA, IEXC, IRA, J, K, L, M
190: DOUBLE PRECISION C, CA, F, G, R, RA, S, SFMAX1, SFMAX2, SFMIN1,
191: $ SFMIN2
192: * ..
193: * .. External Functions ..
1.5 bertrand 194: LOGICAL DISNAN, LSAME
1.1 bertrand 195: INTEGER IZAMAX
1.13 bertrand 196: DOUBLE PRECISION DLAMCH, DZNRM2
197: EXTERNAL DISNAN, LSAME, IZAMAX, DLAMCH, DZNRM2
1.1 bertrand 198: * ..
199: * .. External Subroutines ..
200: EXTERNAL XERBLA, ZDSCAL, ZSWAP
201: * ..
202: * .. Intrinsic Functions ..
203: INTRINSIC ABS, DBLE, DIMAG, MAX, MIN
204: *
205: * Test the input parameters
206: *
207: INFO = 0
208: IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
209: $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
210: INFO = -1
211: ELSE IF( N.LT.0 ) THEN
212: INFO = -2
213: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
214: INFO = -4
215: END IF
216: IF( INFO.NE.0 ) THEN
217: CALL XERBLA( 'ZGEBAL', -INFO )
218: RETURN
219: END IF
220: *
221: K = 1
222: L = N
223: *
224: IF( N.EQ.0 )
225: $ GO TO 210
226: *
227: IF( LSAME( JOB, 'N' ) ) THEN
228: DO 10 I = 1, N
229: SCALE( I ) = ONE
230: 10 CONTINUE
231: GO TO 210
232: END IF
233: *
234: IF( LSAME( JOB, 'S' ) )
235: $ GO TO 120
236: *
237: * Permutation to isolate eigenvalues if possible
238: *
239: GO TO 50
240: *
241: * Row and column exchange.
242: *
243: 20 CONTINUE
244: SCALE( M ) = J
245: IF( J.EQ.M )
246: $ GO TO 30
247: *
248: CALL ZSWAP( L, A( 1, J ), 1, A( 1, M ), 1 )
249: CALL ZSWAP( N-K+1, A( J, K ), LDA, A( M, K ), LDA )
250: *
251: 30 CONTINUE
252: GO TO ( 40, 80 )IEXC
253: *
254: * Search for rows isolating an eigenvalue and push them down.
255: *
256: 40 CONTINUE
257: IF( L.EQ.1 )
258: $ GO TO 210
259: L = L - 1
260: *
261: 50 CONTINUE
262: DO 70 J = L, 1, -1
263: *
264: DO 60 I = 1, L
265: IF( I.EQ.J )
266: $ GO TO 60
267: IF( DBLE( A( J, I ) ).NE.ZERO .OR. DIMAG( A( J, I ) ).NE.
268: $ ZERO )GO TO 70
269: 60 CONTINUE
270: *
271: M = L
272: IEXC = 1
273: GO TO 20
274: 70 CONTINUE
275: *
276: GO TO 90
277: *
278: * Search for columns isolating an eigenvalue and push them left.
279: *
280: 80 CONTINUE
281: K = K + 1
282: *
283: 90 CONTINUE
284: DO 110 J = K, L
285: *
286: DO 100 I = K, L
287: IF( I.EQ.J )
288: $ GO TO 100
289: IF( DBLE( A( I, J ) ).NE.ZERO .OR. DIMAG( A( I, J ) ).NE.
290: $ ZERO )GO TO 110
291: 100 CONTINUE
292: *
293: M = K
294: IEXC = 2
295: GO TO 20
296: 110 CONTINUE
297: *
298: 120 CONTINUE
299: DO 130 I = K, L
300: SCALE( I ) = ONE
301: 130 CONTINUE
302: *
303: IF( LSAME( JOB, 'P' ) )
304: $ GO TO 210
305: *
306: * Balance the submatrix in rows K to L.
307: *
308: * Iterative loop for norm reduction
309: *
310: SFMIN1 = DLAMCH( 'S' ) / DLAMCH( 'P' )
311: SFMAX1 = ONE / SFMIN1
312: SFMIN2 = SFMIN1*SCLFAC
313: SFMAX2 = ONE / SFMIN2
314: 140 CONTINUE
315: NOCONV = .FALSE.
316: *
317: DO 200 I = K, L
318: *
1.13 bertrand 319: C = DZNRM2( L-K+1, A( K, I ), 1 )
320: R = DZNRM2( L-K+1, A( I, K ), LDA )
1.1 bertrand 321: ICA = IZAMAX( L, A( 1, I ), 1 )
322: CA = ABS( A( ICA, I ) )
323: IRA = IZAMAX( 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
1.5 bertrand 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( 'ZGEBAL', -INFO )
342: RETURN
343: END IF
1.1 bertrand 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 ZDSCAL( N-K+1, G, A( I, K ), LDA )
383: CALL ZDSCAL( 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 ZGEBAL
397: *
398: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zgebal.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack