LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dppequ.f
Go to the documentation of this file.
00001 *> \brief \b DPPEQU
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DPPEQU + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dppequ.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dppequ.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dppequ.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          UPLO
00025 *       INTEGER            INFO, N
00026 *       DOUBLE PRECISION   AMAX, SCOND
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       DOUBLE PRECISION   AP( * ), S( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> DPPEQU computes row and column scalings intended to equilibrate a
00039 *> symmetric positive definite matrix A in packed storage and reduce
00040 *> its condition number (with respect to the two-norm).  S contains the
00041 *> scale factors, S(i)=1/sqrt(A(i,i)), chosen so that the scaled matrix
00042 *> B with elements B(i,j)=S(i)*A(i,j)*S(j) has ones on the diagonal.
00043 *> This choice of S puts the condition number of B within a factor N of
00044 *> the smallest possible condition number over all possible diagonal
00045 *> scalings.
00046 *> \endverbatim
00047 *
00048 *  Arguments:
00049 *  ==========
00050 *
00051 *> \param[in] UPLO
00052 *> \verbatim
00053 *>          UPLO is CHARACTER*1
00054 *>          = 'U':  Upper triangle of A is stored;
00055 *>          = 'L':  Lower triangle of A is stored.
00056 *> \endverbatim
00057 *>
00058 *> \param[in] N
00059 *> \verbatim
00060 *>          N is INTEGER
00061 *>          The order of the matrix A.  N >= 0.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] AP
00065 *> \verbatim
00066 *>          AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
00067 *>          The upper or lower triangle of the symmetric matrix A, packed
00068 *>          columnwise in a linear array.  The j-th column of A is stored
00069 *>          in the array AP as follows:
00070 *>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
00071 *>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
00072 *> \endverbatim
00073 *>
00074 *> \param[out] S
00075 *> \verbatim
00076 *>          S is DOUBLE PRECISION array, dimension (N)
00077 *>          If INFO = 0, S contains the scale factors for A.
00078 *> \endverbatim
00079 *>
00080 *> \param[out] SCOND
00081 *> \verbatim
00082 *>          SCOND is DOUBLE PRECISION
00083 *>          If INFO = 0, S contains the ratio of the smallest S(i) to
00084 *>          the largest S(i).  If SCOND >= 0.1 and AMAX is neither too
00085 *>          large nor too small, it is not worth scaling by S.
00086 *> \endverbatim
00087 *>
00088 *> \param[out] AMAX
00089 *> \verbatim
00090 *>          AMAX is DOUBLE PRECISION
00091 *>          Absolute value of largest matrix element.  If AMAX is very
00092 *>          close to overflow or very close to underflow, the matrix
00093 *>          should be scaled.
00094 *> \endverbatim
00095 *>
00096 *> \param[out] INFO
00097 *> \verbatim
00098 *>          INFO is INTEGER
00099 *>          = 0:  successful exit
00100 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
00101 *>          > 0:  if INFO = i, the i-th diagonal element is nonpositive.
00102 *> \endverbatim
00103 *
00104 *  Authors:
00105 *  ========
00106 *
00107 *> \author Univ. of Tennessee 
00108 *> \author Univ. of California Berkeley 
00109 *> \author Univ. of Colorado Denver 
00110 *> \author NAG Ltd. 
00111 *
00112 *> \date November 2011
00113 *
00114 *> \ingroup doubleOTHERcomputational
00115 *
00116 *  =====================================================================
00117       SUBROUTINE DPPEQU( UPLO, N, AP, S, SCOND, AMAX, INFO )
00118 *
00119 *  -- LAPACK computational routine (version 3.4.0) --
00120 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00121 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00122 *     November 2011
00123 *
00124 *     .. Scalar Arguments ..
00125       CHARACTER          UPLO
00126       INTEGER            INFO, N
00127       DOUBLE PRECISION   AMAX, SCOND
00128 *     ..
00129 *     .. Array Arguments ..
00130       DOUBLE PRECISION   AP( * ), S( * )
00131 *     ..
00132 *
00133 *  =====================================================================
00134 *
00135 *     .. Parameters ..
00136       DOUBLE PRECISION   ONE, ZERO
00137       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00138 *     ..
00139 *     .. Local Scalars ..
00140       LOGICAL            UPPER
00141       INTEGER            I, JJ
00142       DOUBLE PRECISION   SMIN
00143 *     ..
00144 *     .. External Functions ..
00145       LOGICAL            LSAME
00146       EXTERNAL           LSAME
00147 *     ..
00148 *     .. External Subroutines ..
00149       EXTERNAL           XERBLA
00150 *     ..
00151 *     .. Intrinsic Functions ..
00152       INTRINSIC          MAX, MIN, SQRT
00153 *     ..
00154 *     .. Executable Statements ..
00155 *
00156 *     Test the input parameters.
00157 *
00158       INFO = 0
00159       UPPER = LSAME( UPLO, 'U' )
00160       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00161          INFO = -1
00162       ELSE IF( N.LT.0 ) THEN
00163          INFO = -2
00164       END IF
00165       IF( INFO.NE.0 ) THEN
00166          CALL XERBLA( 'DPPEQU', -INFO )
00167          RETURN
00168       END IF
00169 *
00170 *     Quick return if possible
00171 *
00172       IF( N.EQ.0 ) THEN
00173          SCOND = ONE
00174          AMAX = ZERO
00175          RETURN
00176       END IF
00177 *
00178 *     Initialize SMIN and AMAX.
00179 *
00180       S( 1 ) = AP( 1 )
00181       SMIN = S( 1 )
00182       AMAX = S( 1 )
00183 *
00184       IF( UPPER ) THEN
00185 *
00186 *        UPLO = 'U':  Upper triangle of A is stored.
00187 *        Find the minimum and maximum diagonal elements.
00188 *
00189          JJ = 1
00190          DO 10 I = 2, N
00191             JJ = JJ + I
00192             S( I ) = AP( JJ )
00193             SMIN = MIN( SMIN, S( I ) )
00194             AMAX = MAX( AMAX, S( I ) )
00195    10    CONTINUE
00196 *
00197       ELSE
00198 *
00199 *        UPLO = 'L':  Lower triangle of A is stored.
00200 *        Find the minimum and maximum diagonal elements.
00201 *
00202          JJ = 1
00203          DO 20 I = 2, N
00204             JJ = JJ + N - I + 2
00205             S( I ) = AP( JJ )
00206             SMIN = MIN( SMIN, S( I ) )
00207             AMAX = MAX( AMAX, S( I ) )
00208    20    CONTINUE
00209       END IF
00210 *
00211       IF( SMIN.LE.ZERO ) THEN
00212 *
00213 *        Find the first non-positive diagonal element and return.
00214 *
00215          DO 30 I = 1, N
00216             IF( S( I ).LE.ZERO ) THEN
00217                INFO = I
00218                RETURN
00219             END IF
00220    30    CONTINUE
00221       ELSE
00222 *
00223 *        Set the scale factors to the reciprocals
00224 *        of the diagonal elements.
00225 *
00226          DO 40 I = 1, N
00227             S( I ) = ONE / SQRT( S( I ) )
00228    40    CONTINUE
00229 *
00230 *        Compute SCOND = min(S(I)) / max(S(I))
00231 *
00232          SCOND = SQRT( SMIN ) / SQRT( AMAX )
00233       END IF
00234       RETURN
00235 *
00236 *     End of DPPEQU
00237 *
00238       END
 All Files Functions