1 /*
2  * cblas_chpr2.c
3  * The program is a C interface to chpr2.
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"
cblas_chpr2(const enum CBLAS_ORDER order,const enum CBLAS_UPLO Uplo,const int N,const void * alpha,const void * X,const int incX,const void * Y,const int incY,void * Ap)12 void cblas_chpr2(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, tincx, tincy, incx=incX, incy=incY;
32    float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
33          *yy=(float *)Y, *tx, *ty, *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_chpr2","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_chpr2(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_chpr2","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(float));
76          y = malloc(n*sizeof(float));
77          tx = x;
78          ty = y;
79          if( incX > 0 ) {
80             i = incX << 1 ;
81             tincx = 2;
82             stx= x+n;
83          } else {
84             i = incX *(-2);
85             tincx = -2;
86             stx = x-2;
87             x +=(n-2);
88          }
89 
90          if( incY > 0 ) {
91             j = incY << 1;
92             tincy = 2;
93             sty= y+n;
94          } else {
95             j = incY *(-2);
96             tincy = -2;
97             sty = y-2;
98             y +=(n-2);
99          }
100 
101          do
102          {
103             *x = *xx;
104             x[1] = -xx[1];
105             x += tincx ;
106             xx += i;
107          }
108          while (x != stx);
109          do
110          {
111             *y = *yy;
112             y[1] = -yy[1];
113             y += tincy ;
114             yy += j;
115          }
116          while (y != sty);
117 
118          x=tx;
119          y=ty;
120 
121          #ifdef F77_INT
122             F77_incX = 1;
123             F77_incY = 1;
124          #else
125             incx = 1;
126             incy = 1;
127          #endif
128 
129       }  else
130       {
131          x = (float *) X;
132          y = (void  *) Y;
133       }
134       F77_chpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
135    } else
136    {
137       cblas_xerbla(1, "cblas_chpr2","Illegal Order setting, %d\n", order);
138       CBLAS_CallFromC = 0;
139       RowMajorStrg = 0;
140       return;
141    }
142    if(X!=x)
143       free(x);
144    if(Y!=y)
145       free(y);
146    CBLAS_CallFromC = 0;
147    RowMajorStrg = 0;
148    return;
149 }
150