LAPACK 3.3.1 Linear Algebra PACKage

# slaqsy.f

Go to the documentation of this file.
```00001       SUBROUTINE SLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          EQUED, UPLO
00010       INTEGER            LDA, N
00011       REAL               AMAX, SCOND
00012 *     ..
00013 *     .. Array Arguments ..
00014       REAL               A( LDA, * ), S( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  SLAQSY equilibrates a symmetric matrix A using the scaling factors
00021 *  in the vector S.
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  UPLO    (input) CHARACTER*1
00027 *          Specifies whether the upper or lower triangular part of the
00028 *          symmetric matrix A is stored.
00029 *          = 'U':  Upper triangular
00030 *          = 'L':  Lower triangular
00031 *
00032 *  N       (input) INTEGER
00033 *          The order of the matrix A.  N >= 0.
00034 *
00035 *  A       (input/output) REAL array, dimension (LDA,N)
00036 *          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
00037 *          n by n upper triangular part of A contains the upper
00038 *          triangular part of the matrix A, and the strictly lower
00039 *          triangular part of A is not referenced.  If UPLO = 'L', the
00040 *          leading n by n lower triangular part of A contains the lower
00041 *          triangular part of the matrix A, and the strictly upper
00042 *          triangular part of A is not referenced.
00043 *
00044 *          On exit, if EQUED = 'Y', the equilibrated matrix:
00045 *          diag(S) * A * diag(S).
00046 *
00047 *  LDA     (input) INTEGER
00048 *          The leading dimension of the array A.  LDA >= max(N,1).
00049 *
00050 *  S       (input) REAL array, dimension (N)
00051 *          The scale factors for A.
00052 *
00053 *  SCOND   (input) REAL
00054 *          Ratio of the smallest S(i) to the largest S(i).
00055 *
00056 *  AMAX    (input) REAL
00057 *          Absolute value of largest matrix entry.
00058 *
00059 *  EQUED   (output) CHARACTER*1
00060 *          Specifies whether or not equilibration was done.
00061 *          = 'N':  No equilibration.
00062 *          = 'Y':  Equilibration was done, i.e., A has been replaced by
00063 *                  diag(S) * A * diag(S).
00064 *
00065 *  Internal Parameters
00066 *  ===================
00067 *
00068 *  THRESH is a threshold value used to decide if scaling should be done
00069 *  based on the ratio of the scaling factors.  If SCOND < THRESH,
00070 *  scaling is done.
00071 *
00072 *  LARGE and SMALL are threshold values used to decide if scaling should
00073 *  be done based on the absolute size of the largest matrix element.
00074 *  If AMAX > LARGE or AMAX < SMALL, scaling is done.
00075 *
00076 *  =====================================================================
00077 *
00078 *     .. Parameters ..
00079       REAL               ONE, THRESH
00080       PARAMETER          ( ONE = 1.0E+0, THRESH = 0.1E+0 )
00081 *     ..
00082 *     .. Local Scalars ..
00083       INTEGER            I, J
00084       REAL               CJ, LARGE, SMALL
00085 *     ..
00086 *     .. External Functions ..
00087       LOGICAL            LSAME
00088       REAL               SLAMCH
00089       EXTERNAL           LSAME, SLAMCH
00090 *     ..
00091 *     .. Executable Statements ..
00092 *
00093 *     Quick return if possible
00094 *
00095       IF( N.LE.0 ) THEN
00096          EQUED = 'N'
00097          RETURN
00098       END IF
00099 *
00100 *     Initialize LARGE and SMALL.
00101 *
00102       SMALL = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
00103       LARGE = ONE / SMALL
00104 *
00105       IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN
00106 *
00107 *        No equilibration
00108 *
00109          EQUED = 'N'
00110       ELSE
00111 *
00112 *        Replace A by diag(S) * A * diag(S).
00113 *
00114          IF( LSAME( UPLO, 'U' ) ) THEN
00115 *
00116 *           Upper triangle of A is stored.
00117 *
00118             DO 20 J = 1, N
00119                CJ = S( J )
00120                DO 10 I = 1, J
00121                   A( I, J ) = CJ*S( I )*A( I, J )
00122    10          CONTINUE
00123    20       CONTINUE
00124          ELSE
00125 *
00126 *           Lower triangle of A is stored.
00127 *
00128             DO 40 J = 1, N
00129                CJ = S( J )
00130                DO 30 I = J, N
00131                   A( I, J ) = CJ*S( I )*A( I, J )
00132    30          CONTINUE
00133    40       CONTINUE
00134          END IF
00135          EQUED = 'Y'
00136       END IF
00137 *
00138       RETURN
00139 *
00140 *     End of SLAQSY
00141 *
00142       END
```