LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
xerbla.f
Go to the documentation of this file.
00001 *> \brief \b XERBLA
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE XERBLA( SRNAME, INFO )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       CHARACTER*(*)      SRNAME
00015 *       INTEGER            INFO
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> This is a special version of XERBLA to be used only as part of
00025 *> the test program for testing error exits from the LAPACK routines.
00026 *> Error messages are printed if INFO.NE.INFOT or if SRNAME.NE.SRNAMT,
00027 *> where INFOT and SRNAMT are values stored in COMMON.
00028 *> \endverbatim
00029 *
00030 *  Arguments:
00031 *  ==========
00032 *
00033 *> \param[in] SRNAME
00034 *> \verbatim
00035 *>          SRNAME is CHARACTER*(*)
00036 *>          The name of the subroutine calling XERBLA.  This name should
00037 *>          match the COMMON variable SRNAMT.
00038 *> \endverbatim
00039 *>
00040 *> \param[in] INFO
00041 *> \verbatim
00042 *>          INFO is INTEGER
00043 *>          The error return code from the calling subroutine.  INFO
00044 *>          should equal the COMMON variable INFOT.
00045 *> \endverbatim
00046 *
00047 *  Authors:
00048 *  ========
00049 *
00050 *> \author Univ. of Tennessee 
00051 *> \author Univ. of California Berkeley 
00052 *> \author Univ. of Colorado Denver 
00053 *> \author NAG Ltd. 
00054 *
00055 *> \date November 2011
00056 *
00057 *> \ingroup aux_eig
00058 *
00059 *> \par Further Details:
00060 *  =====================
00061 *>
00062 *> \verbatim
00063 *>
00064 *>  The following variables are passed via the common blocks INFOC and
00065 *>  SRNAMC:
00066 *>
00067 *>  INFOT   INTEGER      Expected integer return code
00068 *>  NOUT    INTEGER      Unit number for printing error messages
00069 *>  OK      LOGICAL      Set to .TRUE. if INFO = INFOT and
00070 *>                       SRNAME = SRNAMT, otherwise set to .FALSE.
00071 *>  LERR    LOGICAL      Set to .TRUE., indicating that XERBLA was called
00072 *>  SRNAMT  CHARACTER*(*) Expected name of calling subroutine
00073 *> \endverbatim
00074 *>
00075 *  =====================================================================
00076       SUBROUTINE XERBLA( SRNAME, INFO )
00077 *
00078 *  -- LAPACK test routine (version 3.4.0) --
00079 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00080 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00081 *     November 2011
00082 *
00083 *     .. Scalar Arguments ..
00084       CHARACTER*(*)      SRNAME
00085       INTEGER            INFO
00086 *     ..
00087 *
00088 *  =====================================================================
00089 *
00090 *     .. Scalars in Common ..
00091       LOGICAL            LERR, OK
00092       CHARACTER*32       SRNAMT
00093       INTEGER            INFOT, NOUT
00094 *     ..
00095 *     .. Intrinsic Functions ..
00096       INTRINSIC          LEN_TRIM
00097 *     ..
00098 *     .. Common blocks ..
00099       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00100       COMMON             / SRNAMC / SRNAMT
00101 *     ..
00102 *     .. Executable Statements ..
00103 *
00104       LERR = .TRUE.
00105       IF( INFO.NE.INFOT ) THEN
00106          IF( INFOT.NE.0 ) THEN
00107             WRITE( NOUT, FMT = 9999 )
00108      $     SRNAMT( 1:LEN_TRIM( SRNAMT ) ), INFO, INFOT
00109          ELSE
00110             WRITE( NOUT, FMT = 9997 )
00111      $     SRNAME( 1:LEN_TRIM( SRNAME ) ), INFO
00112          END IF
00113          OK = .FALSE.
00114       END IF
00115       IF( SRNAME.NE.SRNAMT ) THEN
00116          WRITE( NOUT, FMT = 9998 )
00117      $     SRNAME( 1:LEN_TRIM( SRNAME ) ),
00118      $     SRNAMT( 1:LEN_TRIM( SRNAMT ) )
00119          OK = .FALSE.
00120       END IF
00121       RETURN
00122 *
00123  9999 FORMAT( ' *** XERBLA was called from ', A, ' with INFO = ', I6,
00124      $      ' instead of ', I2, ' ***' )
00125  9998 FORMAT( ' *** XERBLA was called with SRNAME = ', A,
00126      $      ' instead of ', A6, ' ***' )
00127  9997 FORMAT( ' *** On entry to ', A, ' parameter number ', I6,
00128      $      ' had an illegal value ***' )
00129 *
00130 *     End of XERBLA
00131 *
00132       END
 All Files Functions