LAPACK  3.7.0
LAPACK: Linear Algebra PACKage
subroutine zchkhe_rk ( 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( * )  E,
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_RK

Purpose: 
 ZCHKHE_RK tests ZHETRF_RK, -TRI_3, -TRS_3,
 and -CON_3.
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 CCOMPLEX*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]E
          E is COMPLEX*16 array, dimension (NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is CCOMPLEX*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
December 2016

Definition at line 179 of file zchkhe_rk.f.

179 *
180 * -- LAPACK test routine (version 3.7.0) --
181 * -- LAPACK is a software package provided by Univ. of Tennessee, --
182 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
183 * December 2016
184 *
185 * .. Scalar Arguments ..
186  LOGICAL tsterr
187  INTEGER nmax, nn, nnb, nns, nout
188  DOUBLE PRECISION thresh
189 * ..
190 * .. Array Arguments ..
191  LOGICAL dotype( * )
192  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
193  DOUBLE PRECISION rwork( * )
194  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ), e( * ),
195  $ work( * ), x( * ), xact( * )
196 * ..
197 *
198 * =====================================================================
199 *
200 * .. Parameters ..
201  DOUBLE PRECISION zero, one
202  parameter ( zero = 0.0d+0, one = 1.0d+0 )
203  DOUBLE PRECISION onehalf
204  parameter ( onehalf = 0.5d+0 )
205  DOUBLE PRECISION eight, sevten
206  parameter ( eight = 8.0d+0, sevten = 17.0d+0 )
207  COMPLEX*16 czero
208  parameter ( czero = ( 0.0d+0, 0.0d+0 ) )
209  INTEGER ntypes
210  parameter ( ntypes = 10 )
211  INTEGER ntests
212  parameter ( ntests = 7 )
213 * ..
214 * .. Local Scalars ..
215  LOGICAL trfcon, zerot
216  CHARACTER dist, TYPE, uplo, xtype
217  CHARACTER*3 path, matpath
218  INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
219  $ itemp, itemp2, iuplo, izero, j, k, kl, ku, lda,
220  $ lwork, mode, n, nb, nerrs, nfail, nimat, nrhs,
221  $ nrun, nt
222  DOUBLE PRECISION alpha, anorm, cndnum, const, sing_max,
223  $ sing_min, rcond, rcondc, dtemp
224 * ..
225 * .. Local Arrays ..
226  CHARACTER uplos( 2 )
227  INTEGER iseed( 4 ), iseedy( 4 ), idummy( 1 )
228  DOUBLE PRECISION result( ntests )
229  COMPLEX*16 block( 2, 2 ), zdummy( 1 )
230 * ..
231 * .. External Functions ..
232  DOUBLE PRECISION dget06, zlange, zlanhe
233  EXTERNAL dget06, zlange, zlanhe
234 * ..
235 * .. External Subroutines ..
236  EXTERNAL alaerh, alahd, alasum, zerrhe, zgesvd, zget04,
237  $ zlacpy, zlarhs, zlatb4, zlatms, zpot02, zpot03,
238  $ zhecon_3, zhet01_3, zhetrf_rk, zhetri_3,
239  $ zhetrs_3, xlaenv
240 * ..
241 * .. Intrinsic Functions ..
242  INTRINSIC dconjg, max, min, sqrt
243 * ..
244 * .. Scalars in Common ..
245  LOGICAL lerr, ok
246  CHARACTER*32 srnamt
247  INTEGER infot, nunit
248 * ..
249 * .. Common blocks ..
250  COMMON / infoc / infot, nunit, ok, lerr
251  COMMON / srnamc / srnamt
252 * ..
253 * .. Data statements ..
254  DATA iseedy / 1988, 1989, 1990, 1991 /
255  DATA uplos / 'U', 'L' /
256 * ..
257 * .. Executable Statements ..
258 *
259 * Initialize constants and the random number seed.
260 *
261  alpha = ( one+sqrt( sevten ) ) / eight
262 *
263 * Test path
264 *
265  path( 1: 1 ) = 'Zomplex precision'
266  path( 2: 3 ) = 'HK'
267 *
268 * Path to generate matrices
269 *
270  matpath( 1: 1 ) = 'Zomplex precision'
271  matpath( 2: 3 ) = 'HE'
272 *
273  nrun = 0
274  nfail = 0
275  nerrs = 0
276  DO 10 i = 1, 4
277  iseed( i ) = iseedy( i )
278  10 CONTINUE
279 *
280 * Test the error exits
281 *
282  IF( tsterr )
283  $ CALL zerrhe( path, nout )
284  infot = 0
285 *
286 * Set the minimum block size for which the block routine should
287 * be used, which will be later returned by ILAENV
288 *
289  CALL xlaenv( 2, 2 )
290 *
291 * Do for each value of N in NVAL
292 *
293  DO 270 in = 1, nn
294  n = nval( in )
295  lda = max( n, 1 )
296  xtype = 'N'
297  nimat = ntypes
298  IF( n.LE.0 )
299  $ nimat = 1
300 *
301  izero = 0
302 *
303 * Do for each value of matrix type IMAT
304 *
305  DO 260 imat = 1, nimat
306 *
307 * Do the tests only if DOTYPE( IMAT ) is true.
308 *
309  IF( .NOT.dotype( imat ) )
310  $ GO TO 260
311 *
312 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
313 *
314  zerot = imat.GE.3 .AND. imat.LE.6
315  IF( zerot .AND. n.LT.imat-2 )
316  $ GO TO 260
317 *
318 * Do first for UPLO = 'U', then for UPLO = 'L'
319 *
320  DO 250 iuplo = 1, 2
321  uplo = uplos( iuplo )
322 *
323 * Begin generate the test matrix A.
324 *
325 * Set up parameters with ZLATB4 for the matrix generator
326 * based on the type of matrix to be generated.
327 *
328  CALL zlatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
329  $ mode, cndnum, dist )
330 *
331 * Generate a matrix with ZLATMS.
332 *
333  srnamt = 'ZLATMS'
334  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
335  $ cndnum, anorm, kl, ku, uplo, a, lda,
336  $ work, info )
337 *
338 * Check error code from ZLATMS and handle error.
339 *
340  IF( info.NE.0 ) THEN
341  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n,
342  $ -1, -1, -1, imat, nfail, nerrs, nout )
343 *
344 * Skip all tests for this generated matrix
345 *
346  GO TO 250
347  END IF
348 *
349 * For matrix types 3-6, zero one or more rows and
350 * columns of the matrix to test that INFO is returned
351 * correctly.
352 *
353  IF( zerot ) THEN
354  IF( imat.EQ.3 ) THEN
355  izero = 1
356  ELSE IF( imat.EQ.4 ) THEN
357  izero = n
358  ELSE
359  izero = n / 2 + 1
360  END IF
361 *
362  IF( imat.LT.6 ) THEN
363 *
364 * Set row and column IZERO to zero.
365 *
366  IF( iuplo.EQ.1 ) THEN
367  ioff = ( izero-1 )*lda
368  DO 20 i = 1, izero - 1
369  a( ioff+i ) = czero
370  20 CONTINUE
371  ioff = ioff + izero
372  DO 30 i = izero, n
373  a( ioff ) = czero
374  ioff = ioff + lda
375  30 CONTINUE
376  ELSE
377  ioff = izero
378  DO 40 i = 1, izero - 1
379  a( ioff ) = czero
380  ioff = ioff + lda
381  40 CONTINUE
382  ioff = ioff - izero
383  DO 50 i = izero, n
384  a( ioff+i ) = czero
385  50 CONTINUE
386  END IF
387  ELSE
388  IF( iuplo.EQ.1 ) THEN
389 *
390 * Set the first IZERO rows and columns to zero.
391 *
392  ioff = 0
393  DO 70 j = 1, n
394  i2 = min( j, izero )
395  DO 60 i = 1, i2
396  a( ioff+i ) = czero
397  60 CONTINUE
398  ioff = ioff + lda
399  70 CONTINUE
400  ELSE
401 *
402 * Set the last IZERO rows and columns to zero.
403 *
404  ioff = 0
405  DO 90 j = 1, n
406  i1 = max( j, izero )
407  DO 80 i = i1, n
408  a( ioff+i ) = czero
409  80 CONTINUE
410  ioff = ioff + lda
411  90 CONTINUE
412  END IF
413  END IF
414  ELSE
415  izero = 0
416  END IF
417 *
418 * End generate the test matrix A.
419 *
420 *
421 * Do for each value of NB in NBVAL
422 *
423  DO 240 inb = 1, nnb
424 *
425 * Set the optimal blocksize, which will be later
426 * returned by ILAENV.
427 *
428  nb = nbval( inb )
429  CALL xlaenv( 1, nb )
430 *
431 * Copy the test matrix A into matrix AFAC which
432 * will be factorized in place. This is needed to
433 * preserve the test matrix A for subsequent tests.
434 *
435  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
436 *
437 * Compute the L*D*L**T or U*D*U**T factorization of the
438 * matrix. IWORK stores details of the interchanges and
439 * the block structure of D. AINV is a work array for
440 * block factorization, LWORK is the length of AINV.
441 *
442  lwork = max( 2, nb )*lda
443  srnamt = 'ZHETRF_RK'
444  CALL zhetrf_rk( uplo, n, afac, lda, e, iwork, ainv,
445  $ lwork, info )
446 *
447 * Adjust the expected value of INFO to account for
448 * pivoting.
449 *
450  k = izero
451  IF( k.GT.0 ) THEN
452  100 CONTINUE
453  IF( iwork( k ).LT.0 ) THEN
454  IF( iwork( k ).NE.-k ) THEN
455  k = -iwork( k )
456  GO TO 100
457  END IF
458  ELSE IF( iwork( k ).NE.k ) THEN
459  k = iwork( k )
460  GO TO 100
461  END IF
462  END IF
463 *
464 * Check error code from ZHETRF_RK and handle error.
465 *
466  IF( info.NE.k)
467  $ CALL alaerh( path, 'ZHETRF_RK', info, k,
468  $ uplo, n, n, -1, -1, nb, imat,
469  $ nfail, nerrs, nout )
470 *
471 * Set the condition estimate flag if the INFO is not 0.
472 *
473  IF( info.NE.0 ) THEN
474  trfcon = .true.
475  ELSE
476  trfcon = .false.
477  END IF
478 *
479 *+ TEST 1
480 * Reconstruct matrix from factors and compute residual.
481 *
482  CALL zhet01_3( uplo, n, a, lda, afac, lda, e, iwork,
483  $ ainv, lda, rwork, result( 1 ) )
484  nt = 1
485 *
486 *+ TEST 2
487 * Form the inverse and compute the residual,
488 * if the factorization was competed without INFO > 0
489 * (i.e. there is no zero rows and columns).
490 * Do it only for the first block size.
491 *
492  IF( inb.EQ.1 .AND. .NOT.trfcon ) THEN
493  CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
494  srnamt = 'ZHETRI_3'
495 *
496 * Another reason that we need to compute the invesrse
497 * is that ZPOT03 produces RCONDC which is used later
498 * in TEST6 and TEST7.
499 *
500  lwork = (n+nb+1)*(nb+3)
501  CALL zhetri_3( uplo, n, ainv, lda, e, iwork, work,
502  $ lwork, info )
503 *
504 * Check error code from ZHETRI_3 and handle error.
505 *
506  IF( info.NE.0 )
507  $ CALL alaerh( path, 'ZHETRI_3', info, -1,
508  $ uplo, n, n, -1, -1, -1, imat,
509  $ nfail, nerrs, nout )
510 *
511 * Compute the residual for a Hermitian matrix times
512 * its inverse.
513 *
514  CALL zpot03( uplo, n, a, lda, ainv, lda, work, lda,
515  $ rwork, rcondc, result( 2 ) )
516  nt = 2
517  END IF
518 *
519 * Print information about the tests that did not pass
520 * the threshold.
521 *
522  DO 110 k = 1, nt
523  IF( result( k ).GE.thresh ) THEN
524  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
525  $ CALL alahd( nout, path )
526  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
527  $ result( k )
528  nfail = nfail + 1
529  END IF
530  110 CONTINUE
531  nrun = nrun + nt
532 *
533 *+ TEST 3
534 * Compute largest element in U or L
535 *
536  result( 3 ) = zero
537  dtemp = zero
538 *
539  const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
540  $ ( one-alpha )
541 *
542  IF( iuplo.EQ.1 ) THEN
543 *
544 * Compute largest element in U
545 *
546  k = n
547  120 CONTINUE
548  IF( k.LE.1 )
549  $ GO TO 130
550 *
551  IF( iwork( k ).GT.zero ) THEN
552 *
553 * Get max absolute value from elements
554 * in column k in U
555 *
556  dtemp = zlange( 'M', k-1, 1,
557  $ afac( ( k-1 )*lda+1 ), lda, rwork )
558  ELSE
559 *
560 * Get max absolute value from elements
561 * in columns k and k-1 in U
562 *
563  dtemp = zlange( 'M', k-2, 2,
564  $ afac( ( k-2 )*lda+1 ), lda, rwork )
565  k = k - 1
566 *
567  END IF
568 *
569 * DTEMP should be bounded by CONST
570 *
571  dtemp = dtemp - const + thresh
572  IF( dtemp.GT.result( 3 ) )
573  $ result( 3 ) = dtemp
574 *
575  k = k - 1
576 *
577  GO TO 120
578  130 CONTINUE
579 *
580  ELSE
581 *
582 * Compute largest element in L
583 *
584  k = 1
585  140 CONTINUE
586  IF( k.GE.n )
587  $ GO TO 150
588 *
589  IF( iwork( k ).GT.zero ) THEN
590 *
591 * Get max absolute value from elements
592 * in column k in L
593 *
594  dtemp = zlange( 'M', n-k, 1,
595  $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
596  ELSE
597 *
598 * Get max absolute value from elements
599 * in columns k and k+1 in L
600 *
601  dtemp = zlange( 'M', n-k-1, 2,
602  $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
603  k = k + 1
604 *
605  END IF
606 *
607 * DTEMP should be bounded by CONST
608 *
609  dtemp = dtemp - const + thresh
610  IF( dtemp.GT.result( 3 ) )
611  $ result( 3 ) = dtemp
612 *
613  k = k + 1
614 *
615  GO TO 140
616  150 CONTINUE
617  END IF
618 *
619 *
620 *+ TEST 4
621 * Compute largest 2-Norm (condition number)
622 * of 2-by-2 diag blocks
623 *
624  result( 4 ) = zero
625  dtemp = zero
626 *
627  const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
628  $ ( ( one + alpha ) / ( one - alpha ) )
629  CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
630 *
631  IF( iuplo.EQ.1 ) THEN
632 *
633 * Loop backward for UPLO = 'U'
634 *
635  k = n
636  160 CONTINUE
637  IF( k.LE.1 )
638  $ GO TO 170
639 *
640  IF( iwork( k ).LT.zero ) THEN
641 *
642 * Get the two singular values
643 * (real and non-negative) of a 2-by-2 block,
644 * store them in RWORK array
645 *
646  block( 1, 1 ) = afac( ( k-2 )*lda+k-1 )
647  block( 1, 2 ) = e( k )
648  block( 2, 1 ) = dconjg( block( 1, 2 ) )
649  block( 2, 2 ) = afac( (k-1)*lda+k )
650 *
651  CALL zgesvd( 'N', 'N', 2, 2, block, 2, rwork,
652  $ zdummy, 1, zdummy, 1,
653  $ work, 6, rwork( 3 ), info )
654 *
655 *
656  sing_max = rwork( 1 )
657  sing_min = rwork( 2 )
658 *
659  dtemp = sing_max / sing_min
660 *
661 * DTEMP should be bounded by CONST
662 *
663  dtemp = dtemp - const + thresh
664  IF( dtemp.GT.result( 4 ) )
665  $ result( 4 ) = dtemp
666  k = k - 1
667 *
668  END IF
669 *
670  k = k - 1
671 *
672  GO TO 160
673  170 CONTINUE
674 *
675  ELSE
676 *
677 * Loop forward for UPLO = 'L'
678 *
679  k = 1
680  180 CONTINUE
681  IF( k.GE.n )
682  $ GO TO 190
683 *
684  IF( iwork( k ).LT.zero ) THEN
685 *
686 * Get the two singular values
687 * (real and non-negative) of a 2-by-2 block,
688 * store them in RWORK array
689 *
690  block( 1, 1 ) = afac( ( k-1 )*lda+k )
691  block( 2, 1 ) = e( k )
692  block( 1, 2 ) = dconjg( block( 2, 1 ) )
693  block( 2, 2 ) = afac( k*lda+k+1 )
694 *
695  CALL zgesvd( 'N', 'N', 2, 2, block, 2, rwork,
696  $ zdummy, 1, zdummy, 1,
697  $ work, 6, rwork(3), info )
698 *
699  sing_max = rwork( 1 )
700  sing_min = rwork( 2 )
701 *
702  dtemp = sing_max / sing_min
703 *
704 * DTEMP should be bounded by CONST
705 *
706  dtemp = dtemp - const + thresh
707  IF( dtemp.GT.result( 4 ) )
708  $ result( 4 ) = dtemp
709  k = k + 1
710 *
711  END IF
712 *
713  k = k + 1
714 *
715  GO TO 180
716  190 CONTINUE
717  END IF
718 *
719 * Print information about the tests that did not pass
720 * the threshold.
721 *
722  DO 200 k = 3, 4
723  IF( result( k ).GE.thresh ) THEN
724  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
725  $ CALL alahd( nout, path )
726  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
727  $ result( k )
728  nfail = nfail + 1
729  END IF
730  200 CONTINUE
731  nrun = nrun + 2
732 *
733 * Skip the other tests if this is not the first block
734 * size.
735 *
736  IF( inb.GT.1 )
737  $ GO TO 240
738 *
739 * Do only the condition estimate if INFO is not 0.
740 *
741  IF( trfcon ) THEN
742  rcondc = zero
743  GO TO 230
744  END IF
745 *
746 * Do for each value of NRHS in NSVAL.
747 *
748  DO 220 irhs = 1, nns
749  nrhs = nsval( irhs )
750 *
751 * Begin loop over NRHS values
752 *
753 *
754 *+ TEST 5 ( Using TRS_3)
755 * Solve and compute residual for A * X = B.
756 *
757 * Choose a set of NRHS random solution vectors
758 * stored in XACT and set up the right hand side B
759 *
760  srnamt = 'ZLARHS'
761  CALL zlarhs( matpath, xtype, uplo, ' ', n, n,
762  $ kl, ku, nrhs, a, lda, xact, lda,
763  $ b, lda, iseed, info )
764  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
765 *
766  srnamt = 'ZHETRS_3'
767  CALL zhetrs_3( uplo, n, nrhs, afac, lda, e, iwork,
768  $ x, lda, info )
769 *
770 * Check error code from ZHETRS_3 and handle error.
771 *
772  IF( info.NE.0 )
773  $ CALL alaerh( path, 'ZHETRS_3', info, 0,
774  $ uplo, n, n, -1, -1, nrhs, imat,
775  $ nfail, nerrs, nout )
776 *
777  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
778 *
779 * Compute the residual for the solution
780 *
781  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
782  $ lda, rwork, result( 5 ) )
783 *
784 *+ TEST 6
785 * Check solution from generated exact solution.
786 *
787  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
788  $ result( 6 ) )
789 *
790 * Print information about the tests that did not pass
791 * the threshold.
792 *
793  DO 210 k = 5, 6
794  IF( result( k ).GE.thresh ) THEN
795  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
796  $ CALL alahd( nout, path )
797  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
798  $ imat, k, result( k )
799  nfail = nfail + 1
800  END IF
801  210 CONTINUE
802  nrun = nrun + 2
803 *
804 * End do for each value of NRHS in NSVAL.
805 *
806  220 CONTINUE
807 *
808 *+ TEST 7
809 * Get an estimate of RCOND = 1/CNDNUM.
810 *
811  230 CONTINUE
812  anorm = zlanhe( '1', uplo, n, a, lda, rwork )
813  srnamt = 'ZHECON_3'
814  CALL zhecon_3( uplo, n, afac, lda, e, iwork, anorm,
815  $ rcond, work, info )
816 *
817 * Check error code from ZHECON_3 and handle error.
818 *
819  IF( info.NE.0 )
820  $ CALL alaerh( path, 'ZHECON_3', info, 0,
821  $ uplo, n, n, -1, -1, -1, imat,
822  $ nfail, nerrs, nout )
823 *
824 * Compute the test ratio to compare values of RCOND
825 *
826  result( 7 ) = dget06( rcond, rcondc )
827 *
828 * Print information about the tests that did not pass
829 * the threshold.
830 *
831  IF( result( 7 ).GE.thresh ) THEN
832  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
833  $ CALL alahd( nout, path )
834  WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
835  $ result( 7 )
836  nfail = nfail + 1
837  END IF
838  nrun = nrun + 1
839  240 CONTINUE
840 *
841  250 CONTINUE
842  260 CONTINUE
843  270 CONTINUE
844 *
845 * Print a summary of the results.
846 *
847  CALL alasum( path, nout, nfail, nrun, nerrs )
848 *
849  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
850  $ i2, ', test ', i2, ', ratio =', g12.5 )
851  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
852  $ i2, ', test ', i2, ', ratio =', g12.5 )
853  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
854  $ ', test ', i2, ', ratio =', g12.5 )
855  RETURN
856 *
857 * End of ZCHKHE_RK
858 *
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
zhetrf_rk
subroutine zhetrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
Definition: zhetrf_rk.f:261
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
zhet01_3
subroutine zhet01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
ZHET01_3
Definition: zhet01_3.f:143
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
zhetrs_3
subroutine zhetrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
ZHETRS_3
Definition: zhetrs_3.f:167
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
zlange
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
zhetri_3
subroutine zhetri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZHETRI_3
Definition: zhetri_3.f:172
zgesvd
subroutine zgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
ZGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: zgesvd.f:216
zhecon_3
subroutine zhecon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_3
Definition: zhecon_3.f:173
dget06
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
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: