001: /*
002:  *
003:  * cblas_cherk.c
004:  * This program is a C interface to cherk.
005:  * Written by Keita Teranishi
006:  * 4/8/1998
007:  *
008:  */
009: 
010: #include "cblas.h"
011: #include "cblas_f77.h"
012: void cblas_cherk(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 void *A, const int lda,
015:                  const float beta, void *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:       if( Uplo == CblasUpper) UL='U';
043:       else if ( Uplo == CblasLower ) UL='L';
044:       else
045:       {
046:          cblas_xerbla(2, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo);
047:          CBLAS_CallFromC = 0;
048:          RowMajorStrg = 0;
049:          return;
050:       }
051: 
052:       if( Trans == CblasTrans) TR ='T';
053:       else if ( Trans == CblasConjTrans ) TR='C';
054:       else if ( Trans == CblasNoTrans )   TR='N';
055:       else
056:       {
057:          cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans);
058:          CBLAS_CallFromC = 0;
059:          RowMajorStrg = 0;
060:          return;
061:       }
062: 
063:       #ifdef F77_CHAR
064:          F77_UL = C2F_CHAR(&UL);
065:          F77_TR = C2F_CHAR(&TR);
066:       #endif
067: 
068:       F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, (const float *)A, &F77_lda,
069:                      (const float *)&beta, (float *)C, &F77_ldc);
070:    } else if (Order == CblasRowMajor)
071:    {
072:       RowMajorStrg = 1;
073:       if( Uplo == CblasUpper) UL='L';
074:       else if ( Uplo == CblasLower ) UL='U';
075:       else
076:       {
077:          cblas_xerbla(3, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo);
078:          CBLAS_CallFromC = 0;
079:          RowMajorStrg = 0;
080:          return;
081:       }
082:       if( Trans == CblasTrans) TR ='N';
083:       else if ( Trans == CblasConjTrans ) TR='N';
084:       else if ( Trans == CblasNoTrans )   TR='C';
085:       else
086:       {
087:          cblas_xerbla(3, "cblas_cherk", "Illegal Trans setting, %d\n", Trans);
088:          CBLAS_CallFromC = 0;
089:          RowMajorStrg = 0;
090:          return;
091:       }
092: 
093:       #ifdef F77_CHAR
094:          F77_UL = C2F_CHAR(&UL);
095:          F77_SD = C2F_CHAR(&SD);
096:       #endif
097: 
098:       F77_cherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, (const float *)A, &F77_lda,
099:                 (const float *)&beta, (float *)C, &F77_ldc);
100:    }
101:    else  cblas_xerbla(1, "cblas_cherk", "Illegal Order setting, %d\n", Order);
102:    CBLAS_CallFromC = 0;
103:    RowMajorStrg = 0;
104:    return;
105: }
106: