LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ dchksy_rk()

subroutine dchksy_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,
double precision, dimension( * )  A,
double precision, dimension( * )  AFAC,
double precision, dimension( * )  E,
double precision, dimension( * )  AINV,
double precision, dimension( * )  B,
double precision, dimension( * )  X,
double precision, dimension( * )  XACT,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DCHKSY_RK

Purpose:
 DCHKSY_RK tests DSYTRF_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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]E
          E is DOUBLE PRECISION array, dimension (NMAX)
[out]AINV
          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NSMAX),
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NSMAX),
          where NSMAX is the largest entry in NSVAL.
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX),
          where NSMAX is the largest entry in NSVAL.
[out]WORK
          WORK is DOUBLE PRECISION 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 178 of file dchksy_rk.f.

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