00001 SUBROUTINE ZPOT06( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, 00002 $ RWORK, RESID ) 00003 * 00004 * -- LAPACK test routine (version 3.1.2) -- 00005 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00006 * May 2007 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER LDA, LDB, LDX, N, NRHS 00011 DOUBLE PRECISION RESID 00012 * .. 00013 * .. Array Arguments .. 00014 DOUBLE PRECISION RWORK( * ) 00015 COMPLEX*16 A( LDA, * ), B( LDB, * ), X( LDX, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * ZPOT06 computes the residual for a solution of a system of linear 00022 * equations A*x = b : 00023 * RESID = norm(B - A*X,inf) / ( norm(A,inf) * norm(X,inf) * EPS ), 00024 * where EPS is the machine epsilon. 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * UPLO (input) CHARACTER*1 00030 * Specifies whether the upper or lower triangular part of the 00031 * symmetric matrix A is stored: 00032 * = 'U': Upper triangular 00033 * = 'L': Lower triangular 00034 * 00035 * N (input) INTEGER 00036 * The number of rows and columns of the matrix A. N >= 0. 00037 * 00038 * NRHS (input) INTEGER 00039 * The number of columns of B, the matrix of right hand sides. 00040 * NRHS >= 0. 00041 * 00042 * A (input) COMPLEX*16 array, dimension (LDA,N) 00043 * The original M x N matrix A. 00044 * 00045 * LDA (input) INTEGER 00046 * The leading dimension of the array A. LDA >= max(1,N). 00047 * 00048 * X (input) COMPLEX*16 array, dimension (LDX,NRHS) 00049 * The computed solution vectors for the system of linear 00050 * equations. 00051 * 00052 * LDX (input) INTEGER 00053 * The leading dimension of the array X. If TRANS = 'N', 00054 * LDX >= max(1,N); if TRANS = 'T' or 'C', 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. IF TRANS = 'N', 00063 * LDB >= max(1,M); if TRANS = 'T' or 'C', LDB >= max(1,N). 00064 * 00065 * RWORK (workspace) DOUBLE PRECISION array, dimension (N) 00066 * 00067 * RESID (output) DOUBLE PRECISION 00068 * The maximum over the number of right hand sides of 00069 * norm(B - A*X) / ( norm(A) * norm(X) * EPS ). 00070 * 00071 * ===================================================================== 00072 * 00073 * .. Parameters .. 00074 DOUBLE PRECISION ZERO, ONE, NEGONE 00075 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00076 PARAMETER ( NEGONE = -1.0D+0 ) 00077 COMPLEX*16 CONE, NEGCONE 00078 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) 00079 PARAMETER ( NEGCONE = ( -1.0D+0, 0.0D+0 ) ) 00080 * .. 00081 * .. Local Scalars .. 00082 INTEGER IFAIL, J 00083 DOUBLE PRECISION ANORM, BNORM, EPS, XNORM 00084 COMPLEX*16 ZDUM 00085 * .. 00086 * .. External Functions .. 00087 LOGICAL LSAME 00088 INTEGER IZAMAX 00089 DOUBLE PRECISION DLAMCH, ZLANSY 00090 EXTERNAL LSAME, IZAMAX, DLAMCH, ZLANSY 00091 * .. 00092 * .. External Subroutines .. 00093 EXTERNAL ZHEMM 00094 * .. 00095 * .. Intrinsic Functions .. 00096 INTRINSIC ABS, DBLE, DIMAG, MAX 00097 * .. 00098 * .. Statement Functions .. 00099 DOUBLE PRECISION CABS1 00100 * .. 00101 * .. Statement Function definitions .. 00102 CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) 00103 * .. 00104 * .. 00105 * .. Executable Statements .. 00106 * 00107 * Quick exit if N = 0 or NRHS = 0 00108 * 00109 IF( N.LE.0 .OR. NRHS.EQ.0 ) THEN 00110 RESID = ZERO 00111 RETURN 00112 END IF 00113 * 00114 * Exit with RESID = 1/EPS if ANORM = 0. 00115 * 00116 EPS = DLAMCH( 'Epsilon' ) 00117 ANORM = ZLANSY( 'I', UPLO, N, A, LDA, RWORK ) 00118 IF( ANORM.LE.ZERO ) THEN 00119 RESID = ONE / EPS 00120 RETURN 00121 END IF 00122 * 00123 * Compute B - A*X and store in B. 00124 IFAIL=0 00125 * 00126 CALL ZHEMM( 'Left', UPLO, N, NRHS, NEGCONE, A, LDA, X, 00127 $ LDX, CONE, B, LDB ) 00128 * 00129 * Compute the maximum over the number of right hand sides of 00130 * norm(B - A*X) / ( norm(A) * norm(X) * EPS ) . 00131 * 00132 RESID = ZERO 00133 DO 10 J = 1, NRHS 00134 BNORM = CABS1(B(IZAMAX( N, B( 1, J ), 1 ),J)) 00135 XNORM = CABS1(X(IZAMAX( N, X( 1, J ), 1 ),J)) 00136 IF( XNORM.LE.ZERO ) THEN 00137 RESID = ONE / EPS 00138 ELSE 00139 RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS ) 00140 END IF 00141 10 CONTINUE 00142 * 00143 RETURN 00144 * 00145 * End of ZPOT06 00146 * 00147 END
1.7.2