 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ dchkps()

 subroutine dchkps ( logical, dimension( * ) DOTYPE, integer NN, integer, dimension( * ) NVAL, integer NNB, integer, dimension( * ) NBVAL, integer NRANK, integer, dimension( * ) RANKVAL, double precision THRESH, logical TSTERR, integer NMAX, double precision, dimension( * ) A, double precision, dimension( * ) AFAC, double precision, dimension( * ) PERM, integer, dimension( * ) PIV, double precision, dimension( * ) WORK, double precision, dimension( * ) RWORK, integer NOUT )

DCHKPS

Purpose:
` DCHKPS tests DPSTRF.`
Parameters
 [in] DOTYPE ``` DOTYPE is LOGICAL array, dimension (NTYPES) The matrix types to be used for testing. Matrices of type j (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.``` [in] NN ``` NN is INTEGER The number of values of N contained in the vector NVAL.``` [in] NVAL ``` NVAL is INTEGER array, dimension (NN) The values of the matrix dimension N.``` [in] NNB ``` NNB is INTEGER The number of values of NB contained in the vector NBVAL.``` [in] NBVAL ``` NBVAL is INTEGER array, dimension (NBVAL) The values of the block size NB.``` [in] NRANK ``` NRANK is INTEGER The number of values of RANK contained in the vector RANKVAL.``` [in] RANKVAL ``` RANKVAL is INTEGER array, dimension (NBVAL) The values of the block size NB.``` [in] THRESH ``` THRESH is DOUBLE PRECISION The threshold value for the test ratios. A result is included in the output file if RESULT >= THRESH. To have every test ratio printed, use THRESH = 0.``` [in] TSTERR ``` TSTERR is LOGICAL Flag that indicates whether error exits are to be tested.``` [in] NMAX ``` NMAX is INTEGER The maximum value permitted for N, used in dimensioning the work arrays.``` [out] A ` A is DOUBLE PRECISION array, dimension (NMAX*NMAX)` [out] AFAC ` AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)` [out] PERM ` PERM is DOUBLE PRECISION array, dimension (NMAX*NMAX)` [out] PIV ` PIV is INTEGER array, dimension (NMAX)` [out] WORK ` WORK is DOUBLE PRECISION array, dimension (NMAX*3)` [out] RWORK ` RWORK is DOUBLE PRECISION array, dimension (NMAX)` [in] NOUT ``` NOUT is INTEGER The unit number for output.```
Date
December 2016

