00001
00002
00003
00004
00005
00006
00007
00008 #include "cblas.h"
00009 #include "cblas_f77.h"
00010 void cblas_ctrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
00011 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
00012 const int N, const void *A, const int lda,
00013 void *X, const int incX)
00014
00015 {
00016 char TA;
00017 char UL;
00018 char DI;
00019 #ifdef F77_CHAR
00020 F77_CHAR F77_TA, F77_UL, F77_DI;
00021 #else
00022 #define F77_TA &TA
00023 #define F77_UL &UL
00024 #define F77_DI &DI
00025 #endif
00026 #ifdef F77_INT
00027 F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
00028 #else
00029 #define F77_N N
00030 #define F77_lda lda
00031 #define F77_incX incX
00032 #endif
00033 int n, i=0, tincX;
00034 float *st=0,*x=(float *)X;
00035 extern int CBLAS_CallFromC;
00036 extern int RowMajorStrg;
00037 RowMajorStrg = 0;
00038
00039 CBLAS_CallFromC = 1;
00040 if (order == CblasColMajor)
00041 {
00042 if (Uplo == CblasUpper) UL = 'U';
00043 else if (Uplo == CblasLower) UL = 'L';
00044 else
00045 {
00046 cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo);
00047 CBLAS_CallFromC = 0;
00048 RowMajorStrg = 0;
00049 return;
00050 }
00051 if (TransA == CblasNoTrans) TA = 'N';
00052 else if (TransA == CblasTrans) TA = 'T';
00053 else if (TransA == CblasConjTrans) TA = 'C';
00054 else
00055 {
00056 cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA);
00057 CBLAS_CallFromC = 0;
00058 RowMajorStrg = 0;
00059 return;
00060 }
00061 if (Diag == CblasUnit) DI = 'U';
00062 else if (Diag == CblasNonUnit) DI = 'N';
00063 else
00064 {
00065 cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag);
00066 CBLAS_CallFromC = 0;
00067 RowMajorStrg = 0;
00068 return;
00069 }
00070 #ifdef F77_CHAR
00071 F77_UL = C2F_CHAR(&UL);
00072 F77_TA = C2F_CHAR(&TA);
00073 F77_DI = C2F_CHAR(&DI);
00074 #endif
00075 F77_ctrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
00076 &F77_incX);
00077 }
00078 else if (order == CblasRowMajor)
00079 {
00080 RowMajorStrg = 1;
00081 if (Uplo == CblasUpper) UL = 'L';
00082 else if (Uplo == CblasLower) UL = 'U';
00083 else
00084 {
00085 cblas_xerbla(2, "cblas_ctrmv","Illegal Uplo setting, %d\n", Uplo);
00086 CBLAS_CallFromC = 0;
00087 RowMajorStrg = 0;
00088 return;
00089 }
00090
00091 if (TransA == CblasNoTrans) TA = 'T';
00092 else if (TransA == CblasTrans) TA = 'N';
00093 else if (TransA == CblasConjTrans)
00094 {
00095 TA = 'N';
00096 if ( N > 0)
00097 {
00098 if(incX > 0)
00099 tincX = incX;
00100 else
00101 tincX = -incX;
00102 i = tincX << 1;
00103 n = i * N;
00104 st = x + n;
00105 do
00106 {
00107 x[1] = -x[1];
00108 x+= i;
00109 }
00110 while (x != st);
00111 x -= n;
00112 }
00113 }
00114 else
00115 {
00116 cblas_xerbla(3, "cblas_ctrmv","Illegal TransA setting, %d\n", TransA);
00117 CBLAS_CallFromC = 0;
00118 RowMajorStrg = 0;
00119 return;
00120 }
00121
00122 if (Diag == CblasUnit) DI = 'U';
00123 else if (Diag == CblasNonUnit) DI = 'N';
00124 else
00125 {
00126 cblas_xerbla(4, "cblas_ctrmv","Illegal Diag setting, %d\n", Diag);
00127 CBLAS_CallFromC = 0;
00128 RowMajorStrg = 0;
00129 return;
00130 }
00131 #ifdef F77_CHAR
00132 F77_UL = C2F_CHAR(&UL);
00133 F77_TA = C2F_CHAR(&TA);
00134 F77_DI = C2F_CHAR(&DI);
00135 #endif
00136 F77_ctrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
00137 &F77_incX);
00138 if (TransA == CblasConjTrans)
00139 {
00140 if (N > 0)
00141 {
00142 do
00143 {
00144 x[1] = -x[1];
00145 x += i;
00146 }
00147 while (x != st);
00148 }
00149 }
00150 }
00151 else cblas_xerbla(1, "cblas_ctrmv", "Illegal Order setting, %d\n", order);
00152 CBLAS_CallFromC = 0;
00153 RowMajorStrg = 0;
00154 return;
00155 }