annotate ext/cblas/src/cblas_xerbla.c @ 515:08bcc06c38ec tip master

Remove fast-math
author Chris Cannam <cannam@all-day-breakfast.com>
date Tue, 28 Jan 2020 15:27:37 +0000
parents 905e45637745
children
rev   line source
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 }