swiftnav: cblas_zher2k.c Source File

Go to the documentation of this file.
00001 /*
00002  *
00003  * cblas_zher2k.c
00004  * This program is a C interface to zher2k.
00005  * Written by Keita Teranishi
00006  * 4/8/1998
00007  *
00008  */
00009 
00010 #include "cblas.h"
00011 #include "cblas_f77.h"
00012 void cblas_zher2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
00013                   const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
00014                   const void *alpha, const void *A, const int lda,
00015                   const void *B, const int ldb, const double beta,
00016                   void *C, const int ldc)
00017 {
00018    char UL, TR;   
00019 #ifdef F77_CHAR
00020    F77_CHAR F77_TR, F77_UL;
00021 #else
00022    #define F77_TR &TR  
00023    #define F77_UL &UL  
00024 #endif
00025 
00026 #ifdef F77_INT
00027    F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_ldb=ldb;
00028    F77_INT F77_ldc=ldc;
00029 #else
00030    #define F77_N N
00031    #define F77_K K
00032    #define F77_lda lda
00033    #define F77_ldb ldb
00034    #define F77_ldc ldc
00035 #endif
00036 
00037    extern int CBLAS_CallFromC;
00038    extern int RowMajorStrg;
00039    double ALPHA[2]; 
00040    const double *alp=(double *)alpha;
00041 
00042    CBLAS_CallFromC = 1;
00043    RowMajorStrg = 0;
00044 
00045    if( Order == CblasColMajor )
00046    {
00047 
00048       if( Uplo == CblasUpper) UL='U';
00049       else if ( Uplo == CblasLower ) UL='L';
00050       else 
00051       {
00052          cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo);
00053          CBLAS_CallFromC = 0;
00054          RowMajorStrg = 0;
00055          return;
00056       }
00057 
00058       if( Trans == CblasTrans) TR ='T';
00059       else if ( Trans == CblasConjTrans ) TR='C';
00060       else if ( Trans == CblasNoTrans )   TR='N';
00061       else 
00062       {
00063          cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans);
00064          CBLAS_CallFromC = 0;
00065          RowMajorStrg = 0;
00066          return;
00067       }
00068 
00069       #ifdef F77_CHAR
00070          F77_UL = C2F_CHAR(&UL);
00071          F77_TR = C2F_CHAR(&TR);
00072       #endif
00073 
00074       F77_zher2k(F77_UL, F77_TR, &F77_N, &F77_K, alpha, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
00075    } else if (Order == CblasRowMajor)
00076    {
00077       RowMajorStrg = 1;
00078       
00079       if( Uplo == CblasUpper) UL='L';
00080       else if ( Uplo == CblasLower ) UL='U';
00081       else 
00082       {
00083          cblas_xerbla(2, "cblas_zher2k", "Illegal Uplo setting, %d\n", Uplo);
00084          CBLAS_CallFromC = 0;
00085          RowMajorStrg = 0;
00086          return;
00087       }
00088       if( Trans == CblasTrans) TR ='N';
00089       else if ( Trans == CblasConjTrans ) TR='N';
00090       else if ( Trans == CblasNoTrans )   TR='C';
00091       else 
00092       {
00093          cblas_xerbla(3, "cblas_zher2k", "Illegal Trans setting, %d\n", Trans);
00094          CBLAS_CallFromC = 0;
00095          RowMajorStrg = 0;
00096          return;
00097       }
00098       #ifdef F77_CHAR
00099          F77_UL = C2F_CHAR(&UL);
00100          F77_TR = C2F_CHAR(&TR);
00101       #endif
00102 
00103       ALPHA[0]= *alp;
00104       ALPHA[1]= -alp[1];
00105       F77_zher2k(F77_UL,F77_TR, &F77_N, &F77_K, ALPHA, A, &F77_lda, B, &F77_ldb, &beta, C, &F77_ldc);
00106    } else  cblas_xerbla(1, "cblas_zher2k", "Illegal Order setting, %d\n", Order);
00107    CBLAS_CallFromC = 0;
00108    RowMajorStrg = 0;
00109    return;
00110 }