01:       SUBROUTINE ZLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR )
02: *
03: *     -- LAPACK routine (version 3.2)                                 --
04: *     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
05: *     -- Jason Riedy of Univ. of California Berkeley.                 --
06: *     -- November 2008                                                --
07: *
08: *     -- LAPACK is a software package provided by Univ. of Tennessee, --
09: *     -- 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: *     ZLA_LIN_BERR computes componentwise relative backward error from
21: *     the formula
22: *         max(i) ( abs(R(i)) / ( abs(op(A_s))*abs(Y) + abs(B_s) )(i) )
23: *     where abs(Z) is the componentwise absolute value of the matrix
24: *     or vector Z.
25: *     ..
26: *     .. Local Scalars ..
27:       DOUBLE PRECISION   TMP
28:       INTEGER            I, J
29:       COMPLEX*16         CDUM
30: *     ..
31: *     .. Intrinsic Functions ..
32:       INTRINSIC          ABS, REAL, DIMAG, MAX
33: *     ..
34: *     .. External Functions ..
35:       EXTERNAL           DLAMCH
36:       DOUBLE PRECISION   DLAMCH
37:       DOUBLE PRECISION   SAFE1
38: *     ..
39: *     .. Statement Functions ..
40:       COMPLEX*16         CABS1
41: *     ..
42: *     .. Statement Function Definitions ..
43:       CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
44: *     ..
45: *     .. Executable Statements ..
46: *
47: *     Adding SAFE1 to the numerator guards against spuriously zero
48: *     residuals.  A similar safeguard is in the CLA_yyAMV routine used
49: *     to compute AYB.
50: *
51:       SAFE1 = DLAMCH( 'Safe minimum' )
52:       SAFE1 = (NZ+1)*SAFE1
53: 
54:       DO J = 1, NRHS
55:          BERR(J) = 0.0D+0
56:          DO I = 1, N
57:             IF (AYB(I,J) .NE. 0.0D+0) THEN
58:                TMP = (SAFE1 + CABS1(RES(I,J)))/AYB(I,J)
59:                BERR(J) = MAX( BERR(J), TMP )
60:             END IF
61: *
62: *     If AYB is exactly 0.0 (and if computed by CLA_yyAMV), then we know
63: *     the true residual also must be exactly 0.0.
64: *
65:          END DO
66:       END DO
67:       END SUBROUTINE
68: