1*> \brief \b CCHKPO
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 CCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
12*                          THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
13*                          XACT, WORK, RWORK, NOUT )
14*
15*       .. Scalar Arguments ..
16*       LOGICAL            TSTERR
17*       INTEGER            NMAX, NN, NNB, NNS, NOUT
18*       REAL               THRESH
19*       ..
20*       .. Array Arguments ..
21*       LOGICAL            DOTYPE( * )
22*       INTEGER            NBVAL( * ), NSVAL( * ), 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*> CCHKPO tests CPOTRF, -TRI, -TRS, -RFS, and -CON
35*> \endverbatim
36*
37*  Arguments:
38*  ==========
39*
40*> \param[in] DOTYPE
41*> \verbatim
42*>          DOTYPE is LOGICAL array, dimension (NTYPES)
43*>          The matrix types to be used for testing.  Matrices of type j
44*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
45*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
46*> \endverbatim
47*>
48*> \param[in] NN
49*> \verbatim
50*>          NN is INTEGER
51*>          The number of values of N contained in the vector NVAL.
52*> \endverbatim
53*>
54*> \param[in] NVAL
55*> \verbatim
56*>          NVAL is INTEGER array, dimension (NN)
57*>          The values of the matrix dimension N.
58*> \endverbatim
59*>
60*> \param[in] NNB
61*> \verbatim
62*>          NNB is INTEGER
63*>          The number of values of NB contained in the vector NBVAL.
64*> \endverbatim
65*>
66*> \param[in] NBVAL
67*> \verbatim
68*>          NBVAL is INTEGER array, dimension (NNB)
69*>          The values of the blocksize NB.
70*> \endverbatim
71*>
72*> \param[in] NNS
73*> \verbatim
74*>          NNS is INTEGER
75*>          The number of values of NRHS contained in the vector NSVAL.
76*> \endverbatim
77*>
78*> \param[in] NSVAL
79*> \verbatim
80*>          NSVAL is INTEGER array, dimension (NNS)
81*>          The values of the number of right hand sides NRHS.
82*> \endverbatim
83*>
84*> \param[in] THRESH
85*> \verbatim
86*>          THRESH is REAL
87*>          The threshold value for the test ratios.  A result is
88*>          included in the output file if RESULT >= THRESH.  To have
89*>          every test ratio printed, use THRESH = 0.
90*> \endverbatim
91*>
92*> \param[in] TSTERR
93*> \verbatim
94*>          TSTERR is LOGICAL
95*>          Flag that indicates whether error exits are to be tested.
96*> \endverbatim
97*>
98*> \param[in] NMAX
99*> \verbatim
100*>          NMAX is INTEGER
101*>          The maximum value permitted for N, used in dimensioning the
102*>          work arrays.
103*> \endverbatim
104*>
105*> \param[out] A
106*> \verbatim
107*>          A is COMPLEX array, dimension (NMAX*NMAX)
108*> \endverbatim
109*>
110*> \param[out] AFAC
111*> \verbatim
112*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
113*> \endverbatim
114*>
115*> \param[out] AINV
116*> \verbatim
117*>          AINV is COMPLEX array, dimension (NMAX*NMAX)
118*> \endverbatim
119*>
120*> \param[out] B
121*> \verbatim
122*>          B is COMPLEX array, dimension (NMAX*NSMAX)
123*>          where NSMAX is the largest entry in NSVAL.
124*> \endverbatim
125*>
126*> \param[out] X
127*> \verbatim
128*>          X is COMPLEX array, dimension (NMAX*NSMAX)
129*> \endverbatim
130*>
131*> \param[out] XACT
132*> \verbatim
133*>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
134*> \endverbatim
135*>
136*> \param[out] WORK
137*> \verbatim
138*>          WORK is COMPLEX array, dimension
139*>                      (NMAX*max(3,NSMAX))
140*> \endverbatim
141*>
142*> \param[out] RWORK
143*> \verbatim
144*>          RWORK is REAL array, dimension
145*>                      (NMAX+2*NSMAX)
146*> \endverbatim
147*>
148*> \param[in] NOUT
149*> \verbatim
150*>          NOUT is INTEGER
151*>          The unit number for output.
152*> \endverbatim
153*
154*  Authors:
155*  ========
156*
157*> \author Univ. of Tennessee
158*> \author Univ. of California Berkeley
159*> \author Univ. of Colorado Denver
160*> \author NAG Ltd.
161*
162*> \ingroup complex_lin
163*
164*  =====================================================================
165      SUBROUTINE CCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
166     $                   THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
167     $                   XACT, WORK, RWORK, NOUT )
168*
169*  -- LAPACK test routine --
170*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
171*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172*
173*     .. Scalar Arguments ..
174      LOGICAL            TSTERR
175      INTEGER            NMAX, NN, NNB, NNS, NOUT
176      REAL               THRESH
177*     ..
178*     .. Array Arguments ..
179      LOGICAL            DOTYPE( * )
180      INTEGER            NBVAL( * ), NSVAL( * ), NVAL( * )
181      REAL               RWORK( * )
182      COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
183     $                   WORK( * ), X( * ), XACT( * )
184*     ..
185*
186*  =====================================================================
187*
188*     .. Parameters ..
189      COMPLEX            CZERO
190      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
191      INTEGER            NTYPES
192      PARAMETER          ( NTYPES = 9 )
193      INTEGER            NTESTS
194      PARAMETER          ( NTESTS = 8 )
195*     ..
196*     .. Local Scalars ..
197      LOGICAL            ZEROT
198      CHARACTER          DIST, TYPE, UPLO, XTYPE
199      CHARACTER*3        PATH
200      INTEGER            I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
201     $                   IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS,
202     $                   NFAIL, NIMAT, NRHS, NRUN
203      REAL               ANORM, CNDNUM, RCOND, RCONDC
204*     ..
205*     .. Local Arrays ..
206      CHARACTER          UPLOS( 2 )
207      INTEGER            ISEED( 4 ), ISEEDY( 4 )
208      REAL               RESULT( NTESTS )
209*     ..
210*     .. External Functions ..
211      REAL               CLANHE, SGET06
212      EXTERNAL           CLANHE, SGET06
213*     ..
214*     .. External Subroutines ..
215      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRPO, CGET04, CLACPY,
216     $                   CLAIPD, CLARHS, CLATB4, CLATMS, CPOCON, CPORFS,
217     $                   CPOT01, CPOT02, CPOT03, CPOT05, CPOTRF, CPOTRI,
218     $                   CPOTRS, XLAENV
219*     ..
220*     .. Scalars in Common ..
221      LOGICAL            LERR, OK
222      CHARACTER*32       SRNAMT
223      INTEGER            INFOT, NUNIT
224*     ..
225*     .. Common blocks ..
226      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
227      COMMON             / SRNAMC / SRNAMT
228*     ..
229*     .. Intrinsic Functions ..
230      INTRINSIC          MAX
231*     ..
232*     .. Data statements ..
233      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
234      DATA               UPLOS / 'U', 'L' /
235*     ..
236*     .. Executable Statements ..
237*
238*     Initialize constants and the random number seed.
239*
240      PATH( 1: 1 ) = 'Complex precision'
241      PATH( 2: 3 ) = 'PO'
242      NRUN = 0
243      NFAIL = 0
244      NERRS = 0
245      DO 10 I = 1, 4
246         ISEED( I ) = ISEEDY( I )
247   10 CONTINUE
248*
249*     Test the error exits
250*
251      IF( TSTERR )
252     $   CALL CERRPO( PATH, NOUT )
253      INFOT = 0
254*
255*     Do for each value of N in NVAL
256*
257      DO 120 IN = 1, NN
258         N = NVAL( IN )
259         LDA = MAX( N, 1 )
260         XTYPE = 'N'
261         NIMAT = NTYPES
262         IF( N.LE.0 )
263     $      NIMAT = 1
264*
265         IZERO = 0
266         DO 110 IMAT = 1, NIMAT
267*
268*           Do the tests only if DOTYPE( IMAT ) is true.
269*
270            IF( .NOT.DOTYPE( IMAT ) )
271     $         GO TO 110
272*
273*           Skip types 3, 4, or 5 if the matrix size is too small.
274*
275            ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
276            IF( ZEROT .AND. N.LT.IMAT-2 )
277     $         GO TO 110
278*
279*           Do first for UPLO = 'U', then for UPLO = 'L'
280*
281            DO 100 IUPLO = 1, 2
282               UPLO = UPLOS( IUPLO )
283*
284*              Set up parameters with CLATB4 and generate a test matrix
285*              with CLATMS.
286*
287               CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
288     $                      CNDNUM, DIST )
289*
290               SRNAMT = 'CLATMS'
291               CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
292     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
293     $                      INFO )
294*
295*              Check error code from CLATMS.
296*
297               IF( INFO.NE.0 ) THEN
298                  CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
299     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
300                  GO TO 100
301               END IF
302*
303*              For types 3-5, zero one row and column of the matrix to
304*              test that INFO is returned correctly.
305*
306               IF( ZEROT ) THEN
307                  IF( IMAT.EQ.3 ) THEN
308                     IZERO = 1
309                  ELSE IF( IMAT.EQ.4 ) THEN
310                     IZERO = N
311                  ELSE
312                     IZERO = N / 2 + 1
313                  END IF
314                  IOFF = ( IZERO-1 )*LDA
315*
316*                 Set row and column IZERO of A to 0.
317*
318                  IF( IUPLO.EQ.1 ) THEN
319                     DO 20 I = 1, IZERO - 1
320                        A( IOFF+I ) = CZERO
321   20                CONTINUE
322                     IOFF = IOFF + IZERO
323                     DO 30 I = IZERO, N
324                        A( IOFF ) = CZERO
325                        IOFF = IOFF + LDA
326   30                CONTINUE
327                  ELSE
328                     IOFF = IZERO
329                     DO 40 I = 1, IZERO - 1
330                        A( IOFF ) = CZERO
331                        IOFF = IOFF + LDA
332   40                CONTINUE
333                     IOFF = IOFF - IZERO
334                     DO 50 I = IZERO, N
335                        A( IOFF+I ) = CZERO
336   50                CONTINUE
337                  END IF
338               ELSE
339                  IZERO = 0
340               END IF
341*
342*              Set the imaginary part of the diagonals.
343*
344               CALL CLAIPD( N, A, LDA+1, 0 )
345*
346*              Do for each value of NB in NBVAL
347*
348               DO 90 INB = 1, NNB
349                  NB = NBVAL( INB )
350                  CALL XLAENV( 1, NB )
351*
352*                 Compute the L*L' or U'*U factorization of the matrix.
353*
354                  CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
355                  SRNAMT = 'CPOTRF'
356                  CALL CPOTRF( UPLO, N, AFAC, LDA, INFO )
357*
358*                 Check error code from CPOTRF.
359*
360                  IF( INFO.NE.IZERO ) THEN
361                     CALL ALAERH( PATH, 'CPOTRF', INFO, IZERO, UPLO, N,
362     $                            N, -1, -1, NB, IMAT, NFAIL, NERRS,
363     $                            NOUT )
364                     GO TO 90
365                  END IF
366*
367*                 Skip the tests if INFO is not 0.
368*
369                  IF( INFO.NE.0 )
370     $               GO TO 90
371*
372*+    TEST 1
373*                 Reconstruct matrix from factors and compute residual.
374*
375                  CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
376                  CALL CPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK,
377     $                         RESULT( 1 ) )
378*
379*+    TEST 2
380*                 Form the inverse and compute the residual.
381*
382                  CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
383                  SRNAMT = 'CPOTRI'
384                  CALL CPOTRI( UPLO, N, AINV, LDA, INFO )
385*
386*                 Check error code from CPOTRI.
387*
388                  IF( INFO.NE.0 )
389     $               CALL ALAERH( PATH, 'CPOTRI', INFO, 0, UPLO, N, N,
390     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
391*
392                  CALL CPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
393     $                         RWORK, RCONDC, RESULT( 2 ) )
394*
395*                 Print information about the tests that did not pass
396*                 the threshold.
397*
398                  DO 60 K = 1, 2
399                     IF( RESULT( K ).GE.THRESH ) THEN
400                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
401     $                     CALL ALAHD( NOUT, PATH )
402                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
403     $                     RESULT( K )
404                        NFAIL = NFAIL + 1
405                     END IF
406   60             CONTINUE
407                  NRUN = NRUN + 2
408*
409*                 Skip the rest of the tests unless this is the first
410*                 blocksize.
411*
412                  IF( INB.NE.1 )
413     $               GO TO 90
414*
415                  DO 80 IRHS = 1, NNS
416                     NRHS = NSVAL( IRHS )
417*
418*+    TEST 3
419*                 Solve and compute residual for A * X = B .
420*
421                     SRNAMT = 'CLARHS'
422                     CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
423     $                            NRHS, A, LDA, XACT, LDA, B, LDA,
424     $                            ISEED, INFO )
425                     CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
426*
427                     SRNAMT = 'CPOTRS'
428                     CALL CPOTRS( UPLO, N, NRHS, AFAC, LDA, X, LDA,
429     $                            INFO )
430*
431*                 Check error code from CPOTRS.
432*
433                     IF( INFO.NE.0 )
434     $                  CALL ALAERH( PATH, 'CPOTRS', INFO, 0, UPLO, N,
435     $                               N, -1, -1, NRHS, IMAT, NFAIL,
436     $                               NERRS, NOUT )
437*
438                     CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
439                     CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
440     $                            LDA, RWORK, RESULT( 3 ) )
441*
442*+    TEST 4
443*                 Check solution from generated exact solution.
444*
445                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
446     $                            RESULT( 4 ) )
447*
448*+    TESTS 5, 6, and 7
449*                 Use iterative refinement to improve the solution.
450*
451                     SRNAMT = 'CPORFS'
452                     CALL CPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B,
453     $                            LDA, X, LDA, RWORK, RWORK( NRHS+1 ),
454     $                            WORK, RWORK( 2*NRHS+1 ), INFO )
455*
456*                 Check error code from CPORFS.
457*
458                     IF( INFO.NE.0 )
459     $                  CALL ALAERH( PATH, 'CPORFS', INFO, 0, UPLO, N,
460     $                               N, -1, -1, NRHS, IMAT, NFAIL,
461     $                               NERRS, NOUT )
462*
463                     CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
464     $                            RESULT( 5 ) )
465                     CALL CPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
466     $                            XACT, LDA, RWORK, RWORK( NRHS+1 ),
467     $                            RESULT( 6 ) )
468*
469*                    Print information about the tests that did not pass
470*                    the threshold.
471*
472                     DO 70 K = 3, 7
473                        IF( RESULT( K ).GE.THRESH ) THEN
474                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
475     $                        CALL ALAHD( NOUT, PATH )
476                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
477     $                        IMAT, K, RESULT( K )
478                           NFAIL = NFAIL + 1
479                        END IF
480   70                CONTINUE
481                     NRUN = NRUN + 5
482   80             CONTINUE
483*
484*+    TEST 8
485*                 Get an estimate of RCOND = 1/CNDNUM.
486*
487                  ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK )
488                  SRNAMT = 'CPOCON'
489                  CALL CPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK,
490     $                         RWORK, INFO )
491*
492*                 Check error code from CPOCON.
493*
494                  IF( INFO.NE.0 )
495     $               CALL ALAERH( PATH, 'CPOCON', INFO, 0, UPLO, N, N,
496     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
497*
498                  RESULT( 8 ) = SGET06( RCOND, RCONDC )
499*
500*                 Print the test ratio if it is .GE. THRESH.
501*
502                  IF( RESULT( 8 ).GE.THRESH ) THEN
503                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
504     $                  CALL ALAHD( NOUT, PATH )
505                     WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8,
506     $                  RESULT( 8 )
507                     NFAIL = NFAIL + 1
508                  END IF
509                  NRUN = NRUN + 1
510   90          CONTINUE
511  100       CONTINUE
512  110    CONTINUE
513  120 CONTINUE
514*
515*     Print a summary of the results.
516*
517      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
518*
519 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
520     $      I2, ', test ', I2, ', ratio =', G12.5 )
521 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
522     $      I2, ', test(', I2, ') =', G12.5 )
523 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
524     $      ', test(', I2, ') =', G12.5 )
525      RETURN
526*
527*     End of CCHKPO
528*
529      END
530