1 /*
2 * cblas_zgerc.c
3 * The program is a C interface to zgerc.
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_zgerc(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_zgerc(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 double *y=(double *)Y, *yy=(double *)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_zgerc( &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(double));
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 = (double *) Y;
74
75 F77_zgeru( &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_zgerc", "Illegal Order setting, %d\n", order);
81 CBLAS_CallFromC = 0;
82 RowMajorStrg = 0;
83 return;
84 }
85