LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine schksy_aa ( 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 
)

SCHKSY_AA

Purpose: 
 SCHKSY_AA tests SSYTRF_AA, -TRS_AA.
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 (2*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
December 2016

Definition at line 174 of file schksy_aa.f.

174 *
175 * -- LAPACK test routine (version 3.7.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 * December 2016
179 *
180  IMPLICIT NONE
181 *
182 * .. Scalar Arguments ..
183  LOGICAL tsterr
184  INTEGER nn, nnb, nns, nmax, nout
185  REAL thresh
186 * ..
187 * .. Array Arguments ..
188  LOGICAL dotype( * )
189  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
190  REAL a( * ), afac( * ), ainv( * ), b( * ),
191  $ rwork( * ), work( * ), x( * ), xact( * )
192 * ..
193 *
194 * =====================================================================
195 *
196 * .. Parameters ..
197  REAL zero
198  parameter ( zero = 0.0e+0 )
199  INTEGER ntypes
200  parameter ( ntypes = 10 )
201  INTEGER ntests
202  parameter ( ntests = 9 )
203 * ..
204 * .. Local Scalars ..
205  LOGICAL zerot
206  CHARACTER dist, TYPE, uplo, xtype
207  CHARACTER*3 path, matpath
208  INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
209  $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
210  $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211  REAL anorm, cndnum
212 * ..
213 * .. Local Arrays ..
214  CHARACTER uplos( 2 )
215  INTEGER iseed( 4 ), iseedy( 4 )
216  REAL result( ntests )
217 * ..
218 * .. External Functions ..
219  REAL dget06, slansy
220  EXTERNAL dget06, slansy
221 * ..
222 * .. External Subroutines ..
223  EXTERNAL alaerh, alahd, alasum, serrsy, sget04, slacpy,
224  $ slarhs, slatb4, slatms, spot02, dpot03, dpot05,
225  $ dsycon, ssyrfs, ssyt01_aa, ssytrf_aa,
226  $ dsytri2, ssytrs_aa, xlaenv
227 * ..
228 * .. Intrinsic Functions ..
229  INTRINSIC max, min
230 * ..
231 * .. Scalars in Common ..
232  LOGICAL lerr, ok
233  CHARACTER*32 srnamt
234  INTEGER infot, nunit
235 * ..
236 * .. Common blocks ..
237  COMMON / infoc / infot, nunit, ok, lerr
238  COMMON / srnamc / srnamt
239 * ..
240 * .. Data statements ..
241  DATA iseedy / 1988, 1989, 1990, 1991 /
242  DATA uplos / 'U', 'L' /
243 * ..
244 * .. Executable Statements ..
245 *
246 * Initialize constants and the random number seed.
247 *
248 *
249 * Test path
250 *
251  path( 1: 1 ) = 'Single precision'
252  path( 2: 3 ) = 'SA'
253 *
254 * Path to generate matrices
255 *
256  matpath( 1: 1 ) = 'Single precision'
257  matpath( 2: 3 ) = 'SY'
258  nrun = 0
259  nfail = 0
260  nerrs = 0
261  DO 10 i = 1, 4
262  iseed( i ) = iseedy( i )
263  10 CONTINUE
264 *
265 * Test the error exits
266 *
267  IF( tsterr )
268  $ CALL serrsy( path, nout )
269  infot = 0
270 *
271 * Set the minimum block size for which the block routine should
272 * be used, which will be later returned by ILAENV
273 *
274  CALL xlaenv( 2, 2 )
275 *
276 * Do for each value of N in NVAL
277 *
278  DO 180 in = 1, nn
279  n = nval( in )
280  IF( n .GT. nmax ) THEN
281  nfail = nfail + 1
282  WRITE(nout, 9995) 'M ', n, nmax
283  GO TO 180
284  END IF
285  lda = max( n, 1 )
286  xtype = 'N'
287  nimat = ntypes
288  IF( n.LE.0 )
289  $ nimat = 1
290 *
291  izero = 0
292 *
293 * Do for each value of matrix type IMAT
294 *
295  DO 170 imat = 1, nimat
296 *
297 * Do the tests only if DOTYPE( IMAT ) is true.
298 *
299  IF( .NOT.dotype( imat ) )
300  $ GO TO 170
301 *
302 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
303 *
304  zerot = imat.GE.3 .AND. imat.LE.6
305  IF( zerot .AND. n.LT.imat-2 )
306  $ GO TO 170
307 *
308 * Do first for UPLO = 'U', then for UPLO = 'L'
309 *
310  DO 160 iuplo = 1, 2
311  uplo = uplos( iuplo )
312 *
313 * Begin generate the test matrix A.
314 *
315 *
316 * Set up parameters with SLATB4 for the matrix generator
317 * based on the type of matrix to be generated.
318 *
319  CALL slatb4( matpath, imat, n, n, TYPE, kl, ku,
320  $ anorm, mode, cndnum, dist )
321 *
322 * Generate a matrix with SLATMS.
323 *
324  srnamt = 'SLATMS'
325  CALL slatms( n, n, dist, iseed, TYPE, rwork, mode,
326  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
327  $ info )
328 *
329 * Check error code from SLATMS and handle error.
330 *
331  IF( info.NE.0 ) THEN
332  CALL alaerh( path, 'SLATMS', info, 0, uplo, n, n, -1,
333  $ -1, -1, imat, nfail, nerrs, nout )
334 *
335 * Skip all tests for this generated matrix
336 *
337  GO TO 160
338  END IF
339 *
340 * For matrix types 3-6, zero one or more rows and
341 * columns of the matrix to test that INFO is returned
342 * correctly.
343 *
344  IF( zerot ) THEN
345  IF( imat.EQ.3 ) THEN
346  izero = 1
347  ELSE IF( imat.EQ.4 ) THEN
348  izero = n
349  ELSE
350  izero = n / 2 + 1
351  END IF
352 *
353  IF( imat.LT.6 ) THEN
354 *
355 * Set row and column IZERO to zero.
356 *
357  IF( iuplo.EQ.1 ) THEN
358  ioff = ( izero-1 )*lda
359  DO 20 i = 1, izero - 1
360  a( ioff+i ) = zero
361  20 CONTINUE
362  ioff = ioff + izero
363  DO 30 i = izero, n
364  a( ioff ) = zero
365  ioff = ioff + lda
366  30 CONTINUE
367  ELSE
368  ioff = izero
369  DO 40 i = 1, izero - 1
370  a( ioff ) = zero
371  ioff = ioff + lda
372  40 CONTINUE
373  ioff = ioff - izero
374  DO 50 i = izero, n
375  a( ioff+i ) = zero
376  50 CONTINUE
377  END IF
378  ELSE
379  IF( iuplo.EQ.1 ) THEN
380 *
381 * Set the first IZERO rows and columns to zero.
382 *
383  ioff = 0
384  DO 70 j = 1, n
385  i2 = min( j, izero )
386  DO 60 i = 1, i2
387  a( ioff+i ) = zero
388  60 CONTINUE
389  ioff = ioff + lda
390  70 CONTINUE
391  izero = 1
392  ELSE
393 *
394 * Set the last IZERO rows and columns to zero.
395 *
396  ioff = 0
397  DO 90 j = 1, n
398  i1 = max( j, izero )
399  DO 80 i = i1, n
400  a( ioff+i ) = zero
401  80 CONTINUE
402  ioff = ioff + lda
403  90 CONTINUE
404  END IF
405  END IF
406  ELSE
407  izero = 0
408  END IF
409 *
410 * End generate the test matrix A.
411 *
412 * Do for each value of NB in NBVAL
413 *
414  DO 150 inb = 1, nnb
415 *
416 * Set the optimal blocksize, which will be later
417 * returned by ILAENV.
418 *
419  nb = nbval( inb )
420  CALL xlaenv( 1, nb )
421 *
422 * Copy the test matrix A into matrix AFAC which
423 * will be factorized in place. This is needed to
424 * preserve the test matrix A for subsequent tests.
425 *
426  CALL slacpy( uplo, n, n, a, lda, afac, lda )
427 *
428 * Compute the L*D*L**T or U*D*U**T factorization of the
429 * matrix. IWORK stores details of the interchanges and
430 * the block structure of D. AINV is a work array for
431 * block factorization, LWORK is the length of AINV.
432 *
433  srnamt = 'SSYTRF_AA'
434  lwork = max( 1, n*nb + n )
435  CALL ssytrf_aa( uplo, n, afac, lda, iwork, ainv,
436  $ lwork, info )
437 *
438 * Adjust the expected value of INFO to account for
439 * pivoting.
440 *
441  IF( izero.GT.0 ) THEN
442  j = 1
443  k = izero
444  100 CONTINUE
445  IF( j.EQ.k ) THEN
446  k = iwork( j )
447  ELSE IF( iwork( j ).EQ.k ) THEN
448  k = j
449  END IF
450  IF( j.LT.k ) THEN
451  j = j + 1
452  GO TO 100
453  END IF
454  ELSE
455  k = 0
456  END IF
457 *
458 * Check error code from SSYTRF and handle error.
459 *
460  IF( info.NE.k ) THEN
461  CALL alaerh( path, 'SSYTRF_AA', info, k, uplo,
462  $ n, n, -1, -1, nb, imat, nfail, nerrs,
463  $ nout )
464  END IF
465 *
466 *+ TEST 1
467 * Reconstruct matrix from factors and compute residual.
468 *
469  CALL ssyt01_aa( uplo, n, a, lda, afac, lda, iwork,
470  $ ainv, lda, rwork, result( 1 ) )
471  nt = 1
472 *
473 *
474 * Print information about the tests that did not pass
475 * the threshold.
476 *
477  DO 110 k = 1, nt
478  IF( result( k ).GE.thresh ) THEN
479  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
480  $ CALL alahd( nout, path )
481  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
482  $ result( k )
483  nfail = nfail + 1
484  END IF
485  110 CONTINUE
486  nrun = nrun + nt
487 *
488 * Skip solver test if INFO is not 0.
489 *
490  IF( info.NE.0 ) THEN
491  GO TO 140
492  END IF
493 *
494 * Do for each value of NRHS in NSVAL.
495 *
496  DO 130 irhs = 1, nns
497  nrhs = nsval( irhs )
498 *
499 *+ TEST 2 (Using TRS)
500 * Solve and compute residual for A * X = B.
501 *
502 * Choose a set of NRHS random solution vectors
503 * stored in XACT and set up the right hand side B
504 *
505  srnamt = 'SLARHS'
506  CALL slarhs( matpath, xtype, uplo, ' ', n, n,
507  $ kl, ku, nrhs, a, lda, xact, lda,
508  $ b, lda, iseed, info )
509  CALL slacpy( 'Full', n, nrhs, b, lda, x, lda )
510 *
511  srnamt = 'SSYTRS_AA'
512  lwork = max( 1, 3*n-2 )
513  CALL ssytrs_aa( uplo, n, nrhs, afac, lda,
514  $ iwork, x, lda, work, lwork,
515  $ info )
516 *
517 * Check error code from SSYTRS and handle error.
518 *
519  IF( info.NE.0 ) THEN
520  CALL alaerh( path, 'SSYTRS_AA', info, 0,
521  $ uplo, n, n, -1, -1, nrhs, imat,
522  $ nfail, nerrs, nout )
523  END IF
524 *
525  CALL slacpy( 'Full', n, nrhs, b, lda, work, lda )
526 *
527 * Compute the residual for the solution
528 *
529  CALL spot02( uplo, n, nrhs, a, lda, x, lda, work,
530  $ lda, rwork, result( 2 ) )
531 *
532 *
533 * Print information about the tests that did not pass
534 * the threshold.
535 *
536  DO 120 k = 2, 2
537  IF( result( k ).GE.thresh ) THEN
538  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
539  $ CALL alahd( nout, path )
540  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
541  $ imat, k, result( k )
542  nfail = nfail + 1
543  END IF
544  120 CONTINUE
545  nrun = nrun + 1
546 *
547 * End do for each value of NRHS in NSVAL.
548 *
549  130 CONTINUE
550  140 CONTINUE
551  150 CONTINUE
552  160 CONTINUE
553  170 CONTINUE
554  180 CONTINUE
555 *
556 * Print a summary of the results.
557 *
558  CALL alasum( path, nout, nfail, nrun, nerrs )
559 *
560  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
561  $ i2, ', test ', i2, ', ratio =', g12.5 )
562  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
563  $ i2, ', test(', i2, ') =', g12.5 )
564  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
565  $ i6 )
566  RETURN
567 *
568 * End of SCHKSY_AA
569 *
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
ssytrf_aa
subroutine ssytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_AA
Definition: ssytrf_aa.f:138
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
ssyt01_aa
subroutine ssyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
SSYT01_AA
Definition: ssyt01_aa.f:127
dsytri2
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
Definition: dsytri2.f:129
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
dsycon
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
Definition: dsycon.f:132
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
slatms
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
Definition: slatms.f:323
dpot03
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
Definition: dpot03.f:127
sget04
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
Definition: sget04.f:104
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
serrsy
subroutine serrsy(PATH, NUNIT)
SERRSY
Definition: serrsy.f:57
dpot05
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
Definition: dpot05.f:166
spot02
subroutine spot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
SPOT02
Definition: spot02.f:129
ssytrs_aa
subroutine ssytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYTRS_AA
Definition: ssytrs_aa.f:131
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
ssyrfs
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
Definition: ssyrfs.f:193
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: