1*> \brief \b ZCHKPO
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 ZCHKPO( 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*       DOUBLE PRECISION   THRESH
19*       ..
20*       .. Array Arguments ..
21*       LOGICAL            DOTYPE( * )
22*       INTEGER            NBVAL( * ), NSVAL( * ), NVAL( * )
23*       DOUBLE PRECISION   RWORK( * )
24*       COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
25*      $                   WORK( * ), X( * ), XACT( * )
26*       ..
27*
28*
29*> \par Purpose:
30*  =============
31*>
32*> \verbatim
33*>
34*> ZCHKPO tests ZPOTRF, -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 (NBVAL)
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 DOUBLE PRECISION
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*16 array, dimension (NMAX*NMAX)
108*> \endverbatim
109*>
110*> \param[out] AFAC
111*> \verbatim
112*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
113*> \endverbatim
114*>
115*> \param[out] AINV
116*> \verbatim
117*>          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
118*> \endverbatim
119*>
120*> \param[out] B
121*> \verbatim
122*>          B is COMPLEX*16 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*16 array, dimension (NMAX*NSMAX)
129*> \endverbatim
130*>
131*> \param[out] XACT
132*> \verbatim
133*>          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
134*> \endverbatim
135*>
136*> \param[out] WORK
137*> \verbatim
138*>          WORK is COMPLEX*16 array, dimension
139*>                      (NMAX*max(3,NSMAX))
140*> \endverbatim
141*>
142*> \param[out] RWORK
143*> \verbatim
144*>          RWORK is DOUBLE PRECISION 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*> \date December 2016
163*
164*> \ingroup complex16_lin
165*
166*  =====================================================================
167      SUBROUTINE ZCHKPO( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
168     $                   THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X,
169     $                   XACT, WORK, RWORK, NOUT )
170*
171*  -- LAPACK test routine (version 3.7.0) --
172*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
173*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174*     December 2016
175*
176*     .. Scalar Arguments ..
177      LOGICAL            TSTERR
178      INTEGER            NMAX, NN, NNB, NNS, NOUT
179      DOUBLE PRECISION   THRESH
180*     ..
181*     .. Array Arguments ..
182      LOGICAL            DOTYPE( * )
183      INTEGER            NBVAL( * ), NSVAL( * ), NVAL( * )
184      DOUBLE PRECISION   RWORK( * )
185      COMPLEX*16         A( * ), AFAC( * ), AINV( * ), B( * ),
186     $                   WORK( * ), X( * ), XACT( * )
187*     ..
188*
189*  =====================================================================
190*
191*     .. Parameters ..
192      COMPLEX*16         CZERO
193      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
194      INTEGER            NTYPES
195      PARAMETER          ( NTYPES = 9 )
196      INTEGER            NTESTS
197      PARAMETER          ( NTESTS = 8 )
198*     ..
199*     .. Local Scalars ..
200      LOGICAL            ZEROT
201      CHARACTER          DIST, TYPE, UPLO, XTYPE
202      CHARACTER*3        PATH
203      INTEGER            I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
204     $                   IZERO, K, KL, KU, LDA, MODE, N, NB, NERRS,
205     $                   NFAIL, NIMAT, NRHS, NRUN
206      DOUBLE PRECISION   ANORM, CNDNUM, RCOND, RCONDC
207*     ..
208*     .. Local Arrays ..
209      CHARACTER          UPLOS( 2 )
210      INTEGER            ISEED( 4 ), ISEEDY( 4 )
211      DOUBLE PRECISION   RESULT( NTESTS )
212*     ..
213*     .. External Functions ..
214      DOUBLE PRECISION   DGET06, ZLANHE
215      EXTERNAL           DGET06, ZLANHE
216*     ..
217*     .. External Subroutines ..
218      EXTERNAL           ALAERH, ALAHD, ALASUM, XLAENV, ZERRPO, ZGET04,
219     $                   ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, ZPOCON,
220     $                   ZPORFS, ZPOT01, ZPOT02, ZPOT03, ZPOT05, ZPOTRF,
221     $                   ZPOTRI, ZPOTRS
222*     ..
223*     .. Scalars in Common ..
224      LOGICAL            LERR, OK
225      CHARACTER*32       SRNAMT
226      INTEGER            INFOT, NUNIT
227*     ..
228*     .. Common blocks ..
229      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
230      COMMON             / SRNAMC / SRNAMT
231*     ..
232*     .. Intrinsic Functions ..
233      INTRINSIC          MAX
234*     ..
235*     .. Data statements ..
236      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
237      DATA               UPLOS / 'U', 'L' /
238*     ..
239*     .. Executable Statements ..
240*
241*     Initialize constants and the random number seed.
242*
243      PATH( 1: 1 ) = 'Zomplex precision'
244      PATH( 2: 3 ) = 'PO'
245      NRUN = 0
246      NFAIL = 0
247      NERRS = 0
248      DO 10 I = 1, 4
249         ISEED( I ) = ISEEDY( I )
250   10 CONTINUE
251*
252*     Test the error exits
253*
254      IF( TSTERR )
255     $   CALL ZERRPO( PATH, NOUT )
256      INFOT = 0
257*
258*     Do for each value of N in NVAL
259*
260      DO 120 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         IZERO = 0
269         DO 110 IMAT = 1, NIMAT
270*
271*           Do the tests only if DOTYPE( IMAT ) is true.
272*
273            IF( .NOT.DOTYPE( IMAT ) )
274     $         GO TO 110
275*
276*           Skip types 3, 4, or 5 if the matrix size is too small.
277*
278            ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
279            IF( ZEROT .AND. N.LT.IMAT-2 )
280     $         GO TO 110
281*
282*           Do first for UPLO = 'U', then for UPLO = 'L'
283*
284            DO 100 IUPLO = 1, 2
285               UPLO = UPLOS( IUPLO )
286*
287*              Set up parameters with ZLATB4 and generate a test matrix
288*              with ZLATMS.
289*
290               CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
291     $                      CNDNUM, DIST )
292*
293               SRNAMT = 'ZLATMS'
294               CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
295     $                      CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
296     $                      INFO )
297*
298*              Check error code from ZLATMS.
299*
300               IF( INFO.NE.0 ) THEN
301                  CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
302     $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
303                  GO TO 100
304               END IF
305*
306*              For types 3-5, zero one row and column of the matrix to
307*              test that INFO is returned correctly.
308*
309               IF( ZEROT ) THEN
310                  IF( IMAT.EQ.3 ) THEN
311                     IZERO = 1
312                  ELSE IF( IMAT.EQ.4 ) THEN
313                     IZERO = N
314                  ELSE
315                     IZERO = N / 2 + 1
316                  END IF
317                  IOFF = ( IZERO-1 )*LDA
318*
319*                 Set row and column IZERO of A to 0.
320*
321                  IF( IUPLO.EQ.1 ) THEN
322                     DO 20 I = 1, IZERO - 1
323                        A( IOFF+I ) = CZERO
324   20                CONTINUE
325                     IOFF = IOFF + IZERO
326                     DO 30 I = IZERO, N
327                        A( IOFF ) = CZERO
328                        IOFF = IOFF + LDA
329   30                CONTINUE
330                  ELSE
331                     IOFF = IZERO
332                     DO 40 I = 1, IZERO - 1
333                        A( IOFF ) = CZERO
334                        IOFF = IOFF + LDA
335   40                CONTINUE
336                     IOFF = IOFF - IZERO
337                     DO 50 I = IZERO, N
338                        A( IOFF+I ) = CZERO
339   50                CONTINUE
340                  END IF
341               ELSE
342                  IZERO = 0
343               END IF
344*
345*              Set the imaginary part of the diagonals.
346*
347               CALL ZLAIPD( N, A, LDA+1, 0 )
348*
349*              Do for each value of NB in NBVAL
350*
351               DO 90 INB = 1, NNB
352                  NB = NBVAL( INB )
353                  CALL XLAENV( 1, NB )
354*
355*                 Compute the L*L' or U'*U factorization of the matrix.
356*
357                  CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
358                  SRNAMT = 'ZPOTRF'
359                  CALL ZPOTRF( UPLO, N, AFAC, LDA, INFO )
360*
361*                 Check error code from ZPOTRF.
362*
363                  IF( INFO.NE.IZERO ) THEN
364                     CALL ALAERH( PATH, 'ZPOTRF', INFO, IZERO, UPLO, N,
365     $                            N, -1, -1, NB, IMAT, NFAIL, NERRS,
366     $                            NOUT )
367                     GO TO 90
368                  END IF
369*
370*                 Skip the tests if INFO is not 0.
371*
372                  IF( INFO.NE.0 )
373     $               GO TO 90
374*
375*+    TEST 1
376*                 Reconstruct matrix from factors and compute residual.
377*
378                  CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
379                  CALL ZPOT01( UPLO, N, A, LDA, AINV, LDA, RWORK,
380     $                         RESULT( 1 ) )
381*
382*+    TEST 2
383*                 Form the inverse and compute the residual.
384*
385                  CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
386                  SRNAMT = 'ZPOTRI'
387                  CALL ZPOTRI( UPLO, N, AINV, LDA, INFO )
388*
389*                 Check error code from ZPOTRI.
390*
391                  IF( INFO.NE.0 )
392     $               CALL ALAERH( PATH, 'ZPOTRI', INFO, 0, UPLO, N, N,
393     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
394*
395                  CALL ZPOT03( UPLO, N, A, LDA, AINV, LDA, WORK, LDA,
396     $                         RWORK, RCONDC, RESULT( 2 ) )
397*
398*                 Print information about the tests that did not pass
399*                 the threshold.
400*
401                  DO 60 K = 1, 2
402                     IF( RESULT( K ).GE.THRESH ) THEN
403                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
404     $                     CALL ALAHD( NOUT, PATH )
405                        WRITE( NOUT, FMT = 9999 )UPLO, N, NB, IMAT, K,
406     $                     RESULT( K )
407                        NFAIL = NFAIL + 1
408                     END IF
409   60             CONTINUE
410                  NRUN = NRUN + 2
411*
412*                 Skip the rest of the tests unless this is the first
413*                 blocksize.
414*
415                  IF( INB.NE.1 )
416     $               GO TO 90
417*
418                  DO 80 IRHS = 1, NNS
419                     NRHS = NSVAL( IRHS )
420*
421*+    TEST 3
422*                 Solve and compute residual for A * X = B .
423*
424                     SRNAMT = 'ZLARHS'
425                     CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
426     $                            NRHS, A, LDA, XACT, LDA, B, LDA,
427     $                            ISEED, INFO )
428                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
429*
430                     SRNAMT = 'ZPOTRS'
431                     CALL ZPOTRS( UPLO, N, NRHS, AFAC, LDA, X, LDA,
432     $                            INFO )
433*
434*                 Check error code from ZPOTRS.
435*
436                     IF( INFO.NE.0 )
437     $                  CALL ALAERH( PATH, 'ZPOTRS', INFO, 0, UPLO, N,
438     $                               N, -1, -1, NRHS, IMAT, NFAIL,
439     $                               NERRS, NOUT )
440*
441                     CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
442                     CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
443     $                            LDA, RWORK, RESULT( 3 ) )
444*
445*+    TEST 4
446*                 Check solution from generated exact solution.
447*
448                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
449     $                            RESULT( 4 ) )
450*
451*+    TESTS 5, 6, and 7
452*                 Use iterative refinement to improve the solution.
453*
454                     SRNAMT = 'ZPORFS'
455                     CALL ZPORFS( UPLO, N, NRHS, A, LDA, AFAC, LDA, B,
456     $                            LDA, X, LDA, RWORK, RWORK( NRHS+1 ),
457     $                            WORK, RWORK( 2*NRHS+1 ), INFO )
458*
459*                 Check error code from ZPORFS.
460*
461                     IF( INFO.NE.0 )
462     $                  CALL ALAERH( PATH, 'ZPORFS', INFO, 0, UPLO, N,
463     $                               N, -1, -1, NRHS, IMAT, NFAIL,
464     $                               NERRS, NOUT )
465*
466                     CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
467     $                            RESULT( 5 ) )
468                     CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
469     $                            XACT, LDA, RWORK, RWORK( NRHS+1 ),
470     $                            RESULT( 6 ) )
471*
472*                    Print information about the tests that did not pass
473*                    the threshold.
474*
475                     DO 70 K = 3, 7
476                        IF( RESULT( K ).GE.THRESH ) THEN
477                           IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
478     $                        CALL ALAHD( NOUT, PATH )
479                           WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS,
480     $                        IMAT, K, RESULT( K )
481                           NFAIL = NFAIL + 1
482                        END IF
483   70                CONTINUE
484                     NRUN = NRUN + 5
485   80             CONTINUE
486*
487*+    TEST 8
488*                 Get an estimate of RCOND = 1/CNDNUM.
489*
490                  ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
491                  SRNAMT = 'ZPOCON'
492                  CALL ZPOCON( UPLO, N, AFAC, LDA, ANORM, RCOND, WORK,
493     $                         RWORK, INFO )
494*
495*                 Check error code from ZPOCON.
496*
497                  IF( INFO.NE.0 )
498     $               CALL ALAERH( PATH, 'ZPOCON', INFO, 0, UPLO, N, N,
499     $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
500*
501                  RESULT( 8 ) = DGET06( RCOND, RCONDC )
502*
503*                 Print the test ratio if it is .GE. THRESH.
504*
505                  IF( RESULT( 8 ).GE.THRESH ) THEN
506                     IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
507     $                  CALL ALAHD( NOUT, PATH )
508                     WRITE( NOUT, FMT = 9997 )UPLO, N, IMAT, 8,
509     $                  RESULT( 8 )
510                     NFAIL = NFAIL + 1
511                  END IF
512                  NRUN = NRUN + 1
513   90          CONTINUE
514  100       CONTINUE
515  110    CONTINUE
516  120 CONTINUE
517*
518*     Print a summary of the results.
519*
520      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
521*
522 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NB =', I4, ', type ',
523     $      I2, ', test ', I2, ', ratio =', G12.5 )
524 9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
525     $      I2, ', test(', I2, ') =', G12.5 )
526 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
527     $      ', test(', I2, ') =', G12.5 )
528      RETURN
529*
530*     End of ZCHKPO
531*
532      END
533