1: SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
2: $ EQUED )
3: *
4: * -- LAPACK auxiliary routine (version 3.2) --
5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7: * November 2006
8: *
9: * .. Scalar Arguments ..
10: CHARACTER EQUED
11: INTEGER LDA, M, N
12: DOUBLE PRECISION AMAX, COLCND, ROWCND
13: * ..
14: * .. Array Arguments ..
15: DOUBLE PRECISION A( LDA, * ), C( * ), R( * )
16: * ..
17: *
18: * Purpose
19: * =======
20: *
21: * DLAQGE equilibrates a general M by N matrix A using the row and
22: * column scaling factors in the vectors R and C.
23: *
24: * Arguments
25: * =========
26: *
27: * M (input) INTEGER
28: * The number of rows of the matrix A. M >= 0.
29: *
30: * N (input) INTEGER
31: * The number of columns of the matrix A. N >= 0.
32: *
33: * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
34: * On entry, the M by N matrix A.
35: * On exit, the equilibrated matrix. See EQUED for the form of
36: * the equilibrated matrix.
37: *
38: * LDA (input) INTEGER
39: * The leading dimension of the array A. LDA >= max(M,1).
40: *
41: * R (input) DOUBLE PRECISION array, dimension (M)
42: * The row scale factors for A.
43: *
44: * C (input) DOUBLE PRECISION array, dimension (N)
45: * The column scale factors for A.
46: *
47: * ROWCND (input) DOUBLE PRECISION
48: * Ratio of the smallest R(i) to the largest R(i).
49: *
50: * COLCND (input) DOUBLE PRECISION
51: * Ratio of the smallest C(i) to the largest C(i).
52: *
53: * AMAX (input) DOUBLE PRECISION
54: * Absolute value of largest matrix entry.
55: *
56: * EQUED (output) CHARACTER*1
57: * Specifies the form of equilibration that was done.
58: * = 'N': No equilibration
59: * = 'R': Row equilibration, i.e., A has been premultiplied by
60: * diag(R).
61: * = 'C': Column equilibration, i.e., A has been postmultiplied
62: * by diag(C).
63: * = 'B': Both row and column equilibration, i.e., A has been
64: * replaced by diag(R) * A * diag(C).
65: *
66: * Internal Parameters
67: * ===================
68: *
69: * THRESH is a threshold value used to decide if row or column scaling
70: * should be done based on the ratio of the row or column scaling
71: * factors. If ROWCND < THRESH, row scaling is done, and if
72: * COLCND < THRESH, column scaling is done.
73: *
74: * LARGE and SMALL are threshold values used to decide if row scaling
75: * should be done based on the absolute size of the largest matrix
76: * element. If AMAX > LARGE or AMAX < SMALL, row scaling is done.
77: *
78: * =====================================================================
79: *
80: * .. Parameters ..
81: DOUBLE PRECISION ONE, THRESH
82: PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 )
83: * ..
84: * .. Local Scalars ..
85: INTEGER I, J
86: DOUBLE PRECISION CJ, LARGE, SMALL
87: * ..
88: * .. External Functions ..
89: DOUBLE PRECISION DLAMCH
90: EXTERNAL DLAMCH
91: * ..
92: * .. Executable Statements ..
93: *
94: * Quick return if possible
95: *
96: IF( M.LE.0 .OR. N.LE.0 ) THEN
97: EQUED = 'N'
98: RETURN
99: END IF
100: *
101: * Initialize LARGE and SMALL.
102: *
103: SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
104: LARGE = ONE / SMALL
105: *
106: IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
107: $ THEN
108: *
109: * No row scaling
110: *
111: IF( COLCND.GE.THRESH ) THEN
112: *
113: * No column scaling
114: *
115: EQUED = 'N'
116: ELSE
117: *
118: * Column scaling
119: *
120: DO 20 J = 1, N
121: CJ = C( J )
122: DO 10 I = 1, M
123: A( I, J ) = CJ*A( I, J )
124: 10 CONTINUE
125: 20 CONTINUE
126: EQUED = 'C'
127: END IF
128: ELSE IF( COLCND.GE.THRESH ) THEN
129: *
130: * Row scaling, no column scaling
131: *
132: DO 40 J = 1, N
133: DO 30 I = 1, M
134: A( I, J ) = R( I )*A( I, J )
135: 30 CONTINUE
136: 40 CONTINUE
137: EQUED = 'R'
138: ELSE
139: *
140: * Row and column scaling
141: *
142: DO 60 J = 1, N
143: CJ = C( J )
144: DO 50 I = 1, M
145: A( I, J ) = CJ*R( I )*A( I, J )
146: 50 CONTINUE
147: 60 CONTINUE
148: EQUED = 'B'
149: END IF
150: *
151: RETURN
152: *
153: * End of DLAQGE
154: *
155: END
CVSweb interface <joel.bertrand@systella.fr>