01: /*
02:  * cblas_zgerc.c
03:  * The program is a C interface to zgerc.
04:  *
05:  * Keita Teranishi  5/20/98
06:  *
07:  */
08: #include <stdio.h>
09: #include <stdlib.h>
10: #include "cblas.h"
11: #include "cblas_f77.h"
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 = (double *)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: