"Fossies" - the Fresh Open Source Software Archive

Member "lapack-3.9.1/CBLAS/src/cblas_chbmv.c" (25 Mar 2021, 3580 Bytes) of package /linux/misc/lapack-3.9.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "cblas_chbmv.c": 3.9.0_vs_3.9.1.

    1 /*
    2  * cblas_chbmv.c
    3  * The program is a C interface to chbmv
    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_chbmv(const CBLAS_LAYOUT layout,
   13                  const CBLAS_UPLO Uplo,const CBLAS_INDEX N,const CBLAS_INDEX K,
   14                  const void *alpha, const void  *A, const CBLAS_INDEX lda,
   15                  const void  *X, const CBLAS_INDEX incX, const void *beta,
   16                  void  *Y, const CBLAS_INDEX 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    CBLAS_INDEX n, i=0, incx=incX;
   34    const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
   35    float ALPHA[2],BETA[2];
   36    CBLAS_INDEX tincY, tincx;
   37    float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
   38    extern int CBLAS_CallFromC;
   39    extern int RowMajorStrg;
   40    RowMajorStrg = 0;
   41 
   42    CBLAS_CallFromC = 1;
   43    if (layout == CblasColMajor)
   44    {
   45       if (Uplo == CblasLower) UL = 'L';
   46       else if (Uplo == CblasUpper) UL = 'U';
   47       else
   48       {
   49          cblas_xerbla(2, "cblas_chbmv","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_chbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
   58                      &F77_incX, beta, Y, &F77_incY);
   59    }
   60    else if (layout == 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       if (Uplo == CblasUpper) UL = 'L';
  120       else if (Uplo == CblasLower) UL = 'U';
  121       else
  122       {
  123          cblas_xerbla(2, "cblas_chbmv","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_chbmv(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_chbmv","Illegal layout setting, %d\n", layout);
  137       CBLAS_CallFromC = 0;
  138       RowMajorStrg = 0;
  139       return;
  140    }
  141    if ( layout == 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 }