LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 (NBVAL)
          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.
Date
November 2011

Definition at line 174 of file dchkpo.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: