LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ cchksy_rk()

subroutine cchksy_rk ( 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( * )  E,
complex, dimension( * )  AINV,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKSY_RK

Purpose:
 CCHKSY_RK tests CSYTRF_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 (NNB)
          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]E
          E is COMPLEX array, dimension (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.

Definition at line 174 of file cchksy_rk.f.

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