LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
dlaqge.f
Go to the documentation of this file.
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