LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ schksy_aa()

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
November 2017

Definition at line 172 of file schksy_aa.f.

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