1#include <stdio.h>
2#include <stdlib.h>
3#include <string.h>
4#include <stdarg.h>
5#include "cblas.h"
6#include "cblas_f77.h"
7
8void cblas_xerbla(int info, const char *rout, const char *form, ...)
9{
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