• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1 /*
2  * cblas_cgerc.c
3  * The program is a C interface to cgerc.
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"
cblas_cgerc(const enum CBLAS_ORDER order,const int M,const int N,const void * alpha,const void * X,const int incX,const void * Y,const int incY,void * A,const int lda)12 void cblas_cgerc(const enum CBLAS_ORDER order, const int M, const int N,
13                  const void *alpha, const void *X, const int incX,
14                  const void *Y, const int incY, void *A, const int lda)
15 {
16 #ifdef F77_INT
17    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
18 #else
19    #define F77_M M
20    #define F77_N N
21    #define F77_incX incX
22    #define F77_incY incy
23    #define F77_lda lda
24 #endif
25 
26    int n, i, tincy, incy=incY;
27    float *y=(float *)Y, *yy=(float *)Y, *ty, *st;
28 
29    extern int CBLAS_CallFromC;
30    extern int RowMajorStrg;
31    RowMajorStrg = 0;
32 
33    CBLAS_CallFromC = 1;
34    if (order == CblasColMajor)
35    {
36       F77_cgerc( &F77_M, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, A,
37                       &F77_lda);
38    }  else if (order == CblasRowMajor)
39    {
40       RowMajorStrg = 1;
41       if (N > 0)
42       {
43          n = N << 1;
44          y = malloc(n*sizeof(float));
45 
46          ty = y;
47          if( incY > 0 ) {
48             i = incY << 1;
49             tincy = 2;
50             st= y+n;
51          } else {
52             i = incY *(-2);
53             tincy = -2;
54             st = y-2;
55             y +=(n-2);
56          }
57          do
58          {
59             *y = *yy;
60             y[1] = -yy[1];
61             y += tincy ;
62             yy += i;
63          }
64          while (y != st);
65          y = ty;
66 
67          #ifdef F77_INT
68             F77_incY = 1;
69          #else
70             incy = 1;
71          #endif
72       }
73       else y = (float *) Y;
74 
75       F77_cgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
76                       &F77_lda);
77       if(Y!=y)
78          free(y);
79 
80    } else cblas_xerbla(1, "cblas_cgerc", "Illegal Order setting, %d\n", order);
81    CBLAS_CallFromC = 0;
82    RowMajorStrg = 0;
83    return;
84 }
85