LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dla_porpvgrw.f
Go to the documentation of this file.
00001 *> \brief \b DLA_PORPVGRW
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DLA_PORPVGRW + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dla_porpvgrw.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dla_porpvgrw.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dla_porpvgrw.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       DOUBLE PRECISION FUNCTION DLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, 
00022 *                                               LDAF, WORK )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER*1        UPLO
00026 *       INTEGER            NCOLS, LDA, LDAF
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       DOUBLE PRECISION   A( LDA, * ), AF( LDAF, * ), WORK( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> 
00039 *> DLA_PORPVGRW computes the reciprocal pivot growth factor
00040 *> norm(A)/norm(U). The "max absolute element" norm is used. If this is
00041 *> much less than 1, the stability of the LU factorization of the
00042 *> (equilibrated) matrix A could be poor. This also means that the
00043 *> solution X, estimated condition numbers, and error bounds could be
00044 *> unreliable.
00045 *> \endverbatim
00046 *
00047 *  Arguments:
00048 *  ==========
00049 *
00050 *> \param[in] UPLO
00051 *> \verbatim
00052 *>          UPLO is CHARACTER*1
00053 *>       = 'U':  Upper triangle of A is stored;
00054 *>       = 'L':  Lower triangle of A is stored.
00055 *> \endverbatim
00056 *>
00057 *> \param[in] NCOLS
00058 *> \verbatim
00059 *>          NCOLS is INTEGER
00060 *>     The number of columns of the matrix A. NCOLS >= 0.
00061 *> \endverbatim
00062 *>
00063 *> \param[in] A
00064 *> \verbatim
00065 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
00066 *>     On entry, the N-by-N matrix A.
00067 *> \endverbatim
00068 *>
00069 *> \param[in] LDA
00070 *> \verbatim
00071 *>          LDA is INTEGER
00072 *>     The leading dimension of the array A.  LDA >= max(1,N).
00073 *> \endverbatim
00074 *>
00075 *> \param[in] AF
00076 *> \verbatim
00077 *>          AF is DOUBLE PRECISION array, dimension (LDAF,N)
00078 *>     The triangular factor U or L from the Cholesky factorization
00079 *>     A = U**T*U or A = L*L**T, as computed by DPOTRF.
00080 *> \endverbatim
00081 *>
00082 *> \param[in] LDAF
00083 *> \verbatim
00084 *>          LDAF is INTEGER
00085 *>     The leading dimension of the array AF.  LDAF >= max(1,N).
00086 *> \endverbatim
00087 *>
00088 *> \param[in] WORK
00089 *> \verbatim
00090 *>          WORK is DOUBLE PRECISION array, dimension (2*N)
00091 *> \endverbatim
00092 *
00093 *  Authors:
00094 *  ========
00095 *
00096 *> \author Univ. of Tennessee 
00097 *> \author Univ. of California Berkeley 
00098 *> \author Univ. of Colorado Denver 
00099 *> \author NAG Ltd. 
00100 *
00101 *> \date November 2011
00102 *
00103 *> \ingroup doublePOcomputational
00104 *
00105 *  =====================================================================
00106       DOUBLE PRECISION FUNCTION DLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, 
00107      $                                        LDAF, WORK )
00108 *
00109 *  -- LAPACK computational routine (version 3.4.0) --
00110 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00111 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00112 *     November 2011
00113 *
00114 *     .. Scalar Arguments ..
00115       CHARACTER*1        UPLO
00116       INTEGER            NCOLS, LDA, LDAF
00117 *     ..
00118 *     .. Array Arguments ..
00119       DOUBLE PRECISION   A( LDA, * ), AF( LDAF, * ), WORK( * )
00120 *     ..
00121 *
00122 *  =====================================================================
00123 *
00124 *     .. Local Scalars ..
00125       INTEGER            I, J
00126       DOUBLE PRECISION   AMAX, UMAX, RPVGRW
00127       LOGICAL            UPPER
00128 *     ..
00129 *     .. Intrinsic Functions ..
00130       INTRINSIC          ABS, MAX, MIN
00131 *     ..
00132 *     .. External Functions ..
00133       EXTERNAL           LSAME, DLASET
00134       LOGICAL            LSAME
00135 *     ..
00136 *     .. Executable Statements ..
00137 *
00138       UPPER = LSAME( 'Upper', UPLO )
00139 *
00140 *     DPOTRF will have factored only the NCOLSxNCOLS leading minor, so
00141 *     we restrict the growth search to that minor and use only the first
00142 *     2*NCOLS workspace entries.
00143 *
00144       RPVGRW = 1.0D+0
00145       DO I = 1, 2*NCOLS
00146          WORK( I ) = 0.0D+0
00147       END DO
00148 *
00149 *     Find the max magnitude entry of each column.
00150 *
00151       IF ( UPPER ) THEN
00152          DO J = 1, NCOLS
00153             DO I = 1, J
00154                WORK( NCOLS+J ) =
00155      $              MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
00156             END DO
00157          END DO
00158       ELSE
00159          DO J = 1, NCOLS
00160             DO I = J, NCOLS
00161                WORK( NCOLS+J ) =
00162      $              MAX( ABS( A( I, J ) ), WORK( NCOLS+J ) )
00163             END DO
00164          END DO
00165       END IF
00166 *
00167 *     Now find the max magnitude entry of each column of the factor in
00168 *     AF.  No pivoting, so no permutations.
00169 *
00170       IF ( LSAME( 'Upper', UPLO ) ) THEN
00171          DO J = 1, NCOLS
00172             DO I = 1, J
00173                WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
00174             END DO
00175          END DO
00176       ELSE
00177          DO J = 1, NCOLS
00178             DO I = J, NCOLS
00179                WORK( J ) = MAX( ABS( AF( I, J ) ), WORK( J ) )
00180             END DO
00181          END DO
00182       END IF
00183 *
00184 *     Compute the *inverse* of the max element growth factor.  Dividing
00185 *     by zero would imply the largest entry of the factor's column is
00186 *     zero.  Than can happen when either the column of A is zero or
00187 *     massive pivots made the factor underflow to zero.  Neither counts
00188 *     as growth in itself, so simply ignore terms with zero
00189 *     denominators.
00190 *
00191       IF ( LSAME( 'Upper', UPLO ) ) THEN
00192          DO I = 1, NCOLS
00193             UMAX = WORK( I )
00194             AMAX = WORK( NCOLS+I )
00195             IF ( UMAX /= 0.0D+0 ) THEN
00196                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
00197             END IF
00198          END DO
00199       ELSE
00200          DO I = 1, NCOLS
00201             UMAX = WORK( I )
00202             AMAX = WORK( NCOLS+I )
00203             IF ( UMAX /= 0.0D+0 ) THEN
00204                RPVGRW = MIN( AMAX / UMAX, RPVGRW )
00205             END IF
00206          END DO
00207       END IF
00208 
00209       DLA_PORPVGRW = RPVGRW
00210       END
 All Files Functions