cblas_zhbmv.c
Go to the documentation of this file.
00001 /*
00002  * cblas_zhbmv.c
00003  * The program is a C interface to zhbmv
00004  * 
00005  * Keita Teranishi  5/18/98
00006  *
00007  */
00008 #include "cblas.h"
00009 #include "cblas_f77.h"
00010 #include <stdio.h>
00011 #include <stdlib.h>
00012 void cblas_zhbmv(const enum CBLAS_ORDER order,
00013                  const enum CBLAS_UPLO Uplo,const int N,const int K,
00014                  const void *alpha, const void  *A, const int lda,
00015                  const void  *X, const int incX, const void *beta,
00016                  void  *Y, const int incY)
00017 {
00018    char UL;
00019 #ifdef F77_CHAR
00020    F77_CHAR F77_UL;
00021 #else
00022    #define F77_UL &UL   
00023 #endif
00024 #ifdef F77_INT
00025    F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
00026 #else
00027    #define F77_N N
00028    #define F77_K K
00029    #define F77_lda lda
00030    #define F77_incX incx
00031    #define F77_incY incY
00032 #endif
00033    int n, i=0, incx=incX;
00034    const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
00035    double ALPHA[2],BETA[2];
00036    int tincY, tincx;
00037    double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
00038    extern int CBLAS_CallFromC;
00039    extern int RowMajorStrg;
00040    RowMajorStrg = 0;
00041 
00042    CBLAS_CallFromC = 1;
00043    if (order == CblasColMajor)
00044    {
00045       if (Uplo == CblasLower) UL = 'L';
00046       else if (Uplo == CblasUpper) UL = 'U';
00047       else 
00048       {
00049          cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo );
00050          CBLAS_CallFromC = 0;
00051          RowMajorStrg = 0;
00052          return;
00053       }
00054       #ifdef F77_CHAR
00055          F77_UL = C2F_CHAR(&UL);
00056       #endif
00057       F77_zhbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,  
00058                      &F77_incX, beta, Y, &F77_incY);
00059    }
00060    else if (order == CblasRowMajor)
00061    {
00062       RowMajorStrg = 1;
00063       ALPHA[0]= *alp;
00064       ALPHA[1]= -alp[1];
00065       BETA[0]= *bet;
00066       BETA[1]= -bet[1];
00067 
00068       if (N > 0)
00069       {
00070          n = N << 1;
00071          x = malloc(n*sizeof(double));
00072  
00073          tx = x;
00074          if( incX > 0 ) {
00075            i = incX << 1 ;
00076            tincx = 2;
00077            st= x+n;
00078          } else {
00079            i = incX *(-2);
00080            tincx = -2;
00081            st = x-2;
00082            x +=(n-2);
00083          }
00084 
00085          do
00086          {
00087            *x = *xx;
00088            x[1] = -xx[1];
00089            x += tincx ;
00090            xx += i;
00091          }
00092          while (x != st);
00093          x=tx;
00094 
00095 
00096          #ifdef F77_INT
00097             F77_incX = 1;
00098          #else
00099             incx = 1;
00100          #endif
00101  
00102          if(incY > 0)
00103            tincY = incY;
00104          else
00105            tincY = -incY;
00106          y++;
00107 
00108          i = tincY << 1;
00109          n = i * N ;
00110          st = y + n;
00111          do {
00112             *y = -(*y);
00113             y += i;
00114          } while(y != st);
00115          y -= n;
00116       }  else
00117          x = (double *) X; 
00118 
00119       if (Uplo == CblasUpper) UL = 'L';
00120       else if (Uplo == CblasLower) UL = 'U';
00121       else 
00122       {
00123          cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo);
00124          CBLAS_CallFromC = 0;
00125          RowMajorStrg = 0;
00126          return;
00127       }
00128       #ifdef F77_CHAR
00129          F77_UL = C2F_CHAR(&UL);
00130       #endif
00131       F77_zhbmv(F77_UL, &F77_N, &F77_K, ALPHA, 
00132                      A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
00133    }
00134    else 
00135    {
00136       cblas_xerbla(1, "cblas_zhbmv","Illegal Order setting, %d\n", order);
00137       CBLAS_CallFromC = 0;
00138       RowMajorStrg = 0;
00139       return;
00140    }
00141    if ( order == CblasRowMajor )
00142    {
00143       RowMajorStrg = 1;
00144       if(X!=x)
00145          free(x);
00146       if (N > 0)
00147       {
00148          do
00149          {
00150             *y = -(*y);
00151             y += i;
00152          }
00153          while (y != st);
00154       }
00155    }
00156    CBLAS_CallFromC = 0;
00157    RowMajorStrg = 0;
00158    return;
00159 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:16