SRC/zlaqhp.f

   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