1*> \brief \b ZCHKPS
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 ZCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
12*                          THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
13*                          RWORK, NOUT )
14*
15*       .. Scalar Arguments ..
16*       DOUBLE PRECISION   THRESH
17*       INTEGER            NMAX, NN, NNB, NOUT, NRANK
18*       LOGICAL            TSTERR
19*       ..
20*       .. Array Arguments ..
21*       COMPLEX*16         A( * ), AFAC( * ), PERM( * ), WORK( * )
22*       DOUBLE PRECISION   RWORK( * )
23*       INTEGER            NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
24*       LOGICAL            DOTYPE( * )
25*       ..
26*
27*
28*> \par Purpose:
29*  =============
30*>
31*> \verbatim
32*>
33*> ZCHKPS tests ZPSTRF.
34*> \endverbatim
35*
36*  Arguments:
37*  ==========
38*
39*> \param[in] DOTYPE
40*> \verbatim
41*>          DOTYPE is LOGICAL array, dimension (NTYPES)
42*>          The matrix types to be used for testing.  Matrices of type j
43*>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
44*>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
45*> \endverbatim
46*>
47*> \param[in] NN
48*> \verbatim
49*>          NN is INTEGER
50*>          The number of values of N contained in the vector NVAL.
51*> \endverbatim
52*>
53*> \param[in] NVAL
54*> \verbatim
55*>          NVAL is INTEGER array, dimension (NN)
56*>          The values of the matrix dimension N.
57*> \endverbatim
58*>
59*> \param[in] NNB
60*> \verbatim
61*>          NNB is INTEGER
62*>          The number of values of NB contained in the vector NBVAL.
63*> \endverbatim
64*>
65*> \param[in] NBVAL
66*> \verbatim
67*>          NBVAL is INTEGER array, dimension (NNB)
68*>          The values of the block size NB.
69*> \endverbatim
70*>
71*> \param[in] NRANK
72*> \verbatim
73*>          NRANK is INTEGER
74*>          The number of values of RANK contained in the vector RANKVAL.
75*> \endverbatim
76*>
77*> \param[in] RANKVAL
78*> \verbatim
79*>          RANKVAL is INTEGER array, dimension (NBVAL)
80*>          The values of the block size NB.
81*> \endverbatim
82*>
83*> \param[in] THRESH
84*> \verbatim
85*>          THRESH is DOUBLE PRECISION
86*>          The threshold value for the test ratios.  A result is
87*>          included in the output file if RESULT >= THRESH.  To have
88*>          every test ratio printed, use THRESH = 0.
89*> \endverbatim
90*>
91*> \param[in] TSTERR
92*> \verbatim
93*>          TSTERR is LOGICAL
94*>          Flag that indicates whether error exits are to be tested.
95*> \endverbatim
96*>
97*> \param[in] NMAX
98*> \verbatim
99*>          NMAX is INTEGER
100*>          The maximum value permitted for N, used in dimensioning the
101*>          work arrays.
102*> \endverbatim
103*>
104*> \param[out] A
105*> \verbatim
106*>          A is COMPLEX*16 array, dimension (NMAX*NMAX)
107*> \endverbatim
108*>
109*> \param[out] AFAC
110*> \verbatim
111*>          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
112*> \endverbatim
113*>
114*> \param[out] PERM
115*> \verbatim
116*>          PERM is COMPLEX*16 array, dimension (NMAX*NMAX)
117*> \endverbatim
118*>
119*> \param[out] PIV
120*> \verbatim
121*>          PIV is INTEGER array, dimension (NMAX)
122*> \endverbatim
123*>
124*> \param[out] WORK
125*> \verbatim
126*>          WORK is COMPLEX*16 array, dimension (NMAX*3)
127*> \endverbatim
128*>
129*> \param[out] RWORK
130*> \verbatim
131*>          RWORK is DOUBLE PRECISION array, dimension (NMAX)
132*> \endverbatim
133*>
134*> \param[in] NOUT
135*> \verbatim
136*>          NOUT is INTEGER
137*>          The unit number for output.
138*> \endverbatim
139*
140*  Authors:
141*  ========
142*
143*> \author Univ. of Tennessee
144*> \author Univ. of California Berkeley
145*> \author Univ. of Colorado Denver
146*> \author NAG Ltd.
147*
148*> \ingroup complex16_lin
149*
150*  =====================================================================
151      SUBROUTINE ZCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
152     $                   THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
153     $                   RWORK, NOUT )
154*
155*  -- LAPACK test routine --
156*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
157*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158*
159*     .. Scalar Arguments ..
160      DOUBLE PRECISION   THRESH
161      INTEGER            NMAX, NN, NNB, NOUT, NRANK
162      LOGICAL            TSTERR
163*     ..
164*     .. Array Arguments ..
165      COMPLEX*16         A( * ), AFAC( * ), PERM( * ), WORK( * )
166      DOUBLE PRECISION   RWORK( * )
167      INTEGER            NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
168      LOGICAL            DOTYPE( * )
169*     ..
170*
171*  =====================================================================
172*
173*     .. Parameters ..
174      DOUBLE PRECISION   ONE
175      PARAMETER          ( ONE = 1.0E+0 )
176      INTEGER            NTYPES
177      PARAMETER          ( NTYPES = 9 )
178*     ..
179*     .. Local Scalars ..
180      DOUBLE PRECISION   ANORM, CNDNUM, RESULT, TOL
181      INTEGER            COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
182     $                   IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL,
183     $                   NIMAT, NRUN, RANK, RANKDIFF
184      CHARACTER          DIST, TYPE, UPLO
185      CHARACTER*3        PATH
186*     ..
187*     .. Local Arrays ..
188      INTEGER            ISEED( 4 ), ISEEDY( 4 )
189      CHARACTER          UPLOS( 2 )
190*     ..
191*     .. External Subroutines ..
192      EXTERNAL           ALAERH, ALAHD, ALASUM, XLAENV, ZERRPS, ZLACPY,
193     $                   ZLATB5, ZLATMT, ZPST01, ZPSTRF
194*     ..
195*     .. Scalars in Common ..
196      INTEGER            INFOT, NUNIT
197      LOGICAL            LERR, OK
198      CHARACTER*32       SRNAMT
199*     ..
200*     .. Common blocks ..
201      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
202      COMMON             / SRNAMC / SRNAMT
203*     ..
204*     .. Intrinsic Functions ..
205      INTRINSIC          DBLE, MAX, CEILING
206*     ..
207*     .. Data statements ..
208      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
209      DATA               UPLOS / 'U', 'L' /
210*     ..
211*     .. Executable Statements ..
212*
213*     Initialize constants and the random number seed.
214*
215      PATH( 1: 1 ) = 'Zomplex Precision'
216      PATH( 2: 3 ) = 'PS'
217      NRUN = 0
218      NFAIL = 0
219      NERRS = 0
220      DO 100 I = 1, 4
221         ISEED( I ) = ISEEDY( I )
222  100 CONTINUE
223*
224*     Test the error exits
225*
226      IF( TSTERR )
227     $   CALL ZERRPS( PATH, NOUT )
228      INFOT = 0
229*
230*     Do for each value of N in NVAL
231*
232      DO 150 IN = 1, NN
233         N = NVAL( IN )
234         LDA = MAX( N, 1 )
235         NIMAT = NTYPES
236         IF( N.LE.0 )
237     $      NIMAT = 1
238*
239         IZERO = 0
240         DO 140 IMAT = 1, NIMAT
241*
242*           Do the tests only if DOTYPE( IMAT ) is true.
243*
244            IF( .NOT.DOTYPE( IMAT ) )
245     $         GO TO 140
246*
247*              Do for each value of RANK in RANKVAL
248*
249            DO 130 IRANK = 1, NRANK
250*
251*              Only repeat test 3 to 5 for different ranks
252*              Other tests use full rank
253*
254               IF( ( IMAT.LT.3 .OR. IMAT.GT.5 ) .AND. IRANK.GT.1 )
255     $            GO TO 130
256*
257               RANK = CEILING( ( N * DBLE( RANKVAL( IRANK ) ) )
258     $              / 100.E+0 )
259*
260*
261*           Do first for UPLO = 'U', then for UPLO = 'L'
262*
263               DO 120 IUPLO = 1, 2
264                  UPLO = UPLOS( IUPLO )
265*
266*              Set up parameters with ZLATB5 and generate a test matrix
267*              with ZLATMT.
268*
269                  CALL ZLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM,
270     $                         MODE, CNDNUM, DIST )
271*
272                  SRNAMT = 'ZLATMT'
273                  CALL ZLATMT( N, N, DIST, ISEED, TYPE, RWORK, MODE,
274     $                         CNDNUM, ANORM, RANK, KL, KU, UPLO, A,
275     $                         LDA, WORK, INFO )
276*
277*              Check error code from ZLATMT.
278*
279                  IF( INFO.NE.0 ) THEN
280                    CALL ALAERH( PATH, 'ZLATMT', INFO, 0, UPLO, N,
281     $                           N, -1, -1, -1, IMAT, NFAIL, NERRS,
282     $                           NOUT )
283                     GO TO 120
284                  END IF
285*
286*              Do for each value of NB in NBVAL
287*
288                  DO 110 INB = 1, NNB
289                     NB = NBVAL( INB )
290                     CALL XLAENV( 1, NB )
291*
292*                 Compute the pivoted L*L' or U'*U factorization
293*                 of the matrix.
294*
295                     CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
296                     SRNAMT = 'ZPSTRF'
297*
298*                 Use default tolerance
299*
300                     TOL = -ONE
301                     CALL ZPSTRF( UPLO, N, AFAC, LDA, PIV, COMPRANK,
302     $                            TOL, RWORK, INFO )
303*
304*                 Check error code from ZPSTRF.
305*
306                     IF( (INFO.LT.IZERO)
307     $                    .OR.(INFO.NE.IZERO.AND.RANK.EQ.N)
308     $                    .OR.(INFO.LE.IZERO.AND.RANK.LT.N) ) THEN
309                        CALL ALAERH( PATH, 'ZPSTRF', INFO, IZERO,
310     $                               UPLO, N, N, -1, -1, NB, IMAT,
311     $                               NFAIL, NERRS, NOUT )
312                        GO TO 110
313                     END IF
314*
315*                 Skip the test if INFO is not 0.
316*
317                     IF( INFO.NE.0 )
318     $                  GO TO 110
319*
320*                 Reconstruct matrix from factors and compute residual.
321*
322*                 PERM holds permuted L*L^T or U^T*U
323*
324                     CALL ZPST01( UPLO, N, A, LDA, AFAC, LDA, PERM, LDA,
325     $                            PIV, RWORK, RESULT, COMPRANK )
326*
327*                 Print information about the tests that did not pass
328*                 the threshold or where computed rank was not RANK.
329*
330                     IF( N.EQ.0 )
331     $                  COMPRANK = 0
332                     RANKDIFF = RANK - COMPRANK
333                     IF( RESULT.GE.THRESH ) THEN
334                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
335     $                     CALL ALAHD( NOUT, PATH )
336                        WRITE( NOUT, FMT = 9999 )UPLO, N, RANK,
337     $                     RANKDIFF, NB, IMAT, RESULT
338                        NFAIL = NFAIL + 1
339                     END IF
340                     NRUN = NRUN + 1
341  110             CONTINUE
342*
343  120          CONTINUE
344  130       CONTINUE
345  140    CONTINUE
346  150 CONTINUE
347*
348*     Print a summary of the results.
349*
350      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
351*
352 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', RANK =', I3,
353     $      ', Diff =', I5, ', NB =', I4, ', type ', I2, ', Ratio =',
354     $      G12.5 )
355      RETURN
356*
357*     End of ZCHKPS
358*
359      END
360