LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zchksy_aa()

subroutine zchksy_aa ( logical, dimension( * )  DOTYPE,
integer  NN,
integer, dimension( * )  NVAL,
integer  NNB,
integer, dimension( * )  NBVAL,
integer  NNS,
integer, dimension( * )  NSVAL,
double precision  THRESH,
logical  TSTERR,
integer  NMAX,
complex*16, dimension( * )  A,
complex*16, dimension( * )  AFAC,
complex*16, dimension( * )  AINV,
complex*16, dimension( * )  B,
complex*16, dimension( * )  X,
complex*16, dimension( * )  XACT,
complex*16, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZCHKSY_AA

Purpose:
 ZCHKSY_AA tests ZSYTRF_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 DOUBLE PRECISION
          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 COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is COMPLEX*16 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 173 of file zchksy_aa.f.

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