ydb/contrib/libs/cblas/xerbla_array.c

/* xerbla_array.f -- translated by f2c (version 20061008).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"
#include "blaswrap.h"

/* Subroutine */ int xerbla_array__(char *srname_array__, integer *
	srname_len__, integer *info, ftnlen srname_array_len)
{
    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer i_len(char *, ftnlen);

    /* Local variables */
    integer i__;
    extern /* Subroutine */ int xerbla_(char *, integer *);
    char srname[32];


/*  -- LAPACK auxiliary routine (version 3.0) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
/*     September 19, 2006 */

/*     .. Scalar Arguments .. */
/*     .. */
/*     .. Array Arguments .. */
/*     .. */

/*  Purpose */
/*  ======= */

/*  XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK */
/*  and BLAS error handler.  Rather than taking a Fortran string argument */
/*  as the function's name, XERBLA_ARRAY takes an array of single */
/*  characters along with the array's length.  XERBLA_ARRAY then copies */
/*  up to 32 characters of that array into a Fortran string and passes */
/*  that to XERBLA.  If called with a non-positive SRNAME_LEN, */
/*  XERBLA_ARRAY will call XERBLA with a string of all blank characters. */

/*  Say some macro or other device makes XERBLA_ARRAY available to C99 */
/*  by a name lapack_xerbla and with a common Fortran calling convention. */
/*  Then a C99 program could invoke XERBLA via: */
/*     { */
/*       int flen = strlen(__func__); */
/*       lapack_xerbla(__func__, &flen, &info); */
/*     } */

/*  Providing XERBLA_ARRAY is not necessary for intercepting LAPACK */
/*  errors.  XERBLA_ARRAY calls XERBLA. */

/*  Arguments */
/*  ========= */

/*  SRNAME_ARRAY (input) CHARACTER(1) array, dimension (SRNAME_LEN) */
/*          The name of the routine which called XERBLA_ARRAY. */

/*  SRNAME_LEN (input) INTEGER */
/*          The length of the name in SRNAME_ARRAY. */

/*  INFO    (input) INTEGER */
/*          The position of the invalid parameter in the parameter list */
/*          of the calling routine. */

/* ===================================================================== */

/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
/*     .. Intrinsic Functions .. */
/*     .. */
/*     .. External Functions .. */
/*     .. */
/*     .. Executable Statements .. */
    /* Parameter adjustments */
    --srname_array__;

    /* Function Body */
    s_copy(srname, "", (ftnlen)32, (ftnlen)0);
/* Computing MIN */
    i__2 = *srname_len__, i__3 = i_len(srname, (ftnlen)32);
    i__1 = min(i__2,i__3);
    for (i__ = 1; i__ <= i__1; ++i__) {
	*(unsigned char *)&srname[i__ - 1] = *(unsigned char *)&
		srname_array__[i__];
    }
    xerbla_(srname, info);
    return 0;
} /* xerbla_array__ */