01: #include <stdio.h>
02: #include <stdlib.h>
03: #include <string.h>
04: #include <stdarg.h>
05: #include "cblas.h"
06: #include "cblas_f77.h"
07: 
08: void cblas_xerbla(int info, const char *rout, const char *form, ...)
09: {
10:    extern int RowMajorStrg;
11:    char empty[1] = "";
12:    va_list argptr;
13: 
14:    va_start(argptr, form);
15: 
16:    if (RowMajorStrg)
17:    {
18:       if (strstr(rout,"gemm") != 0)
19:       {
20:          if      (info == 5 ) info =  4;
21:          else if (info == 4 ) info =  5;
22:          else if (info == 11) info =  9;
23:          else if (info == 9 ) info = 11;
24:       }
25:       else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
26:       {
27:          if      (info == 5 ) info =  4;
28:          else if (info == 4 ) info =  5;
29:       }
30:       else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0)
31:       {
32:          if      (info == 7 ) info =  6;
33:          else if (info == 6 ) info =  7;
34:       }
35:       else if (strstr(rout,"gemv") != 0)
36:       {
37:          if      (info == 4)  info = 3;
38:          else if (info == 3)  info = 4;
39:       }
40:       else if (strstr(rout,"gbmv") != 0)
41:       {
42:          if      (info == 4)  info = 3;
43:          else if (info == 3)  info = 4;
44:          else if (info == 6)  info = 5;
45:          else if (info == 5)  info = 6;
46:       }
47:       else if (strstr(rout,"ger") != 0)
48:       {
49:          if      (info == 3) info = 2;
50:          else if (info == 2) info = 3;
51:          else if (info == 8) info = 6;
52:          else if (info == 6) info = 8;
53:       }
54:       else if ( (strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0)
55:                  && strstr(rout,"her2k") == 0 )
56:       {
57:          if      (info == 8) info = 6;
58:          else if (info == 6) info = 8;
59:       }
60:    }
61:    if (info)
62:       fprintf(stderr, "Parameter %d to routine %s was incorrect\n", info, rout);
63:    vfprintf(stderr, form, argptr);
64:    va_end(argptr);
65:    if (info && !info)
66:       F77_xerbla(empty, &info); /* Force link of our F77 error handler */
67:    exit(-1);
68: }
69: