"Fossies" - the Fresh Open Source Software Archive

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

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