1 /* 2 * cblas_cgemv.c 3 * The program is a C interface of cgemv 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" 12 void cblas_cgemv(const enum CBLAS_ORDER order, 13 const enum CBLAS_TRANSPOSE TransA, const int M, const int N, 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 TA; 19 #ifdef F77_CHAR 20 F77_CHAR F77_TA; 21 #else 22 #define F77_TA &TA 23 #endif 24 #ifdef F77_INT 25 F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY; 26 #else 27 #define F77_M M 28 #define F77_N N 29 #define F77_lda lda 30 #define F77_incX incx 31 #define F77_incY incY 32 #endif 33 34 int n=0, i=0, incx=incX; 35 const float *xx= (const float *)X; 36 float ALPHA[2],BETA[2]; 37 int tincY, tincx; 38 float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0; 39 const float *stx = x; 40 extern int CBLAS_CallFromC; 41 extern int RowMajorStrg; 42 RowMajorStrg = 0; 43 44 CBLAS_CallFromC = 1; 45 46 if (order == CblasColMajor) 47 { 48 if (TransA == CblasNoTrans) TA = 'N'; 49 else if (TransA == CblasTrans) TA = 'T'; 50 else if (TransA == CblasConjTrans) TA = 'C'; 51 else 52 { 53 cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA); 54 CBLAS_CallFromC = 0; 55 RowMajorStrg = 0; 56 return; 57 } 58 #ifdef F77_CHAR 59 F77_TA = C2F_CHAR(&TA); 60 #endif 61 F77_cgemv(F77_TA, &F77_M, &F77_N, alpha, A, &F77_lda, X, &F77_incX, 62 beta, Y, &F77_incY); 63 } 64 else if (order == CblasRowMajor) 65 { 66 RowMajorStrg = 1; 67 68 if (TransA == CblasNoTrans) TA = 'T'; 69 else if (TransA == CblasTrans) TA = 'N'; 70 else if (TransA == CblasConjTrans) 71 { 72 ALPHA[0]= *( (const float *) alpha ); 73 ALPHA[1]= -( *( (const float *) alpha+1) ); 74 BETA[0]= *( (const float *) beta ); 75 BETA[1]= -( *( (const float *) beta+1 ) ); 76 TA = 'N'; 77 if (M > 0) 78 { 79 n = M << 1; 80 x = malloc(n*sizeof(float)); 81 tx = x; 82 if( incX > 0 ) { 83 i = incX << 1 ; 84 tincx = 2; 85 st= x+n; 86 } else { 87 i = incX *(-2); 88 tincx = -2; 89 st = x-2; 90 x +=(n-2); 91 } 92 93 do 94 { 95 *x = *xx; 96 x[1] = -xx[1]; 97 x += tincx ; 98 xx += i; 99 } 100 while (x != st); 101 x=tx; 102 103 F77_incX = 1; 104 105 if(incY > 0) 106 tincY = incY; 107 else 108 tincY = -incY; 109 110 y++; 111 112 if (N > 0) 113 { 114 i = tincY << 1; 115 n = i * N ; 116 st = y + n; 117 do { 118 *y = -(*y); 119 y += i; 120 } while(y != st); 121 y -= n; 122 } 123 stx = x; 124 } 125 else stx = (const float *)X; 126 } 127 else 128 { 129 cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA); 130 CBLAS_CallFromC = 0; 131 RowMajorStrg = 0; 132 return; 133 } 134 #ifdef F77_CHAR 135 F77_TA = C2F_CHAR(&TA); 136 #endif 137 if (TransA == CblasConjTrans) 138 F77_cgemv(F77_TA, &F77_N, &F77_M, ALPHA, A, &F77_lda, stx, 139 &F77_incX, BETA, Y, &F77_incY); 140 else 141 F77_cgemv(F77_TA, &F77_N, &F77_M, alpha, A, &F77_lda, x, 142 &F77_incX, beta, Y, &F77_incY); 143 144 if (TransA == CblasConjTrans) 145 { 146 if (x != (const float *)X) free(x); 147 if (N > 0) 148 { 149 do 150 { 151 *y = -(*y); 152 y += i; 153 } 154 while (y != st); 155 } 156 } 157 } 158 else cblas_xerbla(1, "cblas_cgemv", "Illegal Order setting, %d\n", order); 159 CBLAS_CallFromC = 0; 160 RowMajorStrg = 0; 161 return; 162 } 163
