1*> \brief \b CDRVHEX
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 CDRVHE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
12*                          A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
13*                          NOUT )
14*
15*       .. Scalar Arguments ..
16*       LOGICAL            TSTERR
17*       INTEGER            NMAX, NN, NOUT, NRHS
18*       REAL               THRESH
19*       ..
20*       .. Array Arguments ..
21*       LOGICAL            DOTYPE( * )
22*       INTEGER            IWORK( * ), NVAL( * )
23*       REAL               RWORK( * )
24*       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
25*      $                   WORK( * ), X( * ), XACT( * )
26*       ..
27*
28*
29*> \par Purpose:
30*  =============
31*>
32*> \verbatim
33*>
34*> CDRVHE tests the driver routines CHESV, -SVX, and -SVXX.
35*>
36*> Note that this file is used only when the XBLAS are available,
37*> otherwise cdrvhe.f defines this subroutine.
38*> \endverbatim
39*
40*  Arguments:
41*  ==========
42*
43*> \param[in] DOTYPE
44*> \verbatim
45*>          DOTYPE is LOGICAL array, dimension (NTYPES)
46*>          The matrix types to be used for testing.  Matrices of type j
47*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
48*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
49*> \endverbatim
50*>
51*> \param[in] NN
52*> \verbatim
53*>          NN is INTEGER
54*>          The number of values of N contained in the vector NVAL.
55*> \endverbatim
56*>
57*> \param[in] NVAL
58*> \verbatim
59*>          NVAL is INTEGER array, dimension (NN)
60*>          The values of the matrix dimension N.
61*> \endverbatim
62*>
63*> \param[in] NRHS
64*> \verbatim
65*>          NRHS is INTEGER
66*>          The number of right hand side vectors to be generated for
67*>          each linear system.
68*> \endverbatim
69*>
70*> \param[in] THRESH
71*> \verbatim
72*>          THRESH is REAL
73*>          The threshold value for the test ratios.  A result is
74*>          included in the output file if RESULT >= THRESH.  To have
75*>          every test ratio printed, use THRESH = 0.
76*> \endverbatim
77*>
78*> \param[in] TSTERR
79*> \verbatim
80*>          TSTERR is LOGICAL
81*>          Flag that indicates whether error exits are to be tested.
82*> \endverbatim
83*>
84*> \param[in] NMAX
85*> \verbatim
86*>          NMAX is INTEGER
87*>          The maximum value permitted for N, used in dimensioning the
88*>          work arrays.
89*> \endverbatim
90*>
91*> \param[out] A
92*> \verbatim
93*>          A is COMPLEX array, dimension (NMAX*NMAX)
94*> \endverbatim
95*>
96*> \param[out] AFAC
97*> \verbatim
98*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
99*> \endverbatim
100*>
101*> \param[out] AINV
102*> \verbatim
103*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
104*> \endverbatim
105*>
106*> \param[out] B
107*> \verbatim
108*>          B is COMPLEX array, dimension (NMAX*NRHS)
109*> \endverbatim
110*>
111*> \param[out] X
112*> \verbatim
113*>          X is COMPLEX array, dimension (NMAX*NRHS)
114*> \endverbatim
115*>
116*> \param[out] XACT
117*> \verbatim
118*>          XACT is COMPLEX array, dimension (NMAX*NRHS)
119*> \endverbatim
120*>
121*> \param[out] WORK
122*> \verbatim
123*>          WORK is COMPLEX array, dimension
124*>                      (NMAX*max(2,NRHS))
125*> \endverbatim
126*>
127*> \param[out] RWORK
128*> \verbatim
129*>          RWORK is REAL array, dimension (2*NMAX+2*NRHS)
130*> \endverbatim
131*>
132*> \param[out] IWORK
133*> \verbatim
134*>          IWORK is INTEGER array, dimension (NMAX)
135*> \endverbatim
136*>
137*> \param[in] NOUT
138*> \verbatim
139*>          NOUT is INTEGER
140*>          The unit number for output.
141*> \endverbatim
142*
143*  Authors:
144*  ========
145*
146*> \author Univ. of Tennessee
147*> \author Univ. of California Berkeley
148*> \author Univ. of Colorado Denver
149*> \author NAG Ltd.
150*
151*> \date April 2012
152*
153*> \ingroup complex_lin
154*
155*  =====================================================================
156      SUBROUTINE CDRVHE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157     $                   A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
158     $                   NOUT )
159*
160*  -- LAPACK test routine (version 3.7.0) --
161*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
162*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
163*     April 2012
164*
165*     .. Scalar Arguments ..
166      LOGICAL            TSTERR
167      INTEGER            NMAX, NN, NOUT, NRHS
168      REAL               THRESH
169*     ..
170*     .. Array Arguments ..
171      LOGICAL            DOTYPE( * )
172      INTEGER            IWORK( * ), NVAL( * )
173      REAL               RWORK( * )
174      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
175     $                   WORK( * ), X( * ), XACT( * )
176*     ..
177*
178*  =====================================================================
179*
180*     .. Parameters ..
181      REAL               ONE, ZERO
182      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
183      INTEGER            NTYPES, NTESTS
184      PARAMETER          ( NTYPES = 10, NTESTS = 6 )
185      INTEGER            NFACT
186      PARAMETER          ( NFACT = 2 )
187*     ..
188*     .. Local Scalars ..
189      LOGICAL            ZEROT
190      CHARACTER          DIST, EQUED, FACT, TYPE, UPLO, XTYPE
191      CHARACTER*3        PATH
192      INTEGER            I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
193     $                   IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
194     $                   NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT,
195     $                   N_ERR_BNDS
196      REAL               AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
197     $                   RPVGRW_SVXX
198*     ..
199*     .. Local Arrays ..
200      CHARACTER          FACTS( NFACT ), UPLOS( 2 )
201      INTEGER            ISEED( 4 ), ISEEDY( 4 )
202      REAL               RESULT( NTESTS ), BERR( NRHS ),
203     $                   ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
204*     ..
205*     .. External Functions ..
206      REAL               CLANHE, SGET06
207      EXTERNAL           CLANHE, SGET06
208*     ..
209*     .. External Subroutines ..
210      EXTERNAL           ALADHD, ALAERH, ALASVM, CERRVX, CGET04, CHESV,
211     $                   CHESVX, CHET01, CHETRF, CHETRI2, CLACPY,
212     $                   CLAIPD, CLARHS, CLASET, CLATB4, CLATMS, CPOT02,
213     $                   CPOT05, XLAENV, CHESVXX
214*     ..
215*     .. Scalars in Common ..
216      LOGICAL            LERR, OK
217      CHARACTER*32       SRNAMT
218      INTEGER            INFOT, NUNIT
219*     ..
220*     .. Common blocks ..
221      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
222      COMMON             / SRNAMC / SRNAMT
223*     ..
224*     .. Intrinsic Functions ..
225      INTRINSIC          CMPLX, MAX, MIN
226*     ..
227*     .. Data statements ..
228      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
229      DATA               UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
230*     ..
231*     .. Executable Statements ..
232*
233*     Initialize constants and the random number seed.
234*
235      PATH( 1: 1 ) = 'C'
236      PATH( 2: 3 ) = 'HE'
237      NRUN = 0
238      NFAIL = 0
239      NERRS = 0
240      DO 10 I = 1, 4
241         ISEED( I ) = ISEEDY( I )
242   10 CONTINUE
243      LWORK = MAX( 2*NMAX, NMAX*NRHS )
244*
245*     Test the error exits
246*
247      IF( TSTERR )
248     $   CALL CERRVX( PATH, NOUT )
249      INFOT = 0
250*
251*     Set the block size and minimum block size for testing.
252*
253      NB = 1
254      NBMIN = 2
255      CALL XLAENV( 1, NB )
256      CALL XLAENV( 2, NBMIN )
257*
258*     Do for each value of N in NVAL
259*
260      DO 180 IN = 1, NN
261         N = NVAL( IN )
262         LDA = MAX( N, 1 )
263         XTYPE = 'N'
264         NIMAT = NTYPES
265         IF( N.LE.0 )
266     $      NIMAT = 1
267*
268         DO 170 IMAT = 1, NIMAT
269*
270*           Do the tests only if DOTYPE( IMAT ) is true.
271*
272            IF( .NOT.DOTYPE( IMAT ) )
273     $         GO TO 170
274*
275*           Skip types 3, 4, 5, or 6 if the matrix size is too small.
276*
277            ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
278            IF( ZEROT .AND. N.LT.IMAT-2 )
279     $         GO TO 170
280*
281*           Do first for UPLO = 'U', then for UPLO = 'L'
282*
283            DO 160 IUPLO = 1, 2
284               UPLO = UPLOS( IUPLO )
285*
286*              Set up parameters with CLATB4 and generate a test matrix
287*              with CLATMS.
288*
289               CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
290     $                      CNDNUM, DIST )
291*
292               SRNAMT = 'CLATMS'
293               CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
294     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
295     $                      INFO )
296*
297*              Check error code from CLATMS.
298*
299               IF( INFO.NE.0 ) THEN
300                  CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
301     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
302                  GO TO 160
303               END IF
304*
305*              For types 3-6, zero one or more rows and columns of the
306*              matrix to test that INFO is returned correctly.
307*
308               IF( ZEROT ) THEN
309                  IF( IMAT.EQ.3 ) THEN
310                     IZERO = 1
311                  ELSE IF( IMAT.EQ.4 ) THEN
312                     IZERO = N
313                  ELSE
314                     IZERO = N / 2 + 1
315                  END IF
316*
317                  IF( IMAT.LT.6 ) THEN
318*
319*                    Set row and column IZERO to zero.
320*
321                     IF( IUPLO.EQ.1 ) THEN
322                        IOFF = ( IZERO-1 )*LDA
323                        DO 20 I = 1, IZERO - 1
324                           A( IOFF+I ) = ZERO
325   20                   CONTINUE
326                        IOFF = IOFF + IZERO
327                        DO 30 I = IZERO, N
328                           A( IOFF ) = ZERO
329                           IOFF = IOFF + LDA
330   30                   CONTINUE
331                     ELSE
332                        IOFF = IZERO
333                        DO 40 I = 1, IZERO - 1
334                           A( IOFF ) = ZERO
335                           IOFF = IOFF + LDA
336   40                   CONTINUE
337                        IOFF = IOFF - IZERO
338                        DO 50 I = IZERO, N
339                           A( IOFF+I ) = ZERO
340   50                   CONTINUE
341                     END IF
342                  ELSE
343                     IOFF = 0
344                     IF( IUPLO.EQ.1 ) THEN
345*
346*                       Set the first IZERO rows and columns to zero.
347*
348                        DO 70 J = 1, N
349                           I2 = MIN( J, IZERO )
350                           DO 60 I = 1, I2
351                              A( IOFF+I ) = ZERO
352   60                      CONTINUE
353                           IOFF = IOFF + LDA
354   70                   CONTINUE
355                     ELSE
356*
357*                       Set the last IZERO rows and columns to zero.
358*
359                        DO 90 J = 1, N
360                           I1 = MAX( J, IZERO )
361                           DO 80 I = I1, N
362                              A( IOFF+I ) = ZERO
363   80                      CONTINUE
364                           IOFF = IOFF + LDA
365   90                   CONTINUE
366                     END IF
367                  END IF
368               ELSE
369                  IZERO = 0
370               END IF
371*
372*              Set the imaginary part of the diagonals.
373*
374               CALL CLAIPD( N, A, LDA+1, 0 )
375*
376               DO 150 IFACT = 1, NFACT
377*
378*                 Do first for FACT = 'F', then for other values.
379*
380                  FACT = FACTS( IFACT )
381*
382*                 Compute the condition number for comparison with
383*                 the value returned by CHESVX.
384*
385                  IF( ZEROT ) THEN
386                     IF( IFACT.EQ.1 )
387     $                  GO TO 150
388                     RCONDC = ZERO
389*
390                  ELSE IF( IFACT.EQ.1 ) THEN
391*
392*                    Compute the 1-norm of A.
393*
394                     ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
395*
396*                    Factor the matrix A.
397*
398                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
399                     CALL CHETRF( UPLO, N, AFAC, LDA, IWORK, WORK,
400     $                            LWORK, INFO )
401*
402*                    Compute inv(A) and take its norm.
403*
404                     CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
405                     LWORK = (N+NB+1)*(NB+3)
406                     CALL CHETRI2( UPLO, N, AINV, LDA, IWORK, WORK,
407     $                            LWORK, INFO )
408                     AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK )
409*
410*                    Compute the 1-norm condition number of A.
411*
412                     IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
413                        RCONDC = ONE
414                     ELSE
415                        RCONDC = ( ONE / ANORM ) / AINVNM
416                     END IF
417                  END IF
418*
419*                 Form an exact solution and set the right hand side.
420*
421                  SRNAMT = 'CLARHS'
422                  CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
423     $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
424     $                         INFO )
425                  XTYPE = 'C'
426*
427*                 --- Test CHESV  ---
428*
429                  IF( IFACT.EQ.2 ) THEN
430                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
431                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
432*
433*                    Factor the matrix and solve the system using CHESV.
434*
435                     SRNAMT = 'CHESV '
436                     CALL CHESV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
437     $                           LDA, WORK, LWORK, INFO )
438*
439*                    Adjust the expected value of INFO to account for
440*                    pivoting.
441*
442                     K = IZERO
443                     IF( K.GT.0 ) THEN
444  100                   CONTINUE
445                        IF( IWORK( K ).LT.0 ) THEN
446                           IF( IWORK( K ).NE.-K ) THEN
447                              K = -IWORK( K )
448                              GO TO 100
449                           END IF
450                        ELSE IF( IWORK( K ).NE.K ) THEN
451                           K = IWORK( K )
452                           GO TO 100
453                        END IF
454                     END IF
455*
456*                    Check error code from CHESV .
457*
458                     IF( INFO.NE.K ) THEN
459                        CALL ALAERH( PATH, 'CHESV ', INFO, K, UPLO, N,
460     $                               N, -1, -1, NRHS, IMAT, NFAIL,
461     $                               NERRS, NOUT )
462                        GO TO 120
463                     ELSE IF( INFO.NE.0 ) THEN
464                        GO TO 120
465                     END IF
466*
467*                    Reconstruct matrix from factors and compute
468*                    residual.
469*
470                     CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
471     $                            AINV, LDA, RWORK, RESULT( 1 ) )
472*
473*                    Compute residual of the computed solution.
474*
475                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
476                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
477     $                            LDA, RWORK, RESULT( 2 ) )
478*
479*                    Check solution from generated exact solution.
480*
481                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
482     $                            RESULT( 3 ) )
483                     NT = 3
484*
485*                    Print information about the tests that did not pass
486*                    the threshold.
487*
488                     DO 110 K = 1, NT
489                        IF( RESULT( K ).GE.THRESH ) THEN
490                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
491     $                        CALL ALADHD( NOUT, PATH )
492                           WRITE( NOUT, FMT = 9999 )'CHESV ', UPLO, N,
493     $                        IMAT, K, RESULT( K )
494                           NFAIL = NFAIL + 1
495                        END IF
496  110                CONTINUE
497                     NRUN = NRUN + NT
498  120                CONTINUE
499                  END IF
500*
501*                 --- Test CHESVX ---
502*
503                  IF( IFACT.EQ.2 )
504     $               CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
505     $                            CMPLX( ZERO ), AFAC, LDA )
506                  CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
507     $                         CMPLX( ZERO ), X, LDA )
508*
509*                 Solve the system and compute the condition number and
510*                 error bounds using CHESVX.
511*
512                  SRNAMT = 'CHESVX'
513                  CALL CHESVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
514     $                         IWORK, B, LDA, X, LDA, RCOND, RWORK,
515     $                         RWORK( NRHS+1 ), WORK, LWORK,
516     $                         RWORK( 2*NRHS+1 ), INFO )
517*
518*                 Adjust the expected value of INFO to account for
519*                 pivoting.
520*
521                  K = IZERO
522                  IF( K.GT.0 ) THEN
523  130                CONTINUE
524                     IF( IWORK( K ).LT.0 ) THEN
525                        IF( IWORK( K ).NE.-K ) THEN
526                           K = -IWORK( K )
527                           GO TO 130
528                        END IF
529                     ELSE IF( IWORK( K ).NE.K ) THEN
530                        K = IWORK( K )
531                        GO TO 130
532                     END IF
533                  END IF
534*
535*                 Check the error code from CHESVX.
536*
537                  IF( INFO.NE.K ) THEN
538                     CALL ALAERH( PATH, 'CHESVX', INFO, K, FACT // UPLO,
539     $                            N, N, -1, -1, NRHS, IMAT, NFAIL,
540     $                            NERRS, NOUT )
541                     GO TO 150
542                  END IF
543*
544                  IF( INFO.EQ.0 ) THEN
545                     IF( IFACT.GE.2 ) THEN
546*
547*                       Reconstruct matrix from factors and compute
548*                       residual.
549*
550                        CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
551     $                               AINV, LDA, RWORK( 2*NRHS+1 ),
552     $                               RESULT( 1 ) )
553                        K1 = 1
554                     ELSE
555                        K1 = 2
556                     END IF
557*
558*                    Compute residual of the computed solution.
559*
560                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
561                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
562     $                            LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
563*
564*                    Check solution from generated exact solution.
565*
566                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
567     $                            RESULT( 3 ) )
568*
569*                    Check the error bounds from iterative refinement.
570*
571                     CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
572     $                            XACT, LDA, RWORK, RWORK( NRHS+1 ),
573     $                            RESULT( 4 ) )
574                  ELSE
575                     K1 = 6
576                  END IF
577*
578*                 Compare RCOND from CHESVX with the computed value
579*                 in RCONDC.
580*
581                  RESULT( 6 ) = SGET06( RCOND, RCONDC )
582*
583*                 Print information about the tests that did not pass
584*                 the threshold.
585*
586                  DO 140 K = K1, 6
587                     IF( RESULT( K ).GE.THRESH ) THEN
588                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
589     $                     CALL ALADHD( NOUT, PATH )
590                        WRITE( NOUT, FMT = 9998 )'CHESVX', FACT, UPLO,
591     $                     N, IMAT, K, RESULT( K )
592                        NFAIL = NFAIL + 1
593                     END IF
594  140             CONTINUE
595                  NRUN = NRUN + 7 - K1
596*
597*                 --- Test CHESVXX ---
598*
599*                 Restore the matrices A and B.
600*
601                  IF( IFACT.EQ.2 )
602     $               CALL CLASET( UPLO, N, N, CMPLX( ZERO ),
603     $                 CMPLX( ZERO ), AFAC, LDA )
604                  CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
605     $                 CMPLX( ZERO ), X, LDA )
606*
607*                 Solve the system and compute the condition number
608*                 and error bounds using CHESVXX.
609*
610                  SRNAMT = 'CHESVXX'
611                  N_ERR_BNDS = 3
612                  EQUED = 'N'
613                  CALL CHESVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
614     $                 LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
615     $                 LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
616     $                 ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
617     $                 RWORK(2*NRHS+1), INFO )
618*
619*                 Adjust the expected value of INFO to account for
620*                 pivoting.
621*
622                  K = IZERO
623                  IF( K.GT.0 ) THEN
624 135                 CONTINUE
625                     IF( IWORK( K ).LT.0 ) THEN
626                        IF( IWORK( K ).NE.-K ) THEN
627                           K = -IWORK( K )
628                           GO TO 135
629                        END IF
630                     ELSE IF( IWORK( K ).NE.K ) THEN
631                        K = IWORK( K )
632                        GO TO 135
633                     END IF
634                  END IF
635*
636*                 Check the error code from CHESVXX.
637*
638                  IF( INFO.NE.K .AND. INFO.LE.N ) THEN
639                     CALL ALAERH( PATH, 'CHESVXX', INFO, K,
640     $                    FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
641     $                    NERRS, NOUT )
642                     GO TO 150
643                  END IF
644*
645                  IF( INFO.EQ.0 ) THEN
646                     IF( IFACT.GE.2 ) THEN
647*
648*                 Reconstruct matrix from factors and compute
649*                 residual.
650*
651                        CALL CHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
652     $                       AINV, LDA, RWORK(2*NRHS+1),
653     $                       RESULT( 1 ) )
654                        K1 = 1
655                     ELSE
656                        K1 = 2
657                     END IF
658*
659*                 Compute residual of the computed solution.
660*
661                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
662                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
663     $                    LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
664                     RESULT( 2 ) = 0.0
665*
666*                 Check solution from generated exact solution.
667*
668                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
669     $                    RESULT( 3 ) )
670*
671*                 Check the error bounds from iterative refinement.
672*
673                     CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
674     $                    XACT, LDA, RWORK, RWORK( NRHS+1 ),
675     $                    RESULT( 4 ) )
676                  ELSE
677                     K1 = 6
678                  END IF
679*
680*                 Compare RCOND from CHESVXX with the computed value
681*                 in RCONDC.
682*
683                  RESULT( 6 ) = SGET06( RCOND, RCONDC )
684*
685*                 Print information about the tests that did not pass
686*                 the threshold.
687*
688                  DO 85 K = K1, 6
689                     IF( RESULT( K ).GE.THRESH ) THEN
690                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
691     $                       CALL ALADHD( NOUT, PATH )
692                        WRITE( NOUT, FMT = 9998 )'CHESVXX',
693     $                       FACT, UPLO, N, IMAT, K,
694     $                       RESULT( K )
695                        NFAIL = NFAIL + 1
696                     END IF
697 85               CONTINUE
698                  NRUN = NRUN + 7 - K1
699*
700  150          CONTINUE
701*
702  160       CONTINUE
703  170    CONTINUE
704  180 CONTINUE
705*
706*     Print a summary of the results.
707*
708      CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
709*
710
711*     Test Error Bounds from CHESVXX
712
713      CALL CEBCHVXX(THRESH, PATH)
714
715 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
716     $      ', test ', I2, ', ratio =', G12.5 )
717 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
718     $      ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
719      RETURN
720*
721*     End of CDRVHE
722*
723      END
724