001: /*
002:  *
003:  * cblas_ssyrk.c
004:  * This program is a C interface to ssyrk.
005:  * Written by Keita Teranishi
006:  * 4/8/1998
007:  *
008:  */
009: 
010: #include "cblas.h"
011: #include "cblas_f77.h"
012: void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
013:                  const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
014:                  const float alpha, const float  *A, const int lda,
015:                  const float beta, float  *C, const int ldc)
016: {
017:    char UL, TR;
018: #ifdef F77_CHAR
019:    F77_CHAR F77_TR, F77_UL;
020: #else
021:    #define F77_TR &TR
022:    #define F77_UL &UL
023: #endif
024: 
025: #ifdef F77_INT
026:    F77_INT F77_N=N, F77_K=K, F77_lda=lda;
027:    F77_INT F77_ldc=ldc;
028: #else
029:    #define F77_N N
030:    #define F77_K K
031:    #define F77_lda lda
032:    #define F77_ldc ldc
033: #endif
034: 
035:    extern int CBLAS_CallFromC;
036:    extern int RowMajorStrg;
037:    RowMajorStrg = 0;
038:    CBLAS_CallFromC = 1;
039: 
040:    if( Order == CblasColMajor )
041:    {
042: 
043:       if( Uplo == CblasUpper) UL='U';
044:       else if ( Uplo == CblasLower ) UL='L';
045:       else
046:       {
047:          cblas_xerbla(2, "cblas_ssyrk",
048:                        "Illegal Uplo setting, %d\n", Uplo);
049:          CBLAS_CallFromC = 0;
050:          RowMajorStrg = 0;
051:          return;
052:       }
053: 
054:       if( Trans == CblasTrans) TR ='T';
055:       else if ( Trans == CblasConjTrans ) TR='C';
056:       else if ( Trans == CblasNoTrans )   TR='N';
057:       else
058:       {
059:          cblas_xerbla(3, "cblas_ssyrk",
060:                        "Illegal Trans setting, %d\n", Trans);
061:          CBLAS_CallFromC = 0;
062:          RowMajorStrg = 0;
063:          return;
064:       }
065: 
066: 
067:       #ifdef F77_CHAR
068:          F77_UL = C2F_CHAR(&UL);
069:          F77_TR = C2F_CHAR(&TR);
070:       #endif
071: 
072:       F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
073:    } else if (Order == CblasRowMajor)
074:    {
075:       RowMajorStrg = 1;
076:       if( Uplo == CblasUpper) UL='L';
077:       else if ( Uplo == CblasLower ) UL='U';
078:       else
079:       {
080:          cblas_xerbla(3, "cblas_ssyrk",
081:                        "Illegal Uplo setting, %d\n", Uplo);
082:          CBLAS_CallFromC = 0;
083:          RowMajorStrg = 0;
084:          return;
085:       }
086:       if( Trans == CblasTrans) TR ='N';
087:       else if ( Trans == CblasConjTrans ) TR='N';
088:       else if ( Trans == CblasNoTrans )   TR='T';
089:       else
090:       {
091:          cblas_xerbla(3, "cblas_ssyrk",
092:                        "Illegal Trans setting, %d\n", Trans);
093:          CBLAS_CallFromC = 0;
094:          RowMajorStrg = 0;
095:          return;
096:       }
097: 
098:       #ifdef F77_CHAR
099:          F77_UL = C2F_CHAR(&UL);
100:          F77_TR = C2F_CHAR(&TR);
101:       #endif
102: 
103:       F77_ssyrk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, &beta, C, &F77_ldc);
104:    } else  cblas_xerbla(1, "cblas_ssyrk",
105:                      "Illegal Order setting, %d\n", Order);
106:    CBLAS_CallFromC = 0;
107:    RowMajorStrg = 0;
108:    return;
109: }
110: 
111: