1 /* 2 * cblas_chpr2.c 3 * The program is a C interface to chpr2. 4 * 5 * Keita Teranishi 5/20/98 6 * 7 */ 8 #include <stdio.h> 9 #include <stdlib.h> 10 #include "cblas.h" 11 #include "cblas_f77.h" cblas_chpr2(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 * Ap)12 void cblas_chpr2(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, 13 const int N,const void *alpha, const void *X, 14 const int incX,const void *Y, const int incY, void *Ap) 15 16 { 17 char UL; 18 #ifdef F77_CHAR 19 F77_CHAR F77_UL; 20 #else 21 #define F77_UL &UL 22 #endif 23 24 #ifdef F77_INT 25 F77_INT F77_N=N, F77_incX=incX, F77_incY=incY; 26 #else 27 #define F77_N N 28 #define F77_incX incx 29 #define F77_incY incy 30 #endif 31 int n, i, j, tincx, tincy, incx=incX, incy=incY; 32 float *x=(float *)X, *xx=(float *)X, *y=(float *)Y, 33 *yy=(float *)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_chpr2","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_chpr2(F77_UL, &F77_N, alpha, X, &F77_incX, Y, &F77_incY, Ap); 56 57 } else if (order == CblasRowMajor) 58 { 59 RowMajorStrg = 1; 60 if (Uplo == CblasUpper) UL = 'L'; 61 else if (Uplo == CblasLower) UL = 'U'; 62 else 63 { 64 cblas_xerbla(2, "cblas_chpr2","Illegal Uplo setting, %d\n", Uplo); 65 CBLAS_CallFromC = 0; 66 RowMajorStrg = 0; 67 return; 68 } 69 #ifdef F77_CHAR 70 F77_UL = C2F_CHAR(&UL); 71 #endif 72 if (N > 0) 73 { 74 n = N << 1; 75 x = malloc(n*sizeof(float)); 76 y = malloc(n*sizeof(float)); 77 tx = x; 78 ty = y; 79 if( incX > 0 ) { 80 i = incX << 1 ; 81 tincx = 2; 82 stx= x+n; 83 } else { 84 i = incX *(-2); 85 tincx = -2; 86 stx = x-2; 87 x +=(n-2); 88 } 89 90 if( incY > 0 ) { 91 j = incY << 1; 92 tincy = 2; 93 sty= y+n; 94 } else { 95 j = incY *(-2); 96 tincy = -2; 97 sty = y-2; 98 y +=(n-2); 99 } 100 101 do 102 { 103 *x = *xx; 104 x[1] = -xx[1]; 105 x += tincx ; 106 xx += i; 107 } 108 while (x != stx); 109 do 110 { 111 *y = *yy; 112 y[1] = -yy[1]; 113 y += tincy ; 114 yy += j; 115 } 116 while (y != sty); 117 118 x=tx; 119 y=ty; 120 121 #ifdef F77_INT 122 F77_incX = 1; 123 F77_incY = 1; 124 #else 125 incx = 1; 126 incy = 1; 127 #endif 128 129 } else 130 { 131 x = (float *) X; 132 y = (void *) Y; 133 } 134 F77_chpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap); 135 } else 136 { 137 cblas_xerbla(1, "cblas_chpr2","Illegal Order setting, %d\n", order); 138 CBLAS_CallFromC = 0; 139 RowMajorStrg = 0; 140 return; 141 } 142 if(X!=x) 143 free(x); 144 if(Y!=y) 145 free(y); 146 CBLAS_CallFromC = 0; 147 RowMajorStrg = 0; 148 return; 149 } 150