LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ zchkhe_aa_2stage()

subroutine zchkhe_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,
complex*16, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

ZCHKHE_AA_2STAGE

Purpose:
 ZCHKSY_AA_2STAGE tests ZHETRF_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 DOUBLE PRECISION 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 zchkhe_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  COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
191  $ RWORK( * ), 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, zerrhe, zlacpy,
222  $ zlarhs, zlatb4, zlatms, zpot02,
223  $ zhetrf_aa_2stage, zhetrs_aa_2stage,
224  $ 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 ) = 'Zomplex precision'
249  path( 2: 3 ) = 'H2'
250 *
251 * Path to generate matrices
252 *
253  matpath( 1: 1 ) = 'Zomplex precision'
254  matpath( 2: 3 ) = 'HE'
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 zerrhe( 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 ZLATB4 for the matrix generator
314 * based on the type of matrix to be generated.
315 *
316  CALL zlatb4( matpath, imat, n, n, TYPE, KL, KU,
317  $ ANORM, MODE, CNDNUM, DIST )
318 *
319 * Generate a matrix with ZLATMS.
320 *
321  srnamt = 'ZLATMS'
322  CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE,
323  $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
324  $ INFO )
325 *
326 * Check error code from ZLATMS and handle error.
327 *
328  IF( info.NE.0 ) THEN
329  CALL alaerh( path, 'ZLATMS', 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 test matrix A.
408 *
409 *
410 * Set the imaginary part of the diagonals.
411 *
412  CALL zlaipd( n, a, lda+1, 0 )
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 zlacpy( 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 = 'ZHETRF_AA_2STAGE'
436  lwork = min(n*nb, 3*nmax*nmax)
437  CALL zhetrf_aa_2stage( uplo, n, afac, lda,
438  $ ainv, (3*nb+1)*n,
439  $ iwork, iwork( 1+n ),
440  $ work, lwork,
441  $ info )
442 *
443 * Adjust the expected value of INFO to account for
444 * pivoting.
445 *
446  IF( izero.GT.0 ) THEN
447  j = 1
448  k = izero
449  100 CONTINUE
450  IF( j.EQ.k ) THEN
451  k = iwork( j )
452  ELSE IF( iwork( j ).EQ.k ) THEN
453  k = j
454  END IF
455  IF( j.LT.k ) THEN
456  j = j + 1
457  GO TO 100
458  END IF
459  ELSE
460  k = 0
461  END IF
462 *
463 * Check error code from CHETRF and handle error.
464 *
465  IF( info.NE.k ) THEN
466  CALL alaerh( path, 'ZHETRF_AA_2STAGE', info, k,
467  $ uplo, n, n, -1, -1, nb, imat, nfail,
468  $ nerrs, nout )
469  END IF
470 *
471 *+ TEST 1
472 * Reconstruct matrix from factors and compute residual.
473 *
474 * NEED TO CREATE ZHET01_AA_2STAGE
475 * CALL ZHET01_AA( UPLO, N, A, LDA, AFAC, LDA, IWORK,
476 * $ AINV, LDA, RWORK, RESULT( 1 ) )
477 * NT = 1
478  nt = 0
479 *
480 *
481 * Print information about the tests that did not pass
482 * the threshold.
483 *
484  DO 110 k = 1, nt
485  IF( result( k ).GE.thresh ) THEN
486  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
487  $ CALL alahd( nout, path )
488  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
489  $ result( k )
490  nfail = nfail + 1
491  END IF
492  110 CONTINUE
493  nrun = nrun + nt
494 *
495 * Skip solver test if INFO is not 0.
496 *
497  IF( info.NE.0 ) THEN
498  GO TO 140
499  END IF
500 *
501 * Do for each value of NRHS in NSVAL.
502 *
503  DO 130 irhs = 1, nns
504  nrhs = nsval( irhs )
505 *
506 *+ TEST 2 (Using TRS)
507 * Solve and compute residual for A * X = B.
508 *
509 * Choose a set of NRHS random solution vectors
510 * stored in XACT and set up the right hand side B
511 *
512  srnamt = 'ZLARHS'
513  CALL zlarhs( matpath, xtype, uplo, ' ', n, n,
514  $ kl, ku, nrhs, a, lda, xact, lda,
515  $ b, lda, iseed, info )
516  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
517 *
518  srnamt = 'ZHETRS_AA_2STAGE'
519  lwork = max( 1, 3*n-2 )
520  CALL zhetrs_aa_2stage( uplo, n, nrhs, afac, lda,
521  $ ainv, (3*nb+1)*n, iwork, iwork( 1+n ),
522  $ x, lda, info )
523 *
524 * Check error code from ZHETRS and handle error.
525 *
526  IF( info.NE.0 ) THEN
527  IF( izero.EQ.0 ) THEN
528  CALL alaerh( path, 'ZHETRS_AA_2STAGE',
529  $ info, 0, uplo, n, n, -1, -1,
530  $ nrhs, imat, nfail, nerrs, nout )
531  END IF
532  ELSE
533 *
534  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda
535  $ )
536 *
537 * Compute the residual for the solution
538 *
539  CALL zpot02( uplo, n, nrhs, a, lda, x, lda,
540  $ work, lda, rwork, result( 2 ) )
541 *
542 * Print information about the tests that did not pass
543 * the threshold.
544 *
545  DO 120 k = 2, 2
546  IF( result( k ).GE.thresh ) THEN
547  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
548  $ CALL alahd( nout, path )
549  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
550  $ imat, k, result( k )
551  nfail = nfail + 1
552  END IF
553  120 CONTINUE
554  END IF
555  nrun = nrun + 1
556 *
557 * End do for each value of NRHS in NSVAL.
558 *
559  130 CONTINUE
560  140 CONTINUE
561  150 CONTINUE
562  160 CONTINUE
563  170 CONTINUE
564  180 CONTINUE
565 *
566 * Print a summary of the results.
567 *
568  CALL alasum( path, nout, nfail, nrun, nerrs )
569 *
570  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
571  $ i2, ', test ', i2, ', ratio =', g12.5 )
572  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
573  $ i2, ', test(', i2, ') =', g12.5 )
574  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
575  $ i6 )
576  RETURN
577 *
578 * End of ZCHKSY_AA_2STAGE
579 *
Here is the call graph for this function:
Here is the caller graph for this function:
zpot02
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
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
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:109
zlaipd
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
zhetrs_aa_2stage
subroutine zhetrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
ZHETRS_AA_2STAGE
Definition: zhetrs_aa_2stage.f:143
zerrhe
subroutine zerrhe(PATH, NUNIT)
ZERRHE
Definition: zerrhe.f:57
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
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
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
zhetrf_aa_2stage
subroutine zhetrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
ZHETRF_AA_2STAGE
Definition: zhetrf_aa_2stage.f:162
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334