blis/frame/compat/cblas/src/cblas_zhbmv.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_zhbmv.c
   8  * The program is a C interface to zhbmv
   9  *
  10  * Keita Teranishi  5/18/98
  11  *
  12  */
  13 #include "cblas.h"
  14 #include "cblas_f77.h"
  15 #include <stdio.h>
  16 #include <stdlib.h>
  17 void cblas_zhbmv(const enum CBLAS_ORDER order,
  18                  const enum CBLAS_UPLO Uplo,const int N,const int K,
  19                  const void *alpha, const void  *A, const int lda,
  20                  const void  *X, const int incX, const void *beta,
  21                  void  *Y, const int incY)
  22 {
  23    char UL;
  24 #ifdef F77_CHAR
  25    F77_CHAR F77_UL;
  26 #else
  27    #define F77_UL &UL
  28 #endif
  29 #ifdef F77_INT
  30    F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
  31 #else
  32    #define F77_N N
  33    #define F77_K K
  34    #define F77_lda lda
  35    #define F77_incX incx
  36    #define F77_incY incY
  37 #endif
  38    int n, i=0;
  39    const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
  40    double ALPHA[2],BETA[2];
  41    int tincY, tincx;
  42    double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
  43    extern int CBLAS_CallFromC;
  44    extern int RowMajorStrg;
  45    RowMajorStrg = 0;
  46
  47    CBLAS_CallFromC = 1;
  48    if (order == CblasColMajor)
  49    {
  50       if (Uplo == CblasLower) UL = 'L';
  51       else if (Uplo == CblasUpper) UL = 'U';
  52       else
  53       {
  54          cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo );
  55          CBLAS_CallFromC = 0;
  56          RowMajorStrg = 0;
  57          return;
  58       }
  59       #ifdef F77_CHAR
  60          F77_UL = C2F_CHAR(&UL);
  61       #endif
  62       F77_zhbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
  63                      &F77_incX, beta, Y, &F77_incY);
  64    }
  65    else if (order == CblasRowMajor)
  66    {
  67       RowMajorStrg = 1;
  68       ALPHA[0]= *alp;
  69       ALPHA[1]= -alp[1];
  70       BETA[0]= *bet;
  71       BETA[1]= -bet[1];
  72
  73       if (N > 0)
  74       {
  75          n = N << 1;
  76          x = malloc(n*sizeof(double));
  77
  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
  90          do
  91          {
  92            *x = *xx;
  93            x[1] = -xx[1];
  94            x += tincx ;
  95            xx += i;
  96          }
  97          while (x != st);
  98          x=tx;
  99
 100
 101          #ifdef F77_INT
 102             F77_incX = 1;
 103          #else
 104             incx = 1;
 105          #endif
 106
 107          if(incY > 0)
 108            tincY = incY;
 109          else
 110            tincY = -incY;
 111          y++;
 112
 113          i = tincY << 1;
 114          n = i * N ;
 115          st = y + n;
 116          do {
 117             *y = -(*y);
 118             y += i;
 119          } while(y != st);
 120          y -= n;
 121       }  else
 122          x = (double *) X;
 123
 124       if (Uplo == CblasUpper) UL = 'L';
 125       else if (Uplo == CblasLower) UL = 'U';
 126       else
 127       {
 128          cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo);
 129          CBLAS_CallFromC = 0;
 130          RowMajorStrg = 0;
 131          return;
 132       }
 133       #ifdef F77_CHAR
 134          F77_UL = C2F_CHAR(&UL);
 135       #endif
 136       F77_zhbmv(F77_UL, &F77_N, &F77_K, ALPHA,
 137                      A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
 138    }
 139    else
 140    {
 141       cblas_xerbla(1, "cblas_zhbmv","Illegal Order setting, %d\n", order);
 142       CBLAS_CallFromC = 0;
 143       RowMajorStrg = 0;
 144       return;
 145    }
 146    if ( order == CblasRowMajor )
 147    {
 148       RowMajorStrg = 1;
 149       if(X!=x)
 150          free(x);
 151       if (N > 0)
 152       {
 153          do
 154          {
 155             *y = -(*y);
 156             y += i;
 157          }
 158          while (y != st);
 159       }
 160    }
 161    CBLAS_CallFromC = 0;
 162    RowMajorStrg = 0;
 163    return;
 164 }
 165 #endif