LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine schkpo ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
real  THRESH,
logical  TSTERR,
integer  NMAX,
real, dimension( * )  A,
real, dimension( * )  AFAC,
real, dimension( * )  AINV,
real, dimension( * )  B,
real, dimension( * )  X,
real, dimension( * )  XACT,
real, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

SCHKPO

Purpose: 
 SCHKPO tests SPOTRF, -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 REAL
          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 REAL array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is REAL array, dimension (NMAX*NMAX)
[out]AINV
          AINV is REAL array, dimension (NMAX*NMAX)
[out]B
          B is REAL array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is REAL array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is REAL array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is REAL array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL 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 schkpo.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  REAL thresh
184 * ..
185 * .. Array Arguments ..
186  LOGICAL dotype( * )
187  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188  REAL a( * ), afac( * ), ainv( * ), b( * ),
189  $ rwork( * ), work( * ), x( * ), xact( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL zero
196  parameter ( zero = 0.0e+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  REAL anorm, cndnum, rcond, rcondc
210 * ..
211 * .. Local Arrays ..
212  CHARACTER uplos( 2 )
213  INTEGER iseed( 4 ), iseedy( 4 )
214  REAL result( ntests )
215 * ..
216 * .. External Functions ..
217  REAL sget06, slansy
218  EXTERNAL sget06, slansy
219 * ..
220 * .. External Subroutines ..
221  EXTERNAL alaerh, alahd, alasum, serrpo, sget04, slacpy,
222  $ slarhs, slatb4, slatms, spocon, sporfs, spot01,
223  $ spot02, spot03, spot05, spotrf, spotri, spotrs,
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 ) = 'Single 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 serrpo( 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 SLATB4 and generate a test matrix
292 * with SLATMS.
293 *
294  CALL slatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
295  $ cndnum, dist )
296 *
297  srnamt = 'SLATMS'
298  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode,
299  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
300  $ info )
301 *
302 * Check error code from SLATMS.
303 *
304  IF( info.NE.0 ) THEN
305  CALL alaerh( path, 'SLATMS', 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 slacpy( uplo, n, n, a, lda, afac, lda )
358  srnamt = 'SPOTRF'
359  CALL spotrf( uplo, n, afac, lda, info )
360 *
361 * Check error code from SPOTRF.
362 *
363  IF( info.NE.izero ) THEN
364  CALL alaerh( path, 'SPOTRF', 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 slacpy( uplo, n, n, afac, lda, ainv, lda )
379  CALL spot01( 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 slacpy( uplo, n, n, afac, lda, ainv, lda )
386  srnamt = 'SPOTRI'
387  CALL spotri( uplo, n, ainv, lda, info )
388 *
389 * Check error code from SPOTRI.
390 *
391  IF( info.NE.0 )
392  $ CALL alaerh( path, 'SPOTRI', info, 0, uplo, n, n,
393  $ -1, -1, -1, imat, nfail, nerrs, nout )
394 *
395  CALL spot03( 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 = 'SLARHS'
425  CALL slarhs( path, xtype, uplo, ' ', n, n, kl, ku,
426  $ nrhs, a, lda, xact, lda, b, lda,
427  $ iseed, info )
428  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
429 *
430  srnamt = 'SPOTRS'
431  CALL spotrs( uplo, n, nrhs, afac, lda, x, lda,
432  $ info )
433 *
434 * Check error code from SPOTRS.
435 *
436  IF( info.NE.0 )
437  $ CALL alaerh( path, 'SPOTRS', info, 0, uplo, n,
438  $ n, -1, -1, nrhs, imat, nfail,
439  $ nerrs, nout )
440 *
441  CALL slacpy( 'Full', n, nrhs, b, lda, work, lda )
442  CALL spot02( 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 sget04( 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 = 'SPORFS'
455  CALL sporfs( 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 SPORFS.
460 *
461  IF( info.NE.0 )
462  $ CALL alaerh( path, 'SPORFS', info, 0, uplo, n,
463  $ n, -1, -1, nrhs, imat, nfail,
464  $ nerrs, nout )
465 *
466  CALL sget04( n, nrhs, x, lda, xact, lda, rcondc,
467  $ result( 5 ) )
468  CALL spot05( 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 = slansy( '1', uplo, n, a, lda, rwork )
491  srnamt = 'SPOCON'
492  CALL spocon( uplo, n, afac, lda, anorm, rcond, work,
493  $ iwork, info )
494 *
495 * Check error code from SPOCON.
496 *
497  IF( info.NE.0 )
498  $ CALL alaerh( path, 'SPOCON', info, 0, uplo, n, n,
499  $ -1, -1, -1, imat, nfail, nerrs, nout )
500 *
501  result( 8 ) = sget06( 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 SCHKPO
531 *
sporfs
subroutine sporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPORFS
Definition: sporfs.f:185
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
slatb4
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4
Definition: slatb4.f:122
slarhs
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
Definition: slarhs.f:206
spot01
subroutine spot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
SPOT01
Definition: spot01.f:106
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
spot05
subroutine spot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SPOT05
Definition: spot05.f:166
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
slacpy
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
slatms
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
spotrf
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
Definition: spotrf.f:109
sget04
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
spot03
subroutine spot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
SPOT03
Definition: spot03.f:127
spotrs
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
Definition: spotrs.f:112
spocon
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
Definition: spocon.f:123
spot02
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
Definition: spot02.f:129
serrpo
subroutine serrpo(PATH, NUNIT)
SERRPO
Definition: serrpo.f:57
spotri
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
Definition: spotri.f:97
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
slansy
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY 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: slansy.f:124

Here is the call graph for this function:

Here is the caller graph for this function: