blis/frame/compat/cblas/src/cblas_zgemm.c

   1 #include "bli_config.h"
   2 #include "bli_system.h"
   3 #include "bli_type_defs.h"
   4 #include "bli_cblas.h"
   5 #ifdef BLIS_ENABLE_CBLAS
   6 /*
   7  *
   8  * cblas_zgemm.c
   9  * This program is a C interface to zgemm.
  10  * Written by Keita Teranishi
  11  * 4/8/1998
  12  *
  13  */
  14
  15 #include "cblas.h"
  16 #include "cblas_f77.h"
  17 void cblas_zgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
  18                  const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
  19                  const int K, const void *alpha, const void  *A,
  20                  const int lda, const void  *B, const int ldb,
  21                  const void *beta, void  *C, const int ldc)
  22 {
  23    char TA, TB;
  24 #ifdef F77_CHAR
  25    F77_CHAR F77_TA, F77_TB;
  26 #else
  27    #define F77_TA &TA
  28    #define F77_TB &TB
  29 #endif
  30
  31 #ifdef F77_INT
  32    F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
  33    F77_INT F77_ldc=ldc;
  34 #else
  35    #define F77_M M
  36    #define F77_N N
  37    #define F77_K K
  38    #define F77_lda lda
  39    #define F77_ldb ldb
  40    #define F77_ldc ldc
  41 #endif
  42
  43    extern int CBLAS_CallFromC;
  44    extern int RowMajorStrg;
  45    RowMajorStrg = 0;
  46    CBLAS_CallFromC = 1;
  47
  48    if( Order == CblasColMajor )
  49    {
  50       if(TransA == CblasTrans) TA='T';
  51       else if ( TransA == CblasConjTrans ) TA='C';
  52       else if ( TransA == CblasNoTrans )   TA='N';
  53       else
  54       {
  55          cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA);
  56          CBLAS_CallFromC = 0;
  57          RowMajorStrg = 0;
  58          return;
  59       }
  60
  61       if(TransB == CblasTrans) TB='T';
  62       else if ( TransB == CblasConjTrans ) TB='C';
  63       else if ( TransB == CblasNoTrans )   TB='N';
  64       else
  65       {
  66          cblas_xerbla(3, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
  67          CBLAS_CallFromC = 0;
  68          RowMajorStrg = 0;
  69          return;
  70       }
  71
  72       #ifdef F77_CHAR
  73          F77_TA = C2F_CHAR(&TA);
  74          F77_TB = C2F_CHAR(&TB);
  75       #endif
  76
  77       F77_zgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, alpha, A,
  78                      &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
  79    } else if (Order == CblasRowMajor)
  80    {
  81       RowMajorStrg = 1;
  82       if(TransA == CblasTrans) TB='T';
  83       else if ( TransA == CblasConjTrans ) TB='C';
  84       else if ( TransA == CblasNoTrans )   TB='N';
  85       else
  86       {
  87          cblas_xerbla(2, "cblas_zgemm","Illegal TransA setting, %d\n", TransA);
  88          CBLAS_CallFromC = 0;
  89          RowMajorStrg = 0;
  90          return;
  91       }
  92       if(TransB == CblasTrans) TA='T';
  93       else if ( TransB == CblasConjTrans ) TA='C';
  94       else if ( TransB == CblasNoTrans )   TA='N';
  95       else
  96       {
  97          cblas_xerbla(2, "cblas_zgemm","Illegal TransB setting, %d\n", TransB);
  98          CBLAS_CallFromC = 0;
  99          RowMajorStrg = 0;
 100          return;
 101       }
 102       #ifdef F77_CHAR
 103          F77_TA = C2F_CHAR(&TA);
 104          F77_TB = C2F_CHAR(&TB);
 105       #endif
 106
 107       F77_zgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, alpha, B,
 108                   &F77_ldb, A, &F77_lda, beta, C, &F77_ldc);
 109    }
 110    else  cblas_xerbla(1, "cblas_zgemm", "Illegal Order setting, %d\n", Order);
 111    CBLAS_CallFromC = 0;
 112    RowMajorStrg = 0;
 113    return;
 114 }
 115 #endif