Home | History | Annotate | Download | only in src 
      1 /*
      2  * cblas_chemv.c
      3  * The program is a C interface to chemv
      4  *
      5  * Keita Teranishi  5/18/98
      6  *
      7  */
      8 #include <stdio.h>
      9 #include <stdlib.h>
     10 #include "cblas.h"
     11 #include "cblas_f77.h"
     12 void cblas_chemv(const enum CBLAS_ORDER order,
     13                  const enum CBLAS_UPLO Uplo, const int N,
     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_lda=lda, F77_incX=incX, F77_incY=incY;
     26 #else
     27    #define F77_N N
     28    #define F77_lda lda
     29    #define F77_incX incx
     30    #define F77_incY incY
     31 #endif
     32    int n=0, i=0, incx=incX;
     33    const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
     34    float ALPHA[2],BETA[2];
     35    int tincY, tincx;
     36    float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
     37    extern int CBLAS_CallFromC;
     38    extern int RowMajorStrg;
     39    RowMajorStrg = 0;
     40 
     41 
     42    CBLAS_CallFromC = 1;
     43    if (order == CblasColMajor)
     44    {
     45       if (Uplo == CblasUpper) UL = 'U';
     46       else if (Uplo == CblasLower) UL = 'L';
     47       else
     48       {
     49          cblas_xerbla(2, "cblas_chemv","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_chemv(F77_UL, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
     58                 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(float));
     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 = (float *) X;
    118 
    119 
    120       if (Uplo == CblasUpper) UL = 'L';
    121       else if (Uplo == CblasLower) UL = 'U';
    122       else
    123       {
    124          cblas_xerbla(2, "cblas_chemv","Illegal Uplo setting, %d\n", Uplo);
    125          CBLAS_CallFromC = 0;
    126          RowMajorStrg = 0;
    127          return;
    128       }
    129       #ifdef F77_CHAR
    130          F77_UL = C2F_CHAR(&UL);
    131       #endif
    132       F77_chemv(F77_UL, &F77_N, ALPHA, A, &F77_lda, x, &F77_incX,
    133                 BETA, Y, &F77_incY);
    134    }
    135    else
    136    {
    137       cblas_xerbla(1, "cblas_chemv","Illegal Order setting, %d\n", order);
    138       CBLAS_CallFromC = 0;
    139       RowMajorStrg = 0;
    140       return;
    141    }
    142    if ( order == CblasRowMajor )
    143    {
    144       RowMajorStrg = 1;
    145       if ( X != x )
    146          free(x);
    147       if (N > 0)
    148       {
    149          do
    150          {
    151             *y = -(*y);
    152             y += i;
    153          }
    154          while (y != st);
    155      }
    156    }
    157    CBLAS_CallFromC = 0;
    158    RowMajorStrg = 0;
    159    return;
    160 }
    161