Home | History | Annotate | Download | only in src 
      1 /*
      2  *
      3  * cblas_sgemm.c
      4  * This program is a C interface to sgemm.
      5  * Written by Keita Teranishi
      6  * 4/8/1998
      7  *
      8  */
      9 
     10 #include "cblas.h"
     11 #include "cblas_f77.h"
     12 void cblas_sgemm(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 float alpha, const float  *A,
     15                  const int lda, const float  *B, const int ldb,
     16                  const float beta, float  *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    if( Order == CblasColMajor )
     43    {
     44       if(TransA == CblasTrans) TA='T';
     45       else if ( TransA == CblasConjTrans ) TA='C';
     46       else if ( TransA == CblasNoTrans )   TA='N';
     47       else
     48       {
     49          cblas_xerbla(2, "cblas_sgemm",
     50                        "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_sgemm",
     62                        "Illegal TransB setting, %d\n", TransB);
     63          CBLAS_CallFromC = 0;
     64          RowMajorStrg = 0;
     65          return;
     66       }
     67 
     68       #ifdef F77_CHAR
     69          F77_TA = C2F_CHAR(&TA);
     70          F77_TB = C2F_CHAR(&TB);
     71       #endif
     72 
     73       F77_sgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A, &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_sgemm",
     83                        "Illegal TransA setting, %d\n", TransA);
     84          CBLAS_CallFromC = 0;
     85          RowMajorStrg = 0;
     86          return;
     87       }
     88       if(TransB == CblasTrans) TA='T';
     89       else if ( TransB == CblasConjTrans ) TA='C';
     90       else if ( TransB == CblasNoTrans )   TA='N';
     91       else
     92       {
     93          cblas_xerbla(2, "cblas_sgemm",
     94                        "Illegal TransA setting, %d\n", TransA);
     95          CBLAS_CallFromC = 0;
     96          RowMajorStrg = 0;
     97          return;
     98       }
     99       #ifdef F77_CHAR
    100          F77_TA = C2F_CHAR(&TA);
    101          F77_TB = C2F_CHAR(&TB);
    102       #endif
    103 
    104       F77_sgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B, &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
    105    } else
    106      cblas_xerbla(1, "cblas_sgemm",
    107                      "Illegal Order setting, %d\n", Order);
    108    CBLAS_CallFromC = 0;
    109    RowMajorStrg = 0;
    110 }
    111