LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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 *> \ingroup aux_eig
56 *
57 *> \par Further Details:
58 * =====================
59 *>
60 *> \verbatim
61 *>
62 *> The following variables are passed via the common blocks INFOC and
63 *> SRNAMC:
64 *>
65 *> INFOT INTEGER Expected integer return code
66 *> NOUT INTEGER Unit number for printing error messages
67 *> OK LOGICAL Set to .TRUE. if INFO = INFOT and
68 *> SRNAME = SRNAMT, otherwise set to .FALSE.
69 *> LERR LOGICAL Set to .TRUE., indicating that XERBLA was called
70 *> SRNAMT CHARACTER*(*) Expected name of calling subroutine
71 *> \endverbatim
72 *>
73 * =====================================================================
74  SUBROUTINE xerbla( SRNAME, INFO )
75 *
76 * -- LAPACK test routine --
77 * -- LAPACK is a software package provided by Univ. of Tennessee, --
78 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
79 *
80 * .. Scalar Arguments ..
81  CHARACTER*(*) SRNAME
82  INTEGER INFO
83 * ..
84 *
85 * =====================================================================
86 *
87 * .. Scalars in Common ..
88  LOGICAL LERR, OK
89  CHARACTER*32 SRNAMT
90  INTEGER INFOT, NOUT
91 * ..
92 * .. Intrinsic Functions ..
93  INTRINSIC len_trim
94 * ..
95 * .. Common blocks ..
96  COMMON / infoc / infot, nout, ok, lerr
97  COMMON / srnamc / srnamt
98 * ..
99 * .. Executable Statements ..
100 *
101  lerr = .true.
102  IF( info.NE.infot ) THEN
103  IF( infot.NE.0 ) THEN
104  WRITE( nout, fmt = 9999 )
105  $ srnamt( 1:len_trim( srnamt ) ), info, infot
106  ELSE
107  WRITE( nout, fmt = 9997 )
108  $ srname( 1:len_trim( srname ) ), info
109  END IF
110  ok = .false.
111  END IF
112  IF( srname.NE.srnamt ) THEN
113  WRITE( nout, fmt = 9998 )
114  $ srname( 1:len_trim( srname ) ),
115  $ srnamt( 1:len_trim( srnamt ) )
116  ok = .false.
117  END IF
118  RETURN
119 *
120  9999 FORMAT( ' *** XERBLA was called from ', a, ' with INFO = ', i6,
121  $ ' instead of ', i2, ' ***' )
122  9998 FORMAT( ' *** XERBLA was called with SRNAME = ', a,
123  $ ' instead of ', a9, ' ***' )
124  9997 FORMAT( ' *** On entry to ', a, ' parameter number ', i6,
125  $ ' had an illegal value ***' )
126 *
127 * End of XERBLA
128 *
129  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60