LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 void cblas_xerbla ( int info, const char * rout, const char * form, ... )

Definition at line 8 of file c_xerbla.c.

9 {
10  extern int cblas_lerr, cblas_info, cblas_ok;
12  extern int RowMajorStrg;
13  extern char *cblas_rout;
14
15  /* Initially, c__3chke will call this routine with
18  * instead of ones in the CBLAS or the legacy BLAS library.
19  */
21
22  if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0){
23  printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", rout, cblas_rout);
24  cblas_ok = FALSE;
25  }
26
27  if (RowMajorStrg)
28  {
29  /* To properly check leading dimension problems in cblas__gemm, we
30  * need to do the following trick. When cblas__gemm is called with
31  * CblasRowMajor, the arguments A and B switch places in the call to
32  * f77__gemm. Thus when we test for bad leading dimension problems
33  * for A and B, lda is in position 11 instead of 9, and ldb is in
34  * position 9 instead of 11.
35  */
36  if (strstr(rout,"gemm") != 0)
37  {
38  if (info == 5 ) info = 4;
39  else if (info == 4 ) info = 5;
40  else if (info == 11) info = 9;
41  else if (info == 9 ) info = 11;
42  }
43  else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
44  {
45  if (info == 5 ) info = 4;
46  else if (info == 4 ) info = 5;
47  }
48  else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0)
49  {
50  if (info == 7 ) info = 6;
51  else if (info == 6 ) info = 7;
52  }
53  else if (strstr(rout,"gemv") != 0)
54  {
55  if (info == 4) info = 3;
56  else if (info == 3) info = 4;
57  }
58  else if (strstr(rout,"gbmv") != 0)
59  {
60  if (info == 4) info = 3;
61  else if (info == 3) info = 4;
62  else if (info == 6) info = 5;
63  else if (info == 5) info = 6;
64  }
65  else if (strstr(rout,"ger") != 0)
66  {
67  if (info == 3) info = 2;
68  else if (info == 2) info = 3;
69  else if (info == 8) info = 6;
70  else if (info == 6) info = 8;
71  }
72  else if ( ( strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0 )
73  && strstr(rout,"her2k") == 0 )
74  {
75  if (info == 8) info = 6;
76  else if (info == 6) info = 8;
77  }
78  }
79
80  if (info != cblas_info){
81  printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, cblas_info, rout);
82  cblas_lerr = PASSED;
83  cblas_ok = FALSE;
84  } else cblas_lerr = FAILED;
85 }
#define PASSED
Definition: cblas_test.h:11
#define FALSE
Definition: cblas_test.h:14
int RowMajorStrg
Definition: cblas_globals.c:2
int cblas_info
Definition: c_c2chke.c:6
#define FAILED
Definition: cblas_test.h:15
char * cblas_rout
Definition: c_c2chke.c:8
int cblas_lerr
Definition: c_c2chke.c:6