LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine zchkhe_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 
)

ZCHKHE_AA

Purpose: 
 ZCHKHE_AA tests ZHETRF_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 DOUBLE PRECISION array, dimension (max(NMAX,2*NSMAX))
[out]IWORK
          IWORK is INTEGER array, dimension (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 zchkhe_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 nmax, nn, nnb, nns, 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  DOUBLE PRECISION zero
199  parameter ( zero = 0.0d+0 )
200  COMPLEX*16 czero
201  parameter ( czero = ( 0.0d+0, 0.0d+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  DOUBLE PRECISION anorm, cndnum
215 * ..
216 * .. Local Arrays ..
217  CHARACTER uplos( 2 )
218  INTEGER iseed( 4 ), iseedy( 4 )
219  DOUBLE PRECISION result( ntests )
220 * ..
221 * .. External Functions ..
222  DOUBLE PRECISION dget06, zlanhe
223  EXTERNAL dget06, zlanhe
224 * ..
225 * .. External Subroutines ..
226  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrhe, zget04,
227  $ zhecon, zherfs, zhet01_aa, zhetrf_aa, zhetri2,
228  $ zhetrs_aa, zlacpy, zlaipd, zlarhs, zlatb4,
229  $ zlatms, zpot02, zpot03, zpot05
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 ) = 'Zomplex precision'
254  path( 2: 3 ) = 'HA'
255 *
256 * Path to generate matrices
257 *
258  matpath( 1: 1 ) = 'Zomplex precision'
259  matpath( 2: 3 ) = 'HE'
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 zerrhe( 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  DO 170 imat = 1, nimat
295 *
296 * Do the tests only if DOTYPE( IMAT ) is true.
297 *
298  IF( .NOT.dotype( imat ) )
299  $ GO TO 170
300 *
301 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
302 *
303  zerot = imat.GE.3 .AND. imat.LE.6
304  IF( zerot .AND. n.LT.imat-2 )
305  $ GO TO 170
306 *
307 * Do first for UPLO = 'U', then for UPLO = 'L'
308 *
309  DO 160 iuplo = 1, 2
310  uplo = uplos( iuplo )
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 types 3-6, zero one or more rows and columns of
337 * the matrix to test that INFO is returned correctly.
338 *
339  IF( zerot ) THEN
340  IF( imat.EQ.3 ) THEN
341  izero = 1
342  ELSE IF( imat.EQ.4 ) THEN
343  izero = n
344  ELSE
345  izero = n / 2 + 1
346  END IF
347 *
348  IF( imat.LT.6 ) THEN
349 *
350 * Set row and column IZERO to zero.
351 *
352  IF( iuplo.EQ.1 ) THEN
353  ioff = ( izero-1 )*lda
354  DO 20 i = 1, izero - 1
355  a( ioff+i ) = czero
356  20 CONTINUE
357  ioff = ioff + izero
358  DO 30 i = izero, n
359  a( ioff ) = czero
360  ioff = ioff + lda
361  30 CONTINUE
362  ELSE
363  ioff = izero
364  DO 40 i = 1, izero - 1
365  a( ioff ) = czero
366  ioff = ioff + lda
367  40 CONTINUE
368  ioff = ioff - izero
369  DO 50 i = izero, n
370  a( ioff+i ) = czero
371  50 CONTINUE
372  END IF
373  ELSE
374  IF( iuplo.EQ.1 ) THEN
375 *
376 * Set the first IZERO rows and columns to zero.
377 *
378  ioff = 0
379  DO 70 j = 1, n
380  i2 = min( j, izero )
381  DO 60 i = 1, i2
382  a( ioff+i ) = czero
383  60 CONTINUE
384  ioff = ioff + lda
385  70 CONTINUE
386  izero = 1
387  ELSE
388 *
389 * Set the last IZERO rows and columns to zero.
390 *
391  ioff = 0
392  DO 90 j = 1, n
393  i1 = max( j, izero )
394  DO 80 i = i1, n
395  a( ioff+i ) = czero
396  80 CONTINUE
397  ioff = ioff + lda
398  90 CONTINUE
399  END IF
400  END IF
401  ELSE
402  izero = 0
403  END IF
404 *
405 * End generate test matrix A.
406 *
407 *
408 * Set the imaginary part of the diagonals.
409 *
410  CALL zlaipd( n, a, lda+1, 0 )
411 *
412 * Do for each value of NB in NBVAL
413 *
414  DO 150 inb = 1, nnb
415 *
416 * Set the optimal blocksize, which will be later
417 * returned by ILAENV.
418 *
419  nb = nbval( inb )
420  CALL xlaenv( 1, nb )
421 *
422 * Copy the test matrix A into matrix AFAC which
423 * will be factorized in place. This is needed to
424 * preserve the test matrix A for subsequent tests.
425 *
426  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
427 *
428 * Compute the L*D*L**T or U*D*U**T factorization of the
429 * matrix. IWORK stores details of the interchanges and
430 * the block structure of D. AINV is a work array for
431 * block factorization, LWORK is the length of AINV.
432 *
433  lwork = max( 1, ( nb+1 )*lda )
434  srnamt = 'ZHETRF_AA'
435  CALL zhetrf_aa( uplo, n, afac, lda, iwork, ainv,
436  $ lwork, info )
437 *
438 * Adjust the expected value of INFO to account for
439 * pivoting.
440 *
441  IF( izero.GT.0 ) THEN
442  j = 1
443  k = izero
444  100 CONTINUE
445  IF( j.EQ.k ) THEN
446  k = iwork( j )
447  ELSE IF( iwork( j ).EQ.k ) THEN
448  k = j
449  END IF
450  IF( j.LT.k ) THEN
451  j = j + 1
452  GO TO 100
453  END IF
454  ELSE
455  k = 0
456  END IF
457 *
458 * Check error code from ZHETRF and handle error.
459 *
460  IF( info.NE.k ) THEN
461  CALL alaerh( path, 'ZHETRF_AA', info, k, uplo,
462  $ n, n, -1, -1, nb, imat, nfail, nerrs,
463  $ nout )
464  END IF
465 *
466 *+ TEST 1
467 * Reconstruct matrix from factors and compute residual.
468 *
469  CALL zhet01_aa( uplo, n, a, lda, afac, lda, iwork,
470  $ ainv, lda, rwork, result( 1 ) )
471  nt = 1
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 = 'ZHETRS_AA'
512  lwork = max( 1, 3*n-2 )
513  CALL zhetrs_aa( uplo, n, nrhs, afac, lda, iwork,
514  $ x, lda, work, lwork, info )
515 *
516 * Check error code from ZHETRS and handle error.
517 *
518  IF( info.NE.0 ) THEN
519  CALL alaerh( path, 'ZHETRS', info, 0, uplo, n,
520  $ n, -1, -1, nrhs, imat, nfail,
521  $ nerrs, nout )
522  END IF
523 *
524  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
525 *
526 * Compute the residual for the solution
527 *
528  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
529  $ lda, rwork, result( 2 ) )
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  nrun = nrun + 1
544 *
545 * End do for each value of NRHS in NSVAL.
546 *
547  130 CONTINUE
548  140 CONTINUE
549  150 CONTINUE
550  160 CONTINUE
551  170 CONTINUE
552  180 CONTINUE
553 *
554 * Print a summary of the results.
555 *
556  CALL alasum( path, nout, nfail, nrun, nerrs )
557 *
558  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
559  $ i2, ', test ', i2, ', ratio =', g12.5 )
560  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
561  $ i2, ', test(', i2, ') =', g12.5 )
562 c 9997 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ',', 10X, ' type ', I2,
563 c $ ', test(', I2, ') =', G12.5 )
564  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
565  $ i6 )
566  RETURN
567 *
568 * End of ZCHKHE_AA
569 *
zhetri2
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
Definition: zhetri2.f:129
alahd
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:107
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zlanhe
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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 Hermitian matrix.
Definition: zlanhe.f:126
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
zerrhe
subroutine zerrhe(PATH, NUNIT)
ZERRHE
Definition: zerrhe.f:57
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
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
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
zpot03
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
Definition: zpot03.f:128
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
zhecon
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
Definition: zhecon.f:127
zlaipd
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
zhetrs_aa
subroutine zhetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHETRS_AA
Definition: zhetrs_aa.f:132
zherfs
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
Definition: zherfs.f:194
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zhetrf_aa
subroutine zhetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_AA
Definition: zhetrf_aa.f:138
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
zpot05
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:167
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
zhet01_aa
subroutine zhet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_AA
Definition: zhet01_aa.f:127

Here is the call graph for this function:

Here is the caller graph for this function: