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