SRC/dlaqsy.f

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