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, NSIZE 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 NSIZE = LEN_TRIM( SRNAMT ) 105 LERR = .TRUE. 106 IF( INFO.NE.INFOT ) THEN 107 IF( INFOT.NE.0 ) THEN 108 WRITE( NOUT, FMT = 9999 ) 109 $ SRNAMT( 1:NSIZE ), INFO, INFOT 110 ELSE 111 WRITE( NOUT, FMT = 9997 ) 112 $ SRNAME( 1:NSIZE ), INFO 113 END IF 114 OK = .FALSE. 115 END IF 116 IF( SRNAME( 1:NSIZE ).NE.SRNAMT( 1:NSIZE ) ) THEN 117 WRITE( NOUT, FMT = 9998 ) 118 $ SRNAME( 1:NSIZE ), 119 $ SRNAMT( 1:NSIZE ) 120 OK = .FALSE. 121 END IF 122 RETURN 123* 124 9999 FORMAT( ' *** XERBLA was called from ', A, ' with INFO = ', I6, 125 $ ' instead of ', I2, ' ***' ) 126 9998 FORMAT( ' *** XERBLA was called with SRNAME = ', A, 127 $ ' instead of ', A6, ' ***' ) 128 9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6, 129 $ ' had an illegal value ***' ) 130* 131* End of XERBLA 132* 133 END 134