LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
cchkps.f
Go to the documentation of this file.
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
cchkps
subroutine cchkps(DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
CCHKPS
Definition: cchkps.f:156
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
cpstrf
subroutine cpstrf(UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO)
CPSTRF computes the Cholesky factorization with complete pivoting of complex Hermitian positive semid...
Definition: cpstrf.f:144
cpst01
subroutine cpst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
CPST01
Definition: cpst01.f:138
clacpy
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
cerrps
subroutine cerrps(PATH, NUNIT)
CERRPS
Definition: cerrps.f:57
clatb5
subroutine clatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB5
Definition: clatb5.f:116
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
clatmt
subroutine clatmt(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RANK, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMT
Definition: clatmt.f:342
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83