SRC/slaqsb.f

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