Files
lapack/TESTING/LIN/dpot06.f
Julie e18d437924 Making LAPACK's code eternal... no more version and date in source files.
GitHub is now enabling us to track accurately version and date.
No need for this anymore.
2021-03-25 10:16:58 -07:00

207 lines
5.4 KiB
FortranFixed

*> \brief \b DPOT06
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE DPOT06( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB,
* RWORK, RESID )
*
* .. Scalar Arguments ..
* CHARACTER UPLO
* INTEGER LDA, LDB, LDX, N, NRHS
* DOUBLE PRECISION RESID
* ..
* .. Array Arguments ..
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ),
* $ X( LDX, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DPOT06 computes the residual for a solution of a system of linear
*> equations 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] UPLO
*> \verbatim
*> UPLO is CHARACTER*1
*> Specifies whether the upper or lower triangular part of the
*> symmetric matrix A is stored:
*> = 'U': Upper triangular
*> = 'L': Lower triangular
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of rows and 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,N).
*> \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,N).
*> \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 (N)
*> \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.
*
*> \ingroup double_lin
*
* =====================================================================
SUBROUTINE DPOT06( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB,
$ RWORK, RESID )
*
* -- LAPACK test routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER UPLO
INTEGER LDA, LDB, LDX, N, NRHS
DOUBLE PRECISION RESID
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), B( LDB, * ), RWORK( * ),
$ X( LDX, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE, NEGONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
PARAMETER ( NEGONE = -1.0D+0 )
* ..
* .. Local Scalars ..
INTEGER IFAIL, J
DOUBLE PRECISION ANORM, BNORM, EPS, XNORM
* ..
* .. External Functions ..
INTEGER IDAMAX
DOUBLE PRECISION DLAMCH, DLANSY
EXTERNAL IDAMAX, DLAMCH, DLANSY
* ..
* .. External Subroutines ..
EXTERNAL DSYMM
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, ABS
* ..
* .. Executable Statements ..
*
* Quick exit if N = 0 or NRHS = 0
*
IF( N.LE.0 .OR. NRHS.EQ.0 ) THEN
RESID = ZERO
RETURN
END IF
*
* Exit with RESID = 1/EPS if ANORM = 0.
*
EPS = DLAMCH( 'Epsilon' )
ANORM = DLANSY( 'I', UPLO, N, A, LDA, RWORK )
IF( ANORM.LE.ZERO ) THEN
RESID = ONE / EPS
RETURN
END IF
*
* Compute B - A*X and store in B.
IFAIL=0
*
CALL DSYMM( 'Left', UPLO, N, NRHS, NEGONE, 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( N, B( 1, J ), 1 ),J))
XNORM = ABS(X(IDAMAX( N, 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 DPOT06
*
END