• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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"
cblas_zher2(const enum CBLAS_ORDER order,const enum 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)12 void cblas_zher2(const enum CBLAS_ORDER order, const enum 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 (order == 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 (order == 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 Order setting, %d\n", order);
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 }
154