01: #include <stdio.h>
02: #include <ctype.h>
03: #include "cblas.h"
04: #include "cblas_f77.h"
05: 
06: #define XerblaStrLen 6
07: #define XerblaStrLen1 7
08: 
09: #ifdef F77_CHAR
10: void F77_xerbla(F77_CHAR F77_srname, void *vinfo)
11: #else
12: void F77_xerbla(char *srname, void *vinfo)
13: #endif
14: 
15: {
16: #ifdef F77_CHAR
17:    char *srname;
18: #endif
19: 
20:    char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'};
21: 
22: #ifdef F77_INT
23:    F77_INT *info=vinfo;
24:    F77_INT i;
25: #else
26:    int *info= (int *)vinfo;
27:    int i;
28: #endif
29: 
30:    extern int CBLAS_CallFromC;
31: 
32: #ifdef F77_CHAR
33:    srname = F2C_STR(F77_srname, XerblaStrLen);
34: #endif
35: 
36:    if (CBLAS_CallFromC)
37:    {
38:       for(i=0; i != XerblaStrLen; i++) rout[i+6] = tolower(srname[i]);
39:       rout[XerblaStrLen+6] = '\0';
40:       cblas_xerbla(*info+1,rout,"");
41:    }
42:    else
43:    {
44:       fprintf(stderr, "Parameter %d to routine %s was incorrect\n",
45:               *info, srname);
46:    }
47: }
48: