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

CCHKHE_AA

Purpose: 
 CCHKHE_AA tests CHETRF_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 COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX array, dimension (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL 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 cchkhe_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  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.0e+0 )
200  COMPLEX czero
201  parameter ( czero = ( 0.0e+0, 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 Functions ..
222  REAL dget06, clanhe
223  EXTERNAL dget06, clanhe
224 * ..
225 * .. External Subroutines ..
226  EXTERNAL alaerh, alahd, alasum, xlaenv, cerrhe, cget04,
227  $ zhecon, cherfs, chet01_aa, chetrf_aa, zhetri2,
228  $ chetrs_aa, clacpy, claipd, clarhs, clatb4,
229  $ clatms, cpot02, zpot03, zpot05
230 * ..
231 * .. Intrinsic Functions ..
232  INTRINSIC REAL, imag, 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 *
252 * Test path
253 *
254  path( 1: 1 ) = 'Complex precision'
255  path( 2: 3 ) = 'HA'
256 *
257 * Path to generate matrices
258 *
259  matpath( 1: 1 ) = 'Complex precision'
260  matpath( 2: 3 ) = 'HE'
261  nrun = 0
262  nfail = 0
263  nerrs = 0
264  DO 10 i = 1, 4
265  iseed( i ) = iseedy( i )
266  10 CONTINUE
267 *
268 * Test the error exits
269 *
270  IF( tsterr )
271  $ CALL cerrhe( path, nout )
272  infot = 0
273 *
274 * Set the minimum block size for which the block routine should
275 * be used, which will be later returned by ILAENV
276 *
277  CALL xlaenv( 2, 2 )
278 *
279 * Do for each value of N in NVAL
280 *
281  DO 180 in = 1, nn
282  n = nval( in )
283  IF( n .GT. nmax ) THEN
284  nfail = nfail + 1
285  WRITE(nout, 9995) 'M ', n, nmax
286  GO TO 180
287  END IF
288  lda = max( n, 1 )
289  xtype = 'N'
290  nimat = ntypes
291  IF( n.LE.0 )
292  $ nimat = 1
293 *
294  izero = 0
295  DO 170 imat = 1, nimat
296 *
297 * Do the tests only if DOTYPE( IMAT ) is true.
298 *
299  IF( .NOT.dotype( imat ) )
300  $ GO TO 170
301 *
302 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
303 *
304  zerot = imat.GE.3 .AND. imat.LE.6
305  IF( zerot .AND. n.LT.imat-2 )
306  $ GO TO 170
307 *
308 * Do first for UPLO = 'U', then for UPLO = 'L'
309 *
310  DO 160 iuplo = 1, 2
311  uplo = uplos( iuplo )
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 types 3-6, zero one or more rows and columns of
338 * the matrix to test that INFO is returned 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 test matrix A.
407 *
408 *
409 * Set the imaginary part of the diagonals.
410 *
411  CALL claipd( n, a, lda+1, 0 )
412 *
413 * Do for each value of NB in NBVAL
414 *
415  DO 150 inb = 1, nnb
416 *
417 * Set the optimal blocksize, which will be later
418 * returned by ILAENV.
419 *
420  nb = nbval( inb )
421  CALL xlaenv( 1, nb )
422 *
423 * Copy the test matrix A into matrix AFAC which
424 * will be factorized in place. This is needed to
425 * preserve the test matrix A for subsequent tests.
426 *
427  CALL clacpy( uplo, n, n, a, lda, afac, lda )
428 *
429 * Compute the L*D*L**T or U*D*U**T factorization of the
430 * matrix. IWORK stores details of the interchanges and
431 * the block structure of D. AINV is a work array for
432 * block factorization, LWORK is the length of AINV.
433 *
434  lwork = max( 1, ( nb+1 )*lda )
435  srnamt = 'CHETRF_AA'
436  CALL chetrf_aa( uplo, n, afac, lda, iwork, ainv,
437  $ lwork, info )
438 *
439 * Adjust the expected value of INFO to account for
440 * pivoting.
441 *
442  IF( izero.GT.0 ) THEN
443  j = 1
444  k = izero
445  100 CONTINUE
446  IF( j.EQ.k ) THEN
447  k = iwork( j )
448  ELSE IF( iwork( j ).EQ.k ) THEN
449  k = j
450  END IF
451  IF( j.LT.k ) THEN
452  j = j + 1
453  GO TO 100
454  END IF
455  ELSE
456  k = 0
457  END IF
458 *
459 * Check error code from CHETRF and handle error.
460 *
461  IF( info.NE.k ) THEN
462  CALL alaerh( path, 'CHETRF_AA', info, k, uplo,
463  $ n, n, -1, -1, nb, imat, nfail, nerrs,
464  $ nout )
465  END IF
466 *
467 *+ TEST 1
468 * Reconstruct matrix from factors and compute residual.
469 *
470  CALL chet01_aa( uplo, n, a, lda, afac, lda, iwork,
471  $ ainv, lda, rwork, result( 1 ) )
472  nt = 1
473 *
474 *
475 * Print information about the tests that did not pass
476 * the threshold.
477 *
478  DO 110 k = 1, nt
479  IF( result( k ).GE.thresh ) THEN
480  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
481  $ CALL alahd( nout, path )
482  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
483  $ result( k )
484  nfail = nfail + 1
485  END IF
486  110 CONTINUE
487  nrun = nrun + nt
488 *
489 * Skip solver test if INFO is not 0.
490 *
491  IF( info.NE.0 ) THEN
492  GO TO 140
493  END IF
494 *
495 * Do for each value of NRHS in NSVAL.
496 *
497  DO 130 irhs = 1, nns
498  nrhs = nsval( irhs )
499 *
500 *+ TEST 2 (Using TRS)
501 * Solve and compute residual for A * X = B.
502 *
503 * Choose a set of NRHS random solution vectors
504 * stored in XACT and set up the right hand side B
505 *
506  srnamt = 'CLARHS'
507  CALL clarhs( matpath, xtype, uplo, ' ', n, n,
508  $ kl, ku, nrhs, a, lda, xact, lda,
509  $ b, lda, iseed, info )
510  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
511 *
512  srnamt = 'CHETRS_AA'
513  lwork = max( 1, 3*n-2 )
514  CALL chetrs_aa( uplo, n, nrhs, afac, lda, iwork,
515  $ x, lda, work, lwork, info )
516 *
517 * Check error code from CHETRS and handle error.
518 *
519  IF( info.NE.0 ) THEN
520  CALL alaerh( path, 'CHETRS_AA', info, 0,
521  $ uplo, n, n, -1, -1, nrhs, imat,
522  $ nfail, nerrs, nout )
523  END IF
524 *
525  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
526 *
527 * Compute the residual for the solution
528 *
529  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
530  $ lda, rwork, result( 2 ) )
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  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 CCHKHE_AA
568 *
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
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
claipd
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
chetrs_aa
subroutine chetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHETRS_AA
Definition: chetrs_aa.f:131
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
cherfs
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
Definition: cherfs.f:194
zpot03
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
Definition: zpot03.f:128
cpot02
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
cerrhe
subroutine cerrhe(PATH, NUNIT)
CERRHE
Definition: cerrhe.f:57
zhecon
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
Definition: zhecon.f:127
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
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
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
chet01_aa
subroutine chet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_AA
Definition: chet01_aa.f:127
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
zpot05
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:167
chetrf_aa
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
Definition: chetrf_aa.f:138
clanhe
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE 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: clanhe.f:126
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
alasum
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75

Here is the call graph for this function:

Here is the caller graph for this function: