Home | History | Annotate | Download | only in src 
      1 /*
      2  * cblas_chpmv.c
      3  * The program is a C interface of chpmv
      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_chpmv(const enum CBLAS_ORDER order,
     13                  const enum CBLAS_UPLO Uplo,const int N,
     14                  const void *alpha, const void  *AP,
     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_incX incx
     29    #define F77_incY incY
     30 #endif
     31    int n, i=0, incx=incX;
     32    const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
     33    float ALPHA[2],BETA[2];
     34    int tincY, tincx;
     35    float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
     36    extern int CBLAS_CallFromC;
     37    extern int RowMajorStrg;
     38    RowMajorStrg = 0;
     39 
     40    CBLAS_CallFromC = 1;
     41    if (order == CblasColMajor)
     42    {
     43       if (Uplo == CblasLower) UL = 'L';
     44       else if (Uplo == CblasUpper) UL = 'U';
     45       else
     46       {
     47          cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n",Uplo );
     48          CBLAS_CallFromC = 0;
     49          RowMajorStrg = 0;
     50          return;
     51       }
     52       #ifdef F77_CHAR
     53          F77_UL = C2F_CHAR(&UL);
     54       #endif
     55       F77_chpmv(F77_UL, &F77_N, alpha, AP, X,
     56                      &F77_incX, beta, Y, &F77_incY);
     57    }
     58    else if (order == CblasRowMajor)
     59    {
     60       RowMajorStrg = 1;
     61       ALPHA[0]= *alp;
     62       ALPHA[1]= -alp[1];
     63       BETA[0]= *bet;
     64       BETA[1]= -bet[1];
     65 
     66       if (N > 0)
     67       {
     68          n = N << 1;
     69          x = malloc(n*sizeof(float));
     70 
     71          tx = x;
     72          if( incX > 0 ) {
     73            i = incX << 1;
     74            tincx = 2;
     75            st= x+n;
     76          } else {
     77            i = incX *(-2);
     78            tincx = -2;
     79            st = x-2;
     80            x +=(n-2);
     81          }
     82 
     83          do
     84          {
     85            *x = *xx;
     86            x[1] = -xx[1];
     87            x += tincx ;
     88            xx += i;
     89          }
     90          while (x != st);
     91          x=tx;
     92 
     93 
     94          #ifdef F77_INT
     95             F77_incX = 1;
     96          #else
     97             incx = 1;
     98          #endif
     99 
    100          if(incY > 0)
    101            tincY = incY;
    102          else
    103            tincY = -incY;
    104          y++;
    105 
    106          i = tincY << 1;
    107          n = i * N ;
    108          st = y + n;
    109          do {
    110             *y = -(*y);
    111             y += i;
    112          } while(y != st);
    113          y -= n;
    114       }  else
    115          x = (float *) X;
    116 
    117 
    118       if (Uplo == CblasUpper) UL = 'L';
    119       else if (Uplo == CblasLower) UL = 'U';
    120       else
    121       {
    122          cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n", Uplo );
    123          CBLAS_CallFromC = 0;
    124          RowMajorStrg = 0;
    125          return;
    126       }
    127       #ifdef F77_CHAR
    128          F77_UL = C2F_CHAR(&UL);
    129       #endif
    130 
    131       F77_chpmv(F77_UL, &F77_N, ALPHA,
    132                      AP, x, &F77_incX, BETA, Y, &F77_incY);
    133    }
    134    else
    135    {
    136       cblas_xerbla(1, "cblas_chpmv","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 
    157    CBLAS_CallFromC = 0;
    158    RowMajorStrg = 0;
    159    return;
    160 }
    161