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