diff options
author | shmel1k <shmel1k@ydb.tech> | 2022-09-02 12:44:59 +0300 |
---|---|---|
committer | shmel1k <shmel1k@ydb.tech> | 2022-09-02 12:44:59 +0300 |
commit | 90d450f74722da7859d6f510a869f6c6908fd12f (patch) | |
tree | 538c718dedc76cdfe37ad6d01ff250dd930d9278 /contrib/libs/cblas/xerbla_array.c | |
parent | 01f64c1ecd0d4ffa9e3a74478335f1745f26cc75 (diff) | |
download | ydb-90d450f74722da7859d6f510a869f6c6908fd12f.tar.gz |
[] add metering mode to CLI
Diffstat (limited to 'contrib/libs/cblas/xerbla_array.c')
-rw-r--r-- | contrib/libs/cblas/xerbla_array.c | 102 |
1 files changed, 102 insertions, 0 deletions
diff --git a/contrib/libs/cblas/xerbla_array.c b/contrib/libs/cblas/xerbla_array.c new file mode 100644 index 00000000000..d4e4c249026 --- /dev/null +++ b/contrib/libs/cblas/xerbla_array.c @@ -0,0 +1,102 @@ +/* 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__ */ |