1 /* 2 * 3 * cblas_ssyr2.c 4 * This program is a C interface to ssyr2. 5 * Written by Keita Teranishi 6 * 4/6/1998 7 * 8 */ 9 10 #include "cblas.h" 11 #include "cblas_f77.h" 12 void cblas_ssyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, 13 const int N, const float alpha, const float *X, 14 const int incX, const float *Y, const int incY, float *A, 15 const int lda) 16 { 17 char UL; 18 #ifdef F77_CHAR 19 F77_CHAR F77_UL; 20 #else 21 #define F77_UL &UL 22 #endif 23 24 #ifdef F77_INT 25 F77_INT F77_N=N, F77_incX=incX, F77_incY=incY, F77__lda=lda; 26 #else 27 #define F77_N N 28 #define F77_incX incX 29 #define F77_incY incY 30 #define F77_lda lda 31 #endif 32 33 extern int CBLAS_CallFromC; 34 extern int RowMajorStrg; 35 RowMajorStrg = 0; 36 CBLAS_CallFromC = 1; 37 if (order == CblasColMajor) 38 { 39 if (Uplo == CblasLower) UL = 'L'; 40 else if (Uplo == CblasUpper) UL = 'U'; 41 else 42 { 43 cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo ); 44 CBLAS_CallFromC = 0; 45 RowMajorStrg = 0; 46 return; 47 } 48 #ifdef F77_CHAR 49 F77_UL = C2F_CHAR(&UL); 50 #endif 51 52 F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A, 53 &F77_lda); 54 55 } else if (order == CblasRowMajor) 56 { 57 RowMajorStrg = 1; 58 if (Uplo == CblasLower) UL = 'U'; 59 else if (Uplo == CblasUpper) UL = 'L'; 60 else 61 { 62 cblas_xerbla(2, "cblas_ssyr2","Illegal Uplo setting, %d\n",Uplo ); 63 CBLAS_CallFromC = 0; 64 RowMajorStrg = 0; 65 return; 66 } 67 #ifdef F77_CHAR 68 F77_UL = C2F_CHAR(&UL); 69 #endif 70 F77_ssyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY, A, 71 &F77_lda); 72 } else cblas_xerbla(1, "cblas_ssyr2", "Illegal Order setting, %d\n", order); 73 CBLAS_CallFromC = 0; 74 RowMajorStrg = 0; 75 return; 76 } 77
