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*> \ingroup aux_eig 56* 57*> \par Further Details: 58* ===================== 59*> 60*> \verbatim 61*> 62*> The following variables are passed via the common blocks INFOC and 63*> SRNAMC: 64*> 65*> INFOT INTEGER Expected integer return code 66*> NOUT INTEGER Unit number for printing error messages 67*> OK LOGICAL Set to .TRUE. if INFO = INFOT and 68*> SRNAME = SRNAMT, otherwise set to .FALSE. 69*> LERR LOGICAL Set to .TRUE., indicating that XERBLA was called 70*> SRNAMT CHARACTER*(*) Expected name of calling subroutine 71*> \endverbatim 72*> 73* ===================================================================== 74 SUBROUTINE XERBLA( SRNAME, INFO ) 75* 76* -- LAPACK test routine -- 77* -- LAPACK is a software package provided by Univ. of Tennessee, -- 78* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 79* 80* .. Scalar Arguments .. 81 CHARACTER*(*) SRNAME 82 INTEGER INFO 83* .. 84* 85* ===================================================================== 86* 87* .. Scalars in Common .. 88 LOGICAL LERR, OK 89 CHARACTER*32 SRNAMT 90 INTEGER INFOT, NOUT 91* .. 92* .. Intrinsic Functions .. 93 INTRINSIC LEN_TRIM 94* .. 95* .. Common blocks .. 96 COMMON / INFOC / INFOT, NOUT, OK, LERR 97 COMMON / SRNAMC / SRNAMT 98* .. 99* .. Executable Statements .. 100* 101 LERR = .TRUE. 102 IF( INFO.NE.INFOT ) THEN 103 IF( INFOT.NE.0 ) THEN 104 WRITE( NOUT, FMT = 9999 ) 105 $ SRNAMT( 1:LEN_TRIM( SRNAMT ) ), INFO, INFOT 106 ELSE 107 WRITE( NOUT, FMT = 9997 ) 108 $ SRNAME( 1:LEN_TRIM( SRNAME ) ), INFO 109 END IF 110 OK = .FALSE. 111 END IF 112 IF( SRNAME.NE.SRNAMT ) THEN 113 WRITE( NOUT, FMT = 9998 ) 114 $ SRNAME( 1:LEN_TRIM( SRNAME ) ), 115 $ SRNAMT( 1:LEN_TRIM( SRNAMT ) ) 116 OK = .FALSE. 117 END IF 118 RETURN 119* 120 9999 FORMAT( ' *** XERBLA was called from ', A, ' with INFO = ', I6, 121 $ ' instead of ', I2, ' ***' ) 122 9998 FORMAT( ' *** XERBLA was called with SRNAME = ', A, 123 $ ' instead of ', A9, ' ***' ) 124 9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6, 125 $ ' had an illegal value ***' ) 126* 127* End of XERBLA 128* 129 END 130