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