blis/frame/compat/cblas/src/cblas_chpr.c

   1 #include "bli_config.h"
   2 #include "bli_system.h"
   3 #include "bli_type_defs.h"
   4 #include "bli_cblas.h"
   5 #ifdef BLIS_ENABLE_CBLAS
   6 /*
   7  * cblas_chpr.c
   8  * The program is a C interface to chpr.
   9  *
  10  * Keita Teranishi  3/23/98
  11  *
  12  */
  13 #include <stdio.h>
  14 #include <stdlib.h>
  15 #include "cblas.h"
  16 #include "cblas_f77.h"
  17 void cblas_chpr(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
  18                 const int N, const float alpha, const void *X,
  19                 const int incX, void *A)
  20 {
  21    char UL;
  22 #ifdef F77_CHAR
  23    F77_CHAR F77_UL;
  24 #else
  25    #define F77_UL &UL
  26 #endif
  27
  28 #ifdef F77_INT
  29    F77_INT F77_N=N, F77_incX=incX;
  30 #else
  31    #define F77_N N
  32    #define F77_incX incx
  33 #endif
  34    int n, i, tincx;
  35    float *x=(float *)X, *xx=(float *)X, *tx, *st;
  36
  37    extern int CBLAS_CallFromC;
  38    extern int RowMajorStrg;
  39    RowMajorStrg = 0;
  40
  41    CBLAS_CallFromC = 1;
  42    if (order == CblasColMajor)
  43    {
  44       if (Uplo == CblasLower) UL = 'L';
  45       else if (Uplo == CblasUpper) UL = 'U';
  46       else
  47       {
  48          cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n",Uplo );
  49          CBLAS_CallFromC = 0;
  50          RowMajorStrg = 0;
  51          return;
  52       }
  53       #ifdef F77_CHAR
  54          F77_UL = C2F_CHAR(&UL);
  55       #endif
  56
  57       F77_chpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
  58
  59    }  else if (order == CblasRowMajor)
  60    {
  61       RowMajorStrg = 1;
  62       if (Uplo == CblasUpper) UL = 'L';
  63       else if (Uplo == CblasLower) UL = 'U';
  64       else
  65       {
  66          cblas_xerbla(2, "cblas_chpr","Illegal Uplo setting, %d\n", Uplo);
  67          CBLAS_CallFromC = 0;
  68          RowMajorStrg = 0;
  69          return;
  70       }
  71       #ifdef F77_CHAR
  72          F77_UL = C2F_CHAR(&UL);
  73       #endif
  74       if (N > 0)
  75       {
  76          n = N << 1;
  77          x = malloc(n*sizeof(float));
  78          tx = x;
  79          if( incX > 0 ) {
  80             i = incX << 1;
  81             tincx = 2;
  82             st= x+n;
  83          } else {
  84             i = incX *(-2);
  85             tincx = -2;
  86             st = x-2;
  87             x +=(n-2);
  88          }
  89          do
  90          {
  91             *x = *xx;
  92             x[1] = -xx[1];
  93             x += tincx ;
  94             xx += i;
  95          }
  96          while (x != st);
  97          x=tx;
  98          #ifdef F77_INT
  99             F77_incX = 1;
 100          #else
 101             incx = 1;
 102          #endif
 103       }
 104       else x = (float *) X;
 105
 106       F77_chpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
 107
 108    } else
 109    {
 110       cblas_xerbla(1, "cblas_chpr","Illegal Order setting, %d\n", order);
 111       CBLAS_CallFromC = 0;
 112       RowMajorStrg = 0;
 113       return;
 114    }
 115    if(X!=x)
 116      free(x);
 117    CBLAS_CallFromC = 0;
 118    RowMajorStrg = 0;
 119    return;
 120 }
 121 #endif