blis/frame/compat/cblas/src/cblas_zhemm.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_zhemm.c
   9  * This program is a C interface to zhemm.
  10  * Written by Keita Teranishi
  11  * 4/8/1998
  12  *
  13  */
  14
  15 #include "cblas.h"
  16 #include "cblas_f77.h"
  17 void cblas_zhemm(const enum CBLAS_ORDER Order, const  enum CBLAS_SIDE Side,
  18                  const enum CBLAS_UPLO Uplo, const int M, const int N,
  19                  const void *alpha, const void *A, const int lda,
  20                  const void *B, const int ldb, const void *beta,
  21                  void *C, const int ldc)
  22 {
  23    char SD, UL;
  24 #ifdef F77_CHAR
  25    F77_CHAR F77_SD, F77_UL;
  26 #else
  27    #define F77_SD &SD
  28    #define F77_UL &UL
  29 #endif
  30
  31 #ifdef F77_INT
  32    F77_INT F77_M=M, F77_N=N, 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_lda lda
  38    #define F77_ldb ldb
  39    #define F77_ldc ldc
  40 #endif
  41
  42    extern int CBLAS_CallFromC;
  43    extern int RowMajorStrg;
  44    RowMajorStrg = 0;
  45    CBLAS_CallFromC = 1;
  46
  47    if( Order == CblasColMajor )
  48    {
  49       if( Side == CblasRight) SD='R';
  50       else if ( Side == CblasLeft ) SD='L';
  51       else
  52       {
  53          cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side);
  54          CBLAS_CallFromC = 0;
  55          RowMajorStrg = 0;
  56          return;
  57       }
  58
  59       if( Uplo == CblasUpper) UL='U';
  60       else if ( Uplo == CblasLower ) UL='L';
  61       else
  62       {
  63          cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo);
  64          CBLAS_CallFromC = 0;
  65          RowMajorStrg = 0;
  66          return;
  67       }
  68
  69       #ifdef F77_CHAR
  70          F77_UL = C2F_CHAR(&UL);
  71          F77_SD = C2F_CHAR(&SD);
  72       #endif
  73
  74       F77_zhemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
  75                      B, &F77_ldb, beta, C, &F77_ldc);
  76    } else if (Order == CblasRowMajor)
  77    {
  78       RowMajorStrg = 1;
  79       if( Side == CblasRight) SD='L';
  80       else if ( Side == CblasLeft ) SD='R';
  81       else
  82       {
  83          cblas_xerbla(2, "cblas_zhemm", "Illegal Side setting, %d\n", Side);
  84          CBLAS_CallFromC = 0;
  85          RowMajorStrg = 0;
  86          return;
  87       }
  88
  89       if( Uplo == CblasUpper) UL='L';
  90       else if ( Uplo == CblasLower ) UL='U';
  91       else
  92       {
  93          cblas_xerbla(3, "cblas_zhemm", "Illegal Uplo setting, %d\n", Uplo);
  94          CBLAS_CallFromC = 0;
  95          RowMajorStrg = 0;
  96          return;
  97       }
  98
  99       #ifdef F77_CHAR
 100          F77_UL = C2F_CHAR(&UL);
 101          F77_SD = C2F_CHAR(&SD);
 102       #endif
 103
 104       F77_zhemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
 105                  &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
 106    }
 107    else  cblas_xerbla(1, "cblas_zhemm", "Illegal Order setting, %d\n", Order);
 108    CBLAS_CallFromC = 0;
 109    RowMajorStrg = 0;
 110    return;
 111 }
 112 #endif