00001 /* xerbla_array.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int xerbla_array__(char *srname_array__, integer * 00017 srname_len__, integer *info, ftnlen srname_array_len) 00018 { 00019 /* System generated locals */ 00020 integer i__1, i__2, i__3; 00021 00022 /* Builtin functions */ 00023 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); 00024 integer i_len(char *, ftnlen); 00025 00026 /* Local variables */ 00027 integer i__; 00028 extern /* Subroutine */ int xerbla_(char *, integer *); 00029 char srname[32]; 00030 00031 00032 /* -- LAPACK auxiliary routine (version 3.0) -- */ 00033 /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ 00034 /* September 19, 2006 */ 00035 00036 /* .. Scalar Arguments .. */ 00037 /* .. */ 00038 /* .. Array Arguments .. */ 00039 /* .. */ 00040 00041 /* Purpose */ 00042 /* ======= */ 00043 00044 /* XERBLA_ARRAY assists other languages in calling XERBLA, the LAPACK */ 00045 /* and BLAS error handler. Rather than taking a Fortran string argument */ 00046 /* as the function's name, XERBLA_ARRAY takes an array of single */ 00047 /* characters along with the array's length. XERBLA_ARRAY then copies */ 00048 /* up to 32 characters of that array into a Fortran string and passes */ 00049 /* that to XERBLA. If called with a non-positive SRNAME_LEN, */ 00050 /* XERBLA_ARRAY will call XERBLA with a string of all blank characters. */ 00051 00052 /* Say some macro or other device makes XERBLA_ARRAY available to C99 */ 00053 /* by a name lapack_xerbla and with a common Fortran calling convention. */ 00054 /* Then a C99 program could invoke XERBLA via: */ 00055 /* { */ 00056 /* int flen = strlen(__func__); */ 00057 /* lapack_xerbla(__func__, &flen, &info); */ 00058 /* } */ 00059 00060 /* Providing XERBLA_ARRAY is not necessary for intercepting LAPACK */ 00061 /* errors. XERBLA_ARRAY calls XERBLA. */ 00062 00063 /* Arguments */ 00064 /* ========= */ 00065 00066 /* SRNAME_ARRAY (input) CHARACTER(1) array, dimension (SRNAME_LEN) */ 00067 /* The name of the routine which called XERBLA_ARRAY. */ 00068 00069 /* SRNAME_LEN (input) INTEGER */ 00070 /* The length of the name in SRNAME_ARRAY. */ 00071 00072 /* INFO (input) INTEGER */ 00073 /* The position of the invalid parameter in the parameter list */ 00074 /* of the calling routine. */ 00075 00076 /* ===================================================================== */ 00077 00078 /* .. */ 00079 /* .. Local Scalars .. */ 00080 /* .. */ 00081 /* .. Local Arrays .. */ 00082 /* .. */ 00083 /* .. Intrinsic Functions .. */ 00084 /* .. */ 00085 /* .. External Functions .. */ 00086 /* .. */ 00087 /* .. Executable Statements .. */ 00088 /* Parameter adjustments */ 00089 --srname_array__; 00090 00091 /* Function Body */ 00092 s_copy(srname, "", (ftnlen)32, (ftnlen)0); 00093 /* Computing MIN */ 00094 i__2 = *srname_len__, i__3 = i_len(srname, (ftnlen)32); 00095 i__1 = min(i__2,i__3); 00096 for (i__ = 1; i__ <= i__1; ++i__) { 00097 *(unsigned char *)&srname[i__ - 1] = *(unsigned char *)& 00098 srname_array__[i__]; 00099 } 00100 xerbla_(srname, info); 00101 return 0; 00102 } /* xerbla_array__ */