LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
cblas_zher2.c
Go to the documentation of this file.
1 /*
2  * cblas_zher2.c
3  * The program is a C interface to zher2.
4  *
5  * Keita Teranishi 3/23/98
6  *
7  */
8 #include <stdio.h>
9 #include <stdlib.h>
10 #include "cblas.h"
11 #include "cblas_f77.h"
12 void cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
13  const int N, const void *alpha, const void *X, const int incX,
14  const void *Y, const int incY, void *A, const int lda)
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 }
cblas_f77.h
cblas_zher2
void cblas_zher2(const CBLAS_LAYOUT layout, const 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: cblas_zher2.c:12
cblas_xerbla
void cblas_xerbla(int p, const char *rout, const char *form,...)
Definition: cblas_xerbla.c:8
CblasUpper
Definition: cblas.h:21
F77_lda
#define F77_lda
F77_N
#define F77_N
CblasColMajor
Definition: cblas.h:19
CBLAS_CallFromC
int CBLAS_CallFromC
Definition: cblas_globals.c:1
cblas.h
CBLAS_LAYOUT
CBLAS_LAYOUT
Definition: cblas.h:19
CblasRowMajor
Definition: cblas.h:19
RowMajorStrg
int RowMajorStrg
Definition: cblas_globals.c:2
F77_zher2
#define F77_zher2
Definition: cblas_f77.h:124
F77_incX
#define F77_incX
CblasLower
Definition: cblas.h:21
F77_incY
#define F77_incY
F77_UL
#define F77_UL
CBLAS_UPLO
CBLAS_UPLO
Definition: cblas.h:21
N
#define N
Definition: example_user.c:10