"Fossies" - the Fresh Open Source Software Archive

Member "lapack-3.9.1/CBLAS/src/cblas_cherk.c" (25 Mar 2021, 2694 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_cherk.c": 3.9.0_vs_3.9.1.

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