"Fossies" - the Fresh Open Source Software Archive

Member "lapack-3.9.1/CBLAS/src/cblas_chpmv.c" (25 Mar 2021, 3442 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_chpmv.c": 3.9.0_vs_3.9.1.

    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 CBLAS_LAYOUT layout,
   13                  const CBLAS_UPLO Uplo,const CBLAS_INDEX N,
   14                  const void *alpha, const void  *AP,
   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_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    CBLAS_INDEX n, i=0, incx=incX;
   32    const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
   33    float ALPHA[2],BETA[2];
   34    CBLAS_INDEX 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 (layout == 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 (layout == 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 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 
  157    CBLAS_CallFromC = 0;
  158    RowMajorStrg = 0;
  159    return;
  160 }