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.

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 74 of file xerbla.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. 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
*