1 SUBROUTINE DLA_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 DOUBLE PRECISION RES( N, NRHS )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * DLA_LIN_BERR computes component-wise 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 component-wise absolute value of the matrix
28 * or vector Z.
29 *
30 * Arguments
31 * ==========
32 *
33 * N (input) INTEGER
34 * The number of linear equations, i.e., the order of the
35 * matrix A. N >= 0.
36 *
37 * NZ (input) INTEGER
38 * We add (NZ+1)*SLAMCH( 'Safe minimum' ) to R(i) in the numerator to
39 * guard against spuriously zero residuals. Default value is N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand sides, i.e., the number of columns
43 * of the matrices AYB, RES, and BERR. NRHS >= 0.
44 *
45 * RES (input) DOUBLE PRECISION array, dimension (N,NRHS)
46 * The residual matrix, i.e., the matrix R in the relative backward
47 * error formula above.
48 *
49 * AYB (input) DOUBLE PRECISION array, dimension (N, NRHS)
50 * The denominator in the relative backward error formula above, i.e.,
51 * the matrix abs(op(A_s))*abs(Y) + abs(B_s). The matrices A, Y, and B
52 * are from iterative refinement (see dla_gerfsx_extended.f).
53 *
54 * BERR (output) DOUBLE PRECISION array, dimension (NRHS)
55 * The component-wise relative backward error from the formula above.
56 *
57 * =====================================================================
58 *
59 * .. Local Scalars ..
60 DOUBLE PRECISION TMP
61 INTEGER I, J
62 * ..
63 * .. Intrinsic Functions ..
64 INTRINSIC ABS, MAX
65 * ..
66 * .. External Functions ..
67 EXTERNAL DLAMCH
68 DOUBLE PRECISION DLAMCH
69 DOUBLE PRECISION SAFE1
70 * ..
71 * .. Executable Statements ..
72 *
73 * Adding SAFE1 to the numerator guards against spuriously zero
74 * residuals. A similar safeguard is in the SLA_yyAMV routine used
75 * to compute AYB.
76 *
77 SAFE1 = DLAMCH( 'Safe minimum' )
78 SAFE1 = (NZ+1)*SAFE1
79
80 DO J = 1, NRHS
81 BERR(J) = 0.0D+0
82 DO I = 1, N
83 IF (AYB(I,J) .NE. 0.0D+0) THEN
84 TMP = (SAFE1+ABS(RES(I,J)))/AYB(I,J)
85 BERR(J) = MAX( BERR(J), TMP )
86 END IF
87 *
88 * If AYB is exactly 0.0 (and if computed by SLA_yyAMV), then we know
89 * the true residual also must be exactly 0.0.
90 *
91 END DO
92 END DO
93 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 DOUBLE PRECISION RES( N, NRHS )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * DLA_LIN_BERR computes component-wise 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 component-wise absolute value of the matrix
28 * or vector Z.
29 *
30 * Arguments
31 * ==========
32 *
33 * N (input) INTEGER
34 * The number of linear equations, i.e., the order of the
35 * matrix A. N >= 0.
36 *
37 * NZ (input) INTEGER
38 * We add (NZ+1)*SLAMCH( 'Safe minimum' ) to R(i) in the numerator to
39 * guard against spuriously zero residuals. Default value is N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand sides, i.e., the number of columns
43 * of the matrices AYB, RES, and BERR. NRHS >= 0.
44 *
45 * RES (input) DOUBLE PRECISION array, dimension (N,NRHS)
46 * The residual matrix, i.e., the matrix R in the relative backward
47 * error formula above.
48 *
49 * AYB (input) DOUBLE PRECISION array, dimension (N, NRHS)
50 * The denominator in the relative backward error formula above, i.e.,
51 * the matrix abs(op(A_s))*abs(Y) + abs(B_s). The matrices A, Y, and B
52 * are from iterative refinement (see dla_gerfsx_extended.f).
53 *
54 * BERR (output) DOUBLE PRECISION array, dimension (NRHS)
55 * The component-wise relative backward error from the formula above.
56 *
57 * =====================================================================
58 *
59 * .. Local Scalars ..
60 DOUBLE PRECISION TMP
61 INTEGER I, J
62 * ..
63 * .. Intrinsic Functions ..
64 INTRINSIC ABS, MAX
65 * ..
66 * .. External Functions ..
67 EXTERNAL DLAMCH
68 DOUBLE PRECISION DLAMCH
69 DOUBLE PRECISION SAFE1
70 * ..
71 * .. Executable Statements ..
72 *
73 * Adding SAFE1 to the numerator guards against spuriously zero
74 * residuals. A similar safeguard is in the SLA_yyAMV routine used
75 * to compute AYB.
76 *
77 SAFE1 = DLAMCH( 'Safe minimum' )
78 SAFE1 = (NZ+1)*SAFE1
79
80 DO J = 1, NRHS
81 BERR(J) = 0.0D+0
82 DO I = 1, N
83 IF (AYB(I,J) .NE. 0.0D+0) THEN
84 TMP = (SAFE1+ABS(RES(I,J)))/AYB(I,J)
85 BERR(J) = MAX( BERR(J), TMP )
86 END IF
87 *
88 * If AYB is exactly 0.0 (and if computed by SLA_yyAMV), then we know
89 * the true residual also must be exactly 0.0.
90 *
91 END DO
92 END DO
93 END