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 8 void 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
