swiftnav: cblas_dsyr2k.c Source File

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