blas_intfc.cc

Go to the documentation of this file.

#include <stdio.h>

extern "C" {

#if FC_SYMBOL==2
#define F_DAXPY daxpy_
#define F_DCOPY dcopy_
#define F_DGEMM dgemm_
#define F_DROT drot_
#define F_DSCAL dscal_
#define F_DGEMV dgemv_
#define F_DSPMV dspmv_
#define F_DDOT  ddot_
#elif FC_SYMBOL==1
#define F_DAXPY daxpy
#define F_DCOPY dcopy
#define F_DGEMM dgemm
#define F_DROT drot
#define F_DSCAL dscal
#define F_DGEMV dgemv
#define F_DSPMV dspmv
#define F_DDOT  ddot
#elif FC_SYMBOL==3
#define F_DAXPY DAXPY
#define F_DCOPY DCOPY
#define F_DGEMM DGEMM
#define F_DROT DROT
#define F_DSCAL DSCAL
#define F_DGEMV DGEMV
#define F_DSPMV DSPMV
#define F_DDOT  DDOT
#elif FC_SYMBOL==4
#define F_DAXPY DAXPY_
#define F_DCOPY DCOPY_
#define F_DGEMM DGEMM_
#define F_DROT DROT_
#define F_DSCAL DSCAL_
#define F_DGEMV DGEMV_
#define F_DSPMV DSPMV_
#define F_DDOT  DDOT_
#endif

extern void F_DAXPY(int *length, double *a, double *x, int *inc_x, 
  double *y, int *inc_y);
extern void F_DCOPY(int *length, double *x, int *inc_x, 
  double *y, int *inc_y);
extern void F_DGEMM(char *transa, char *transb, int *m, int *n, int *k, 
  double *alpha, double *A, int *lda, double *B, int *ldb, 
  double *beta, double *C, int *ldc);
extern void F_DROT(int *ntot, double *x, int *incx, double *y, int *incy,
  double *cotheta, double *sintheta);
extern void F_DSCAL(int *n, double *alpha, double *vec, int *inc);
extern void F_DGEMV(char *transa, int *m, int *n, double *alpha, double *A, 
  int *lda, double *X, int *inc_x, double *beta, double *Y, int *inc_y);
extern void F_DSPMV(char *uplo, int *n, double *alpha, double *A, double *X,
  int *inc_x, double *beta, double *Y, int *inc_y);
extern double F_DDOT(int *n, double *x, int *incx, double *y, int *incy);


void C_DAXPY(int length, double a, double *x, int inc_x, 
             double *y, int inc_y)
{
  F_DAXPY(&length, &a, x, &inc_x, y, &inc_y);
}


void C_DCOPY(int length, double *x, int inc_x, 
             double *y, int inc_y)
{
  F_DCOPY(&length, x, &inc_x, y, &inc_y);
}


void C_DSCAL(int length, double alpha, double *vec, int inc)
{
  F_DSCAL(&length, &alpha, vec, &inc);
}


void C_DROT(int length, double *x, int inc_x, double *y, int inc_y,
            double costheta, double sintheta)
{

  F_DROT(&length,x,&inc_x,y,&inc_y,&costheta,&sintheta);
}


void C_DGEMM(char transa, char transb, int m, int n, int k, double alpha,
           double *A, int nca, double *B, int ncb, double beta, double *C,
           int ncc)
{

  /* the only strange thing we need to do is reverse everything
     since the stride runs differently in C vs. Fortran
   */
  
  /* also, do nothing if a dimension is 0 */
  if (m == 0 || n == 0 || k == 0) return;

  F_DGEMM(&transb,&transa,&n,&m,&k,&alpha,B,&ncb,A,&nca,&beta,C,&ncc);

}


void C_DGEMV(char transa, int m, int n, double alpha, double *A, 
             int nca, double *X, int inc_x, double beta, double *Y,
             int inc_y)
{
  if (m == 0 || n == 0) return;

  if(transa == 'n') transa = 't';
  else transa = 'n';

  F_DGEMV(&transa,&n,&m,&alpha,A,&nca,X,&inc_x,&beta,Y,&inc_y);

}


void C_DSPMV(char uplo, int n, double alpha, double *A, 
             double *X, int inc_x, double beta, double *Y,
             int inc_y)
{
  if (n == 0) return;

  if (uplo != 'U' && uplo != 'u' && uplo != 'L' && uplo != 'l')
    fprintf(stderr, "C_DSPMV: called with unrecognized option for uplo!\n");

  if (uplo == 'U' || uplo == 'u') uplo = 'L';
  else uplo = 'U';

  F_DSPMV(&uplo,&n,&alpha,A,X,&inc_x,&beta,Y,&inc_y);

}


double C_DDOT(int n, double *x, int inc_x, double *y, int inc_y)
{
   if(n == 0) return 0.0;

   return F_DDOT(&n,x,&inc_x,y,&inc_y);
}

} /* extern "C" */

---