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