v0.9.0
cblas_zhpr2.c
Go to the documentation of this file.
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"
12 void 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 }
void cblas_zhpr2(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)
Definition: cblas_zhpr2.c:12
CBLAS_UPLO
Definition: cblas.h:12
#define F77_incX
int CBLAS_CallFromC
Definition: cblas_globals.c:1
#define F77_incY
CBLAS_ORDER
Definition: cblas.h:10
void cblas_xerbla(int p, const char *rout, const char *form,...)
Definition: cblas_xerbla.c:8
void F77_zhpr2(FCHAR, FINT, const double *, const void *, FINT, const void *, FINT, void *)
#define F77_N
const int N
Definition: speed_test.cpp:3
int RowMajorStrg
Definition: cblas_globals.c:2
#define F77_UL