LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ cchksy_aa()

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

Definition at line 174 of file cchksy_aa.f.

174 *
175 * -- LAPACK test routine (version 3.8.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 2017
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 Subroutines ..
222  EXTERNAL alaerh, alahd, alasum, cerrsy, clacpy, clarhs,
223  $ clatb4, clatms, csyt02, csyt01_aa, csytrf_aa,
224  $ csytrs_aa, xlaenv
225 * ..
226 * .. Intrinsic Functions ..
227  INTRINSIC max, min
228 * ..
229 * .. Scalars in Common ..
230  LOGICAL LERR, OK
231  CHARACTER*32 SRNAMT
232  INTEGER INFOT, NUNIT
233 * ..
234 * .. Common blocks ..
235  COMMON / infoc / infot, nunit, ok, lerr
236  COMMON / srnamc / srnamt
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 * Test path
247 *
248  path( 1: 1 ) = 'Complex precision'
249  path( 2: 3 ) = 'SA'
250 *
251 * Path to generate matrices
252 *
253  matpath( 1: 1 ) = 'Complex precision'
254  matpath( 2: 3 ) = 'SY'
255  nrun = 0
256  nfail = 0
257  nerrs = 0
258  DO 10 i = 1, 4
259  iseed( i ) = iseedy( i )
260  10 CONTINUE
261 *
262 * Test the error exits
263 *
264  IF( tsterr )
265  $ CALL cerrsy( path, nout )
266  infot = 0
267 *
268 * Set the minimum block size for which the block routine should
269 * be used, which will be later returned by ILAENV
270 *
271  CALL xlaenv( 2, 2 )
272 *
273 * Do for each value of N in NVAL
274 *
275  DO 180 in = 1, nn
276  n = nval( in )
277  IF( n .GT. nmax ) THEN
278  nfail = nfail + 1
279  WRITE(nout, 9995) 'M ', n, nmax
280  GO TO 180
281  END IF
282  lda = max( n, 1 )
283  xtype = 'N'
284  nimat = ntypes
285  IF( n.LE.0 )
286  $ nimat = 1
287 *
288  izero = 0
289 *
290 * Do for each value of matrix type IMAT
291 *
292  DO 170 imat = 1, nimat
293 *
294 * Do the tests only if DOTYPE( IMAT ) is true.
295 *
296  IF( .NOT.dotype( imat ) )
297  $ GO TO 170
298 *
299 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
300 *
301  zerot = imat.GE.3 .AND. imat.LE.6
302  IF( zerot .AND. n.LT.imat-2 )
303  $ GO TO 170
304 *
305 * Do first for UPLO = 'U', then for UPLO = 'L'
306 *
307  DO 160 iuplo = 1, 2
308  uplo = uplos( iuplo )
309 *
310 * Begin generate the test matrix A.
311 *
312 *
313 * Set up parameters with CLATB4 for the matrix generator
314 * based on the type of matrix to be generated.
315 *
316  CALL clatb4( matpath, imat, n, n, TYPE, KL, KU,
317  $ ANORM, MODE, CNDNUM, DIST )
318 *
319 * Generate a matrix with CLATMS.
320 *
321  srnamt = 'CLATMS'
322  CALL clatms( n, n, dist, iseed, TYPE, RWORK, MODE,
323  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
324  $ INFO )
325 *
326 * Check error code from CLATMS and handle error.
327 *
328  IF( info.NE.0 ) THEN
329  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
330  $ -1, -1, imat, nfail, nerrs, nout )
331 *
332 * Skip all tests for this generated matrix
333 *
334  GO TO 160
335  END IF
336 *
337 * For matrix types 3-6, zero one or more rows and
338 * columns of the matrix to test that INFO is returned
339 * correctly.
340 *
341  IF( zerot ) THEN
342  IF( imat.EQ.3 ) THEN
343  izero = 1
344  ELSE IF( imat.EQ.4 ) THEN
345  izero = n
346  ELSE
347  izero = n / 2 + 1
348  END IF
349 *
350  IF( imat.LT.6 ) THEN
351 *
352 * Set row and column IZERO to zero.
353 *
354  IF( iuplo.EQ.1 ) THEN
355  ioff = ( izero-1 )*lda
356  DO 20 i = 1, izero - 1
357  a( ioff+i ) = czero
358  20 CONTINUE
359  ioff = ioff + izero
360  DO 30 i = izero, n
361  a( ioff ) = czero
362  ioff = ioff + lda
363  30 CONTINUE
364  ELSE
365  ioff = izero
366  DO 40 i = 1, izero - 1
367  a( ioff ) = czero
368  ioff = ioff + lda
369  40 CONTINUE
370  ioff = ioff - izero
371  DO 50 i = izero, n
372  a( ioff+i ) = czero
373  50 CONTINUE
374  END IF
375  ELSE
376  IF( iuplo.EQ.1 ) THEN
377 *
378 * Set the first IZERO rows and columns to zero.
379 *
380  ioff = 0
381  DO 70 j = 1, n
382  i2 = min( j, izero )
383  DO 60 i = 1, i2
384  a( ioff+i ) = czero
385  60 CONTINUE
386  ioff = ioff + lda
387  70 CONTINUE
388  izero = 1
389  ELSE
390 *
391 * Set the last IZERO rows and columns to zero.
392 *
393  ioff = 0
394  DO 90 j = 1, n
395  i1 = max( j, izero )
396  DO 80 i = i1, n
397  a( ioff+i ) = czero
398  80 CONTINUE
399  ioff = ioff + lda
400  90 CONTINUE
401  END IF
402  END IF
403  ELSE
404  izero = 0
405  END IF
406 *
407 * End generate the test matrix A.
408 *
409 * Do for each value of NB in NBVAL
410 *
411  DO 150 inb = 1, nnb
412 *
413 * Set the optimal blocksize, which will be later
414 * returned by ILAENV.
415 *
416  nb = nbval( inb )
417  CALL xlaenv( 1, nb )
418 *
419 * Copy the test matrix A into matrix AFAC which
420 * will be factorized in place. This is needed to
421 * preserve the test matrix A for subsequent tests.
422 *
423  CALL clacpy( uplo, n, n, a, lda, afac, lda )
424 *
425 * Compute the L*D*L**T or U*D*U**T factorization of the
426 * matrix. IWORK stores details of the interchanges and
427 * the block structure of D. AINV is a work array for
428 * block factorization, LWORK is the length of AINV.
429 *
430  srnamt = 'CSYTRF_AA'
431  lwork = max( 1, n*nb + n )
432  CALL csytrf_aa( uplo, n, afac, lda, iwork, ainv,
433  $ lwork, info )
434 *
435 * Adjust the expected value of INFO to account for
436 * pivoting.
437 *
438 c IF( IZERO.GT.0 ) THEN
439 c J = 1
440 c K = IZERO
441 c 100 CONTINUE
442 c IF( J.EQ.K ) THEN
443 c K = IWORK( J )
444 c ELSE IF( IWORK( J ).EQ.K ) THEN
445 c K = J
446 c END IF
447 c IF( J.LT.K ) THEN
448 c J = J + 1
449 c GO TO 100
450 c END IF
451 c ELSE
452  k = 0
453 c END IF
454 *
455 * Check error code from CSYTRF and handle error.
456 *
457  IF( info.NE.k ) THEN
458  CALL alaerh( path, 'CSYTRF_AA', info, k, uplo,
459  $ n, n, -1, -1, nb, imat, nfail, nerrs,
460  $ nout )
461  END IF
462 *
463 *+ TEST 1
464 * Reconstruct matrix from factors and compute residual.
465 *
466  CALL csyt01_aa( uplo, n, a, lda, afac, lda, iwork,
467  $ ainv, lda, rwork, result( 1 ) )
468  nt = 1
469 *
470 *
471 * Print information about the tests that did not pass
472 * the threshold.
473 *
474  DO 110 k = 1, nt
475  IF( result( k ).GE.thresh ) THEN
476  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
477  $ CALL alahd( nout, path )
478  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
479  $ result( k )
480  nfail = nfail + 1
481  END IF
482  110 CONTINUE
483  nrun = nrun + nt
484 *
485 * Skip solver test if INFO is not 0.
486 *
487  IF( info.NE.0 ) THEN
488  GO TO 140
489  END IF
490 *
491 * Do for each value of NRHS in NSVAL.
492 *
493  DO 130 irhs = 1, nns
494  nrhs = nsval( irhs )
495 *
496 *+ TEST 2 (Using TRS)
497 * Solve and compute residual for A * X = B.
498 *
499 * Choose a set of NRHS random solution vectors
500 * stored in XACT and set up the right hand side B
501 *
502  srnamt = 'CLARHS'
503  CALL clarhs( matpath, xtype, uplo, ' ', n, n,
504  $ kl, ku, nrhs, a, lda, xact, lda,
505  $ b, lda, iseed, info )
506  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
507 *
508  srnamt = 'CSYTRS_AA'
509  lwork = max( 1, 3*n-2 )
510  CALL csytrs_aa( uplo, n, nrhs, afac, lda,
511  $ iwork, x, lda, work, lwork,
512  $ info )
513 *
514 * Check error code from CSYTRS and handle error.
515 *
516  IF( info.NE.0 ) THEN
517  IF( izero.EQ.0 ) THEN
518  CALL alaerh( path, 'CSYTRS_AA', info, 0,
519  $ uplo, n, n, -1, -1, nrhs, imat,
520  $ nfail, nerrs, nout )
521  END IF
522  ELSE
523  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda
524  $ )
525 *
526 * Compute the residual for the solution
527 *
528  CALL csyt02( uplo, n, nrhs, a, lda, x, lda,
529  $ work, lda, rwork, result( 2 ) )
530 *
531 *
532 * Print information about the tests that did not pass
533 * the threshold.
534 *
535  DO 120 k = 2, 2
536  IF( result( k ).GE.thresh ) THEN
537  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
538  $ CALL alahd( nout, path )
539  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
540  $ imat, k, result( k )
541  nfail = nfail + 1
542  END IF
543  120 CONTINUE
544  END IF
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 CCHKSY_AA
569 *
Here is the call graph for this function:
Here is the caller graph for this function:
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
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
csytrf_aa
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
Definition: csytrf_aa.f:134
csyt01_aa
subroutine csyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
Definition: csyt01_aa.f:128
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
csytrs_aa
subroutine csytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYTRS_AA
Definition: csytrs_aa.f:133
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
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
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83