SRC/claqsy.f

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