6e4f039b50d01aa6860a498f3c37858bd72a2414
[platform/upstream/lapack.git] / SRC / dlaqge.f
1 *> \brief \b DLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
2 *
3 *  =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at 
6 *            http://www.netlib.org/lapack/explore-html/ 
7 *
8 *> \htmlonly
9 *> Download DLAQGE + dependencies 
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqge.f"> 
11 *> [TGZ]</a> 
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqge.f"> 
13 *> [ZIP]</a> 
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqge.f"> 
15 *> [TXT]</a>
16 *> \endhtmlonly 
17 *
18 *  Definition:
19 *  ===========
20 *
21 *       SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
22 *                          EQUED )
23
24 *       .. Scalar Arguments ..
25 *       CHARACTER          EQUED
26 *       INTEGER            LDA, M, N
27 *       DOUBLE PRECISION   AMAX, COLCND, ROWCND
28 *       ..
29 *       .. Array Arguments ..
30 *       DOUBLE PRECISION   A( LDA, * ), C( * ), R( * )
31 *       ..
32 *  
33 *
34 *> \par Purpose:
35 *  =============
36 *>
37 *> \verbatim
38 *>
39 *> DLAQGE equilibrates a general M by N matrix A using the row and
40 *> column scaling factors in the vectors R and C.
41 *> \endverbatim
42 *
43 *  Arguments:
44 *  ==========
45 *
46 *> \param[in] M
47 *> \verbatim
48 *>          M is INTEGER
49 *>          The number of rows of the matrix A.  M >= 0.
50 *> \endverbatim
51 *>
52 *> \param[in] N
53 *> \verbatim
54 *>          N is INTEGER
55 *>          The number of columns of the matrix A.  N >= 0.
56 *> \endverbatim
57 *>
58 *> \param[in,out] A
59 *> \verbatim
60 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
61 *>          On entry, the M by N matrix A.
62 *>          On exit, the equilibrated matrix.  See EQUED for the form of
63 *>          the equilibrated matrix.
64 *> \endverbatim
65 *>
66 *> \param[in] LDA
67 *> \verbatim
68 *>          LDA is INTEGER
69 *>          The leading dimension of the array A.  LDA >= max(M,1).
70 *> \endverbatim
71 *>
72 *> \param[in] R
73 *> \verbatim
74 *>          R is DOUBLE PRECISION array, dimension (M)
75 *>          The row scale factors for A.
76 *> \endverbatim
77 *>
78 *> \param[in] C
79 *> \verbatim
80 *>          C is DOUBLE PRECISION array, dimension (N)
81 *>          The column scale factors for A.
82 *> \endverbatim
83 *>
84 *> \param[in] ROWCND
85 *> \verbatim
86 *>          ROWCND is DOUBLE PRECISION
87 *>          Ratio of the smallest R(i) to the largest R(i).
88 *> \endverbatim
89 *>
90 *> \param[in] COLCND
91 *> \verbatim
92 *>          COLCND is DOUBLE PRECISION
93 *>          Ratio of the smallest C(i) to the largest C(i).
94 *> \endverbatim
95 *>
96 *> \param[in] AMAX
97 *> \verbatim
98 *>          AMAX is DOUBLE PRECISION
99 *>          Absolute value of largest matrix entry.
100 *> \endverbatim
101 *>
102 *> \param[out] EQUED
103 *> \verbatim
104 *>          EQUED is CHARACTER*1
105 *>          Specifies the form of equilibration that was done.
106 *>          = 'N':  No equilibration
107 *>          = 'R':  Row equilibration, i.e., A has been premultiplied by
108 *>                  diag(R).
109 *>          = 'C':  Column equilibration, i.e., A has been postmultiplied
110 *>                  by diag(C).
111 *>          = 'B':  Both row and column equilibration, i.e., A has been
112 *>                  replaced by diag(R) * A * diag(C).
113 *> \endverbatim
114 *
115 *> \par Internal Parameters:
116 *  =========================
117 *>
118 *> \verbatim
119 *>  THRESH is a threshold value used to decide if row or column scaling
120 *>  should be done based on the ratio of the row or column scaling
121 *>  factors.  If ROWCND < THRESH, row scaling is done, and if
122 *>  COLCND < THRESH, column scaling is done.
123 *>
124 *>  LARGE and SMALL are threshold values used to decide if row scaling
125 *>  should be done based on the absolute size of the largest matrix
126 *>  element.  If AMAX > LARGE or AMAX < SMALL, row scaling is done.
127 *> \endverbatim
128 *
129 *  Authors:
130 *  ========
131 *
132 *> \author Univ. of Tennessee 
133 *> \author Univ. of California Berkeley 
134 *> \author Univ. of Colorado Denver 
135 *> \author NAG Ltd. 
136 *
137 *> \date September 2012
138 *
139 *> \ingroup doubleGEauxiliary
140 *
141 *  =====================================================================
142       SUBROUTINE DLAQGE( M, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
143      $                   EQUED )
144 *
145 *  -- LAPACK auxiliary routine (version 3.4.2) --
146 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
147 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148 *     September 2012
149 *
150 *     .. Scalar Arguments ..
151       CHARACTER          EQUED
152       INTEGER            LDA, M, N
153       DOUBLE PRECISION   AMAX, COLCND, ROWCND
154 *     ..
155 *     .. Array Arguments ..
156       DOUBLE PRECISION   A( LDA, * ), C( * ), R( * )
157 *     ..
158 *
159 *  =====================================================================
160 *
161 *     .. Parameters ..
162       DOUBLE PRECISION   ONE, THRESH
163       PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
164 *     ..
165 *     .. Local Scalars ..
166       INTEGER            I, J
167       DOUBLE PRECISION   CJ, LARGE, SMALL
168 *     ..
169 *     .. External Functions ..
170       DOUBLE PRECISION   DLAMCH
171       EXTERNAL           DLAMCH
172 *     ..
173 *     .. Executable Statements ..
174 *
175 *     Quick return if possible
176 *
177       IF( M.LE.0 .OR. N.LE.0 ) THEN
178          EQUED = 'N'
179          RETURN
180       END IF
181 *
182 *     Initialize LARGE and SMALL.
183 *
184       SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
185       LARGE = ONE / SMALL
186 *
187       IF( ROWCND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE )
188      $     THEN
189 *
190 *        No row scaling
191 *
192          IF( COLCND.GE.THRESH ) THEN
193 *
194 *           No column scaling
195 *
196             EQUED = 'N'
197          ELSE
198 *
199 *           Column scaling
200 *
201             DO 20 J = 1, N
202                CJ = C( J )
203                DO 10 I = 1, M
204                   A( I, J ) = CJ*A( I, J )
205    10          CONTINUE
206    20       CONTINUE
207             EQUED = 'C'
208          END IF
209       ELSE IF( COLCND.GE.THRESH ) THEN
210 *
211 *        Row scaling, no column scaling
212 *
213          DO 40 J = 1, N
214             DO 30 I = 1, M
215                A( I, J ) = R( I )*A( I, J )
216    30       CONTINUE
217    40    CONTINUE
218          EQUED = 'R'
219       ELSE
220 *
221 *        Row and column scaling
222 *
223          DO 60 J = 1, N
224             CJ = C( J )
225             DO 50 I = 1, M
226                A( I, J ) = CJ*R( I )*A( I, J )
227    50       CONTINUE
228    60    CONTINUE
229          EQUED = 'B'
230       END IF
231 *
232       RETURN
233 *
234 *     End of DLAQGE
235 *
236       END