1/* 2 * 3 * cblas_zherk.c 4 * This program is a C interface to zherk. 5 * Written by Keita Teranishi 6 * 4/8/1998 7 * 8 */ 9 10#include "cblas.h" 11#include "cblas_f77.h" 12void cblas_zherk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo, 13 const enum CBLAS_TRANSPOSE Trans, const int N, const int K, 14 const double alpha, const void *A, const int lda, 15 const double beta, void *C, const int ldc) 16{ 17 char UL, TR; 18#ifdef F77_CHAR 19 F77_CHAR F77_TR, F77_UL; 20#else 21 #define F77_TR &TR 22 #define F77_UL &UL 23#endif 24 25#ifdef F77_INT 26 F77_INT F77_N=N, F77_K=K, F77_lda=lda; 27 F77_INT F77_ldc=ldc; 28#else 29 #define F77_N N 30 #define F77_K K 31 #define F77_lda lda 32 #define F77_ldc ldc 33#endif 34 35 extern int CBLAS_CallFromC; 36 extern int RowMajorStrg; 37 RowMajorStrg = 0; 38 CBLAS_CallFromC = 1; 39 40 if( Order == CblasColMajor ) 41 { 42 if( Uplo == CblasUpper) UL='U'; 43 else if ( Uplo == CblasLower ) UL='L'; 44 else 45 { 46 cblas_xerbla(2, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo); 47 CBLAS_CallFromC = 0; 48 RowMajorStrg = 0; 49 return; 50 } 51 52 if( Trans == CblasTrans) TR ='T'; 53 else if ( Trans == CblasConjTrans ) TR='C'; 54 else if ( Trans == CblasNoTrans ) TR='N'; 55 else 56 { 57 cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans); 58 CBLAS_CallFromC = 0; 59 RowMajorStrg = 0; 60 return; 61 } 62 63 #ifdef F77_CHAR 64 F77_UL = C2F_CHAR(&UL); 65 F77_TR = C2F_CHAR(&TR); 66 #endif 67 68 F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, 69 &beta, C, &F77_ldc); 70 } else if (Order == CblasRowMajor) 71 { 72 RowMajorStrg = 1; 73 if( Uplo == CblasUpper) UL='L'; 74 else if ( Uplo == CblasLower ) UL='U'; 75 else 76 { 77 cblas_xerbla(3, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo); 78 CBLAS_CallFromC = 0; 79 RowMajorStrg = 0; 80 return; 81 } 82 if( Trans == CblasTrans) TR ='N'; 83 else if ( Trans == CblasConjTrans ) TR='N'; 84 else if ( Trans == CblasNoTrans ) TR='C'; 85 else 86 { 87 cblas_xerbla(3, "cblas_zherk", "Illegal Trans setting, %d\n", Trans); 88 CBLAS_CallFromC = 0; 89 RowMajorStrg = 0; 90 return; 91 } 92 93 #ifdef F77_CHAR 94 F77_UL = C2F_CHAR(&UL); 95 F77_SD = C2F_CHAR(&SD); 96 #endif 97 98 F77_zherk(F77_UL, F77_TR, &F77_N, &F77_K, &alpha, A, &F77_lda, 99 &beta, C, &F77_ldc); 100 } 101 else cblas_xerbla(1, "cblas_zherk", "Illegal Order setting, %d\n", Order); 102 CBLAS_CallFromC = 0; 103 RowMajorStrg = 0; 104 return; 105} 106