Definition at line 156 of file dchkps.f.

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  DOUBLE PRECISION thresh
164  INTEGER nmax, nn, nnb, nout, nrank
165  LOGICAL tsterr
166 * ..
167 * .. Array Arguments ..
168  DOUBLE PRECISION a( * ), afac( * ), perm( * ), rwork( * ),
169  \$ work( * )
170  INTEGER nbval( * ), nval( * ), piv( * ), rankval( * )
171  LOGICAL dotype( * )
172 * ..
173 *
174 * =====================================================================
175 *
176 * .. Parameters ..
177  DOUBLE PRECISION one
178  parameter( one = 1.0d+0 )
179  INTEGER ntypes
180  parameter( ntypes = 9 )
181 * ..
182 * .. Local Scalars ..
183  DOUBLE PRECISION 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, derrps, dlacpy, dlatb5,
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 dble, max, 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 ) = 'Double 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 derrps( path, nout )
231  infot = 0
232  CALL xlaenv( 2, 2 )
233 *
234 * Do for each value of N in NVAL
235 *
236  DO 150 in = 1, nn
237  n = nval( in )
238  lda = max( n, 1 )
239  nimat = ntypes
240  IF( n.LE.0 )
241  \$ nimat = 1
242 *
243  izero = 0
244  DO 140 imat = 1, nimat
245 *
246 * Do the tests only if DOTYPE( IMAT ) is true.
247 *
248  IF( .NOT.dotype( imat ) )
249  \$ GO TO 140
250 *
251 * Do for each value of RANK in RANKVAL
252 *
253  DO 130 irank = 1, nrank
254 *
255 * Only repeat test 3 to 5 for different ranks
256 * Other tests use full rank
257 *
258  IF( ( imat.LT.3 .OR. imat.GT.5 ) .AND. irank.GT.1 )
259  \$ GO TO 130
260 *
261  rank = ceiling( ( n * dble( rankval( irank ) ) )
262  \$ / 100.d+0 )
263 *
264 *
265 * Do first for UPLO = 'U', then for UPLO = 'L'
266 *
267  DO 120 iuplo = 1, 2
268  uplo = uplos( iuplo )
269 *
270 * Set up parameters with DLATB5 and generate a test matrix
271 * with DLATMT.
272 *
273  CALL dlatb5( path, imat, n, TYPE, kl, ku, anorm,
274  \$ mode, cndnum, dist )
275 *
276  srnamt = 'DLATMT'
277  CALL dlatmt( n, n, dist, iseed, TYPE, rwork, mode,
278  \$ cndnum, anorm, rank, kl, ku, uplo, a,
279  \$ lda, work, info )
280 *
281 * Check error code from DLATMT.
282 *
283  IF( info.NE.0 ) THEN
284  CALL alaerh( path, 'DLATMT', info, 0, uplo, n,
285  \$ n, -1, -1, -1, imat, nfail, nerrs,
286  \$ nout )
287  GO TO 120
288  END IF
289 *
290 * Do for each value of NB in NBVAL
291 *
292  DO 110 inb = 1, nnb
293  nb = nbval( inb )
294  CALL xlaenv( 1, nb )
295 *
296 * Compute the pivoted L*L' or U'*U factorization
297 * of the matrix.
298 *
299  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
300  srnamt = 'DPSTRF'
301 *
302 * Use default tolerance
303 *
304  tol = -one
305  CALL dpstrf( uplo, n, afac, lda, piv, comprank,
306  \$ tol, work, info )
307 *
308 * Check error code from DPSTRF.
309 *
310  IF( (info.LT.izero)
311  \$ .OR.(info.NE.izero.AND.rank.EQ.n)
312  \$ .OR.(info.LE.izero.AND.rank.LT.n) ) THEN
313  CALL alaerh( path, 'DPSTRF', info, izero,
314  \$ uplo, n, n, -1, -1, nb, imat,
315  \$ nfail, nerrs, nout )
316  GO TO 110
317  END IF
318 *
319 * Skip the test if INFO is not 0.
320 *
321  IF( info.NE.0 )
322  \$ GO TO 110
323 *
324 * Reconstruct matrix from factors and compute residual.
325 *
326 * PERM holds permuted L*L^T or U^T*U
327 *
328  CALL dpst01( uplo, n, a, lda, afac, lda, perm, lda,
329  \$ piv, rwork, result, comprank )
330 *
331 * Print information about the tests that did not pass
332 * the threshold or where computed rank was not RANK.
333 *
334  IF( n.EQ.0 )
335  \$ comprank = 0
336  rankdiff = rank - comprank
337  IF( result.GE.thresh ) THEN
338  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
339  \$ CALL alahd( nout, path )
340  WRITE( nout, fmt = 9999 )uplo, n, rank,
341  \$ rankdiff, nb, imat, result
342  nfail = nfail + 1
343  END IF
344  nrun = nrun + 1
345  110 CONTINUE
346 *
347  120 CONTINUE
348  130 CONTINUE
349  140 CONTINUE
350  150 CONTINUE
351 *
352 * Print a summary of the results.
353 *
354  CALL alasum( path, nout, nfail, nrun, nerrs )
355 *
356  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', RANK =', i3,
357  \$ ', Diff =', i5, ', NB =', i4, ', type ', i2, ', Ratio =',
358  \$ g12.5 )
359  RETURN
360 *
361 * End of DCHKPS
362 *
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine dpstrf(UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO)
DPSTRF computes the Cholesky factorization with complete pivoting of a real symmetric positive semide...
Definition: dpstrf.f:144
subroutine dpst01(UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
DPST01
Definition: dpst01.f:136
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
subroutine dlatb5(PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB5
Definition: dlatb5.f:116
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine derrps(PATH, NUNIT)
DERRPS
Definition: derrps.f:57
subroutine dlatmt(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RANK, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMT
Definition: dlatmt.f:333
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
Here is the call graph for this function:
Here is the caller graph for this function: