1*> \brief \b CCHKPS
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 CCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
12*                          THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
13*                          RWORK, NOUT )
14*
15*       .. Scalar Arguments ..
16*       REAL               THRESH
17*       INTEGER            NMAX, NN, NNB, NOUT, NRANK
18*       LOGICAL            TSTERR
19*       ..
20*       .. Array Arguments ..
21*       COMPLEX            A( * ), AFAC( * ), PERM( * ), WORK( * )
22*       REAL               RWORK( * )
23*       INTEGER            NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
24*       LOGICAL            DOTYPE( * )
25*       ..
26*
27*
28*> \par Purpose:
29*  =============
30*>
31*> \verbatim
32*>
33*> CCHKPS tests CPSTRF.
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 (NBVAL)
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 REAL
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 array, dimension (NMAX*NMAX)
107*> \endverbatim
108*>
109*> \param[out] AFAC
110*> \verbatim
111*>          AFAC is COMPLEX array, dimension (NMAX*NMAX)
112*> \endverbatim
113*>
114*> \param[out] PERM
115*> \verbatim
116*>          PERM is COMPLEX 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 array, dimension (NMAX*3)
127*> \endverbatim
128*>
129*> \param[out] RWORK
130*> \verbatim
131*>          RWORK is REAL 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*> \date December 2016
149*
150*> \ingroup complex_lin
151*
152*  =====================================================================
153      SUBROUTINE CCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
154     $                   THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
155     $                   RWORK, NOUT )
156*
157*  -- LAPACK test routine (version 3.7.0) --
158*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
159*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
160*     December 2016
161*
162*     .. Scalar Arguments ..
163      REAL               THRESH
164      INTEGER            NMAX, NN, NNB, NOUT, NRANK
165      LOGICAL            TSTERR
166*     ..
167*     .. Array Arguments ..
168      COMPLEX            A( * ), AFAC( * ), PERM( * ), WORK( * )
169      REAL               RWORK( * )
170      INTEGER            NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
171      LOGICAL            DOTYPE( * )
172*     ..
173*
174*  =====================================================================
175*
176*     .. Parameters ..
177      REAL               ONE
178      PARAMETER          ( ONE = 1.0E+0 )
179      INTEGER            NTYPES
180      PARAMETER          ( NTYPES = 9 )
181*     ..
182*     .. Local Scalars ..
183      REAL               ANORM, CNDNUM, RESULT, TOL
184      INTEGER            COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
185     $                   IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL,
186     $                   NIMAT, NRUN, RANK, RANKDIFF
187      CHARACTER          DIST, TYPE, UPLO
188      CHARACTER*3        PATH
189*     ..
190*     .. Local Arrays ..
191      INTEGER            ISEED( 4 ), ISEEDY( 4 )
192      CHARACTER          UPLOS( 2 )
193*     ..
194*     .. External Subroutines ..
195      EXTERNAL           ALAERH, ALAHD, ALASUM, CERRPS, CLACPY,
196     $                   CLATB5, CLATMT, CPST01, CPSTRF, XLAENV
197*     ..
198*     .. Scalars in Common ..
199      INTEGER            INFOT, NUNIT
200      LOGICAL            LERR, OK
201      CHARACTER*32       SRNAMT
202*     ..
203*     .. Common blocks ..
204      COMMON             / INFOC / INFOT, NUNIT, OK, LERR
205      COMMON             / SRNAMC / SRNAMT
206*     ..
207*     .. Intrinsic Functions ..
208      INTRINSIC          MAX, REAL, CEILING
209*     ..
210*     .. Data statements ..
211      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
212      DATA               UPLOS / 'U', 'L' /
213*     ..
214*     .. Executable Statements ..
215*
216*     Initialize constants and the random number seed.
217*
218      PATH( 1: 1 ) = 'Complex Precision'
219      PATH( 2: 3 ) = 'PS'
220      NRUN = 0
221      NFAIL = 0
222      NERRS = 0
223      DO 100 I = 1, 4
224         ISEED( I ) = ISEEDY( I )
225  100 CONTINUE
226*
227*     Test the error exits
228*
229      IF( TSTERR )
230     $   CALL CERRPS( PATH, NOUT )
231      INFOT = 0
232*
233*     Do for each value of N in NVAL
234*
235      DO 150 IN = 1, NN
236         N = NVAL( IN )
237         LDA = MAX( N, 1 )
238         NIMAT = NTYPES
239         IF( N.LE.0 )
240     $      NIMAT = 1
241*
242         IZERO = 0
243         DO 140 IMAT = 1, NIMAT
244*
245*           Do the tests only if DOTYPE( IMAT ) is true.
246*
247            IF( .NOT.DOTYPE( IMAT ) )
248     $         GO TO 140
249*
250*              Do for each value of RANK in RANKVAL
251*
252            DO 130 IRANK = 1, NRANK
253*
254*              Only repeat test 3 to 5 for different ranks
255*              Other tests use full rank
256*
257               IF( ( IMAT.LT.3 .OR. IMAT.GT.5 ) .AND. IRANK.GT.1 )
258     $            GO TO 130
259*
260               RANK = CEILING( ( N * REAL( RANKVAL( IRANK ) ) )
261     $              / 100.E+0 )
262*
263*
264*           Do first for UPLO = 'U', then for UPLO = 'L'
265*
266               DO 120 IUPLO = 1, 2
267                  UPLO = UPLOS( IUPLO )
268*
269*              Set up parameters with CLATB5 and generate a test matrix
270*              with CLATMT.
271*
272                  CALL CLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM,
273     $                         MODE, CNDNUM, DIST )
274*
275                  SRNAMT = 'CLATMT'
276                  CALL CLATMT( N, N, DIST, ISEED, TYPE, RWORK, MODE,
277     $                         CNDNUM, ANORM, RANK, KL, KU, UPLO, A,
278     $                         LDA, WORK, INFO )
279*
280*              Check error code from CLATMT.
281*
282                  IF( INFO.NE.0 ) THEN
283                    CALL ALAERH( PATH, 'CLATMT', INFO, 0, UPLO, N,
284     $                           N, -1, -1, -1, IMAT, NFAIL, NERRS,
285     $                           NOUT )
286                     GO TO 120
287                  END IF
288*
289*              Do for each value of NB in NBVAL
290*
291                  DO 110 INB = 1, NNB
292                     NB = NBVAL( INB )
293                     CALL XLAENV( 1, NB )
294*
295*                 Compute the pivoted L*L' or U'*U factorization
296*                 of the matrix.
297*
298                     CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
299                     SRNAMT = 'CPSTRF'
300*
301*                 Use default tolerance
302*
303                     TOL = -ONE
304                     CALL CPSTRF( UPLO, N, AFAC, LDA, PIV, COMPRANK,
305     $                            TOL, RWORK, INFO )
306*
307*                 Check error code from CPSTRF.
308*
309                     IF( (INFO.LT.IZERO)
310     $                    .OR.(INFO.NE.IZERO.AND.RANK.EQ.N)
311     $                    .OR.(INFO.LE.IZERO.AND.RANK.LT.N) ) THEN
312                        CALL ALAERH( PATH, 'CPSTRF', INFO, IZERO,
313     $                               UPLO, N, N, -1, -1, NB, IMAT,
314     $                               NFAIL, NERRS, NOUT )
315                        GO TO 110
316                     END IF
317*
318*                 Skip the test if INFO is not 0.
319*
320                     IF( INFO.NE.0 )
321     $                  GO TO 110
322*
323*                 Reconstruct matrix from factors and compute residual.
324*
325*                 PERM holds permuted L*L^T or U^T*U
326*
327                     CALL CPST01( UPLO, N, A, LDA, AFAC, LDA, PERM, LDA,
328     $                            PIV, RWORK, RESULT, COMPRANK )
329*
330*                 Print information about the tests that did not pass
331*                 the threshold or where computed rank was not RANK.
332*
333                     IF( N.EQ.0 )
334     $                  COMPRANK = 0
335                     RANKDIFF = RANK - COMPRANK
336                     IF( RESULT.GE.THRESH ) THEN
337                        IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
338     $                     CALL ALAHD( NOUT, PATH )
339                        WRITE( NOUT, FMT = 9999 )UPLO, N, RANK,
340     $                     RANKDIFF, NB, IMAT, RESULT
341                        NFAIL = NFAIL + 1
342                     END IF
343                     NRUN = NRUN + 1
344  110             CONTINUE
345*
346  120          CONTINUE
347  130       CONTINUE
348  140    CONTINUE
349  150 CONTINUE
350*
351*     Print a summary of the results.
352*
353      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
354*
355 9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', RANK =', I3,
356     $      ', Diff =', I5, ', NB =', I4, ', type ', I2, ', Ratio =',
357     $      G12.5 )
358      RETURN
359*
360*     End of CCHKPS
361*
362      END
363