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