SRC/xerbla_array.f

   1 *> \brief \b XERBLA_ARRAY
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download XERBLA_ARRAY + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/xerbla_array.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/xerbla_array.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/xerbla_array.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO)
  22 *
  23 *       .. Scalar Arguments ..
  24 *       INTEGER SRNAME_LEN, INFO
  25 *       ..
  26 *       .. Array Arguments ..
  27 *       CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
  28 *       ..
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *> XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK
  37 *> and BLAS error handler.  Rather than taking a Fortran string argument
  38 *> as the function's name, XERBLA_ARRAY takes an array of single
  39 *> characters along with the array's length.  XERBLA_ARRAY then copies
  40 *> up to 32 characters of that array into a Fortran string and passes
  41 *> that to XERBLA.  If called with a non-positive SRNAME_LEN,
  42 *> XERBLA_ARRAY will call XERBLA with a string of all blank characters.
  43 *>
  44 *> Say some macro or other device makes XERBLA_ARRAY available to C99
  45 *> by a name lapack_xerbla and with a common Fortran calling convention.
  46 *> Then a C99 program could invoke XERBLA via:
  47 *>    {
  48 *>      int flen = strlen(__func__);
  49 *>      lapack_xerbla(__func__, &flen, &info);
  50 *>    }
  51 *>
  52 *> Providing XERBLA_ARRAY is not necessary for intercepting LAPACK
  53 *> errors.  XERBLA_ARRAY calls XERBLA.
  54 *> \endverbatim
  55 *
  56 *  Arguments:
  57 *  ==========
  58 *
  59 *> \param[in] SRNAME_ARRAY
  60 *> \verbatim
  61 *>          SRNAME_ARRAY is CHARACTER(1) array, dimension (SRNAME_LEN)
  62 *>          The name of the routine which called XERBLA_ARRAY.
  63 *> \endverbatim
  64 *>
  65 *> \param[in] SRNAME_LEN
  66 *> \verbatim
  67 *>          SRNAME_LEN is INTEGER
  68 *>          The length of the name in SRNAME_ARRAY.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] INFO
  72 *> \verbatim
  73 *>          INFO is INTEGER
  74 *>          The position of the invalid parameter in the parameter list
  75 *>          of the calling routine.
  76 *> \endverbatim
  77 *
  78 *  Authors:
  79 *  ========
  80 *
  81 *> \author Univ. of Tennessee
  82 *> \author Univ. of California Berkeley
  83 *> \author Univ. of Colorado Denver
  84 *> \author NAG Ltd.
  85 *
  86 *> \date November 2011
  87 *
  88 *> \ingroup OTHERauxiliary
  89 *
  90 *  =====================================================================
  91       SUBROUTINE XERBLA_ARRAY( SRNAME_ARRAY, SRNAME_LEN, INFO)
  92 *
  93 *  -- LAPACK auxiliary routine (version 3.4.0) --
  94 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  95 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  96 *     November 2011
  97 *
  98 *     .. Scalar Arguments ..
  99       INTEGER SRNAME_LEN, INFO
 100 *     ..
 101 *     .. Array Arguments ..
 102       CHARACTER(1) SRNAME_ARRAY(SRNAME_LEN)
 103 *     ..
 104 *
 105 * =====================================================================
 106 *
 107 *     ..
 108 *     .. Local Scalars ..
 109       INTEGER I
 110 *     ..
 111 *     .. Local Arrays ..
 112       CHARACTER*32 SRNAME
 113 *     ..
 114 *     .. Intrinsic Functions ..
 115       INTRINSIC MIN, LEN
 116 *     ..
 117 *     .. External Functions ..
 118       EXTERNAL XERBLA
 119 *     ..
 120 *     .. Executable Statements ..
 121       SRNAME = ''
 122       DO I = 1, MIN( SRNAME_LEN, LEN( SRNAME ) )
 123          SRNAME( I:I ) = SRNAME_ARRAY( I )
 124       END DO
 125
 126       CALL XERBLA( SRNAME, INFO )
 127
 128       RETURN
 129       END