LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zchksy_aa_2stage()

subroutine zchksy_aa_2stage ( 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_2STAGE

Purpose:
 ZCHKSY_AA_2STAGE tests ZSYTRF_AA_2STAGE, -TRS_AA_2STAGE.
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 174 of file zchksy_aa_2stage.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  DOUBLE PRECISION THRESH
186 * ..
187 * .. Array Arguments ..
188  LOGICAL DOTYPE( * )
189  INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
190  DOUBLE PRECISION RWORK( * )
191  COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
192  $ WORK( * ), X( * ), XACT( * )
193 * ..
194 *
195 * =====================================================================
196 *
197 * .. Parameters ..
198  COMPLEX*16 CZERO
199  parameter( czero = ( 0.0d+0, 0.0d+0 ) )
200  INTEGER NTYPES
201  parameter( ntypes = 10 )
202  INTEGER NTESTS
203  parameter( ntests = 9 )
204 * ..
205 * .. Local Scalars ..
206  LOGICAL ZEROT
207  CHARACTER DIST, TYPE, UPLO, XTYPE
208  CHARACTER*3 PATH, MATPATH
209  INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
210  $ IUPLO, IZERO, J, K, KL, KU, LDA, LWORK, MODE,
211  $ N, NB, NERRS, NFAIL, NIMAT, NRHS, NRUN, NT
212  DOUBLE PRECISION ANORM, CNDNUM
213 * ..
214 * .. Local Arrays ..
215  CHARACTER UPLOS( 2 )
216  INTEGER ISEED( 4 ), ISEEDY( 4 )
217  DOUBLE PRECISION RESULT( NTESTS )
218 * ..
219 * .. External Subroutines ..
220  EXTERNAL alaerh, alahd, alasum, zerrsy, zlacpy, zlarhs,
221  $ zlatb4, zlatms, zsyt02, zsyt01,
222  $ zsytrf_aa_2stage, zsytrs_aa_2stage,
223  $ 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 ) = 'S2'
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_2STAGE'
430  lwork = min(n*nb, 3*nmax*nmax)
431  CALL zsytrf_aa_2stage( uplo, n, afac, lda,
432  $ ainv, (3*nb+1)*n,
433  $ iwork, iwork( 1+n ),
434  $ work, lwork,
435  $ info )
436 *
437 * Adjust the expected value of INFO to account for
438 * pivoting.
439 *
440  IF( izero.GT.0 ) THEN
441  j = 1
442  k = izero
443  100 CONTINUE
444  IF( j.EQ.k ) THEN
445  k = iwork( j )
446  ELSE IF( iwork( j ).EQ.k ) THEN
447  k = j
448  END IF
449  IF( j.LT.k ) THEN
450  j = j + 1
451  GO TO 100
452  END IF
453  ELSE
454  k = 0
455  END IF
456 *
457 * Check error code from ZSYTRF and handle error.
458 *
459  IF( info.NE.k ) THEN
460  CALL alaerh( path, 'ZSYTRF_AA_2STAGE', info, k,
461  $ uplo, n, n, -1, -1, nb, imat, nfail,
462  $ nerrs, nout )
463  END IF
464 *
465 *+ TEST 1
466 * Reconstruct matrix from factors and compute residual.
467 *
468 c CALL ZSYT01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
469 c $ AINV, LDA, RWORK, RESULT( 1 ) )
470 c NT = 1
471  nt = 0
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 = 'ZLARHS'
506  CALL zlarhs( matpath, xtype, uplo, ' ', n, n,
507  $ kl, ku, nrhs, a, lda, xact, lda,
508  $ b, lda, iseed, info )
509  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
510 *
511  srnamt = 'ZSYTRS_AA_2STAGE'
512  lwork = max( 1, 3*n-2 )
513  CALL zsytrs_aa_2stage( uplo, n, nrhs, afac, lda,
514  $ ainv, (3*nb+1)*n, iwork, iwork( 1+n ),
515  $ x, lda, info )
516 *
517 * Check error code from ZSYTRS and handle error.
518 *
519  IF( info.NE.0 ) THEN
520  IF( izero.EQ.0 ) THEN
521  CALL alaerh( path, 'ZSYTRS_AA_2STAGE',
522  $ info, 0, uplo, n, n, -1, -1,
523  $ nrhs, imat, nfail, nerrs, nout )
524  END IF
525  ELSE
526  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda
527  $ )
528 *
529 * Compute the residual for the solution
530 *
531  CALL zsyt02( uplo, n, nrhs, a, lda, x, lda,
532  $ work, 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  END IF
548  nrun = nrun + 1
549 *
550 * End do for each value of NRHS in NSVAL.
551 *
552  130 CONTINUE
553  140 CONTINUE
554  150 CONTINUE
555  160 CONTINUE
556  170 CONTINUE
557  180 CONTINUE
558 *
559 * Print a summary of the results.
560 *
561  CALL alasum( path, nout, nfail, nrun, nerrs )
562 *
563  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
564  $ i2, ', test ', i2, ', ratio =', g12.5 )
565  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
566  $ i2, ', test(', i2, ') =', g12.5 )
567  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
568  $ i6 )
569  RETURN
570 *
571 * End of ZCHKSY_AA_2STAGE
572 *
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
zsytrs_aa_2stage
subroutine zsytrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
ZSYTRS_AA_2STAGE
Definition: zsytrs_aa_2stage.f:141
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
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
zsytrf_aa_2stage
subroutine zsytrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
ZSYTRF_AA_2STAGE
Definition: zsytrf_aa_2stage.f:162
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
zsyt01
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
Definition: zsyt01.f:127
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