1 SUBROUTINE ZLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR )
2 *
3 * -- LAPACK routine (version 3.2.2) --
4 * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
5 * -- Jason Riedy of Univ. of California Berkeley. --
6 * -- June 2010 --
7 *
8 * -- LAPACK is a software package provided by Univ. of Tennessee, --
9 * -- Univ. of California Berkeley and NAG Ltd. --
10 *
11 IMPLICIT NONE
12 * ..
13 * .. Scalar Arguments ..
14 INTEGER N, NZ, NRHS
15 * ..
16 * .. Array Arguments ..
17 DOUBLE PRECISION AYB( N, NRHS ), BERR( NRHS )
18 COMPLEX*16 RES( N, NRHS )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZLA_LIN_BERR computes componentwise relative backward error from
25 * the formula
26 * max(i) ( abs(R(i)) / ( abs(op(A_s))*abs(Y) + abs(B_s) )(i) )
27 * where abs(Z) is the componentwise absolute value of the matrix
28 * or vector Z.
29 *
30 * N (input) INTEGER
31 * The number of linear equations, i.e., the order of the
32 * matrix A. N >= 0.
33 *
34 * NZ (input) INTEGER
35 * We add (NZ+1)*SLAMCH( 'Safe minimum' ) to R(i) in the numerator to
36 * guard against spuriously zero residuals. Default value is N.
37 *
38 * NRHS (input) INTEGER
39 * The number of right hand sides, i.e., the number of columns
40 * of the matrices AYB, RES, and BERR. NRHS >= 0.
41 *
42 * RES (input) DOUBLE PRECISION array, dimension (N,NRHS)
43 * The residual matrix, i.e., the matrix R in the relative backward
44 * error formula above.
45 *
46 * AYB (input) DOUBLE PRECISION array, dimension (N, NRHS)
47 * The denominator in the relative backward error formula above, i.e.,
48 * the matrix abs(op(A_s))*abs(Y) + abs(B_s). The matrices A, Y, and B
49 * are from iterative refinement (see zla_gerfsx_extended.f).
50 *
51 * BERR (output) COMPLEX*16 array, dimension (NRHS)
52 * The componentwise relative backward error from the formula above.
53 *
54 * =====================================================================
55 *
56 * .. Local Scalars ..
57 DOUBLE PRECISION TMP
58 INTEGER I, J
59 COMPLEX*16 CDUM
60 * ..
61 * .. Intrinsic Functions ..
62 INTRINSIC ABS, REAL, DIMAG, MAX
63 * ..
64 * .. External Functions ..
65 EXTERNAL DLAMCH
66 DOUBLE PRECISION DLAMCH
67 DOUBLE PRECISION SAFE1
68 * ..
69 * .. Statement Functions ..
70 COMPLEX*16 CABS1
71 * ..
72 * .. Statement Function Definitions ..
73 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
74 * ..
75 * .. Executable Statements ..
76 *
77 * Adding SAFE1 to the numerator guards against spuriously zero
78 * residuals. A similar safeguard is in the CLA_yyAMV routine used
79 * to compute AYB.
80 *
81 SAFE1 = DLAMCH( 'Safe minimum' )
82 SAFE1 = (NZ+1)*SAFE1
83
84 DO J = 1, NRHS
85 BERR(J) = 0.0D+0
86 DO I = 1, N
87 IF (AYB(I,J) .NE. 0.0D+0) THEN
88 TMP = (SAFE1 + CABS1(RES(I,J)))/AYB(I,J)
89 BERR(J) = MAX( BERR(J), TMP )
90 END IF
91 *
92 * If AYB is exactly 0.0 (and if computed by CLA_yyAMV), then we know
93 * the true residual also must be exactly 0.0.
94 *
95 END DO
96 END DO
97 END
2 *
3 * -- LAPACK routine (version 3.2.2) --
4 * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
5 * -- Jason Riedy of Univ. of California Berkeley. --
6 * -- June 2010 --
7 *
8 * -- LAPACK is a software package provided by Univ. of Tennessee, --
9 * -- Univ. of California Berkeley and NAG Ltd. --
10 *
11 IMPLICIT NONE
12 * ..
13 * .. Scalar Arguments ..
14 INTEGER N, NZ, NRHS
15 * ..
16 * .. Array Arguments ..
17 DOUBLE PRECISION AYB( N, NRHS ), BERR( NRHS )
18 COMPLEX*16 RES( N, NRHS )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZLA_LIN_BERR computes componentwise relative backward error from
25 * the formula
26 * max(i) ( abs(R(i)) / ( abs(op(A_s))*abs(Y) + abs(B_s) )(i) )
27 * where abs(Z) is the componentwise absolute value of the matrix
28 * or vector Z.
29 *
30 * N (input) INTEGER
31 * The number of linear equations, i.e., the order of the
32 * matrix A. N >= 0.
33 *
34 * NZ (input) INTEGER
35 * We add (NZ+1)*SLAMCH( 'Safe minimum' ) to R(i) in the numerator to
36 * guard against spuriously zero residuals. Default value is N.
37 *
38 * NRHS (input) INTEGER
39 * The number of right hand sides, i.e., the number of columns
40 * of the matrices AYB, RES, and BERR. NRHS >= 0.
41 *
42 * RES (input) DOUBLE PRECISION array, dimension (N,NRHS)
43 * The residual matrix, i.e., the matrix R in the relative backward
44 * error formula above.
45 *
46 * AYB (input) DOUBLE PRECISION array, dimension (N, NRHS)
47 * The denominator in the relative backward error formula above, i.e.,
48 * the matrix abs(op(A_s))*abs(Y) + abs(B_s). The matrices A, Y, and B
49 * are from iterative refinement (see zla_gerfsx_extended.f).
50 *
51 * BERR (output) COMPLEX*16 array, dimension (NRHS)
52 * The componentwise relative backward error from the formula above.
53 *
54 * =====================================================================
55 *
56 * .. Local Scalars ..
57 DOUBLE PRECISION TMP
58 INTEGER I, J
59 COMPLEX*16 CDUM
60 * ..
61 * .. Intrinsic Functions ..
62 INTRINSIC ABS, REAL, DIMAG, MAX
63 * ..
64 * .. External Functions ..
65 EXTERNAL DLAMCH
66 DOUBLE PRECISION DLAMCH
67 DOUBLE PRECISION SAFE1
68 * ..
69 * .. Statement Functions ..
70 COMPLEX*16 CABS1
71 * ..
72 * .. Statement Function Definitions ..
73 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
74 * ..
75 * .. Executable Statements ..
76 *
77 * Adding SAFE1 to the numerator guards against spuriously zero
78 * residuals. A similar safeguard is in the CLA_yyAMV routine used
79 * to compute AYB.
80 *
81 SAFE1 = DLAMCH( 'Safe minimum' )
82 SAFE1 = (NZ+1)*SAFE1
83
84 DO J = 1, NRHS
85 BERR(J) = 0.0D+0
86 DO I = 1, N
87 IF (AYB(I,J) .NE. 0.0D+0) THEN
88 TMP = (SAFE1 + CABS1(RES(I,J)))/AYB(I,J)
89 BERR(J) = MAX( BERR(J), TMP )
90 END IF
91 *
92 * If AYB is exactly 0.0 (and if computed by CLA_yyAMV), then we know
93 * the true residual also must be exactly 0.0.
94 *
95 END DO
96 END DO
97 END