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