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