1 /* 2 * cblas_ctpmv.c 3 * The program is a C interface to ctpmv. 4 * 5 * Keita Teranishi 5/20/98 6 * 7 */ 8 #include "cblas.h" 9 #include "cblas_f77.h" cblas_ctpmv(const enum CBLAS_ORDER order,const enum CBLAS_UPLO Uplo,const enum CBLAS_TRANSPOSE TransA,const enum CBLAS_DIAG Diag,const int N,const void * Ap,void * X,const int incX)10 void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo, 11 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag, 12 const int N, const void *Ap, void *X, const int incX) 13 { 14 char TA; 15 char UL; 16 char DI; 17 #ifdef F77_CHAR 18 F77_CHAR F77_TA, F77_UL, F77_DI; 19 #else 20 #define F77_TA &TA 21 #define F77_UL &UL 22 #define F77_DI &DI 23 #endif 24 #ifdef F77_INT 25 F77_INT F77_N=N, F77_incX=incX; 26 #else 27 #define F77_N N 28 #define F77_incX incX 29 #endif 30 int n, i=0, tincX; 31 float *st=0,*x=(float *)X; 32 extern int CBLAS_CallFromC; 33 extern int RowMajorStrg; 34 RowMajorStrg = 0; 35 36 CBLAS_CallFromC = 1; 37 if (order == CblasColMajor) 38 { 39 if (Uplo == CblasUpper) UL = 'U'; 40 else if (Uplo == CblasLower) UL = 'L'; 41 else 42 { 43 cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo); 44 CBLAS_CallFromC = 0; 45 RowMajorStrg = 0; 46 return; 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(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA); 54 CBLAS_CallFromC = 0; 55 RowMajorStrg = 0; 56 return; 57 } 58 if (Diag == CblasUnit) DI = 'U'; 59 else if (Diag == CblasNonUnit) DI = 'N'; 60 else 61 { 62 cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag); 63 CBLAS_CallFromC = 0; 64 RowMajorStrg = 0; 65 return; 66 } 67 #ifdef F77_CHAR 68 F77_UL = C2F_CHAR(&UL); 69 F77_TA = C2F_CHAR(&TA); 70 F77_DI = C2F_CHAR(&DI); 71 #endif 72 F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX); 73 } 74 else if (order == CblasRowMajor) 75 { 76 RowMajorStrg = 1; 77 if (Uplo == CblasUpper) UL = 'L'; 78 else if (Uplo == CblasLower) UL = 'U'; 79 else 80 { 81 cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo); 82 CBLAS_CallFromC = 0; 83 RowMajorStrg = 0; 84 return; 85 } 86 87 if (TransA == CblasNoTrans) TA = 'T'; 88 else if (TransA == CblasTrans) TA = 'N'; 89 else if (TransA == CblasConjTrans) 90 { 91 TA = 'N'; 92 if ( N > 0) 93 { 94 if(incX > 0) 95 tincX = incX; 96 else 97 tincX = -incX; 98 i = tincX << 1; 99 n = i * N; 100 x++; 101 st = x + n; 102 do 103 { 104 *x = -(*x); 105 x += i; 106 } 107 while (x != st); 108 x -= n; 109 } 110 } 111 else 112 { 113 cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA); 114 CBLAS_CallFromC = 0; 115 RowMajorStrg = 0; 116 return; 117 } 118 119 if (Diag == CblasUnit) DI = 'U'; 120 else if (Diag == CblasNonUnit) DI = 'N'; 121 else 122 { 123 cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag); 124 CBLAS_CallFromC = 0; 125 RowMajorStrg = 0; 126 return; 127 } 128 #ifdef F77_CHAR 129 F77_UL = C2F_CHAR(&UL); 130 F77_TA = C2F_CHAR(&TA); 131 F77_DI = C2F_CHAR(&DI); 132 #endif 133 134 F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX); 135 if (TransA == CblasConjTrans) 136 { 137 if (N > 0) 138 { 139 do 140 { 141 *x = -(*x); 142 x += i; 143 } 144 while (x != st); 145 } 146 } 147 } 148 else cblas_xerbla(1, "cblas_ctpmv", "Illegal Order setting, %d\n", order); 149 CBLAS_CallFromC = 0; 150 RowMajorStrg = 0; 151 return; 152 } 153