swiftnav: cblas_ssyr2k.c Source File

Go to the documentation of this file.
00001 /*
00002  *
00003  * cblas_ssyr2k.c
00004  * This program is a C interface to ssyr2k.
00005  * Written by Keita Teranishi
00006  * 4/6/1998
00007  *
00008  */
00009 
00010 #include "cblas.h"
00011 #include "cblas_f77.h"
00012 void cblas_ssyr2k(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
00013                   const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
00014                   const float alpha, const float  *A, const int lda,
00015                   const float  *B, const int ldb, const float beta,
00016                   float  *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_ssyr2k", 
00050                        "Illegal Uplo setting, %d\n", Uplo);
00051          CBLAS_CallFromC = 0;
00052          RowMajorStrg = 0;
00053          return;
00054       }
00055 
00056       if( Trans == CblasTrans) TR ='T';
00057       else if ( Trans == CblasConjTrans ) TR='C';
00058       else if ( Trans == CblasNoTrans )   TR='N';
00059       else 
00060       {
00061          cblas_xerbla(3, "cblas_ssyr2k", 
00062                        "Illegal Trans setting, %d\n", Trans);
00063          CBLAS_CallFromC = 0;
00064          RowMajorStrg = 0;
00065          return;
00066       }
00067 
00068 
00069       #ifdef F77_CHAR
00070          F77_UL = C2F_CHAR(&UL);
00071          F77_TR = C2F_CHAR(&TR);
00072       #endif
00073 
00074       F77_ssyr2k(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       if( Uplo == CblasUpper) UL='L';
00079       else if ( Uplo == CblasLower ) UL='U';
00080       else 
00081       {
00082          cblas_xerbla(3, "cblas_ssyr2k", 
00083                        "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='T';
00091       else 
00092       {
00093          cblas_xerbla(3, "cblas_ssyr2k", 
00094                        "Illegal Trans setting, %d\n", Trans);
00095          CBLAS_CallFromC = 0;
00096          RowMajorStrg = 0;
00097          return;
00098       }
00099 
00100       #ifdef F77_CHAR
00101          F77_UL = C2F_CHAR(&UL);
00102          F77_TR = C2F_CHAR(&TR);
00103       #endif
00104 
00105       F77_ssyr2k(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_ssyr2k",
00107                      "Illegal Order setting, %d\n", Order);
00108    CBLAS_CallFromC = 0;
00109    RowMajorStrg = 0;
00110    return;
00111 }