LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cblas_zher2()

void cblas_zher2 ( 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 *  A,
const int  lda 
)

Definition at line 12 of file cblas_zher2.c.

15 {
16  char UL;
17 #ifdef F77_CHAR
18  F77_CHAR F77_UL;
19 #else
20  #define F77_UL &UL
21 #endif
22 
23 #ifdef F77_INT
24  F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
25 #else
26  #define F77_N N
27  #define F77_lda lda
28  #define F77_incX incx
29  #define F77_incY incy
30 #endif
31  int n, i, j, tincx, tincy, incx=incX, incy=incY;
32  double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
33  *yy=(double *)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 (layout == CblasColMajor)
41  {
42  if (Uplo == CblasLower) UL = 'L';
43  else if (Uplo == CblasUpper) UL = 'U';
44  else
45  {
46  cblas_xerbla(2, "cblas_zher2", "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_zher2(F77_UL, &F77_N, alpha, X, &F77_incX,
56  Y, &F77_incY, A, &F77_lda);
57 
58  } else if (layout == CblasRowMajor)
59  {
60  RowMajorStrg = 1;
61  if (Uplo == CblasUpper) UL = 'L';
62  else if (Uplo == CblasLower) UL = 'U';
63  else
64  {
65  cblas_xerbla(2, "cblas_zher2", "Illegal Uplo setting, %d\n", Uplo);
66  CBLAS_CallFromC = 0;
67  RowMajorStrg = 0;
68  return;
69  }
70  #ifdef F77_CHAR
71  F77_UL = C2F_CHAR(&UL);
72  #endif
73  if (N > 0)
74  {
75  n = N << 1;
76  x = malloc(n*sizeof(double));
77  y = malloc(n*sizeof(double));
78  tx = x;
79  ty = y;
80  if( incX > 0 ) {
81  i = incX << 1 ;
82  tincx = 2;
83  stx= x+n;
84  } else {
85  i = incX *(-2);
86  tincx = -2;
87  stx = x-2;
88  x +=(n-2);
89  }
90 
91  if( incY > 0 ) {
92  j = incY << 1;
93  tincy = 2;
94  sty= y+n;
95  } else {
96  j = incY *(-2);
97  tincy = -2;
98  sty = y-2;
99  y +=(n-2);
100  }
101 
102  do
103  {
104  *x = *xx;
105  x[1] = -xx[1];
106  x += tincx ;
107  xx += i;
108  }
109  while (x != stx);
110 
111  do
112  {
113  *y = *yy;
114  y[1] = -yy[1];
115  y += tincy ;
116  yy += j;
117  }
118  while (y != sty);
119 
120  x=tx;
121  y=ty;
122 
123  #ifdef F77_INT
124  F77_incX = 1;
125  F77_incY = 1;
126  #else
127  incx = 1;
128  incy = 1;
129  #endif
130  } else
131  {
132  x = (double *) X;
133  y = (double *) Y;
134  }
135  F77_zher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
136  &F77_incX, A, &F77_lda);
137  }
138  else
139  {
140  cblas_xerbla(1, "cblas_zher2", "Illegal layout setting, %d\n", layout);
141  CBLAS_CallFromC = 0;
142  RowMajorStrg = 0;
143  return;
144  }
145  if(X!=x)
146  free(x);
147  if(Y!=y)
148  free(y);
149 
150  CBLAS_CallFromC = 0;
151  RowMajorStrg = 0;
152  return;
153 }
int RowMajorStrg
Definition: cblas_globals.c:2
#define F77_zher2
Definition: cblas_f77.h:124
#define F77_incY
#define F77_UL
#define F77_incX
#define F77_N
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_lda
#define N
Definition: example_user.c:10
Here is the call graph for this function:
Here is the caller graph for this function: