Chris@202: /*
Chris@202:  *
Chris@202:  * cblas_dgemm.c
Chris@202:  * This program is a C interface to dgemm.
Chris@202:  * Written by Keita Teranishi
Chris@202:  * 4/8/1998
Chris@202:  *
Chris@202:  */
Chris@202: 
Chris@202: #include "cblas.h"
Chris@202: #include "cblas_f77.h"
Chris@202: void cblas_dgemm(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TransA,
Chris@202:                  const enum CBLAS_TRANSPOSE TransB, const int M, const int N,
Chris@202:                  const int K, const double alpha, const double  *A,
Chris@202:                  const int lda, const double  *B, const int ldb,
Chris@202:                  const double beta, double  *C, const int ldc)
Chris@202: {
Chris@202:    char TA, TB;   
Chris@202: #ifdef F77_CHAR
Chris@202:    F77_CHAR F77_TA, F77_TB;
Chris@202: #else
Chris@202:    #define F77_TA &TA  
Chris@202:    #define F77_TB &TB  
Chris@202: #endif
Chris@202: 
Chris@202: #ifdef F77_INT
Chris@202:    F77_INT F77_M=M, F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
Chris@202:    F77_INT F77_ldc=ldc;
Chris@202: #else
Chris@202:    #define F77_M M
Chris@202:    #define F77_N N
Chris@202:    #define F77_K K
Chris@202:    #define F77_lda lda
Chris@202:    #define F77_ldb ldb
Chris@202:    #define F77_ldc ldc
Chris@202: #endif
Chris@202: 
Chris@202:    extern int CBLAS_CallFromC;
Chris@202:    extern int RowMajorStrg;
Chris@202:    RowMajorStrg = 0;
Chris@202:    CBLAS_CallFromC = 1;
Chris@202: 
Chris@202:    if( Order == CblasColMajor )
Chris@202:    {
Chris@202:       if(TransA == CblasTrans) TA='T';
Chris@202:       else if ( TransA == CblasConjTrans ) TA='C';
Chris@202:       else if ( TransA == CblasNoTrans )   TA='N';
Chris@202:       else 
Chris@202:       {
Chris@202:          cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
Chris@202:          CBLAS_CallFromC = 0;
Chris@202:          RowMajorStrg = 0;
Chris@202:          return;
Chris@202:       }
Chris@202: 
Chris@202:       if(TransB == CblasTrans) TB='T';
Chris@202:       else if ( TransB == CblasConjTrans ) TB='C';
Chris@202:       else if ( TransB == CblasNoTrans )   TB='N';
Chris@202:       else 
Chris@202:       {
Chris@202:          cblas_xerbla(3, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
Chris@202:          CBLAS_CallFromC = 0;
Chris@202:          RowMajorStrg = 0;
Chris@202:          return;
Chris@202:       }
Chris@202: 
Chris@202:       #ifdef F77_CHAR
Chris@202:          F77_TA = C2F_CHAR(&TA);
Chris@202:          F77_TB = C2F_CHAR(&TB);
Chris@202:       #endif
Chris@202: 
Chris@202:       F77_dgemm(F77_TA, F77_TB, &F77_M, &F77_N, &F77_K, &alpha, A,
Chris@202:        &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
Chris@202:    } else if (Order == CblasRowMajor)
Chris@202:    {
Chris@202:       RowMajorStrg = 1;
Chris@202:       if(TransA == CblasTrans) TB='T';
Chris@202:       else if ( TransA == CblasConjTrans ) TB='C';
Chris@202:       else if ( TransA == CblasNoTrans )   TB='N';
Chris@202:       else 
Chris@202:       {
Chris@202:          cblas_xerbla(2, "cblas_dgemm","Illegal TransA setting, %d\n", TransA);
Chris@202:          CBLAS_CallFromC = 0;
Chris@202:          RowMajorStrg = 0;
Chris@202:          return;
Chris@202:       }
Chris@202:       if(TransB == CblasTrans) TA='T';
Chris@202:       else if ( TransB == CblasConjTrans ) TA='C';
Chris@202:       else if ( TransB == CblasNoTrans )   TA='N';
Chris@202:       else 
Chris@202:       {
Chris@202:          cblas_xerbla(2, "cblas_dgemm","Illegal TransB setting, %d\n", TransB);
Chris@202:          CBLAS_CallFromC = 0;
Chris@202:          RowMajorStrg = 0;
Chris@202:          return;
Chris@202:       }
Chris@202:       #ifdef F77_CHAR
Chris@202:          F77_TA = C2F_CHAR(&TA);
Chris@202:          F77_TB = C2F_CHAR(&TB);
Chris@202:       #endif
Chris@202: 
Chris@202:       F77_dgemm(F77_TA, F77_TB, &F77_N, &F77_M, &F77_K, &alpha, B,
Chris@202:                   &F77_ldb, A, &F77_lda, &beta, C, &F77_ldc);
Chris@202:    } 
Chris@202:    else  cblas_xerbla(1, "cblas_dgemm", "Illegal Order setting, %d\n", Order);
Chris@202:    CBLAS_CallFromC = 0;
Chris@202:    RowMajorStrg = 0;
Chris@202:    return;
Chris@202: }