1*1858f998SYi Kong /*
2*1858f998SYi Kong * cblas_chpmv.c
3*1858f998SYi Kong * The program is a C interface of chpmv
4*1858f998SYi Kong *
5*1858f998SYi Kong * Keita Teranishi 5/18/98
6*1858f998SYi Kong *
7*1858f998SYi Kong */
8*1858f998SYi Kong #include <stdio.h>
9*1858f998SYi Kong #include <stdlib.h>
10*1858f998SYi Kong #include "cblas.h"
11*1858f998SYi Kong #include "cblas_f77.h"
cblas_chpmv(const enum CBLAS_ORDER order,const enum CBLAS_UPLO Uplo,const int N,const void * alpha,const void * AP,const void * X,const int incX,const void * beta,void * Y,const int incY)12*1858f998SYi Kong void cblas_chpmv(const enum CBLAS_ORDER order,
13*1858f998SYi Kong const enum CBLAS_UPLO Uplo,const int N,
14*1858f998SYi Kong const void *alpha, const void *AP,
15*1858f998SYi Kong const void *X, const int incX, const void *beta,
16*1858f998SYi Kong void *Y, const int incY)
17*1858f998SYi Kong {
18*1858f998SYi Kong char UL;
19*1858f998SYi Kong #ifdef F77_CHAR
20*1858f998SYi Kong F77_CHAR F77_UL;
21*1858f998SYi Kong #else
22*1858f998SYi Kong #define F77_UL &UL
23*1858f998SYi Kong #endif
24*1858f998SYi Kong #ifdef F77_INT
25*1858f998SYi Kong F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
26*1858f998SYi Kong #else
27*1858f998SYi Kong #define F77_N N
28*1858f998SYi Kong #define F77_incX incx
29*1858f998SYi Kong #define F77_incY incY
30*1858f998SYi Kong #endif
31*1858f998SYi Kong int n, i=0, incx=incX;
32*1858f998SYi Kong const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
33*1858f998SYi Kong float ALPHA[2],BETA[2];
34*1858f998SYi Kong int tincY, tincx;
35*1858f998SYi Kong float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
36*1858f998SYi Kong extern int CBLAS_CallFromC;
37*1858f998SYi Kong extern int RowMajorStrg;
38*1858f998SYi Kong RowMajorStrg = 0;
39*1858f998SYi Kong
40*1858f998SYi Kong CBLAS_CallFromC = 1;
41*1858f998SYi Kong if (order == CblasColMajor)
42*1858f998SYi Kong {
43*1858f998SYi Kong if (Uplo == CblasLower) UL = 'L';
44*1858f998SYi Kong else if (Uplo == CblasUpper) UL = 'U';
45*1858f998SYi Kong else
46*1858f998SYi Kong {
47*1858f998SYi Kong cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n",Uplo );
48*1858f998SYi Kong CBLAS_CallFromC = 0;
49*1858f998SYi Kong RowMajorStrg = 0;
50*1858f998SYi Kong return;
51*1858f998SYi Kong }
52*1858f998SYi Kong #ifdef F77_CHAR
53*1858f998SYi Kong F77_UL = C2F_CHAR(&UL);
54*1858f998SYi Kong #endif
55*1858f998SYi Kong F77_chpmv(F77_UL, &F77_N, alpha, AP, X,
56*1858f998SYi Kong &F77_incX, beta, Y, &F77_incY);
57*1858f998SYi Kong }
58*1858f998SYi Kong else if (order == CblasRowMajor)
59*1858f998SYi Kong {
60*1858f998SYi Kong RowMajorStrg = 1;
61*1858f998SYi Kong ALPHA[0]= *alp;
62*1858f998SYi Kong ALPHA[1]= -alp[1];
63*1858f998SYi Kong BETA[0]= *bet;
64*1858f998SYi Kong BETA[1]= -bet[1];
65*1858f998SYi Kong
66*1858f998SYi Kong if (N > 0)
67*1858f998SYi Kong {
68*1858f998SYi Kong n = N << 1;
69*1858f998SYi Kong x = malloc(n*sizeof(float));
70*1858f998SYi Kong
71*1858f998SYi Kong tx = x;
72*1858f998SYi Kong if( incX > 0 ) {
73*1858f998SYi Kong i = incX << 1;
74*1858f998SYi Kong tincx = 2;
75*1858f998SYi Kong st= x+n;
76*1858f998SYi Kong } else {
77*1858f998SYi Kong i = incX *(-2);
78*1858f998SYi Kong tincx = -2;
79*1858f998SYi Kong st = x-2;
80*1858f998SYi Kong x +=(n-2);
81*1858f998SYi Kong }
82*1858f998SYi Kong
83*1858f998SYi Kong do
84*1858f998SYi Kong {
85*1858f998SYi Kong *x = *xx;
86*1858f998SYi Kong x[1] = -xx[1];
87*1858f998SYi Kong x += tincx ;
88*1858f998SYi Kong xx += i;
89*1858f998SYi Kong }
90*1858f998SYi Kong while (x != st);
91*1858f998SYi Kong x=tx;
92*1858f998SYi Kong
93*1858f998SYi Kong
94*1858f998SYi Kong #ifdef F77_INT
95*1858f998SYi Kong F77_incX = 1;
96*1858f998SYi Kong #else
97*1858f998SYi Kong incx = 1;
98*1858f998SYi Kong #endif
99*1858f998SYi Kong
100*1858f998SYi Kong if(incY > 0)
101*1858f998SYi Kong tincY = incY;
102*1858f998SYi Kong else
103*1858f998SYi Kong tincY = -incY;
104*1858f998SYi Kong y++;
105*1858f998SYi Kong
106*1858f998SYi Kong i = tincY << 1;
107*1858f998SYi Kong n = i * N ;
108*1858f998SYi Kong st = y + n;
109*1858f998SYi Kong do {
110*1858f998SYi Kong *y = -(*y);
111*1858f998SYi Kong y += i;
112*1858f998SYi Kong } while(y != st);
113*1858f998SYi Kong y -= n;
114*1858f998SYi Kong } else
115*1858f998SYi Kong x = (float *) X;
116*1858f998SYi Kong
117*1858f998SYi Kong
118*1858f998SYi Kong if (Uplo == CblasUpper) UL = 'L';
119*1858f998SYi Kong else if (Uplo == CblasLower) UL = 'U';
120*1858f998SYi Kong else
121*1858f998SYi Kong {
122*1858f998SYi Kong cblas_xerbla(2, "cblas_chpmv","Illegal Uplo setting, %d\n", Uplo );
123*1858f998SYi Kong CBLAS_CallFromC = 0;
124*1858f998SYi Kong RowMajorStrg = 0;
125*1858f998SYi Kong return;
126*1858f998SYi Kong }
127*1858f998SYi Kong #ifdef F77_CHAR
128*1858f998SYi Kong F77_UL = C2F_CHAR(&UL);
129*1858f998SYi Kong #endif
130*1858f998SYi Kong
131*1858f998SYi Kong F77_chpmv(F77_UL, &F77_N, ALPHA,
132*1858f998SYi Kong AP, x, &F77_incX, BETA, Y, &F77_incY);
133*1858f998SYi Kong }
134*1858f998SYi Kong else
135*1858f998SYi Kong {
136*1858f998SYi Kong cblas_xerbla(1, "cblas_chpmv","Illegal Order setting, %d\n", order);
137*1858f998SYi Kong CBLAS_CallFromC = 0;
138*1858f998SYi Kong RowMajorStrg = 0;
139*1858f998SYi Kong return;
140*1858f998SYi Kong }
141*1858f998SYi Kong if ( order == CblasRowMajor )
142*1858f998SYi Kong {
143*1858f998SYi Kong RowMajorStrg = 1;
144*1858f998SYi Kong if(X!=x)
145*1858f998SYi Kong free(x);
146*1858f998SYi Kong if (N > 0)
147*1858f998SYi Kong {
148*1858f998SYi Kong do
149*1858f998SYi Kong {
150*1858f998SYi Kong *y = -(*y);
151*1858f998SYi Kong y += i;
152*1858f998SYi Kong }
153*1858f998SYi Kong while (y != st);
154*1858f998SYi Kong }
155*1858f998SYi Kong }
156*1858f998SYi Kong
157*1858f998SYi Kong CBLAS_CallFromC = 0;
158*1858f998SYi Kong RowMajorStrg = 0;
159*1858f998SYi Kong return;
160*1858f998SYi Kong }
161