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