Files
lapack/TESTING/LIN/zget03.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

189 lines
4.8 KiB
FortranFixed

*> \brief \b ZGET03
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ZGET03( N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK,
* RCOND, RESID )
*
* .. Scalar Arguments ..
* INTEGER LDA, LDAINV, LDWORK, N
* DOUBLE PRECISION RCOND, RESID
* ..
* .. Array Arguments ..
* DOUBLE PRECISION RWORK( * )
* COMPLEX*16 A( LDA, * ), AINV( LDAINV, * ),
* $ WORK( LDWORK, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZGET03 computes the residual for a general matrix times its inverse:
*> norm( I - AINV*A ) / ( N * norm(A) * norm(AINV) * EPS ),
*> where EPS is the machine epsilon.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of rows and columns of the matrix A. N >= 0.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> The original N 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] AINV
*> \verbatim
*> AINV is COMPLEX*16 array, dimension (LDAINV,N)
*> The inverse of the matrix A.
*> \endverbatim
*>
*> \param[in] LDAINV
*> \verbatim
*> LDAINV is INTEGER
*> The leading dimension of the array AINV. LDAINV >= max(1,N).
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*> WORK is COMPLEX*16 array, dimension (LDWORK,N)
*> \endverbatim
*>
*> \param[in] LDWORK
*> \verbatim
*> LDWORK is INTEGER
*> The leading dimension of the array WORK. LDWORK >= max(1,N).
*> \endverbatim
*>
*> \param[out] RWORK
*> \verbatim
*> RWORK is DOUBLE PRECISION array, dimension (N)
*> \endverbatim
*>
*> \param[out] RCOND
*> \verbatim
*> RCOND is DOUBLE PRECISION
*> The reciprocal of the condition number of A, computed as
*> ( 1/norm(A) ) / norm(AINV).
*> \endverbatim
*>
*> \param[out] RESID
*> \verbatim
*> RESID is DOUBLE PRECISION
*> norm(I - AINV*A) / ( N * norm(A) * norm(AINV) * EPS )
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16_lin
*
* =====================================================================
SUBROUTINE ZGET03( N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK,
$ RCOND, 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 ..
INTEGER LDA, LDAINV, LDWORK, N
DOUBLE PRECISION RCOND, RESID
* ..
* .. Array Arguments ..
DOUBLE PRECISION RWORK( * )
COMPLEX*16 A( LDA, * ), AINV( LDAINV, * ),
$ WORK( LDWORK, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
COMPLEX*16 CZERO, CONE
PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
$ CONE = ( 1.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
INTEGER I
DOUBLE PRECISION AINVNM, ANORM, EPS
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH, ZLANGE
EXTERNAL DLAMCH, ZLANGE
* ..
* .. External Subroutines ..
EXTERNAL ZGEMM
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE
* ..
* .. Executable Statements ..
*
* Quick exit if N = 0.
*
IF( N.LE.0 ) THEN
RCOND = ONE
RESID = ZERO
RETURN
END IF
*
* Exit with RESID = 1/EPS if ANORM = 0 or AINVNM = 0.
*
EPS = DLAMCH( 'Epsilon' )
ANORM = ZLANGE( '1', N, N, A, LDA, RWORK )
AINVNM = ZLANGE( '1', N, N, AINV, LDAINV, RWORK )
IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
RCOND = ZERO
RESID = ONE / EPS
RETURN
END IF
RCOND = ( ONE / ANORM ) / AINVNM
*
* Compute I - A * AINV
*
CALL ZGEMM( 'No transpose', 'No transpose', N, N, N, -CONE, AINV,
$ LDAINV, A, LDA, CZERO, WORK, LDWORK )
DO 10 I = 1, N
WORK( I, I ) = CONE + WORK( I, I )
10 CONTINUE
*
* Compute norm(I - AINV*A) / (N * norm(A) * norm(AINV) * EPS)
*
RESID = ZLANGE( '1', N, N, WORK, LDWORK, RWORK )
*
RESID = ( ( RESID*RCOND ) / EPS ) / DBLE( N )
*
RETURN
*
* End of ZGET03
*
END