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