1 /* 2 * cblas_zhbmv.c 3 * The program is a C interface to zhbmv 4 * 5 * Keita Teranishi 5/18/98 6 * 7 */ 8 #include "cblas.h" 9 #include "cblas_f77.h" 10 #include <stdio.h> 11 #include <stdlib.h> 12 void cblas_zhbmv(const enum CBLAS_ORDER order, 13 const enum CBLAS_UPLO Uplo,const int N,const int K, 14 const void *alpha, const void *A, const int lda, 15 const void *X, const int incX, const void *beta, 16 void *Y, const int incY) 17 { 18 char UL; 19 #ifdef F77_CHAR 20 F77_CHAR F77_UL; 21 #else 22 #define F77_UL &UL 23 #endif 24 #ifdef F77_INT 25 F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY; 26 #else 27 #define F77_N N 28 #define F77_K K 29 #define F77_lda lda 30 #define F77_incX incx 31 #define F77_incY incY 32 #endif 33 int n, i=0, incx=incX; 34 const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta; 35 double ALPHA[2],BETA[2]; 36 int tincY, tincx; 37 double *x=(double *)X, *y=(double *)Y, *st=0, *tx; 38 extern int CBLAS_CallFromC; 39 extern int RowMajorStrg; 40 RowMajorStrg = 0; 41 42 CBLAS_CallFromC = 1; 43 if (order == CblasColMajor) 44 { 45 if (Uplo == CblasLower) UL = 'L'; 46 else if (Uplo == CblasUpper) UL = 'U'; 47 else 48 { 49 cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n",Uplo ); 50 CBLAS_CallFromC = 0; 51 RowMajorStrg = 0; 52 return; 53 } 54 #ifdef F77_CHAR 55 F77_UL = C2F_CHAR(&UL); 56 #endif 57 F77_zhbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X, 58 &F77_incX, beta, Y, &F77_incY); 59 } 60 else if (order == CblasRowMajor) 61 { 62 RowMajorStrg = 1; 63 ALPHA[0]= *alp; 64 ALPHA[1]= -alp[1]; 65 BETA[0]= *bet; 66 BETA[1]= -bet[1]; 67 68 if (N > 0) 69 { 70 n = N << 1; 71 x = malloc(n*sizeof(double)); 72 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 85 do 86 { 87 *x = *xx; 88 x[1] = -xx[1]; 89 x += tincx ; 90 xx += i; 91 } 92 while (x != st); 93 x=tx; 94 95 96 #ifdef F77_INT 97 F77_incX = 1; 98 #else 99 incx = 1; 100 #endif 101 102 if(incY > 0) 103 tincY = incY; 104 else 105 tincY = -incY; 106 y++; 107 108 i = tincY << 1; 109 n = i * N ; 110 st = y + n; 111 do { 112 *y = -(*y); 113 y += i; 114 } while(y != st); 115 y -= n; 116 } else 117 x = (double *) X; 118 119 if (Uplo == CblasUpper) UL = 'L'; 120 else if (Uplo == CblasLower) UL = 'U'; 121 else 122 { 123 cblas_xerbla(2, "cblas_zhbmv","Illegal Uplo setting, %d\n", Uplo); 124 CBLAS_CallFromC = 0; 125 RowMajorStrg = 0; 126 return; 127 } 128 #ifdef F77_CHAR 129 F77_UL = C2F_CHAR(&UL); 130 #endif 131 F77_zhbmv(F77_UL, &F77_N, &F77_K, ALPHA, 132 A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY); 133 } 134 else 135 { 136 cblas_xerbla(1, "cblas_zhbmv","Illegal Order setting, %d\n", order); 137 CBLAS_CallFromC = 0; 138 RowMajorStrg = 0; 139 return; 140 } 141 if ( order == CblasRowMajor ) 142 { 143 RowMajorStrg = 1; 144 if(X!=x) 145 free(x); 146 if (N > 0) 147 { 148 do 149 { 150 *y = -(*y); 151 y += i; 152 } 153 while (y != st); 154 } 155 } 156 CBLAS_CallFromC = 0; 157 RowMajorStrg = 0; 158 return; 159 } 160
