1/*
2 * cblas_zhpr2.c
3 * The program is a C interface to zhpr2.
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"
12void cblas_zhpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
13                      const int N,const void *alpha, const void *X,
14                      const int incX,const void *Y, const int incY, void *Ap)
15
16{
17   char UL;
18#ifdef F77_CHAR
19   F77_CHAR F77_UL;
20#else
21   #define F77_UL &UL
22#endif
23
24#ifdef F77_INT
25   F77_INT F77_N=N,  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, j, incx=incX, incy=incY;
32   double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
33         *yy=(double *)Y, *stx, *sty;
34
35   extern int CBLAS_CallFromC;
36   extern int RowMajorStrg;
37   RowMajorStrg = 0;
38
39   CBLAS_CallFromC = 1;
40   if (order == CblasColMajor)
41   {
42      if (Uplo == CblasLower) UL = 'L';
43      else if (Uplo == CblasUpper) UL = 'U';
44      else
45      {
46         cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n",Uplo );
47         CBLAS_CallFromC = 0;
48         RowMajorStrg = 0;
49         return;
50      }
51      #ifdef F77_CHAR
52         F77_UL = C2F_CHAR(&UL);
53      #endif
54
55      F77_zhpr2(F77_UL, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, Ap);
56
57   }  else if (order == CblasRowMajor)
58   {
59      RowMajorStrg = 1;
60      if (Uplo == CblasUpper) UL = 'L';
61      else if (Uplo == CblasLower) UL = 'U';
62      else
63      {
64         cblas_xerbla(2, "cblas_zhpr2","Illegal Uplo setting, %d\n", Uplo);
65         CBLAS_CallFromC = 0;
66         RowMajorStrg = 0;
67         return;
68      }
69      #ifdef F77_CHAR
70         F77_UL = C2F_CHAR(&UL);
71      #endif
72      if (N > 0)
73      {
74         n = N << 1;
75         x = malloc(n*sizeof(double));
76         y = malloc(n*sizeof(double));
77         stx = x + n;
78         sty = y + n;
79         if( incX > 0 )
80            i = incX << 1;
81         else
82            i = incX *(-2);
83
84         if( incY > 0 )
85            j = incY << 1;
86         else
87            j = incY *(-2);
88         do
89         {
90            *x = *xx;
91            x[1] = -xx[1];
92            x += 2;
93            xx += i;
94         } while (x != stx);
95         do
96         {
97            *y = *yy;
98            y[1] = -yy[1];
99            y += 2;
100            yy += j;
101         }
102         while (y != sty);
103         x -= n;
104         y -= n;
105
106         #ifdef F77_INT
107            if(incX > 0 )
108               F77_incX = 1;
109            else
110               F77_incX = -1;
111
112            if(incY > 0 )
113               F77_incY = 1;
114            else
115               F77_incY = -1;
116
117         #else
118            if(incX > 0 )
119               incx = 1;
120            else
121               incx = -1;
122
123            if(incY > 0 )
124               incy = 1;
125            else
126               incy = -1;
127         #endif
128
129      }  else
130      {
131         x = (double *) X;
132         y = (void  *) Y;
133      }
134      F77_zhpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
135   }
136   else
137   {
138      cblas_xerbla(1, "cblas_zhpr2","Illegal Order setting, %d\n", order);
139      CBLAS_CallFromC = 0;
140      RowMajorStrg = 0;
141      return;
142   }
143   if(X!=x)
144      free(x);
145   if(Y!=y)
146      free(y);
147   CBLAS_CallFromC = 0;
148   RowMajorStrg = 0;
149   return;
150}
151