Hans Johnson
9dafba6d41
This is mostly a long term maintenance improvement.
Many coding styles require elimination of trailing whitespace, and
many editors and source code management configurations automatically
gobble up whitespace. When these tools gobble up whitespace, it
complicates reviewing the meaningful code changes.
By removing whitespace on one patch, it makes future
code reviews much easier.
=SCRIPT====================================================================
if which tempfile &>/dev/null; then
TEMPMAKER=tempfile
elif which mktemp &>/dev/null; then
TEMPMAKER=mktemp
else
echo "Cannot find tempfile program." 2>&1
exit 1
fi
MYTEMP=$($TEMPMAKER)
trap 'rm -f $MYTEMP' SIGINT SIGTERM
stripit() {
echo "stripping $1"
sed 's/[ \t]*$//' "$1" > $MYTEMP
cp $MYTEMP "$1"
}
if [ $# -gt 0 ]; then
while [ "$1" != "" ]; do
stripit $1
shift
done
else
while read -t 2; do
stripit $REPLY
done
fi
rm $MYTEMP
=================================================
254 lines
6.8 KiB
FortranFixed
254 lines
6.8 KiB
FortranFixed
*> \brief \b SPOCON
|
|
*
|
|
* =========== DOCUMENTATION ===========
|
|
*
|
|
* Online html documentation available at
|
|
* http://www.netlib.org/lapack/explore-html/
|
|
*
|
|
*> \htmlonly
|
|
*> Download SPOCON + dependencies
|
|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spocon.f">
|
|
*> [TGZ]</a>
|
|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spocon.f">
|
|
*> [ZIP]</a>
|
|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spocon.f">
|
|
*> [TXT]</a>
|
|
*> \endhtmlonly
|
|
*
|
|
* Definition:
|
|
* ===========
|
|
*
|
|
* SUBROUTINE SPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
|
|
* INFO )
|
|
*
|
|
* .. Scalar Arguments ..
|
|
* CHARACTER UPLO
|
|
* INTEGER INFO, LDA, N
|
|
* REAL ANORM, RCOND
|
|
* ..
|
|
* .. Array Arguments ..
|
|
* INTEGER IWORK( * )
|
|
* REAL A( LDA, * ), WORK( * )
|
|
* ..
|
|
*
|
|
*
|
|
*> \par Purpose:
|
|
* =============
|
|
*>
|
|
*> \verbatim
|
|
*>
|
|
*> SPOCON estimates the reciprocal of the condition number (in the
|
|
*> 1-norm) of a real symmetric positive definite matrix using the
|
|
*> Cholesky factorization A = U**T*U or A = L*L**T computed by SPOTRF.
|
|
*>
|
|
*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
|
|
*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
|
|
*> \endverbatim
|
|
*
|
|
* Arguments:
|
|
* ==========
|
|
*
|
|
*> \param[in] UPLO
|
|
*> \verbatim
|
|
*> UPLO is CHARACTER*1
|
|
*> = 'U': Upper triangle of A is stored;
|
|
*> = 'L': Lower triangle of A is stored.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] N
|
|
*> \verbatim
|
|
*> N is INTEGER
|
|
*> The order of the matrix A. N >= 0.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] A
|
|
*> \verbatim
|
|
*> A is REAL array, dimension (LDA,N)
|
|
*> The triangular factor U or L from the Cholesky factorization
|
|
*> A = U**T*U or A = L*L**T, as computed by SPOTRF.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] LDA
|
|
*> \verbatim
|
|
*> LDA is INTEGER
|
|
*> The leading dimension of the array A. LDA >= max(1,N).
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] ANORM
|
|
*> \verbatim
|
|
*> ANORM is REAL
|
|
*> The 1-norm (or infinity-norm) of the symmetric matrix A.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] RCOND
|
|
*> \verbatim
|
|
*> RCOND is REAL
|
|
*> The reciprocal of the condition number of the matrix A,
|
|
*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
|
|
*> estimate of the 1-norm of inv(A) computed in this routine.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] WORK
|
|
*> \verbatim
|
|
*> WORK is REAL array, dimension (3*N)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] IWORK
|
|
*> \verbatim
|
|
*> IWORK is INTEGER array, dimension (N)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] INFO
|
|
*> \verbatim
|
|
*> INFO is INTEGER
|
|
*> = 0: successful exit
|
|
*> < 0: if INFO = -i, the i-th argument had an illegal value
|
|
*> \endverbatim
|
|
*
|
|
* Authors:
|
|
* ========
|
|
*
|
|
*> \author Univ. of Tennessee
|
|
*> \author Univ. of California Berkeley
|
|
*> \author Univ. of Colorado Denver
|
|
*> \author NAG Ltd.
|
|
*
|
|
*> \date November 2011
|
|
*
|
|
*> \ingroup realPOcomputational
|
|
*
|
|
* =====================================================================
|
|
SUBROUTINE SPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK,
|
|
$ INFO )
|
|
*
|
|
* -- LAPACK computational routine (version 3.4.0) --
|
|
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
|
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
|
* November 2011
|
|
*
|
|
* .. Scalar Arguments ..
|
|
CHARACTER UPLO
|
|
INTEGER INFO, LDA, N
|
|
REAL ANORM, RCOND
|
|
* ..
|
|
* .. Array Arguments ..
|
|
INTEGER IWORK( * )
|
|
REAL A( LDA, * ), WORK( * )
|
|
* ..
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
REAL ONE, ZERO
|
|
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
LOGICAL UPPER
|
|
CHARACTER NORMIN
|
|
INTEGER IX, KASE
|
|
REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
|
|
* ..
|
|
* .. Local Arrays ..
|
|
INTEGER ISAVE( 3 )
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME
|
|
INTEGER ISAMAX
|
|
REAL SLAMCH
|
|
EXTERNAL LSAME, ISAMAX, SLAMCH
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL SLACN2, SLATRS, SRSCL, XERBLA
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC ABS, MAX
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* Test the input parameters.
|
|
*
|
|
INFO = 0
|
|
UPPER = LSAME( UPLO, 'U' )
|
|
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
|
|
INFO = -1
|
|
ELSE IF( N.LT.0 ) THEN
|
|
INFO = -2
|
|
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
|
INFO = -4
|
|
ELSE IF( ANORM.LT.ZERO ) THEN
|
|
INFO = -5
|
|
END IF
|
|
IF( INFO.NE.0 ) THEN
|
|
CALL XERBLA( 'SPOCON', -INFO )
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Quick return if possible
|
|
*
|
|
RCOND = ZERO
|
|
IF( N.EQ.0 ) THEN
|
|
RCOND = ONE
|
|
RETURN
|
|
ELSE IF( ANORM.EQ.ZERO ) THEN
|
|
RETURN
|
|
END IF
|
|
*
|
|
SMLNUM = SLAMCH( 'Safe minimum' )
|
|
*
|
|
* Estimate the 1-norm of inv(A).
|
|
*
|
|
KASE = 0
|
|
NORMIN = 'N'
|
|
10 CONTINUE
|
|
CALL SLACN2( N, WORK( N+1 ), WORK, IWORK, AINVNM, KASE, ISAVE )
|
|
IF( KASE.NE.0 ) THEN
|
|
IF( UPPER ) THEN
|
|
*
|
|
* Multiply by inv(U**T).
|
|
*
|
|
CALL SLATRS( 'Upper', 'Transpose', 'Non-unit', NORMIN, N, A,
|
|
$ LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
|
|
NORMIN = 'Y'
|
|
*
|
|
* Multiply by inv(U).
|
|
*
|
|
CALL SLATRS( 'Upper', 'No transpose', 'Non-unit', NORMIN, N,
|
|
$ A, LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
|
|
ELSE
|
|
*
|
|
* Multiply by inv(L).
|
|
*
|
|
CALL SLATRS( 'Lower', 'No transpose', 'Non-unit', NORMIN, N,
|
|
$ A, LDA, WORK, SCALEL, WORK( 2*N+1 ), INFO )
|
|
NORMIN = 'Y'
|
|
*
|
|
* Multiply by inv(L**T).
|
|
*
|
|
CALL SLATRS( 'Lower', 'Transpose', 'Non-unit', NORMIN, N, A,
|
|
$ LDA, WORK, SCALEU, WORK( 2*N+1 ), INFO )
|
|
END IF
|
|
*
|
|
* Multiply by 1/SCALE if doing so will not cause overflow.
|
|
*
|
|
SCALE = SCALEL*SCALEU
|
|
IF( SCALE.NE.ONE ) THEN
|
|
IX = ISAMAX( N, WORK, 1 )
|
|
IF( SCALE.LT.ABS( WORK( IX ) )*SMLNUM .OR. SCALE.EQ.ZERO )
|
|
$ GO TO 20
|
|
CALL SRSCL( N, SCALE, WORK, 1 )
|
|
END IF
|
|
GO TO 10
|
|
END IF
|
|
*
|
|
* Compute the estimate of the reciprocal condition number.
|
|
*
|
|
IF( AINVNM.NE.ZERO )
|
|
$ RCOND = ( ONE / AINVNM ) / ANORM
|
|
*
|
|
20 CONTINUE
|
|
RETURN
|
|
*
|
|
* End of SPOCON
|
|
*
|
|
END
|