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