Home | History | Annotate | Download | only in src 
      1 /*
      2  *
      3  * cblas_zher2k.c
      4  * This program is a C interface to zher2k.
      5  * Written by Keita Teranishi
      6  * 4/8/1998
      7  *
      8  */
      9 
     10 #include "cblas.h"
     11 #include "cblas_f77.h"
     12 void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
     13                   const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
     14                   const void *alpha, const void *A, const int lda,
     15                   const void *B, const int ldb, const double beta,
     16                   void *C, const int 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    double ALPHA[2];
     40    const double *alp=(double *)alpha;
     41 
     42    CBLAS_CallFromC = 1;
     43    RowMajorStrg = 0;
     44 
     45    if( Order == CblasColMajor )
     46    {
     47 
     48       if( Uplo == CblasUpper) UL='U';
     49       else if ( Uplo == CblasLower ) UL='L';
     50       else
     51       {
     52          cblas_xerbla(2, "cblas_zher2k", "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_zher2k", "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_zher2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
     75    } else if (Order == 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_zher2k", "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_zher2k", "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_zher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
    106    } else  cblas_xerbla(1, "cblas_zher2k", "Illegal Order setting, %d\n", Order);
    107    CBLAS_CallFromC = 0;
    108    RowMajorStrg = 0;
    109    return;
    110 }
    111