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