1*> \brief \b ALASVM
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE ALASVM( TYPE, NOUT, NFAIL, NRUN, NERRS )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER*3        TYPE
15*       INTEGER            NFAIL, NOUT, NRUN, NERRS
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> ALASVM prints a summary of results from one of the -DRV- routines.
25*> \endverbatim
26*
27*  Arguments:
28*  ==========
29*
30*> \param[in] TYPE
31*> \verbatim
32*>          TYPE is CHARACTER*3
33*>          The LAPACK path name.
34*> \endverbatim
35*>
36*> \param[in] NOUT
37*> \verbatim
38*>          NOUT is INTEGER
39*>          The unit number on which results are to be printed.
40*>          NOUT >= 0.
41*> \endverbatim
42*>
43*> \param[in] NFAIL
44*> \verbatim
45*>          NFAIL is INTEGER
46*>          The number of tests which did not pass the threshold ratio.
47*> \endverbatim
48*>
49*> \param[in] NRUN
50*> \verbatim
51*>          NRUN is INTEGER
52*>          The total number of tests.
53*> \endverbatim
54*>
55*> \param[in] NERRS
56*> \verbatim
57*>          NERRS is INTEGER
58*>          The number of error messages recorded.
59*> \endverbatim
60*
61*  Authors:
62*  ========
63*
64*> \author Univ. of Tennessee
65*> \author Univ. of California Berkeley
66*> \author Univ. of Colorado Denver
67*> \author NAG Ltd.
68*
69*> \date November 2011
70*
71*> \ingroup aux_lin
72*
73*  =====================================================================
74      SUBROUTINE ALASVM( TYPE, NOUT, NFAIL, NRUN, NERRS )
75*
76*  -- LAPACK test routine (version 3.4.0) --
77*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
78*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
79*     November 2011
80*
81*     .. Scalar Arguments ..
82      CHARACTER*3        TYPE
83      INTEGER            NFAIL, NOUT, NRUN, NERRS
84*     ..
85*
86*  =====================================================================
87*
88*     .. Executable Statements ..
89*
90      IF( NFAIL.GT.0 ) THEN
91         WRITE( NOUT, FMT = 9999 )TYPE, NFAIL, NRUN
92      ELSE
93         WRITE( NOUT, FMT = 9998 )TYPE, NRUN
94      END IF
95      IF( NERRS.GT.0 ) THEN
96         WRITE( NOUT, FMT = 9997 )NERRS
97      END IF
98*
99 9999 FORMAT( 1X, A3, ' drivers: ', I6, ' out of ', I6,
100     $      ' tests failed to pass the threshold' )
101 9998 FORMAT( /1X, 'All tests for ', A3, ' drivers  passed the ',
102     $      'threshold ( ', I6, ' tests run)' )
103 9997 FORMAT( 14X, I6, ' error messages recorded' )
104      RETURN
105*
106*     End of ALASVM
107*
108      END
109