001:       SUBROUTINE DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       CHARACTER          EQUED, UPLO
009:       INTEGER            LDA, N
010:       DOUBLE PRECISION   AMAX, SCOND
011: *     ..
012: *     .. Array Arguments ..
013:       DOUBLE PRECISION   A( LDA, * ), S( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DLAQSY equilibrates a symmetric matrix A using the scaling factors
020: *  in the vector S.
021: *
022: *  Arguments
023: *  =========
024: *
025: *  UPLO    (input) CHARACTER*1
026: *          Specifies whether the upper or lower triangular part of the
027: *          symmetric matrix A is stored.
028: *          = 'U':  Upper triangular
029: *          = 'L':  Lower triangular
030: *
031: *  N       (input) INTEGER
032: *          The order of the matrix A.  N >= 0.
033: *
034: *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
035: *          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
036: *          n by n upper triangular part of A contains the upper
037: *          triangular part of the matrix A, and the strictly lower
038: *          triangular part of A is not referenced.  If UPLO = 'L', the
039: *          leading n by n lower triangular part of A contains the lower
040: *          triangular part of the matrix A, and the strictly upper
041: *          triangular part of A is not referenced.
042: *
043: *          On exit, if EQUED = 'Y', the equilibrated matrix:
044: *          diag(S) * A * diag(S).
045: *
046: *  LDA     (input) INTEGER
047: *          The leading dimension of the array A.  LDA >= max(N,1).
048: *
049: *  S       (input) DOUBLE PRECISION array, dimension (N)
050: *          The scale factors for A.
051: *
052: *  SCOND   (input) DOUBLE PRECISION
053: *          Ratio of the smallest S(i) to the largest S(i).
054: *
055: *  AMAX    (input) DOUBLE PRECISION
056: *          Absolute value of largest matrix entry.
057: *
058: *  EQUED   (output) CHARACTER*1
059: *          Specifies whether or not equilibration was done.
060: *          = 'N':  No equilibration.
061: *          = 'Y':  Equilibration was done, i.e., A has been replaced by
062: *                  diag(S) * A * diag(S).
063: *
064: *  Internal Parameters
065: *  ===================
066: *
067: *  THRESH is a threshold value used to decide if scaling should be done
068: *  based on the ratio of the scaling factors.  If SCOND < THRESH,
069: *  scaling is done.
070: *
071: *  LARGE and SMALL are threshold values used to decide if scaling should
072: *  be done based on the absolute size of the largest matrix element.
073: *  If AMAX > LARGE or AMAX < SMALL, scaling is done.
074: *
075: *  =====================================================================
076: *
077: *     .. Parameters ..
078:       DOUBLE PRECISION   ONE, THRESH
079:       PARAMETER          ( ONE = 1.0D+0, THRESH = 0.1D+0 )
080: *     ..
081: *     .. Local Scalars ..
082:       INTEGER            I, J
083:       DOUBLE PRECISION   CJ, LARGE, SMALL
084: *     ..
085: *     .. External Functions ..
086:       LOGICAL            LSAME
087:       DOUBLE PRECISION   DLAMCH
088:       EXTERNAL           LSAME, DLAMCH
089: *     ..
090: *     .. Executable Statements ..
091: *
092: *     Quick return if possible
093: *
094:       IF( N.LE.0 ) THEN
095:          EQUED = 'N'
096:          RETURN
097:       END IF
098: *
099: *     Initialize LARGE and SMALL.
100: *
101:       SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
102:       LARGE = ONE / SMALL
103: *
104:       IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
105: *
106: *        No equilibration
107: *
108:          EQUED = 'N'
109:       ELSE
110: *
111: *        Replace A by diag(S) * A * diag(S).
112: *
113:          IF( LSAME( UPLO, 'U' ) ) THEN
114: *
115: *           Upper triangle of A is stored.
116: *
117:             DO 20 J = 1, N
118:                CJ = S( J )
119:                DO 10 I = 1, J
120:                   A( I, J ) = CJ*S( I )*A( I, J )
121:    10          CONTINUE
122:    20       CONTINUE
123:          ELSE
124: *
125: *           Lower triangle of A is stored.
126: *
127:             DO 40 J = 1, N
128:                CJ = S( J )
129:                DO 30 I = J, N
130:                   A( I, J ) = CJ*S( I )*A( I, J )
131:    30          CONTINUE
132:    40       CONTINUE
133:          END IF
134:          EQUED = 'Y'
135:       END IF
136: *
137:       RETURN
138: *
139: *     End of DLAQSY
140: *
141:       END
142: