1*> \brief \b XERBLA
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 XERBLA( SRNAME, INFO )
12*
13*       .. Scalar Arguments ..
14*       CHARACTER*(*)      SRNAME
15*       INTEGER            INFO
16*       ..
17*
18*
19*> \par Purpose:
20*  =============
21*>
22*> \verbatim
23*>
24*> This is a special version of XERBLA to be used only as part of
25*> the test program for testing error exits from the LAPACK routines.
26*> Error messages are printed if INFO.NE.INFOT or if SRNAME.NE.SRNAMT,
27*> where INFOT and SRNAMT are values stored in COMMON.
28*> \endverbatim
29*
30*  Arguments:
31*  ==========
32*
33*> \param[in] SRNAME
34*> \verbatim
35*>          SRNAME is CHARACTER*(*)
36*>          The name of the subroutine calling XERBLA.  This name should
37*>          match the COMMON variable SRNAMT.
38*> \endverbatim
39*>
40*> \param[in] INFO
41*> \verbatim
42*>          INFO is INTEGER
43*>          The error return code from the calling subroutine.  INFO
44*>          should equal the COMMON variable INFOT.
45*> \endverbatim
46*
47*  Authors:
48*  ========
49*
50*> \author Univ. of Tennessee
51*> \author Univ. of California Berkeley
52*> \author Univ. of Colorado Denver
53*> \author NAG Ltd.
54*
55*> \date November 2011
56*
57*> \ingroup aux_eig
58*
59*> \par Further Details:
60*  =====================
61*>
62*> \verbatim
63*>
64*>  The following variables are passed via the common blocks INFOC and
65*>  SRNAMC:
66*>
67*>  INFOT   INTEGER      Expected integer return code
68*>  NOUT    INTEGER      Unit number for printing error messages
69*>  OK      LOGICAL      Set to .TRUE. if INFO = INFOT and
70*>                       SRNAME = SRNAMT, otherwise set to .FALSE.
71*>  LERR    LOGICAL      Set to .TRUE., indicating that XERBLA was called
72*>  SRNAMT  CHARACTER*(*) Expected name of calling subroutine
73*> \endverbatim
74*>
75*  =====================================================================
76      SUBROUTINE XERBLA( SRNAME, INFO )
77*
78*  -- LAPACK test routine (version 3.4.0) --
79*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
80*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
81*     November 2011
82*
83*     .. Scalar Arguments ..
84      CHARACTER*(*)      SRNAME
85      INTEGER            INFO
86*     ..
87*
88*  =====================================================================
89*
90*     .. Scalars in Common ..
91      LOGICAL            LERR, OK
92      CHARACTER*32       SRNAMT
93      INTEGER            INFOT, NOUT, NSIZE
94*     ..
95*     .. Intrinsic Functions ..
96      INTRINSIC          LEN_TRIM
97*     ..
98*     .. Common blocks ..
99      COMMON             / INFOC / INFOT, NOUT, OK, LERR
100      COMMON             / SRNAMC / SRNAMT
101*     ..
102*     .. Executable Statements ..
103*
104      NSIZE = LEN_TRIM( SRNAMT )
105      LERR = .TRUE.
106      IF( INFO.NE.INFOT ) THEN
107         IF( INFOT.NE.0 ) THEN
108            WRITE( NOUT, FMT = 9999 )
109     $     SRNAMT( 1:NSIZE ), INFO, INFOT
110         ELSE
111            WRITE( NOUT, FMT = 9997 )
112     $     SRNAME( 1:NSIZE ), INFO
113         END IF
114         OK = .FALSE.
115      END IF
116      IF( SRNAME( 1:NSIZE ).NE.SRNAMT( 1:NSIZE ) ) THEN
117         WRITE( NOUT, FMT = 9998 )
118     $     SRNAME( 1:NSIZE ),
119     $     SRNAMT( 1:NSIZE )
120         OK = .FALSE.
121      END IF
122      RETURN
123*
124 9999 FORMAT( ' *** XERBLA was called from ', A, ' with INFO = ', I6,
125     $      ' instead of ', I2, ' ***' )
126 9998 FORMAT( ' *** XERBLA was called with SRNAME = ', A,
127     $      ' instead of ', A6, ' ***' )
128 9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6,
129     $      ' had an illegal value ***' )
130*
131*     End of XERBLA
132*
133      END
134