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