LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
cchkhe_rook.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cchkhe_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKHE_ROOK More...
 

Function/Subroutine Documentation

subroutine cchkhe_rook ( 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_ROOK

Purpose:
 CCHKHE_ROOK tests CHETRF_ROOK, -TRI_ROOK, -TRS_ROOK,
 and -CON_ROOK.
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 (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 2013

Definition at line 174 of file cchkhe_rook.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: