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
=================================================
223 lines
5.8 KiB
FortranFixed
223 lines
5.8 KiB
FortranFixed
*> \brief \b DGET08
|
|
*
|
|
* =========== DOCUMENTATION ===========
|
|
*
|
|
* Online html documentation available at
|
|
* http://www.netlib.org/lapack/explore-html/
|
|
*
|
|
* Definition:
|
|
* ===========
|
|
*
|
|
* SUBROUTINE DGET08( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
|
|
* RWORK, RESID )
|
|
*
|
|
* .. Scalar Arguments ..
|
|
* CHARACTER TRANS
|
|
* INTEGER LDA, LDB, LDX, M, N, NRHS
|
|
* DOUBLE PRECISION RESID
|
|
* ..
|
|
* .. Array Arguments ..
|
|
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ),
|
|
* $ X( LDX, * )
|
|
* ..
|
|
*
|
|
*
|
|
*> \par Purpose:
|
|
* =============
|
|
*>
|
|
*> \verbatim
|
|
*>
|
|
*> DGET08 computes the residual for a solution of a system of linear
|
|
*> equations A*x = b or A'*x = b:
|
|
*> RESID = norm(B - A*X,inf) / ( norm(A,inf) * norm(X,inf) * EPS ),
|
|
*> where EPS is the machine epsilon.
|
|
*> \endverbatim
|
|
*
|
|
* Arguments:
|
|
* ==========
|
|
*
|
|
*> \param[in] TRANS
|
|
*> \verbatim
|
|
*> TRANS is CHARACTER*1
|
|
*> Specifies the form of the system of equations:
|
|
*> = 'N': A *x = b
|
|
*> = 'T': A'*x = b, where A' is the transpose of A
|
|
*> = 'C': A'*x = b, where A' is the transpose of A
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] M
|
|
*> \verbatim
|
|
*> M is INTEGER
|
|
*> The number of rows of the matrix A. M >= 0.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] N
|
|
*> \verbatim
|
|
*> N is INTEGER
|
|
*> The number of columns of the matrix A. N >= 0.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] NRHS
|
|
*> \verbatim
|
|
*> NRHS is INTEGER
|
|
*> The number of columns of B, the matrix of right hand sides.
|
|
*> NRHS >= 0.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] A
|
|
*> \verbatim
|
|
*> A is DOUBLE PRECISION array, dimension (LDA,N)
|
|
*> The original M x N matrix A.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] LDA
|
|
*> \verbatim
|
|
*> LDA is INTEGER
|
|
*> The leading dimension of the array A. LDA >= max(1,M).
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] X
|
|
*> \verbatim
|
|
*> X is DOUBLE PRECISION array, dimension (LDX,NRHS)
|
|
*> The computed solution vectors for the system of linear
|
|
*> equations.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] LDX
|
|
*> \verbatim
|
|
*> LDX is INTEGER
|
|
*> The leading dimension of the array X. If TRANS = 'N',
|
|
*> LDX >= max(1,N); if TRANS = 'T' or 'C', LDX >= max(1,M).
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in,out] B
|
|
*> \verbatim
|
|
*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
|
|
*> On entry, the right hand side vectors for the system of
|
|
*> linear equations.
|
|
*> On exit, B is overwritten with the difference B - A*X.
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[in] LDB
|
|
*> \verbatim
|
|
*> LDB is INTEGER
|
|
*> The leading dimension of the array B. IF TRANS = 'N',
|
|
*> LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N).
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] RWORK
|
|
*> \verbatim
|
|
*> RWORK is DOUBLE PRECISION array, dimension (M)
|
|
*> \endverbatim
|
|
*>
|
|
*> \param[out] RESID
|
|
*> \verbatim
|
|
*> RESID is DOUBLE PRECISION
|
|
*> The maximum over the number of right hand sides of
|
|
*> norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
|
|
*> \endverbatim
|
|
*
|
|
* Authors:
|
|
* ========
|
|
*
|
|
*> \author Univ. of Tennessee
|
|
*> \author Univ. of California Berkeley
|
|
*> \author Univ. of Colorado Denver
|
|
*> \author NAG Ltd.
|
|
*
|
|
*> \date November 2011
|
|
*
|
|
*> \ingroup double_lin
|
|
*
|
|
* =====================================================================
|
|
SUBROUTINE DGET08( TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB,
|
|
$ RWORK, RESID )
|
|
*
|
|
* -- LAPACK test 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 TRANS
|
|
INTEGER LDA, LDB, LDX, M, N, NRHS
|
|
DOUBLE PRECISION RESID
|
|
* ..
|
|
* .. Array Arguments ..
|
|
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ),
|
|
$ X( LDX, * )
|
|
* ..
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
DOUBLE PRECISION ZERO, ONE
|
|
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
INTEGER J, N1, N2
|
|
DOUBLE PRECISION ANORM, BNORM, EPS, XNORM
|
|
* ..
|
|
* .. External Functions ..
|
|
LOGICAL LSAME
|
|
INTEGER IDAMAX
|
|
DOUBLE PRECISION DLAMCH, DLANGE
|
|
EXTERNAL LSAME, IDAMAX, DLAMCH, DLANGE
|
|
* ..
|
|
* .. External Subroutines ..
|
|
EXTERNAL DGEMM
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC MAX, ABS
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
* Quick exit if M = 0 or N = 0 or NRHS = 0
|
|
*
|
|
IF( M.LE.0 .OR. N.LE.0 .OR. NRHS.EQ.0 ) THEN
|
|
RESID = ZERO
|
|
RETURN
|
|
END IF
|
|
*
|
|
IF( LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) ) THEN
|
|
N1 = N
|
|
N2 = M
|
|
ELSE
|
|
N1 = M
|
|
N2 = N
|
|
END IF
|
|
*
|
|
* Exit with RESID = 1/EPS if ANORM = 0.
|
|
*
|
|
EPS = DLAMCH( 'Epsilon' )
|
|
ANORM = DLANGE( 'I', N1, N2, A, LDA, RWORK )
|
|
IF( ANORM.LE.ZERO ) THEN
|
|
RESID = ONE / EPS
|
|
RETURN
|
|
END IF
|
|
*
|
|
* Compute B - A*X (or B - A'*X ) and store in B.
|
|
*
|
|
CALL DGEMM( TRANS, 'No transpose', N1, NRHS, N2, -ONE, A, LDA, X,
|
|
$ LDX, ONE, B, LDB )
|
|
*
|
|
* Compute the maximum over the number of right hand sides of
|
|
* norm(B - A*X) / ( norm(A) * norm(X) * EPS ) .
|
|
*
|
|
RESID = ZERO
|
|
DO 10 J = 1, NRHS
|
|
BNORM = ABS(B(IDAMAX( N1, B( 1, J ), 1 ),J))
|
|
XNORM = ABS(X(IDAMAX( N2, X( 1, J ), 1 ),J))
|
|
IF( XNORM.LE.ZERO ) THEN
|
|
RESID = ONE / EPS
|
|
ELSE
|
|
RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
|
|
END IF
|
|
10 CONTINUE
|
|
*
|
|
RETURN
|
|
*
|
|
* End of DGET02
|
|
*
|
|
END
|