LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cblas_zhpr2()

void cblas_zhpr2 ( CBLAS_LAYOUT  layout,
CBLAS_UPLO  Uplo,
const int  N,
const void *  alpha,
const void *  X,
const int  incX,
const void *  Y,
const int  incY,
void *  Ap 
)

Definition at line 12 of file cblas_zhpr2.c.

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 (layout == 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 (layout == 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 layout setting, %d\n", layout);
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 }
int RowMajorStrg
Definition: cblas_globals.c:2
#define F77_UL
#define F77_incY
int CBLAS_CallFromC
Definition: cblas_globals.c:1
void cblas_xerbla(int p, const char *rout, const char *form,...)
Definition: cblas_xerbla.c:8
#define F77_zhpr2
Definition: cblas_f77.h:125
#define F77_incX
#define N
Definition: example_user.c:10
#define F77_N
Here is the call graph for this function:
Here is the caller graph for this function: