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