Home | History | Annotate | Download | only in src
      1 /*
      2  *
      3  * cblas_dsyr2.c
      4  * This program is a C interface to dsyr2.
      5  * Written by Keita Teranishi
      6  * 4/6/1998
      7  *
      8  */
      9 
     10 #include "cblas.h"
     11 #include "cblas_f77.h"
     12 void cblas_dsyr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
     13                 const int N, const double  alpha, const double  *X,
     14                 const int incX, const double  *Y, const int incY, double  *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_dsyr2","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_dsyr2(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_dsyr2","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_dsyr2(F77_UL, &F77_N, &alpha, X, &F77_incX, Y, &F77_incY,  A,
     71                     &F77_lda);
     72    } else cblas_xerbla(1, "cblas_dsyr2", "Illegal Order setting, %d\n", order);
     73    CBLAS_CallFromC = 0;
     74    RowMajorStrg = 0;
     75    return;
     76 }
     77