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