LAPACK 3.3.0
|
00001 SUBROUTINE ZPPT02( UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, 00002 $ RESID ) 00003 * 00004 * -- LAPACK test routine (version 3.1) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER LDB, LDX, N, NRHS 00011 DOUBLE PRECISION RESID 00012 * .. 00013 * .. Array Arguments .. 00014 DOUBLE PRECISION RWORK( * ) 00015 COMPLEX*16 A( * ), B( LDB, * ), X( LDX, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * ZPPT02 computes the residual in the solution of a Hermitian system 00022 * of linear equations A*x = b when packed storage is used for the 00023 * coefficient matrix. The ratio computed is 00024 * 00025 * RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS), 00026 * 00027 * where EPS is the machine precision. 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * UPLO (input) CHARACTER*1 00033 * Specifies whether the upper or lower triangular part of the 00034 * Hermitian matrix A is stored: 00035 * = 'U': Upper triangular 00036 * = 'L': Lower triangular 00037 * 00038 * N (input) INTEGER 00039 * The number of rows and columns of the matrix A. N >= 0. 00040 * 00041 * NRHS (input) INTEGER 00042 * The number of columns of B, the matrix of right hand sides. 00043 * NRHS >= 0. 00044 * 00045 * A (input) COMPLEX*16 array, dimension (N*(N+1)/2) 00046 * The original Hermitian matrix A, stored as a packed 00047 * triangular matrix. 00048 * 00049 * X (input) COMPLEX*16 array, dimension (LDX,NRHS) 00050 * The computed solution vectors for the system of linear 00051 * equations. 00052 * 00053 * LDX (input) INTEGER 00054 * The leading dimension of the array X. LDX >= max(1,N). 00055 * 00056 * B (input/output) COMPLEX*16 array, dimension (LDB,NRHS) 00057 * On entry, the right hand side vectors for the system of 00058 * linear equations. 00059 * On exit, B is overwritten with the difference B - A*X. 00060 * 00061 * LDB (input) INTEGER 00062 * The leading dimension of the array B. LDB >= max(1,N). 00063 * 00064 * RWORK (workspace) DOUBLE PRECISION array, dimension (N) 00065 * 00066 * RESID (output) DOUBLE PRECISION 00067 * The maximum over the number of right hand sides of 00068 * norm(B - A*X) / ( norm(A) * norm(X) * EPS ). 00069 * 00070 * ===================================================================== 00071 * 00072 * .. Parameters .. 00073 DOUBLE PRECISION ZERO, ONE 00074 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00075 COMPLEX*16 CONE 00076 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) 00077 * .. 00078 * .. Local Scalars .. 00079 INTEGER J 00080 DOUBLE PRECISION ANORM, BNORM, EPS, XNORM 00081 * .. 00082 * .. External Functions .. 00083 DOUBLE PRECISION DLAMCH, DZASUM, ZLANHP 00084 EXTERNAL DLAMCH, DZASUM, ZLANHP 00085 * .. 00086 * .. External Subroutines .. 00087 EXTERNAL ZHPMV 00088 * .. 00089 * .. Intrinsic Functions .. 00090 INTRINSIC MAX 00091 * .. 00092 * .. Executable Statements .. 00093 * 00094 * Quick exit if N = 0 or NRHS = 0. 00095 * 00096 IF( N.LE.0 .OR. NRHS.LE.0 ) THEN 00097 RESID = ZERO 00098 RETURN 00099 END IF 00100 * 00101 * Exit with RESID = 1/EPS if ANORM = 0. 00102 * 00103 EPS = DLAMCH( 'Epsilon' ) 00104 ANORM = ZLANHP( '1', UPLO, N, A, RWORK ) 00105 IF( ANORM.LE.ZERO ) THEN 00106 RESID = ONE / EPS 00107 RETURN 00108 END IF 00109 * 00110 * Compute B - A*X for the matrix of right hand sides B. 00111 * 00112 DO 10 J = 1, NRHS 00113 CALL ZHPMV( UPLO, N, -CONE, A, X( 1, J ), 1, CONE, B( 1, J ), 00114 $ 1 ) 00115 10 CONTINUE 00116 * 00117 * Compute the maximum over the number of right hand sides of 00118 * norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) . 00119 * 00120 RESID = ZERO 00121 DO 20 J = 1, NRHS 00122 BNORM = DZASUM( N, B( 1, J ), 1 ) 00123 XNORM = DZASUM( N, X( 1, J ), 1 ) 00124 IF( XNORM.LE.ZERO ) THEN 00125 RESID = ONE / EPS 00126 ELSE 00127 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 00128 END IF 00129 20 CONTINUE 00130 * 00131 RETURN 00132 * 00133 * End of ZPPT02 00134 * 00135 END