LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
xerbla.f
Go to the documentation of this file.
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
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  lerr = .true.
105  IF( info.NE.infot ) THEN
106  IF( infot.NE.0 ) THEN
107  WRITE( nout, fmt = 9999 )
108  $ srnamt( 1:len_trim( srnamt ) ), info, infot
109  ELSE
110  WRITE( nout, fmt = 9997 )
111  $ srname( 1:len_trim( srname ) ), info
112  END IF
113  ok = .false.
114  END IF
115  IF( srname.NE.srnamt ) THEN
116  WRITE( nout, fmt = 9998 )
117  $ srname( 1:len_trim( srname ) ),
118  $ srnamt( 1:len_trim( srnamt ) )
119  ok = .false.
120  END IF
121  RETURN
122 *
123  9999 FORMAT( ' *** XERBLA was called from ', a, ' with INFO = ', i6,
124  $ ' instead of ', i2, ' ***' )
125  9998 FORMAT( ' *** XERBLA was called with SRNAME = ', a,
126  $ ' instead of ', a6, ' ***' )
127  9997 FORMAT( ' *** On entry to ', a, ' parameter number ', i6,
128  $ ' had an illegal value ***' )
129 *
130 * End of XERBLA
131 *
132  END