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