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