1 #include <stdio.h>
2 #include <ctype.h>
3 #include "cblas.h"
4 #include "cblas_f77.h"
5
6 #define XerblaStrLen 6
7 #define XerblaStrLen1 7
8
9 #ifdef F77_CHAR
F77_xerbla(F77_CHAR F77_srname,void * vinfo)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=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