void cblas_xerbla	(	int	info,
		const char *	rout,
		const char *	form,
			...
	)

Definition at line 8 of file c_xerbla.c.

{
   extern int cblas_lerr, cblas_info, cblas_ok;
   extern int link_xerbla;
   extern int RowMajorStrg;
   extern char *cblas_rout;
   
   /* Initially, c__3chke will call this routine with 
    * global variable link_xerbla=1, and F77_xerbla will set link_xerbla=0. 
    * This is done to fool the linker into loading these subroutines first 
    * instead of ones in the CBLAS or the legacy BLAS library.
    */
   if (link_xerbla) return;

   if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0){
      printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", rout, cblas_rout);
      cblas_ok = FALSE;
   }

   if (RowMajorStrg)
   {
      /* To properly check leading dimension problems in cblas__gemm, we 
       * need to do the following trick. When cblas__gemm is called with 
       * CblasRowMajor, the arguments A and B switch places in the call to 
       * f77__gemm. Thus when we test for bad leading dimension problems 
       * for A and B, lda is in position 11 instead of 9, and ldb is in 
       * position 9 instead of 11.
       */
      if (strstr(rout,"gemm") != 0)
      {
         if      (info == 5 ) info =  4;
         else if (info == 4 ) info =  5;
         else if (info == 11) info =  9;
         else if (info == 9 ) info = 11;
      }
      else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0)
      {
         if      (info == 5 ) info =  4;
         else if (info == 4 ) info =  5;
      }
      else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0)
      {
         if      (info == 7 ) info =  6;
         else if (info == 6 ) info =  7;
      }
      else if (strstr(rout,"gemv") != 0)
      {
         if      (info == 4)  info = 3;
         else if (info == 3)  info = 4;
      }
      else if (strstr(rout,"gbmv") != 0)
      {
         if      (info == 4)  info = 3;
         else if (info == 3)  info = 4;
         else if (info == 6)  info = 5;
         else if (info == 5)  info = 6;
      }
      else if (strstr(rout,"ger") != 0)
      {
         if      (info == 3) info = 2;
         else if (info == 2) info = 3;
         else if (info == 8) info = 6;
         else if (info == 6) info = 8;
      }
      else if ( ( strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0 )
               && strstr(rout,"her2k") == 0 )
      {
         if      (info == 8) info = 6;
         else if (info == 6) info = 8;
      }
   }

   if (info != cblas_info){
      printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, cblas_info, rout);
      cblas_lerr = PASSED;
      cblas_ok = FALSE;
   } else cblas_lerr = FAILED;
}