ger.cc (interfaces/blas/C/ger.cc)

      1
      2
      3
      4
      5
      6
      7
      8
      9
     10
     11
     12
     13
     14
     15
     16
     17
     18
     19
     20
     21
     22
     23
     24
     25
     26
     27
     28
     29
     30
     31
     32
     33
     34
     35
     36
     37
     38
     39
     40
     41
     42
     43
     44
     45
     46
     47
     48
     49
     50
     51
     52
     53
     54
     55
     56
     57
     58
     59
     60
     61
     62
     63
     64
     65
     66
     67
     68
     69
     70
     71
     72
     73
     74
     75
     76
     77
     78
     79
     80
     81
     82
     83
     84
     85
     86
     87
     88
     89
     90
     91
     92
     93
     94
     95
     96
     97
     98
     99
     100

#include BLAS_HEADER

#include <algorithm>

#include <interfaces/blas/C/xerbla.h>

#include <ulmblas/level1/copy.h>

#include <ulmblas/level1extensions/gecopy.h>

#include <ulmblas/level2/ger.h>

//#define SCATTER

#ifdef SCATTER

#define   SCATTER_INCROWA   1

#define   SCATTER_INCCOLA   1

#define   SCATTER_INCX      2

#define   SCATTER_INCY      1

#endif

extern "C" {

void

ULMBLAS(dger)(const int         m,

              const int         n,

              const double      alpha,

              const double      *x,

              const int         incX,

              const double      *y,

              const int         incY,

              double            *A,

              const int         ldA)

{

//

//  Test the input parameters

//

    int info = 0;

    if (m<0) {

        info = 1;

    } else if (n<0) {

        info = 2;

    } else if (incX==0) {

        info = 5;

    } else if (incY==0) {

        info = 7;

    } else if (ldA<std::max(1,m)) {

        info = 9;

    }

    if (info!=0) {

        ULMBLAS(xerbla)("DGER  ", &info);

    }

    if (incX<0) {

        x -= incX*(m-1);

    }

    if (incY<0) {

        y -= incY*(n-1);

    }

#ifndef SCATTER

//

//  Start the operations.

//

    ulmBLAS::ger(m, n, alpha, x, incX, y, incY, A, 1, ldA);

#else

//

//  Scatter operands

//

    double *x_ = new double[m*incX*SCATTER_INCX];

    double *y_ = new double[n*incY*SCATTER_INCY];

    double *A_ = new double[ldA*n*SCATTER_INCROWA*SCATTER_INCCOLA];

    ulmBLAS::copy(m, x, incX, x_, incX*SCATTER_INCX);

    ulmBLAS::copy(m, y, incY, y_, incY*SCATTER_INCY);

    ulmBLAS::gecopy(m, n,

                    A, 1, ldA,

                    A_, SCATTER_INCROWA, ldA*SCATTER_INCCOLA);

//

//  Start the operations.

//

    ulmBLAS::ger(m, n, alpha,

                 x_, incX*SCATTER_INCX,

                 y_, incY*SCATTER_INCY,

                 A_, SCATTER_INCROWA, ldA*SCATTER_INCCOLA);

    ulmBLAS::gecopy(m, n,

                    A_, SCATTER_INCROWA, ldA*SCATTER_INCCOLA,

                    A, 1, ldA);

//

//  Gather result

//

    delete [] x_;

    delete [] y_;

    delete [] A_;

#endif

}

} // extern "C"