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 December 2016 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.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 ', A9, ' ***' ) 127 9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6, 128 $ ' had an illegal value ***' ) 129* 130* End of XERBLA 131* 132 END 133