1*> \brief \b ZSYT02
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE ZSYT02( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK,
12*                          RESID )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER          UPLO
16*       INTEGER            LDA, LDB, LDX, N, NRHS
17*       DOUBLE PRECISION   RESID
18*       ..
19*       .. Array Arguments ..
20*       DOUBLE PRECISION   RWORK( * )
21*       COMPLEX*16         A( LDA, * ), B( LDB, * ), X( LDX, * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> ZSYT02 computes the residual for a solution to a complex symmetric
31*> system of linear equations  A*x = b:
32*>
33*>    RESID = norm(B - A*X) / ( norm(A) * norm(X) * EPS ),
34*>
35*> where EPS is the machine epsilon.
36*> \endverbatim
37*
38*  Arguments:
39*  ==========
40*
41*> \param[in] UPLO
42*> \verbatim
43*>          UPLO is CHARACTER*1
44*>          Specifies whether the upper or lower triangular part of the
45*>          symmetric matrix A is stored:
46*>          = 'U':  Upper triangular
47*>          = 'L':  Lower triangular
48*> \endverbatim
49*>
50*> \param[in] N
51*> \verbatim
52*>          N is INTEGER
53*>          The number of rows and columns of the matrix A.  N >= 0.
54*> \endverbatim
55*>
56*> \param[in] NRHS
57*> \verbatim
58*>          NRHS is INTEGER
59*>          The number of columns of B, the matrix of right hand sides.
60*>          NRHS >= 0.
61*> \endverbatim
62*>
63*> \param[in] A
64*> \verbatim
65*>          A is COMPLEX*16 array, dimension (LDA,N)
66*>          The original complex symmetric matrix A.
67*> \endverbatim
68*>
69*> \param[in] LDA
70*> \verbatim
71*>          LDA is INTEGER
72*>          The leading dimension of the array A.  LDA >= max(1,N)
73*> \endverbatim
74*>
75*> \param[in] X
76*> \verbatim
77*>          X is COMPLEX*16 array, dimension (LDX,NRHS)
78*>          The computed solution vectors for the system of linear
79*>          equations.
80*> \endverbatim
81*>
82*> \param[in] LDX
83*> \verbatim
84*>          LDX is INTEGER
85*>          The leading dimension of the array X.   LDX >= max(1,N).
86*> \endverbatim
87*>
88*> \param[in,out] B
89*> \verbatim
90*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
91*>          On entry, the right hand side vectors for the system of
92*>          linear equations.
93*>          On exit, B is overwritten with the difference B - A*X.
94*> \endverbatim
95*>
96*> \param[in] LDB
97*> \verbatim
98*>          LDB is INTEGER
99*>          The leading dimension of the array B.  LDB >= max(1,N).
100*> \endverbatim
101*>
102*> \param[out] RWORK
103*> \verbatim
104*>          RWORK is DOUBLE PRECISION array, dimension (N)
105*> \endverbatim
106*>
107*> \param[out] RESID
108*> \verbatim
109*>          RESID is DOUBLE PRECISION
110*>          The maximum over the number of right hand sides of
111*>          norm(B - A*X) / ( norm(A) * norm(X) * EPS ).
112*> \endverbatim
113*
114*  Authors:
115*  ========
116*
117*> \author Univ. of Tennessee
118*> \author Univ. of California Berkeley
119*> \author Univ. of Colorado Denver
120*> \author NAG Ltd.
121*
122*> \ingroup complex16_lin
123*
124*  =====================================================================
125      SUBROUTINE ZSYT02( UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK,
126     $                   RESID )
127*
128*  -- LAPACK test routine --
129*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
130*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
131*
132*     .. Scalar Arguments ..
133      CHARACTER          UPLO
134      INTEGER            LDA, LDB, LDX, N, NRHS
135      DOUBLE PRECISION   RESID
136*     ..
137*     .. Array Arguments ..
138      DOUBLE PRECISION   RWORK( * )
139      COMPLEX*16         A( LDA, * ), B( LDB, * ), X( LDX, * )
140*     ..
141*
142*  =====================================================================
143*
144*     .. Parameters ..
145      DOUBLE PRECISION   ZERO, ONE
146      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
147      COMPLEX*16         CONE
148      PARAMETER          ( CONE = ( 1.0D+0, 0.0D+0 ) )
149*     ..
150*     .. Local Scalars ..
151      INTEGER            J
152      DOUBLE PRECISION   ANORM, BNORM, EPS, XNORM
153*     ..
154*     .. External Functions ..
155      DOUBLE PRECISION   DLAMCH, DZASUM, ZLANSY
156      EXTERNAL           DLAMCH, DZASUM, ZLANSY
157*     ..
158*     .. External Subroutines ..
159      EXTERNAL           ZSYMM
160*     ..
161*     .. Intrinsic Functions ..
162      INTRINSIC          MAX
163*     ..
164*     .. Executable Statements ..
165*
166*     Quick exit if N = 0 or NRHS = 0
167*
168      IF( N.LE.0 .OR. NRHS.LE.0 ) THEN
169         RESID = ZERO
170         RETURN
171      END IF
172*
173*     Exit with RESID = 1/EPS if ANORM = 0.
174*
175      EPS = DLAMCH( 'Epsilon' )
176      ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK )
177      IF( ANORM.LE.ZERO ) THEN
178         RESID = ONE / EPS
179         RETURN
180      END IF
181*
182*     Compute  B - A*X  (or  B - A'*X ) and store in B .
183*
184      CALL ZSYMM( 'Left', UPLO, N, NRHS, -CONE, A, LDA, X, LDX, CONE, B,
185     $            LDB )
186*
187*     Compute the maximum over the number of right hand sides of
188*        norm( B - A*X ) / ( norm(A) * norm(X) * EPS ) .
189*
190      RESID = ZERO
191      DO 10 J = 1, NRHS
192         BNORM = DZASUM( N, B( 1, J ), 1 )
193         XNORM = DZASUM( N, X( 1, J ), 1 )
194         IF( XNORM.LE.ZERO ) THEN
195            RESID = ONE / EPS
196         ELSE
197            RESID = MAX( RESID, ( ( BNORM / ANORM ) / XNORM ) / EPS )
198         END IF
199   10 CONTINUE
200*
201      RETURN
202*
203*     End of ZSYT02
204*
205      END
206