LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ xerbla()

subroutine xerbla ( character*(*)  SRNAME,
integer  INFO 
)

XERBLA

Purpose:
 This is a special version of XERBLA to be used only as part of
 the test program for testing error exits from the LAPACK routines.
 Error messages are printed if INFO.NE.INFOT or if SRNAME.NE.SRNAMT,
 where INFOT and SRNAMT are values stored in COMMON.
Parameters
[in]SRNAME
          SRNAME is CHARACTER*(*)
          The name of the subroutine calling XERBLA.  This name should
          match the COMMON variable SRNAMT.
[in]INFO
          INFO is INTEGER
          The error return code from the calling subroutine.  INFO
          should equal the COMMON variable INFOT.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016
Further Details:
  The following variables are passed via the common blocks INFOC and
  SRNAMC:

  INFOT   INTEGER      Expected integer return code
  NOUT    INTEGER      Unit number for printing error messages
  OK      LOGICAL      Set to .TRUE. if INFO = INFOT and
                       SRNAME = SRNAMT, otherwise set to .FALSE.
  LERR    LOGICAL      Set to .TRUE., indicating that XERBLA was called
  SRNAMT  CHARACTER*(*) Expected name of calling subroutine

Definition at line 77 of file xerbla.f.

77 *
78 * -- LAPACK test routine (version 3.7.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 * December 2016
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 *