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

CCHKSY_ROOK

Purpose: 
 CCHKSY_ROOK tests CSYTRF_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
December 2016

Definition at line 174 of file cchksy_rook.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 * .. 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 = 11 )
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  $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
215  $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
216  REAL alpha, anorm, cndnum, const, sing_max,
217  $ sing_min, rcond, rcondc, stemp
218 * ..
219 * .. Local Arrays ..
220  CHARACTER uplos( 2 )
221  INTEGER iseed( 4 ), iseedy( 4 )
222  REAL result( ntests )
223  COMPLEX block( 2, 2 ), cdummy( 1 )
224 * ..
225 * .. External Functions ..
226  REAL clange, clansy, sget06
227  EXTERNAL clange, clansy, sget06
228 * ..
229 * .. External Subroutines ..
230  EXTERNAL alaerh, alahd, alasum, cerrsy, cgesvd, cget04,
231  $ clacpy, clarhs, clatb4, clatms, clatsy, csyt02,
232  $ csyt03, csycon_rook, csyt01_rook, csytrf_rook,
233  $ csytri_rook, csytrs_rook, xlaenv
234 * ..
235 * .. Intrinsic Functions ..
236  INTRINSIC max, min, sqrt
237 * ..
238 * .. Scalars in Common ..
239  LOGICAL lerr, ok
240  CHARACTER*32 srnamt
241  INTEGER infot, nunit
242 * ..
243 * .. Common blocks ..
244  COMMON / infoc / infot, nunit, ok, lerr
245  COMMON / srnamc / srnamt
246 * ..
247 * .. Data statements ..
248  DATA iseedy / 1988, 1989, 1990, 1991 /
249  DATA uplos / 'U', 'L' /
250 * ..
251 * .. Executable Statements ..
252 *
253 * Initialize constants and the random number seed.
254 *
255  alpha = ( one+sqrt( sevten ) ) / eight
256 *
257 * Test path
258 *
259  path( 1: 1 ) = 'Complex precision'
260  path( 2: 3 ) = 'SR'
261 *
262 * Path to generate matrices
263 *
264  matpath( 1: 1 ) = 'Complex precision'
265  matpath( 2: 3 ) = 'SY'
266 *
267  nrun = 0
268  nfail = 0
269  nerrs = 0
270  DO 10 i = 1, 4
271  iseed( i ) = iseedy( i )
272  10 CONTINUE
273 *
274 * Test the error exits
275 *
276  IF( tsterr )
277  $ CALL cerrsy( path, nout )
278  infot = 0
279 *
280 * Set the minimum block size for which the block routine should
281 * be used, which will be later returned by ILAENV
282 *
283  CALL xlaenv( 2, 2 )
284 *
285 * Do for each value of N in NVAL
286 *
287  DO 270 in = 1, nn
288  n = nval( in )
289  lda = max( n, 1 )
290  xtype = 'N'
291  nimat = ntypes
292  IF( n.LE.0 )
293  $ nimat = 1
294 *
295  izero = 0
296 *
297 * Do for each value of matrix type IMAT
298 *
299  DO 260 imat = 1, nimat
300 *
301 * Do the tests only if DOTYPE( IMAT ) is true.
302 *
303  IF( .NOT.dotype( imat ) )
304  $ GO TO 260
305 *
306 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
307 *
308  zerot = imat.GE.3 .AND. imat.LE.6
309  IF( zerot .AND. n.LT.imat-2 )
310  $ GO TO 260
311 *
312 * Do first for UPLO = 'U', then for UPLO = 'L'
313 *
314  DO 250 iuplo = 1, 2
315  uplo = uplos( iuplo )
316 *
317 * Begin generate test matrix A.
318 *
319  IF( imat.NE.ntypes ) THEN
320 *
321 * Set up parameters with CLATB4 for the matrix generator
322 * based on the type of matrix to be generated.
323 *
324  CALL clatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
325  $ mode, cndnum, dist )
326 *
327 * Generate a matrix with CLATMS.
328 *
329  srnamt = 'CLATMS'
330  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
331  $ cndnum, anorm, kl, ku, uplo, a, lda,
332  $ work, info )
333 *
334 * Check error code from CLATMS and handle error.
335 *
336  IF( info.NE.0 ) THEN
337  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n,
338  $ -1, -1, -1, imat, nfail, nerrs, nout )
339 *
340 * Skip all tests for this generated matrix
341 *
342  GO TO 250
343  END IF
344 *
345 * For matrix types 3-6, zero one or more rows and
346 * columns of the matrix to test that INFO is returned
347 * correctly.
348 *
349  IF( zerot ) THEN
350  IF( imat.EQ.3 ) THEN
351  izero = 1
352  ELSE IF( imat.EQ.4 ) THEN
353  izero = n
354  ELSE
355  izero = n / 2 + 1
356  END IF
357 *
358  IF( imat.LT.6 ) THEN
359 *
360 * Set row and column IZERO to zero.
361 *
362  IF( iuplo.EQ.1 ) THEN
363  ioff = ( izero-1 )*lda
364  DO 20 i = 1, izero - 1
365  a( ioff+i ) = czero
366  20 CONTINUE
367  ioff = ioff + izero
368  DO 30 i = izero, n
369  a( ioff ) = czero
370  ioff = ioff + lda
371  30 CONTINUE
372  ELSE
373  ioff = izero
374  DO 40 i = 1, izero - 1
375  a( ioff ) = czero
376  ioff = ioff + lda
377  40 CONTINUE
378  ioff = ioff - izero
379  DO 50 i = izero, n
380  a( ioff+i ) = czero
381  50 CONTINUE
382  END IF
383  ELSE
384  IF( iuplo.EQ.1 ) THEN
385 *
386 * Set the first IZERO rows and columns to zero.
387 *
388  ioff = 0
389  DO 70 j = 1, n
390  i2 = min( j, izero )
391  DO 60 i = 1, i2
392  a( ioff+i ) = czero
393  60 CONTINUE
394  ioff = ioff + lda
395  70 CONTINUE
396  ELSE
397 *
398 * Set the last IZERO rows and columns to zero.
399 *
400  ioff = 0
401  DO 90 j = 1, n
402  i1 = max( j, izero )
403  DO 80 i = i1, n
404  a( ioff+i ) = czero
405  80 CONTINUE
406  ioff = ioff + lda
407  90 CONTINUE
408  END IF
409  END IF
410  ELSE
411  izero = 0
412  END IF
413 *
414  ELSE
415 *
416 * For matrix kind IMAT = 11, generate special block
417 * diagonal matrix to test alternate code
418 * for the 2 x 2 blocks.
419 *
420  CALL clatsy( uplo, n, a, lda, iseed )
421 *
422  END IF
423 *
424 * End generate test matrix A.
425 *
426 *
427 * Do for each value of NB in NBVAL
428 *
429  DO 240 inb = 1, nnb
430 *
431 * Set the optimal blocksize, which will be later
432 * returned by ILAENV.
433 *
434  nb = nbval( inb )
435  CALL xlaenv( 1, nb )
436 *
437 * Copy the test matrix A into matrix AFAC which
438 * will be factorized in place. This is needed to
439 * preserve the test matrix A for subsequent tests.
440 *
441  CALL clacpy( uplo, n, n, a, lda, afac, lda )
442 *
443 * Compute the L*D*L**T or U*D*U**T factorization of the
444 * matrix. IWORK stores details of the interchanges and
445 * the block structure of D. AINV is a work array for
446 * block factorization, LWORK is the length of AINV.
447 *
448  lwork = max( 2, nb )*lda
449  srnamt = 'CSYTRF_ROOK'
450  CALL csytrf_rook( uplo, n, afac, lda, iwork, ainv,
451  $ lwork, info )
452 *
453 * Adjust the expected value of INFO to account for
454 * pivoting.
455 *
456  k = izero
457  IF( k.GT.0 ) THEN
458  100 CONTINUE
459  IF( iwork( k ).LT.0 ) THEN
460  IF( iwork( k ).NE.-k ) THEN
461  k = -iwork( k )
462  GO TO 100
463  END IF
464  ELSE IF( iwork( k ).NE.k ) THEN
465  k = iwork( k )
466  GO TO 100
467  END IF
468  END IF
469 *
470 * Check error code from CSYTRF_ROOK and handle error.
471 *
472  IF( info.NE.k)
473  $ CALL alaerh( path, 'CSYTRF_ROOK', info, k,
474  $ uplo, n, n, -1, -1, nb, imat,
475  $ nfail, nerrs, nout )
476 *
477 * Set the condition estimate flag if the INFO is not 0.
478 *
479  IF( info.NE.0 ) THEN
480  trfcon = .true.
481  ELSE
482  trfcon = .false.
483  END IF
484 *
485 *+ TEST 1
486 * Reconstruct matrix from factors and compute residual.
487 *
488  CALL csyt01_rook( uplo, n, a, lda, afac, lda, iwork,
489  $ ainv, lda, rwork, result( 1 ) )
490  nt = 1
491 *
492 *+ TEST 2
493 * Form the inverse and compute the residual,
494 * if the factorization was competed without INFO > 0
495 * (i.e. there is no zero rows and columns).
496 * Do it only for the first block size.
497 *
498  IF( inb.EQ.1 .AND. .NOT.trfcon ) THEN
499  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
500  srnamt = 'CSYTRI_ROOK'
501  CALL csytri_rook( uplo, n, ainv, lda, iwork, work,
502  $ info )
503 *
504 * Check error code from CSYTRI_ROOK and handle error.
505 *
506  IF( info.NE.0 )
507  $ CALL alaerh( path, 'CSYTRI_ROOK', info, -1,
508  $ uplo, n, n, -1, -1, -1, imat,
509  $ nfail, nerrs, nout )
510 *
511 * Compute the residual for a symmetric matrix times
512 * its inverse.
513 *
514  CALL csyt03( 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  stemp = 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 in U
555 *
556  stemp = clange( '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  stemp = clange( 'M', k-2, 2,
564  $ afac( ( k-2 )*lda+1 ), lda, rwork )
565  k = k - 1
566 *
567  END IF
568 *
569 * STEMP should be bounded by CONST
570 *
571  stemp = stemp - const + thresh
572  IF( stemp.GT.result( 3 ) )
573  $ result( 3 ) = stemp
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 in L
593 *
594  stemp = clange( '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  stemp = clange( 'M', n-k-1, 2,
602  $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
603  k = k + 1
604 *
605  END IF
606 *
607 * STEMP should be bounded by CONST
608 *
609  stemp = stemp - const + thresh
610  IF( stemp.GT.result( 3 ) )
611  $ result( 3 ) = stemp
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  stemp = zero
626 *
627  const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
628  $ ( ( one + alpha ) / ( one - alpha ) )
629 *
630  IF( iuplo.EQ.1 ) THEN
631 *
632 * Loop backward for UPLO = 'U'
633 *
634  k = n
635  160 CONTINUE
636  IF( k.LE.1 )
637  $ GO TO 170
638 *
639  IF( iwork( k ).LT.zero ) THEN
640 *
641 * Get the two singular values
642 * (real and non-negative) of a 2-by-2 block,
643 * store them in RWORK array
644 *
645  block( 1, 1 ) = afac( ( k-2 )*lda+k-1 )
646  block( 1, 2 ) = afac( (k-1)*lda+k-1 )
647  block( 2, 1 ) = block( 1, 2 )
648  block( 2, 2 ) = afac( (k-1)*lda+k )
649 *
650  CALL cgesvd( 'N', 'N', 2, 2, block, 2, rwork,
651  $ cdummy, 1, cdummy, 1,
652  $ work, 6, rwork( 3 ), info )
653 *
654 *
655  sing_max = rwork( 1 )
656  sing_min = rwork( 2 )
657 *
658  stemp = sing_max / sing_min
659 *
660 * STEMP should be bounded by CONST
661 *
662  stemp = stemp - const + thresh
663  IF( stemp.GT.result( 4 ) )
664  $ result( 4 ) = stemp
665  k = k - 1
666 *
667  END IF
668 *
669  k = k - 1
670 *
671  GO TO 160
672  170 CONTINUE
673 *
674  ELSE
675 *
676 * Loop forward for UPLO = 'L'
677 *
678  k = 1
679  180 CONTINUE
680  IF( k.GE.n )
681  $ GO TO 190
682 *
683  IF( iwork( k ).LT.zero ) THEN
684 *
685 * Get the two singular values
686 * (real and non-negative) of a 2-by-2 block,
687 * store them in RWORK array
688 *
689  block( 1, 1 ) = afac( ( k-1 )*lda+k )
690  block( 2, 1 ) = afac( ( k-1 )*lda+k+1 )
691  block( 1, 2 ) = block( 2, 1 )
692  block( 2, 2 ) = afac( k*lda+k+1 )
693 *
694  CALL cgesvd( 'N', 'N', 2, 2, block, 2, rwork,
695  $ cdummy, 1, cdummy, 1,
696  $ work, 6, rwork(3), info )
697 *
698  sing_max = rwork( 1 )
699  sing_min = rwork( 2 )
700 *
701  stemp = sing_max / sing_min
702 *
703 * STEMP should be bounded by CONST
704 *
705  stemp = stemp - const + thresh
706  IF( stemp.GT.result( 4 ) )
707  $ result( 4 ) = stemp
708  k = k + 1
709 *
710  END IF
711 *
712  k = k + 1
713 *
714  GO TO 180
715  190 CONTINUE
716  END IF
717 *
718 * Print information about the tests that did not pass
719 * the threshold.
720 *
721  DO 200 k = 3, 4
722  IF( result( k ).GE.thresh ) THEN
723  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
724  $ CALL alahd( nout, path )
725  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
726  $ result( k )
727  nfail = nfail + 1
728  END IF
729  200 CONTINUE
730  nrun = nrun + 2
731 *
732 * Skip the other tests if this is not the first block
733 * size.
734 *
735  IF( inb.GT.1 )
736  $ GO TO 240
737 *
738 * Do only the condition estimate if INFO is not 0.
739 *
740  IF( trfcon ) THEN
741  rcondc = zero
742  GO TO 230
743  END IF
744 *
745 * Do for each value of NRHS in NSVAL.
746 *
747  DO 220 irhs = 1, nns
748  nrhs = nsval( irhs )
749 *
750 *+ TEST 5 ( Using TRS_ROOK)
751 * Solve and compute residual for A * X = B.
752 *
753 * Choose a set of NRHS random solution vectors
754 * stored in XACT and set up the right hand side B
755 *
756  srnamt = 'CLARHS'
757  CALL clarhs( matpath, xtype, uplo, ' ', n, n,
758  $ kl, ku, nrhs, a, lda, xact, lda,
759  $ b, lda, iseed, info )
760  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
761 *
762  srnamt = 'CSYTRS_ROOK'
763  CALL csytrs_rook( uplo, n, nrhs, afac, lda, iwork,
764  $ x, lda, info )
765 *
766 * Check error code from CSYTRS_ROOK and handle error.
767 *
768  IF( info.NE.0 )
769  $ CALL alaerh( path, 'CSYTRS_ROOK', info, 0,
770  $ uplo, n, n, -1, -1, nrhs, imat,
771  $ nfail, nerrs, nout )
772 *
773  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
774 *
775 * Compute the residual for the solution
776 *
777  CALL csyt02( uplo, n, nrhs, a, lda, x, lda, work,
778  $ lda, rwork, result( 5 ) )
779 *
780 *+ TEST 6
781 * Check solution from generated exact solution.
782 *
783  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
784  $ result( 6 ) )
785 *
786 * Print information about the tests that did not pass
787 * the threshold.
788 *
789  DO 210 k = 5, 6
790  IF( result( k ).GE.thresh ) THEN
791  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
792  $ CALL alahd( nout, path )
793  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
794  $ imat, k, result( k )
795  nfail = nfail + 1
796  END IF
797  210 CONTINUE
798  nrun = nrun + 2
799 *
800 * End do for each value of NRHS in NSVAL.
801 *
802  220 CONTINUE
803 *
804 *+ TEST 7
805 * Get an estimate of RCOND = 1/CNDNUM.
806 *
807  230 CONTINUE
808  anorm = clansy( '1', uplo, n, a, lda, rwork )
809  srnamt = 'CSYCON_ROOK'
810  CALL csycon_rook( uplo, n, afac, lda, iwork, anorm,
811  $ rcond, work, info )
812 *
813 * Check error code from CSYCON_ROOK and handle error.
814 *
815  IF( info.NE.0 )
816  $ CALL alaerh( path, 'CSYCON_ROOK', info, 0,
817  $ uplo, n, n, -1, -1, -1, imat,
818  $ nfail, nerrs, nout )
819 *
820 * Compute the test ratio to compare values of RCOND
821 *
822  result( 7 ) = sget06( rcond, rcondc )
823 *
824 * Print information about the tests that did not pass
825 * the threshold.
826 *
827  IF( result( 7 ).GE.thresh ) THEN
828  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
829  $ CALL alahd( nout, path )
830  WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
831  $ result( 7 )
832  nfail = nfail + 1
833  END IF
834  nrun = nrun + 1
835  240 CONTINUE
836 *
837  250 CONTINUE
838  260 CONTINUE
839  270 CONTINUE
840 *
841 * Print a summary of the results.
842 *
843  CALL alasum( path, nout, nfail, nrun, nerrs )
844 *
845  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
846  $ i2, ', test ', i2, ', ratio =', g12.5 )
847  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
848  $ i2, ', test(', i2, ') =', g12.5 )
849  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
850  $ ', test(', i2, ') =', g12.5 )
851  RETURN
852 *
853 * End of CCHKSY_ROOK
854 *
csytri_rook
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
Definition: csytri_rook.f:131
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
clatsy
subroutine clatsy(UPLO, N, X, LDX, ISEED)
CLATSY
Definition: clatsy.f:91
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
csyt02
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
Definition: csyt02.f:129
cgesvd
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:216
cerrsy
subroutine cerrsy(PATH, NUNIT)
CERRSY
Definition: cerrsy.f:57
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
clange
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
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
csytrs_rook
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
Definition: csytrs_rook.f:138
csyt03
subroutine csyt03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CSYT03
Definition: csyt03.f:128
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
csytrf_rook
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
Definition: csytrf_rook.f:210
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
clansy
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, or the element of largest absolute value of a complex symmetric matrix.
Definition: clansy.f:125
csycon_rook
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK
Definition: csycon_rook.f:141
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
csyt01_rook
subroutine csyt01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01_ROOK
Definition: csyt01_rook.f:127
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: