xref: /aosp_15_r20/external/cblas/src/cblas_chpmv.c (revision 1858f9982ea1ad57fb52080c08594e4d1cce4fa1)
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