LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ dchkpo()

subroutine dchkpo ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
double precision, dimension( * )  A,
double precision, dimension( * )  AFAC,
double precision, dimension( * )  AINV,
double precision, dimension( * )  B,
double precision, dimension( * )  X,
double precision, dimension( * )  XACT,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DCHKPO

Purpose:
 DCHKPO tests DPOTRF, -TRI, -TRS, -RFS, and -CON
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 (NNB)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[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]AINV
          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension
                      (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 169 of file dchkpo.f.

172 *
173 * -- LAPACK test routine --
174 * -- LAPACK is a software package provided by Univ. of Tennessee, --
175 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
176 *
177 * .. Scalar Arguments ..
178  LOGICAL TSTERR
179  INTEGER NMAX, NN, NNB, NNS, NOUT
180  DOUBLE PRECISION THRESH
181 * ..
182 * .. Array Arguments ..
183  LOGICAL DOTYPE( * )
184  INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
185  DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
186  $ RWORK( * ), WORK( * ), X( * ), XACT( * )
187 * ..
188 *
189 * =====================================================================
190 *
191 * .. Parameters ..
192  DOUBLE PRECISION ZERO
193  parameter( zero = 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, DLANSY
215  EXTERNAL dget06, dlansy
216 * ..
217 * .. External Subroutines ..
218  EXTERNAL alaerh, alahd, alasum, derrpo, dget04, dlacpy,
219  $ dlarhs, dlatb4, dlatms, dpocon, dporfs, dpot01,
220  $ dpot02, dpot03, dpot05, dpotrf, dpotri, dpotrs,
221  $ xlaenv
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 ) = 'Double 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 derrpo( path, nout )
256  infot = 0
257  CALL xlaenv( 2, 2 )
258 *
259 * Do for each value of N in NVAL
260 *
261  DO 120 in = 1, nn
262  n = nval( in )
263  lda = max( n, 1 )
264  xtype = 'N'
265  nimat = ntypes
266  IF( n.LE.0 )
267  $ nimat = 1
268 *
269  izero = 0
270  DO 110 imat = 1, nimat
271 *
272 * Do the tests only if DOTYPE( IMAT ) is true.
273 *
274  IF( .NOT.dotype( imat ) )
275  $ GO TO 110
276 *
277 * Skip types 3, 4, or 5 if the matrix size is too small.
278 *
279  zerot = imat.GE.3 .AND. imat.LE.5
280  IF( zerot .AND. n.LT.imat-2 )
281  $ GO TO 110
282 *
283 * Do first for UPLO = 'U', then for UPLO = 'L'
284 *
285  DO 100 iuplo = 1, 2
286  uplo = uplos( iuplo )
287 *
288 * Set up parameters with DLATB4 and generate a test matrix
289 * with DLATMS.
290 *
291  CALL dlatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
292  $ CNDNUM, DIST )
293 *
294  srnamt = 'DLATMS'
295  CALL dlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
296  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
297  $ INFO )
298 *
299 * Check error code from DLATMS.
300 *
301  IF( info.NE.0 ) THEN
302  CALL alaerh( path, 'DLATMS', info, 0, uplo, n, n, -1,
303  $ -1, -1, imat, nfail, nerrs, nout )
304  GO TO 100
305  END IF
306 *
307 * For types 3-5, zero one row and column of the matrix to
308 * test that INFO is returned correctly.
309 *
310  IF( zerot ) THEN
311  IF( imat.EQ.3 ) THEN
312  izero = 1
313  ELSE IF( imat.EQ.4 ) THEN
314  izero = n
315  ELSE
316  izero = n / 2 + 1
317  END IF
318  ioff = ( izero-1 )*lda
319 *
320 * Set row and column IZERO of A to 0.
321 *
322  IF( iuplo.EQ.1 ) THEN
323  DO 20 i = 1, izero - 1
324  a( ioff+i ) = zero
325  20 CONTINUE
326  ioff = ioff + izero
327  DO 30 i = izero, n
328  a( ioff ) = zero
329  ioff = ioff + lda
330  30 CONTINUE
331  ELSE
332  ioff = izero
333  DO 40 i = 1, izero - 1
334  a( ioff ) = zero
335  ioff = ioff + lda
336  40 CONTINUE
337  ioff = ioff - izero
338  DO 50 i = izero, n
339  a( ioff+i ) = zero
340  50 CONTINUE
341  END IF
342  ELSE
343  izero = 0
344  END IF
345 *
346 * Do for each value of NB in NBVAL
347 *
348  DO 90 inb = 1, nnb
349  nb = nbval( inb )
350  CALL xlaenv( 1, nb )
351 *
352 * Compute the L*L' or U'*U factorization of the matrix.
353 *
354  CALL dlacpy( uplo, n, n, a, lda, afac, lda )
355  srnamt = 'DPOTRF'
356  CALL dpotrf( uplo, n, afac, lda, info )
357 *
358 * Check error code from DPOTRF.
359 *
360  IF( info.NE.izero ) THEN
361  CALL alaerh( path, 'DPOTRF', info, izero, uplo, n,
362  $ n, -1, -1, nb, imat, nfail, nerrs,
363  $ nout )
364  GO TO 90
365  END IF
366 *
367 * Skip the tests if INFO is not 0.
368 *
369  IF( info.NE.0 )
370  $ GO TO 90
371 *
372 *+ TEST 1
373 * Reconstruct matrix from factors and compute residual.
374 *
375  CALL dlacpy( uplo, n, n, afac, lda, ainv, lda )
376  CALL dpot01( uplo, n, a, lda, ainv, lda, rwork,
377  $ result( 1 ) )
378 *
379 *+ TEST 2
380 * Form the inverse and compute the residual.
381 *
382  CALL dlacpy( uplo, n, n, afac, lda, ainv, lda )
383  srnamt = 'DPOTRI'
384  CALL dpotri( uplo, n, ainv, lda, info )
385 *
386 * Check error code from DPOTRI.
387 *
388  IF( info.NE.0 )
389  $ CALL alaerh( path, 'DPOTRI', info, 0, uplo, n, n,
390  $ -1, -1, -1, imat, nfail, nerrs, nout )
391 *
392  CALL dpot03( uplo, n, a, lda, ainv, lda, work, lda,
393  $ rwork, rcondc, result( 2 ) )
394 *
395 * Print information about the tests that did not pass
396 * the threshold.
397 *
398  DO 60 k = 1, 2
399  IF( result( k ).GE.thresh ) THEN
400  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
401  $ CALL alahd( nout, path )
402  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
403  $ result( k )
404  nfail = nfail + 1
405  END IF
406  60 CONTINUE
407  nrun = nrun + 2
408 *
409 * Skip the rest of the tests unless this is the first
410 * blocksize.
411 *
412  IF( inb.NE.1 )
413  $ GO TO 90
414 *
415  DO 80 irhs = 1, nns
416  nrhs = nsval( irhs )
417 *
418 *+ TEST 3
419 * Solve and compute residual for A * X = B .
420 *
421  srnamt = 'DLARHS'
422  CALL dlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
423  $ nrhs, a, lda, xact, lda, b, lda,
424  $ iseed, info )
425  CALL dlacpy( 'Full', n, nrhs, b, lda, x, lda )
426 *
427  srnamt = 'DPOTRS'
428  CALL dpotrs( uplo, n, nrhs, afac, lda, x, lda,
429  $ info )
430 *
431 * Check error code from DPOTRS.
432 *
433  IF( info.NE.0 )
434  $ CALL alaerh( path, 'DPOTRS', info, 0, uplo, n,
435  $ n, -1, -1, nrhs, imat, nfail,
436  $ nerrs, nout )
437 *
438  CALL dlacpy( 'Full', n, nrhs, b, lda, work, lda )
439  CALL dpot02( uplo, n, nrhs, a, lda, x, lda, work,
440  $ lda, rwork, result( 3 ) )
441 *
442 *+ TEST 4
443 * Check solution from generated exact solution.
444 *
445  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
446  $ result( 4 ) )
447 *
448 *+ TESTS 5, 6, and 7
449 * Use iterative refinement to improve the solution.
450 *
451  srnamt = 'DPORFS'
452  CALL dporfs( uplo, n, nrhs, a, lda, afac, lda, b,
453  $ lda, x, lda, rwork, rwork( nrhs+1 ),
454  $ work, iwork, info )
455 *
456 * Check error code from DPORFS.
457 *
458  IF( info.NE.0 )
459  $ CALL alaerh( path, 'DPORFS', info, 0, uplo, n,
460  $ n, -1, -1, nrhs, imat, nfail,
461  $ nerrs, nout )
462 *
463  CALL dget04( n, nrhs, x, lda, xact, lda, rcondc,
464  $ result( 5 ) )
465  CALL dpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
466  $ xact, lda, rwork, rwork( nrhs+1 ),
467  $ result( 6 ) )
468 *
469 * Print information about the tests that did not pass
470 * the threshold.
471 *
472  DO 70 k = 3, 7
473  IF( result( k ).GE.thresh ) THEN
474  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
475  $ CALL alahd( nout, path )
476  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
477  $ imat, k, result( k )
478  nfail = nfail + 1
479  END IF
480  70 CONTINUE
481  nrun = nrun + 5
482  80 CONTINUE
483 *
484 *+ TEST 8
485 * Get an estimate of RCOND = 1/CNDNUM.
486 *
487  anorm = dlansy( '1', uplo, n, a, lda, rwork )
488  srnamt = 'DPOCON'
489  CALL dpocon( uplo, n, afac, lda, anorm, rcond, work,
490  $ iwork, info )
491 *
492 * Check error code from DPOCON.
493 *
494  IF( info.NE.0 )
495  $ CALL alaerh( path, 'DPOCON', info, 0, uplo, n, n,
496  $ -1, -1, -1, imat, nfail, nerrs, nout )
497 *
498  result( 8 ) = dget06( rcond, rcondc )
499 *
500 * Print the test ratio if it is .GE. THRESH.
501 *
502  IF( result( 8 ).GE.thresh ) THEN
503  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
504  $ CALL alahd( nout, path )
505  WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
506  $ result( 8 )
507  nfail = nfail + 1
508  END IF
509  nrun = nrun + 1
510  90 CONTINUE
511  100 CONTINUE
512  110 CONTINUE
513  120 CONTINUE
514 *
515 * Print a summary of the results.
516 *
517  CALL alasum( path, nout, nfail, nrun, nerrs )
518 *
519  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
520  $ i2, ', test ', i2, ', ratio =', g12.5 )
521  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
522  $ i2, ', test(', i2, ') =', g12.5 )
523  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
524  $ ', test(', i2, ') =', g12.5 )
525  RETURN
526 *
527 * End of DCHKPO
528 *
dlacpy
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:103
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:73
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
dlarhs
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:205
dget04
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:102
dpot01
subroutine dpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
DPOT01
Definition: dpot01.f:104
derrpo
subroutine derrpo(PATH, NUNIT)
DERRPO
Definition: derrpo.f:55
dpot02
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
Definition: dpot02.f:127
dpot03
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
Definition: dpot03.f:125
dlatb4
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:120
dpot05
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
Definition: dpot05.f:164
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:55
dlatms
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:321
dporfs
subroutine dporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPORFS
Definition: dporfs.f:183
dpotrs
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
Definition: dpotrs.f:110
dpotrf
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
Definition: dpotrf.f:107
dpocon
subroutine dpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DPOCON
Definition: dpocon.f:121
dpotri
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI
Definition: dpotri.f:95
dlansy
double precision function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: dlansy.f:122
Here is the call graph for this function:
Here is the caller graph for this function: