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.

*
*  -- LAPACK test routine (version 3.7.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     December 2016
*
*     .. Scalar Arguments ..
      CHARACTER*(*)      SRNAME
      INTEGER            INFO
*     ..
*
*  =====================================================================
*
*     .. Scalars in Common ..
      LOGICAL            LERR, OK
      CHARACTER*32       SRNAMT
      INTEGER            INFOT, NOUT
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          len_trim
*     ..
*     .. Common blocks ..
      COMMON             / infoc / infot, nout, ok, lerr
      COMMON             / srnamc / srnamt
*     ..
*     .. Executable Statements ..
*
      lerr = .true.
      IF( info.NE.infot ) THEN
         IF( infot.NE.0 ) THEN
            WRITE( nout, fmt = 9999 )
     $     srnamt( 1:len_trim( srnamt ) ), info, infot
         ELSE
            WRITE( nout, fmt = 9997 )
     $     srname( 1:len_trim( srname ) ), info
         END IF
         ok = .false.
      END IF
      IF( srname.NE.srnamt ) THEN
         WRITE( nout, fmt = 9998 )
     $     srname( 1:len_trim( srname ) ),
     $     srnamt( 1:len_trim( srnamt ) )
         ok = .false.
      END IF
      RETURN
*
 9999 FORMAT( ' *** XERBLA was called from ', a, ' with INFO = ', i6,
     $      ' instead of ', i2, ' ***' )
 9998 FORMAT( ' *** XERBLA was called with SRNAME = ', a,
     $      ' instead of ', a6, ' ***' )
 9997 FORMAT( ' *** On entry to ', a, ' parameter number ', i6,
     $      ' had an illegal value ***' )
*
*     End of XERBLA
*