"Fossies" - the Fresh Open Source Software Archive

Member "lapack-3.9.1/CBLAS/src/cblas_chemm.c" (25 Mar 2021, 2684 Bytes) of package /linux/misc/lapack-3.9.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "cblas_chemm.c": 3.9.0_vs_3.9.1.

    1 /*
    2  *
    3  * cblas_chemm.c
    4  * This program is a C interface to chemm.
    5  * Written by Keita Teranishi
    6  * 4/8/1998
    7  *
    8  */
    9 
   10 #include "cblas.h"
   11 #include "cblas_f77.h"
   12 void cblas_chemm(const CBLAS_LAYOUT layout, const  CBLAS_SIDE Side,
   13                  const CBLAS_UPLO Uplo, const CBLAS_INDEX M, const CBLAS_INDEX N,
   14                  const void *alpha, const void *A, const CBLAS_INDEX lda,
   15                  const void *B, const CBLAS_INDEX ldb, const void *beta,
   16                  void *C, const CBLAS_INDEX ldc)
   17 {
   18    char SD, UL;
   19 #ifdef F77_CHAR
   20    F77_CHAR F77_SD, F77_UL;
   21 #else
   22    #define F77_SD &SD
   23    #define F77_UL &UL
   24 #endif
   25 
   26 #ifdef F77_INT
   27    F77_INT F77_M=M, F77_N=N, 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_lda lda
   33    #define F77_ldb ldb
   34    #define F77_ldc ldc
   35 #endif
   36 
   37    extern int CBLAS_CallFromC;
   38    extern int RowMajorStrg;
   39    RowMajorStrg = 0;
   40    CBLAS_CallFromC = 1;
   41 
   42    if( layout == CblasColMajor )
   43    {
   44       if( Side == CblasRight) SD='R';
   45       else if ( Side == CblasLeft ) SD='L';
   46       else
   47       {
   48          cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
   49          CBLAS_CallFromC = 0;
   50          RowMajorStrg = 0;
   51          return;
   52       }
   53 
   54       if( Uplo == CblasUpper) UL='U';
   55       else if ( Uplo == CblasLower ) UL='L';
   56       else
   57       {
   58          cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
   59          CBLAS_CallFromC = 0;
   60          RowMajorStrg = 0;
   61          return;
   62       }
   63 
   64       #ifdef F77_CHAR
   65          F77_UL = C2F_CHAR(&UL);
   66          F77_SD = C2F_CHAR(&SD);
   67       #endif
   68 
   69       F77_chemm(F77_SD, F77_UL, &F77_M, &F77_N, alpha, A, &F77_lda,
   70                      B, &F77_ldb, beta, C, &F77_ldc);
   71    } else if (layout == CblasRowMajor)
   72    {
   73       RowMajorStrg = 1;
   74       if( Side == CblasRight) SD='L';
   75       else if ( Side == CblasLeft ) SD='R';
   76       else
   77       {
   78          cblas_xerbla(2, "cblas_chemm", "Illegal Side setting, %d\n", Side);
   79          CBLAS_CallFromC = 0;
   80          RowMajorStrg = 0;
   81          return;
   82       }
   83 
   84       if( Uplo == CblasUpper) UL='L';
   85       else if ( Uplo == CblasLower ) UL='U';
   86       else
   87       {
   88          cblas_xerbla(3, "cblas_chemm", "Illegal Uplo setting, %d\n", Uplo);
   89          CBLAS_CallFromC = 0;
   90          RowMajorStrg = 0;
   91          return;
   92       }
   93 
   94       #ifdef F77_CHAR
   95          F77_UL = C2F_CHAR(&UL);
   96          F77_SD = C2F_CHAR(&SD);
   97       #endif
   98 
   99       F77_chemm(F77_SD, F77_UL, &F77_N, &F77_M, alpha, A,
  100                  &F77_lda, B, &F77_ldb, beta, C, &F77_ldc);
  101    }
  102    else  cblas_xerbla(1, "cblas_chemm", "Illegal layout setting, %d\n", layout);
  103    CBLAS_CallFromC = 0;
  104    RowMajorStrg = 0;
  105    return;
  106 }