LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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"
12void API_SUFFIX(cblas_zher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
13 const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX,
14 const void *Y, const CBLAS_INT incY, void *A, const CBLAS_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 CBLAS_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
40 if (layout == CblasColMajor)
41 {
42 if (Uplo == CblasLower) UL = 'L';
43 else if (Uplo == CblasUpper) UL = 'U';
44 else
45 {
46 API_SUFFIX(cblas_xerbla)(2, "cblas_zher2", "Illegal Uplo setting, %d\n",Uplo );
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 API_SUFFIX(cblas_xerbla)(2, "cblas_zher2", "Illegal Uplo setting, %d\n", Uplo);
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 API_SUFFIX(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_UPLO
Definition cblas.h:41
@ CblasLower
Definition cblas.h:41
@ CblasUpper
Definition cblas.h:41
void cblas_xerbla(CBLAS_INT p, const char *rout, const char *form,...)
CBLAS_LAYOUT
Definition cblas.h:39
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
#define API_SUFFIX(a)
Definition cblas.h:57
#define CBLAS_INT
Definition cblas.h:24
#define F77_INT
#define F77_zher2(...)
Definition cblas_f77.h:377
int CBLAS_CallFromC
int RowMajorStrg
#define F77_incX
#define F77_incY
void API_SUFFIX() cblas_zher2(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_INT N, const void *alpha, const void *X, const CBLAS_INT incX, const void *Y, const CBLAS_INT incY, void *A, const CBLAS_INT lda)
Definition cblas_zher2.c:12
#define F77_N
#define F77_lda
#define F77_UL