LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cblas_zhpr.c
Go to the documentation of this file.
1/*
2 * cblas_zhpr.c
3 * The program is a C interface to zhpr.
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_zhpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
13 const CBLAS_INT N, const double alpha, const void *X,
14 const CBLAS_INT incX, void *A)
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_incX=incX;
25#else
26 #define F77_N N
27 #define F77_incX incx
28#endif
29 CBLAS_INT n, i, tincx, incx=incX;
30 double *x=(double *)X, *xx=(double *)X, *tx, *st;
31
32 extern int CBLAS_CallFromC;
33 extern int RowMajorStrg;
34 RowMajorStrg = 0;
35
37 if (layout == CblasColMajor)
38 {
39 if (Uplo == CblasLower) UL = 'L';
40 else if (Uplo == CblasUpper) UL = 'U';
41 else
42 {
43 API_SUFFIX(cblas_xerbla)(2, "cblas_zhpr","Illegal Uplo setting, %d\n",Uplo );
45 RowMajorStrg = 0;
46 return;
47 }
48 #ifdef F77_CHAR
49 F77_UL = C2F_CHAR(&UL);
50 #endif
51
52 F77_zhpr(F77_UL, &F77_N, &alpha, X, &F77_incX, A);
53
54 } else if (layout == CblasRowMajor)
55 {
56 RowMajorStrg = 1;
57 if (Uplo == CblasUpper) UL = 'L';
58 else if (Uplo == CblasLower) UL = 'U';
59 else
60 {
61 API_SUFFIX(cblas_xerbla)(2, "cblas_zhpr","Illegal Uplo setting, %d\n", Uplo);
63 RowMajorStrg = 0;
64 return;
65 }
66 #ifdef F77_CHAR
67 F77_UL = C2F_CHAR(&UL);
68 #endif
69 if (N > 0)
70 {
71 n = N << 1;
72 x = malloc(n*sizeof(double));
73 tx = x;
74 if( incX > 0 ) {
75 i = incX << 1;
76 tincx = 2;
77 st= x+n;
78 } else {
79 i = incX *(-2);
80 tincx = -2;
81 st = x-2;
82 x +=(n-2);
83 }
84 do
85 {
86 *x = *xx;
87 x[1] = -xx[1];
88 x += tincx ;
89 xx += i;
90 }
91 while (x != st);
92 x=tx;
93 #ifdef F77_INT
94 F77_incX = 1;
95 #else
96 incx = 1;
97 #endif
98 }
99 else x = (double *) X;
100
101 F77_zhpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
102
103 } else
104 {
105 API_SUFFIX(cblas_xerbla)(1, "cblas_zhpr","Illegal layout setting, %d\n", layout);
106 CBLAS_CallFromC = 0;
107 RowMajorStrg = 0;
108 return;
109 }
110 if(X!=x)
111 free(x);
112 CBLAS_CallFromC = 0;
113 RowMajorStrg = 0;
114 return;
115}
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_zhpr(...)
Definition cblas_f77.h:378
int CBLAS_CallFromC
int RowMajorStrg
#define F77_incX
void API_SUFFIX() cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX, void *A)
Definition cblas_zhpr.c:12
#define F77_N
#define F77_UL