LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine cchksy_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,
complex, dimension( * )  A,
complex, dimension( * )  AFAC,
complex, dimension( * )  AINV,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKSY_AA

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

Here is the call graph for this function:

Here is the caller graph for this function: