001: /*
002:  * cblas_cher2.c
003:  * The program is a C interface to cher2.
004:  *
005:  * Keita Teranishi  3/23/98
006:  *
007:  */
008: #include <stdio.h>
009: #include <stdlib.h>
010: #include "cblas.h"
011: #include "cblas_f77.h"
012: void cblas_cher2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
013:                  const int N, const void *alpha, const void *X, const int incX,
014:                  const void *Y, const int incY, void *A, const int lda)
015: {
016:    char UL;
017: #ifdef F77_CHAR
018:    F77_CHAR F77_UL;
019: #else
020:    #define F77_UL &UL
021: #endif
022: 
023: #ifdef F77_INT
024:    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
025: #else
026:    #define F77_N N
027:    #define F77_lda lda
028:    #define F77_incX incx
029:    #define F77_incY incy
030: #endif
031:    int n, i, j, tincx, tincy, incx=incX, incy=incY;
032:    float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
033:          *yy=(float *)Y, *tx, *ty, *stx, *sty;
034: 
035:    extern int CBLAS_CallFromC;
036:    extern int RowMajorStrg;
037:    RowMajorStrg = 0;
038: 
039:    CBLAS_CallFromC = 1;
040:    if (order == CblasColMajor)
041:    {
042:       if (Uplo == CblasLower) UL = 'L';
043:       else if (Uplo == CblasUpper) UL = 'U';
044:       else
045:       {
046:          cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n",Uplo );
047:          CBLAS_CallFromC = 0;
048:          RowMajorStrg = 0;
049:          return;
050:       }
051:       #ifdef F77_CHAR
052:          F77_UL = C2F_CHAR(&UL);
053:       #endif
054: 
055:       F77_cher2(F77_UL, &F77_N, alpha, X, &F77_incX,
056:                                             Y, &F77_incY, A, &F77_lda);
057: 
058:    }  else if (order == CblasRowMajor)
059:    {
060:       RowMajorStrg = 1;
061:       if (Uplo == CblasUpper) UL = 'L';
062:       else if (Uplo == CblasLower) UL = 'U';
063:       else
064:       {
065:          cblas_xerbla(2, "cblas_cher2","Illegal Uplo setting, %d\n", Uplo);
066:          CBLAS_CallFromC = 0;
067:          RowMajorStrg = 0;
068:          return;
069:       }
070:       #ifdef F77_CHAR
071:          F77_UL = C2F_CHAR(&UL);
072:       #endif
073:       if (N > 0)
074:       {
075:          n = N << 1;
076:          x = (float *)malloc(n*sizeof(float));
077:          y = (float *)malloc(n*sizeof(float));
078:          tx = x;
079:          ty = y;
080:          if( incX > 0 ) {
081:             i = incX << 1 ;
082:             tincx = 2;
083:             stx= x+n;
084:          } else {
085:             i = incX *(-2);
086:             tincx = -2;
087:             stx = x-2;
088:             x +=(n-2);
089:          }
090: 
091:          if( incY > 0 ) {
092:             j = incY << 1;
093:             tincy = 2;
094:             sty= y+n;
095:          } else {
096:             j = incY *(-2);
097:             tincy = -2;
098:             sty = y-2;
099:             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 = (float *) X;
133:          y = (float *) Y;
134:       }
135:       F77_cher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
136:                                       &F77_incX, A, &F77_lda);
137:    } else
138:    {
139:       cblas_xerbla(1, "cblas_cher2","Illegal Order setting, %d\n", order);
140:       CBLAS_CallFromC = 0;
141:       RowMajorStrg = 0;
142:       return;
143:    }
144:    if(X!=x)
145:       free(x);
146:    if(Y!=y)
147:       free(y);
148: 
149:    CBLAS_CallFromC = 0;
150:    RowMajorStrg = 0;
151:    return;
152: }
153: