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