Exemplo n.º 1
0
void cblas_sspr(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha,
                const float *X, const int incX, float *A)
{
   int info = 2000;
   #define x X

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_sspr", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX;

   if (Order == CblasColMajor)
      ATL_sspr(Uplo, N, alpha, x, incX, A);
   else
      ATL_sspr(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ),
                    N, alpha, x, incX, A);
}
Exemplo n.º 2
0
void cblas_zhpr2(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const int N, const void *alpha,
                 const void *X, const int incX,
                 const void *Y, const int incY, void *A)
{
   int info = 2000;
   void *vx, *vy;
   double *x0, *y0;
   const double *x=X, *y=Y, *alp=alpha;
   const double one[2]={ATL_rone, ATL_rzero};

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(8, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_zhpr2", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX<<1;
   if (incY < 0) y += (1-N)*incY<<1;

   if (Order == CblasColMajor)
      ATL_zhpr2(Uplo, N, alpha, x, incX, y, incY, A);
   else if (alp[0] != ATL_rzero || alp[1] != ATL_rzero)
   {
      vx = malloc(ATL_Cachelen + ATL_MulBySize(N));
      vy = malloc(ATL_Cachelen + ATL_MulBySize(N));
      ATL_assert(vx != NULL && vy != NULL);
      x0 = ATL_AlignPtr(vx);
      y0 = ATL_AlignPtr(vy);
      ATL_zmoveConj(N, alpha, y, incY, y0, 1);
      ATL_zcopyConj(N, x, incX, x0, 1);
      ATL_zhpr2(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ),
                N, one, y0, 1, x0, 1, A);
      free(vx);
      free(vy);
   }
   else ATL_zhpr2(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ),
                  N, alpha, y, incY, x, incX, A);
}
Exemplo n.º 3
0
void cblas_dger2(const enum CBLAS_ORDER Order, ATL_CINT M, ATL_CINT N,
                 const double alpha, const double *X, ATL_CINT incX,
                 const double *Y, ATL_CINT incY, const double beta,
                 const double *W, ATL_CINT incW,
                 const double *Z, ATL_CINT incZ, double *A, ATL_CINT lda)
{
   int info = 2000;
   #define x X
   #define y Y
   #define w W
   #define z Z

#ifndef NoCblasErrorChecks
   if (M < 0) info = cblas_errprn(2, info,
                        "M cannot be less than zero; is set to %d.", M);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(8, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (!incW) info = cblas_errprn(11, info,
                                  "incW cannot be zero; is set to %d.", incW);
   if (!incZ) info = cblas_errprn(13, info,
                                  "incZ cannot be zero; is set to %d.", incZ);
   if (Order == CblasColMajor)
   {
      if (lda < M || lda < 1)
         info = cblas_errprn(15, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                             lda, M);
   }
   else if (Order == CblasRowMajor)
   {
      if (lda < N || lda < 1)
         info = cblas_errprn(15, info, "lda must be >= MAX(N,1): lda=%d M=%d",
                             lda, N);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_dger2", "");
      return;
   }
#endif

   if (incX < 0) x += (1-M)*incX;
   if (incY < 0) y += (1-N)*incY;
   if (incW < 0) w += (1-M)*incW;
   if (incZ < 0) z += (1-N)*incZ;

   if (Order == CblasColMajor)
      ATL_dger2(M, N, alpha, x, incX, y, incY, beta, w, incW, z, incZ, A, lda);
   else
      ATL_dger2(N, M, alpha, y, incY, x, incX, beta, w, incW, z, incZ, A, lda);
}
Exemplo n.º 4
0
void cblas_cher(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                const int N, const float alpha,
                const void *X, const int incX, void *A, const int lda)
{
   int info = 2000;
   void *vx;
   float one[2] = {ATL_rone, ATL_rzero};
   float *x0;
   const float *x=X;

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (lda < N || lda < 1)
      info = cblas_errprn(8, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                          lda, N);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_cher", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX<<1;

   if (Order == CblasColMajor)
      ATL_cher(Uplo, N, alpha, x, incX, A, lda);
   else if (alpha != ATL_rzero)
   {
      vx = malloc(ATL_Cachelen + ATL_MulBySize(N));
      ATL_assert(vx);
      x0 = ATL_AlignPtr(vx);
      ATL_cmoveConj(N, one, x, incX, x0, 1);
      ATL_cher(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ),
               N, alpha, x0, 1, A, lda);
      free(vx);
   }
   else
      ATL_cher(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ),
               N, ATL_rzero, x, incX, A, lda);
}
Exemplo n.º 5
0
void cblas_ctbmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TA, const enum CBLAS_DIAG Diag,
                 const int N, const int K, const void *A, const int lda,
                 void *X, const int incX)
{
   int info = 2000;
   enum CBLAS_UPLO uplo;
   enum CBLAS_TRANSPOSE ta;
   float *x = X;

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);
   if (TA != CblasNoTrans && TA != CblasTrans && TA != CblasConjTrans)
      info = cblas_errprn(3, info,
                          "TransA must be %d, %d or %d, but is set to %d",
                          CblasNoTrans, CblasTrans, CblasConjTrans, TA);
   if (Diag != CblasUnit && Diag != CblasNonUnit)
      info = cblas_errprn(4, info, "DIAG must be %d or %d, but is set to %d",
                          CblasUnit, CblasNonUnit, Diag);

   if (N < 0) info = cblas_errprn(5, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (K < 0)
      info = cblas_errprn(6, info, "Valid K: 0 < K < N; K=%d, N=%d.", K, N);
   if (lda < K+1)
      info = cblas_errprn(8, info, "lda must be >= K+1: lda=%d K=%d", lda, K);
   if (!incX)
      info = cblas_errprn(10, info, "incX cannot be zero; is set to %d.", incX);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_ctbmv", "");
      return;
   }
#endif
   if (incX < 0) x += (1-N)*incX<<1;
   if (Order == CblasColMajor)
      ATL_ctbmv(Uplo, TA, Diag, N, K, A, lda, x, incX);
   else
   {
      uplo = ( (Uplo == CblasUpper) ? CblasLower : CblasUpper );
      if (TA == CblasNoTrans) ta = CblasTrans;
      else if (TA == CblasConjTrans) ta = AtlasConj;
      else ta = CblasNoTrans;
      ATL_ctbmv(uplo, ta, Diag, N, K, A, lda, x, incX);
   }
}
Exemplo n.º 6
0
void cblas_zgerc(const enum CBLAS_ORDER Order, const int M, const int N,
                 const void *alpha, const void *X, const int incX,
                 const void *Y, const int incY, void *A, const int lda)
{
   int info = 2000;
   const double *x = X, *y = Y;
   void *vy;
   double *y0;
   double one[2] = {ATL_rone, ATL_rzero};

#ifndef NoCblasErrorChecks
   if (M < 0) info = cblas_errprn(2, info,
                        "M cannot be less than zero; is set to %d.", M);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(8, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (Order == CblasColMajor)
   {
      if (lda < M || lda < 1)
         info = cblas_errprn(10, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                             lda, M);
   }
   else if (Order == CblasRowMajor)
   {
      if (lda < N || lda < 1)
         info = cblas_errprn(10, info, "lda must be >= MAX(N,1): lda=%d M=%d",
                             lda, N);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_zgerc", "");
      return;
   }
#endif

   if (incX < 0) x += (1-M)*incX<<1;
   if (incY < 0) y += (1-N)*incY<<1;

   if (Order == CblasColMajor)
      ATL_zgerc(M, N, alpha, x, incX, y, incY, A, lda);
   else
   {
      vy = malloc(ATL_Cachelen + ATL_MulBySize(N));
      ATL_assert(vy);
      y0 = ATL_AlignPtr(vy);
      ATL_zmoveConj(N, alpha, y, incY, y0, 1);
      ATL_zgeru(N, M, one, y0, 1, x, incX, A, lda);
      free(vy);
   }
}
Exemplo n.º 7
0
void cblas_dsyr(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                const int N, const double alpha,
                const double *X, const int incX, double *A, const int lda)
{
   int info = 2000;
   #define x X

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (lda < N || lda < 1)
      info = cblas_errprn(8, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                          lda, N);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_dsyr", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX;

   if (Order == CblasColMajor)
      ATL_dsyr(Uplo, N, alpha, x, incX, A, lda);
   else
      ATL_dsyr(( (Uplo == CblasUpper) ? CblasLower : CblasUpper ),
                    N, alpha, x, incX, A, lda);
}
Exemplo n.º 8
0
void cblas_dtrmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE TA, const enum CBLAS_DIAG Diag,
                 const int N, const double *A, const int lda,
                 double *X, const int incX)
{
   int info = 2000;
   enum CBLAS_UPLO uplo;
   enum CBLAS_TRANSPOSE ta;
   #define x X

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);
   if (TA != CblasNoTrans && TA != CblasTrans && TA != CblasConjTrans)
      info = cblas_errprn(3, info,
                          "TransA must be %d, %d or %d, but is set to %d",
                          CblasNoTrans, CblasTrans, CblasConjTrans, TA);
   if (Diag != CblasUnit && Diag != CblasNonUnit)
      info = cblas_errprn(4, info, "DIAG must be %d or %d, but is set to %d",
                          CblasUnit, CblasNonUnit, Diag);

   if (N < 0) info = cblas_errprn(5, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (lda < N || lda < 1)
      info = cblas_errprn(7, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                          lda, N);
   if (!incX) info = cblas_errprn(9, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_dtrmv", "");
      return;
   }
#endif
   if (incX < 0) x += (1-N)*incX;
   if (Order == CblasColMajor)
      ATL_dtrmv(Uplo, TA, Diag, N, A, lda, x, incX);
   else
   {
      uplo = ( (Uplo == CblasUpper) ? CblasLower : CblasUpper );
      if (TA == CblasNoTrans) ta = CblasTrans;
      else ta = CblasNoTrans;
      ATL_dtrmv(uplo, ta, Diag, N, A, lda, x, incX);
   }
}
Exemplo n.º 9
0
void cblas_sger (const enum CBLAS_ORDER Order, const int M, const int N,
                 const float alpha, const float *X, const int incX,
                 const float *Y, const int incY, float *A, const int lda)
{
   int info = 2000;
   #define x X
   #define y Y

#ifndef NoCblasErrorChecks
   if (M < 0) info = cblas_errprn(2, info,
                        "M cannot be less than zero; is set to %d.", M);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(8, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (Order == CblasColMajor)
   {
      if (lda < M || lda < 1)
         info = cblas_errprn(10, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                             lda, M);
   }
   else if (Order == CblasRowMajor)
   {
      if (lda < N || lda < 1)
         info = cblas_errprn(10, info, "lda must be >= MAX(N,1): lda=%d M=%d",
                             lda, N);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_sger", "");
      return;
   }
#endif

   if (incX < 0) x += (1-M)*incX;
   if (incY < 0) y += (1-N)*incY;

   if (Order == CblasColMajor)
      ATL_sger(M, N, alpha, x, incX, y, incY, A, lda);
   else
      ATL_sger(N, M, alpha, y, incY, x, incX, A, lda);
}
Exemplo n.º 10
0
void cblas_dsbmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const int N, const int K, const double alpha, const double *A,
                 const int lda, const double *X, const int incX,
                 const double beta, double *Y, const int incY)
{
   int info = 2000;
   const enum CBLAS_UPLO ruplo = (Uplo == CblasUpper) ? CblasLower : CblasUpper;
   #define x X
   #define y Y

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info,
                          "Uplo must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);

   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (K < 0)
      info = cblas_errprn(4, info, "Valid K: 0 < K < N; K=%d, N=%d.", K, N);
   if (lda < K+1) info = cblas_errprn(7, info,
      "lda cannot be less than K+1;  K=%d, lda=%d\n", K, lda);
   if (!incX) info = cblas_errprn(9, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(12, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_dsbmv", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX;
   if (incY < 0) y += (1-N)*incY;
   if (Order == CblasColMajor)
      ATL_dsbmv(Uplo, N, K, alpha, A, lda, x, incX, beta, y, incY);
   else
      ATL_dsbmv(ruplo, N, K, alpha, A, lda, x, incX, beta, y, incY);
}
Exemplo n.º 11
0
void cblas_ssymv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const int N, const float alpha, const float *A,
                 const int lda, const float *X, const int incX,
                 const float beta, float *Y, const int incY)
{
   int info = 2000;
   const enum CBLAS_UPLO ruplo = (Uplo == CblasUpper) ? CblasLower : CblasUpper;
   #define x X
   #define y Y

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info,
                          "Uplo must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);

   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (lda < Mmax(N,1)) info = cblas_errprn(6, info,
      "lda cannot be less than MAX(N,1);  N=%d, lda=%d\n", N, lda);
   if (!incX) info = cblas_errprn(8, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(11, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_ssymv", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX;
   if (incY < 0) y += (1-N)*incY;
   if (Order == CblasColMajor)
      ATL_ssymv(Uplo, N, alpha, A, lda, x, incX, beta, y, incY);
   else
      ATL_ssymv(ruplo, N, alpha, A, lda, x, incX, beta, y, incY);
}
Exemplo n.º 12
0
void cblas_zhbmv(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const int N, const int K, const void *alpha, const void *A,
                 const int lda, const void *X, const int incX,
                 const void *beta, void *Y, const int incY)
{
   int info = 2000;
   const enum CBLAS_UPLO ruplo = (Uplo == CblasUpper) ? CblasLower : CblasUpper;
   void *vx;
   double *X0, *x = (double*) X;
   double *y = Y;
   const double *alp=alpha;
   const double *bet=beta;
   double calpha[2], cbeta[2];
   const double one[2] = {ATL_rone, ATL_rzero};
   calpha[0] = *alp;
   calpha[1] = -alp[1];
   cbeta[0] = *bet;
   cbeta[1] = -bet[1];

#ifndef NoCblasErrorChecks
   if (Order != CblasColMajor && Order != CblasRowMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info,
                          "Uplo must be %d or %d, but is set to %d",
                          CblasUpper, CblasLower, Uplo);

   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (K < 0)
      info = cblas_errprn(4, info, "Valid K: 0 < K < N; K=%d, N=%d.", K, N);
   if (lda < K+1) info = cblas_errprn(7, info,
      "lda cannot be less than K+1;  K=%d, lda=%d\n", K, lda);
   if (!incX) info = cblas_errprn(9, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(12, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_zhbmv", "");
      return;
   }
#endif

   if (incX < 0) x += (1-N)*incX<<1;
   if (incY < 0) y += (1-N)*incY<<1;
   if (Order == CblasColMajor)
      ATL_zhbmv(Uplo, N, K, alpha, A, lda, x, incX, beta, y, incY);
   else
   {
      vx = malloc(ATL_Cachelen + 2*N*sizeof(double));
      ATL_assert(vx);
      X0 = x;
      x = ATL_AlignPtr(vx);
      ATL_zmoveConj(N, calpha, X0, incX, x, 1);
      if (*bet != ATL_rzero || bet[1] != ATL_rzero)
      {
         ATL_zscalConj(N, cbeta, y, incY);
         ATL_zhbmv(ruplo, N, K, one, A, lda, x, 1, one, y, incY);
      }
      else ATL_zhbmv(ruplo, N, K, one, A, lda, x, 1, beta, y, incY);
      free(vx);
      ATL_zscalConj(N, one, y, incY);
   }
}
Exemplo n.º 13
0
void cblas_cgemv(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TA,
                 const int M, const int N, const void *alpha, const void *A,
                 const int lda, const void *X, const int incX,
                 const void *beta, void *Y, const int incY)
{
   int info = 2000;
   const float *x = X;
   float *y = Y;

#ifndef NoCblasErrorChecks
   if (TA != CblasNoTrans && TA != CblasTrans && TA != CblasConjTrans)
      info = cblas_errprn(2, info,
                          "TransA must be %d, %d or %d, but is set to %d",
                          CblasNoTrans, CblasTrans, CblasConjTrans, TA);

   if (M < 0) info = cblas_errprn(3, info,
                        "M cannot be less than zero; is set to %d.", M);
   if (N < 0) info = cblas_errprn(4, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(9, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(12, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (Order == CblasColMajor)
   {
      if (lda < M || lda < 1)
         info = cblas_errprn(7, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                             lda, M);
   }
   else if (Order == CblasRowMajor)
   {
      if (lda < N || lda < 1)
         info = cblas_errprn(7, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                             lda, N);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_cgemv", "");
      return;
   }
#endif
   if (TA == AtlasNoTrans)
   {
      if (incX < 0) x += (1-N)*incX<<1;
      if (incY < 0) y += (1-M)*incY<<1;
   }
   else
   {
      if (incX < 0) x += (1-M)*incX<<1;
      if (incY < 0) y += (1-N)*incY<<1;
   }
   if (Order == CblasColMajor)
   {
      if (TA == CblasNoTrans)
         ATL_cgemv(TA, M, N, alpha, A, lda, x, incX, beta, y, incY);
      else ATL_cgemv(TA, N, M, alpha, A, lda, x, incX, beta, y, incY);
   }
   else
   {
      if (TA == CblasNoTrans)
         ATL_cgemv(CblasTrans, M, N, alpha, A, lda, x, incX, beta, y, incY);
      else if (TA == CblasConjTrans)
         ATL_cgemv(AtlasConj, N, M, alpha, A, lda, x, incX, beta, y, incY);
      else
         ATL_cgemv(CblasNoTrans, N, M, alpha, A, lda, x, incX, beta, y, incY);
   }
}
Exemplo n.º 14
0
void cblas_cger2c(const enum CBLAS_ORDER Order, ATL_CINT M, ATL_CINT N,
                 const void *alpha, const void *X, ATL_CINT incX,
                 const void *Y, ATL_CINT incY, const void *beta,
                 const void *W, ATL_CINT incW,
                 const void *Z, ATL_CINT incZ, void *A, ATL_CINT lda)
{
   int info = 2000;
   const float *x = X, *y = Y, *w = W, *z = Z;
   void *vy;
   float *y0, *z0;
   float one[2] = {ATL_rone, ATL_rzero};

#ifndef NoCblasErrorChecks
   if (M < 0) info = cblas_errprn(2, info,
                        "M cannot be less than zero; is set to %d.", M);
   if (N < 0) info = cblas_errprn(3, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (!incX) info = cblas_errprn(6, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(8, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (!incW) info = cblas_errprn(11, info,
                                  "incW cannot be zero; is set to %d.", incW);
   if (!incZ) info = cblas_errprn(13, info,
                                  "incZ cannot be zero; is set to %d.", incZ);
   if (Order == CblasColMajor)
   {
      if (lda < M || lda < 1)
         info = cblas_errprn(15, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                             lda, M);
   }
   else if (Order == CblasRowMajor)
   {
      if (lda < N || lda < 1)
         info = cblas_errprn(15, info, "lda must be >= MAX(N,1): lda=%d M=%d",
                             lda, N);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_cger2c", "");
      return;
   }
#endif

   if (incX < 0) x += (1-M)*incX<<1;
   if (incY < 0) y += (1-N)*incY<<1;
   if (incW < 0) w += (1-M)*incW<<1;
   if (incZ < 0) z += (1-N)*incZ<<1;

   if (Order == CblasColMajor)
      ATL_cger2c(M, N, alpha, x, incX, y, incY, beta, w, incW, z, incZ, A, lda);
   else
   {
      vy = malloc(ATL_Cachelen+ATL_Cachelen + ATL_MulBySize(N+N));
      ATL_assert(vy);
      y0 = ATL_AlignPtr(vy);
      z0 = y0 + N;
      z0 = ATL_AlignPtr(z0);
      ATL_cmoveConj(N, alpha, y, incY, y0, 1);
      ATL_cmoveConj(N, alpha, z, incZ, z0, 1);
      ATL_cger2u(N, M, one, y0, 1, x, incX, beta, w, incW, z, incZ, A, lda);
      free(vy);
   }
}
Exemplo n.º 15
0
void cblas_dgemm(const enum CBLAS_ORDER Order,
                 const enum CBLAS_TRANSPOSE TA, const enum CBLAS_TRANSPOSE TB,
                 const int M, const int N, const int K,
                 const double  alpha, const double *A, const int lda,
                 const double *B, const int ldb, const double  beta,
                 double *C, const int ldc)
{
   int info=2000;

#ifndef NoCblasErrorChecks
   if (M < 0) info = cblas_errprn(4, info,
                     "M cannot be less than zero 0,; is set to %d.", M);
   if (N < 0) info = cblas_errprn(5, info,
                     "N cannot be less than zero 0,; is set to %d.", N);
   if (K < 0) info = cblas_errprn(6, info,
                     "K cannot be less than zero 0,; is set to %d.", K);

   if (Order == CblasRowMajor)
   {
      if (TA == CblasNoTrans)
      {
         if ( (lda < K) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(K,1): lda=%d K=%d",
                                lda, K);
      }
      else
      {
         if (TA != CblasConjTrans && TA != CblasTrans)
            info = cblas_errprn(2, info,
                                "TransA must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TA);
         if ( (lda < M) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                                lda, M);
      }
      if (TB == CblasNoTrans)
      {
         if ( (ldb < N) || (ldb < 1) )
            info = cblas_errprn(11, info,"ldb must be >= MAX(N,1): ldb=%d N=%d",
                                ldb, N);
      }
      else
      {
         if (TB != CblasConjTrans && TB != CblasTrans)
            info = cblas_errprn(3, info,
                                "TransB must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TB);
         if ( (ldb < K) || (ldb < 1) )
            info = cblas_errprn(11, info,"ldb must be >= MAX(N,1): ldb=%d K=%d",
                                ldb, K);
      }
      if ( (ldc < N) || (ldc < 1) )
         info = cblas_errprn(14, info,"ldc must be >= MAX(N,1): ldc=%d N=%d",
                             ldc, N);
   }
   else if (Order == CblasColMajor)
   {
      if (TA == CblasNoTrans)
      {
         if ( (lda < M) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                                lda, M);
      }
      else
      {
         if (TA != CblasConjTrans && TA != CblasTrans)
            info = cblas_errprn(2, info,
                                "TransA must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TA);
         if ( (lda < K) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(K,1): lda=%d K=%d",
                                lda, K);
      }
      if (TB == CblasNoTrans)
      {
         if ( (ldb < K) || (ldb < 1) )
            info = cblas_errprn(11,info, "ldb must be >= MAX(K,1): ldb=%d K=%d",
                                ldb, K);
      }
      else
      {
         if (TB != CblasConjTrans && TB != CblasTrans)
            info = cblas_errprn(3, info,
                                "TransB must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TB);
         if ( (ldb < N) || (ldb < 1) )
            info = cblas_errprn(11,info, "ldb must be >= MAX(K,1): ldb=%d K=%d",
                                ldb, K);
      }
      if ( (ldc < M) || (ldc < 1) )
         info = cblas_errprn(14, info,"ldc must be >= MAX(M,1): ldc=%d M=%d",
                             ldc, M);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_dgemm", "");
      return;
   }
#endif

   if (Order == CblasColMajor)
      ATL_dgemm(TA, TB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
   else
      ATL_dgemm(TB, TA, N, M, K, alpha, B, ldb, A, lda, beta, C, ldc);
}
Exemplo n.º 16
0
void cblas_ssyrk(const enum CBLAS_ORDER Order, const enum CBLAS_UPLO Uplo,
                 const enum CBLAS_TRANSPOSE Trans, const int N, const int K,
                 const float  alpha, const float *A, const int lda,
                 const float  beta, float *C, const int ldc)
{
   enum CBLAS_UPLO uplo;
   enum CBLAS_TRANSPOSE trans;

#ifndef NoCblasErrorChecks
   int info = 2000;
   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(2, info, "UPLO must be %d or %d, but is set to %d",
                               CblasUpper, CblasLower, Uplo);
   if (N < 0) info = cblas_errprn(4, info,
                     "N cannot be less than zero; it is set to %d.", N);
   if (K < 0) info = cblas_errprn(5, info,
                     "K cannot be less than zero; it is set to %d.", K);

   if (Order == CblasColMajor)
   {
      if (Trans == AtlasNoTrans)
      {
         if ( (lda < N) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                                lda, N);
      }
      else
      {
         if (Trans != AtlasTrans && Trans != AtlasConjTrans)
            info = cblas_errprn(3, info,
                                "Trans must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans,Trans);
         if ( (lda < K) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(K,1): lda=%d K=%d",
                                lda, K);
      }
   }
   else if (Order == CblasRowMajor)
   {
      if (Trans == AtlasNoTrans)
      {
         if ( (lda < K) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(K,1): lda=%d K=%d",
                                lda, K);
      }
      else
      {
         if (Trans != AtlasTrans && Trans != AtlasConjTrans)
            info = cblas_errprn(3, info,
                                "Trans must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans,Trans);
         if ( (lda < N) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                                lda, N);
      }
   }
   else info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                            CblasRowMajor, CblasColMajor, Order);
   if ( (ldc < N) || (ldc < 1) )
      info = cblas_errprn(11, info, "ldc must be >= MAX(N,1): ldc=%d N=%d",
                          ldc, N);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_ssyrk", "");
      return;
   }
#endif
   if (Order == CblasColMajor)
      ATL_ssyrk(Uplo, Trans, N, K, alpha, A, lda, beta, C, ldc);
   else
   {
      if (Uplo == CblasUpper) uplo = CblasLower;
      else uplo = CblasUpper;
      if (Trans == CblasNoTrans) trans = CblasTrans;
      else trans = CblasNoTrans;
      ATL_ssyrk(uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   }
}
Exemplo n.º 17
0
void cblas_ssymm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const int M, const int N,
                 const float  alpha, const float *A, const int lda,
                 const float *B, const int ldb, const float  beta,
                 float *C, const int ldc)
{
   enum CBLAS_SIDE side;
   enum CBLAS_UPLO uplo;
   int info=2000;

#ifndef NoCblasErrorChecks
   if (Order == CblasColMajor)
   {
      if (Side == CblasLeft)
      {
         if ( (lda < M) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                                lda, M);
      }
      else if (Side == CblasRight)
      {
         if ( (lda < N) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                                lda, N);
      }
      else info = cblas_errprn(2, info,
                               "SIDE must be %d or %d, but is set to %d",
                               CblasRight, CblasLeft, Side);
      if ( (ldb < M) || (ldb < 1) )
         info = cblas_errprn(10, info, "ldb must be >= MAX(M,1): ldb=%d M=%d",
                             ldb, M);
      if ( (ldc < M) || (ldc < 1) )
         info = cblas_errprn(13, info,"ldc must be >= MAX(M,1): ldc=%d M=%d",
                             ldc, M);
   }
   else if (Order == CblasRowMajor)
   {
      if (Side == CblasLeft)
      {
         if ( (lda < M) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                                lda, M);
      }
      else if (Side == CblasRight)
      {
         if ( (lda < N) || (lda < 1) )
            info = cblas_errprn(8, info, "lda must be >= MAX(N,1): lda=%d N=%d",
                                lda, N);
      }
      else info = cblas_errprn(2, info,
                               "SIDE must be %d or %d, but is set to %d",
                               CblasRight, CblasLeft, Side);
      if ( (ldb < N) || (ldb < 1) )
         info = cblas_errprn(10, info, "ldb must be >= MAX(N,1): ldb=%d N=%d",
                             ldb, N);
      if ( (ldc < N) || (ldc < 1) )
         info = cblas_errprn(13, info,"ldc must be >= MAX(N,1): ldc=%d N=%d",
                             ldc, N);
   }
   else info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                            CblasRowMajor, CblasColMajor, Order);

   if (Uplo != CblasUpper && Uplo != CblasLower)
      info = cblas_errprn(3, info, "UPLO must be %d or %d, but is set to %d",
                               CblasUpper, CblasLower, Uplo);

   if (M < 0) info = cblas_errprn(4, info,
                     "M cannot be less than zero; it is set to %d.", M);
   if (N < 0) info = cblas_errprn(5, info,
                     "N cannot be less than zero; it is set to %d.", N);

   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_ssymm", "");
      return;
   }
#endif

   if (Order == CblasColMajor)
      ATL_ssymm(Side, Uplo, M, N, alpha, A, lda, B, ldb, beta, C, ldc);
   else
   {
      if (Side == CblasLeft) side = CblasRight;
      else side = CblasLeft;
      if (Uplo == CblasUpper) uplo = CblasLower;
      else uplo = CblasUpper;
      ATL_ssymm(side, uplo, N, M, alpha, A, lda, B, ldb, beta, C, ldc);
   }
}
Exemplo n.º 18
0
void cblas_dgemm(const enum CBLAS_ORDER Order,
                 const enum CBLAS_TRANSPOSE TA, const enum CBLAS_TRANSPOSE TB,
                 const int M, const int N, const int K,
                 const double  alpha, const double *A, const int lda,
                 const double *B, const int ldb, const double  beta,
                 double *C, const int ldc)
{
   int info=2000;

#ifndef NoCblasErrorChecks
   if (M < 0) info = cblas_errprn(4, info,
                     "M cannot be less than zero 0,; is set to %d.", M);
   if (N < 0) info = cblas_errprn(5, info,
                     "N cannot be less than zero 0,; is set to %d.", N);
   if (K < 0) info = cblas_errprn(6, info,
                     "K cannot be less than zero 0,; is set to %d.", K);

   if (Order == CblasRowMajor)
   {
      if (TA == CblasNoTrans)
      {
         if ( (lda < K) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(K,1): lda=%d K=%d",
                                lda, K);
      }
      else
      {
         if (TA != CblasConjTrans && TA != CblasTrans)
            info = cblas_errprn(2, info,
                                "TransA must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TA);
         if ( (lda < M) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                                lda, M);
      }
      if (TB == CblasNoTrans)
      {
         if ( (ldb < N) || (ldb < 1) )
            info = cblas_errprn(11, info,"ldb must be >= MAX(N,1): ldb=%d N=%d",
                                ldb, N);
      }
      else
      {
         if (TB != CblasConjTrans && TB != CblasTrans)
            info = cblas_errprn(3, info,
                                "TransB must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TB);
         if ( (ldb < K) || (ldb < 1) )
            info = cblas_errprn(11, info,"ldb must be >= MAX(K,1): ldb=%d K=%d",
                                ldb, K);
      }
      if ( (ldc < N) || (ldc < 1) )
         info = cblas_errprn(14, info,"ldc must be >= MAX(N,1): ldc=%d N=%d",
                             ldc, N);
   }
   else if (Order == CblasColMajor)
   {
      if (TA == CblasNoTrans)
      {
         if ( (lda < M) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(M,1): lda=%d M=%d",
                                lda, M);
      }
      else
      {
         if (TA != CblasConjTrans && TA != CblasTrans)
            info = cblas_errprn(2, info,
                                "TransA must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TA);
         if ( (lda < K) || (lda < 1) )
            info = cblas_errprn(9, info, "lda must be >= MAX(K,1): lda=%d K=%d",
                                lda, K);
      }
      if (TB == CblasNoTrans)
      {
         if ( (ldb < K) || (ldb < 1) )
            info = cblas_errprn(11,info, "ldb must be >= MAX(K,1): ldb=%d K=%d",
                                ldb, K);
      }
      else
      {
         if (TB != CblasConjTrans && TB != CblasTrans)
            info = cblas_errprn(3, info,
                                "TransB must be %d, %d or %d, but is set to %d",
                                CblasNoTrans, CblasTrans, CblasConjTrans, TB);
         if ( (ldb < N) || (ldb < 1) )
            info = cblas_errprn(11,info, "ldb must be >= MAX(K,1): ldb=%d K=%d",
                                ldb, K);
      }
      if ( (ldc < M) || (ldc < 1) )
         info = cblas_errprn(14, info,"ldc must be >= MAX(M,1): ldc=%d M=%d",
                             ldc, M);
   }
   else
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_dgemm", "");
      return;
   }
#endif
/*
 * Call SYRK when that's what the user is actually asking for; just handle
 * beta=0, because beta=X requires we copy C and then subtract to preserve
 * asymmetry
 */
   if (A == B && M == N && TA != TB && lda == ldb && beta == 0.0)
   {
      ATL_dsyrk(CblasUpper, (Order == CblasColMajor) ? TA : TB, N, K,
                alpha, A, lda, beta, C, ldc);
      ATL_dsyreflect(CblasUpper, N, C, ldc);
      return;
   }
   if (Order == CblasColMajor)
      ATL_dgemm(TA, TB, M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
   else
      ATL_dgemm(TB, TA, N, M, K, alpha, B, ldb, A, lda, beta, C, ldc);
}
Exemplo n.º 19
0
void cblas_ctrmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
                 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TA,
                 const enum CBLAS_DIAG Diag, const int M, const int N,
                 const void * alpha, const void *A, const int lda,
                 void *B, const int ldb)
{
    enum CBLAS_SIDE side;
    enum CBLAS_UPLO uplo;
    int info=2000;

#ifndef NoCblasErrorChecks
    if (Order == CblasColMajor)
    {
        if (Side == CblasLeft)
        {
            if ( (lda < M) || (lda < 1) )
                info = cblas_errprn(10, info,"lda must be >= MAX(M,1): lda=%d M=%d",
                                    lda, M);
        }
        else if (Side == CblasRight)
        {
            if ( (lda < N) || (lda < 1) )
                info = cblas_errprn(10, info,"lda must be >= MAX(N,1): lda=%d N=%d",
                                    lda, N);
        }
        else info = cblas_errprn(2, info,
                                     "SIDE must be %d or %d, but is set to %d",
                                     CblasRight, CblasLeft, Side);
        if ( (ldb < M) || (ldb < 1) )
            info = cblas_errprn(12, info, "ldb must be >= MAX(M,1): ldb=%d M=%d",
                                ldb, M);
    }
    else if (Order == CblasRowMajor)
    {
        if (Side == CblasLeft)
        {
            if ( (lda < M) || (lda < 1) )
                info = cblas_errprn(10, info,"lda must be >= MAX(M,1): lda=%d M=%d",
                                    lda, M);
        }
        else if (Side == CblasRight)
        {
            if ( (lda < N) || (lda < 1) )
                info = cblas_errprn(10, info,"lda must be >= MAX(N,1): lda=%d N=%d",
                                    lda, N);
        }
        else info = cblas_errprn(2, info,
                                     "SIDE must be %d or %d, but is set to %d",
                                     CblasRight, CblasLeft, Side);
        if ( (ldb < N) || (ldb < 1) )
            info = cblas_errprn(12, info, "ldb must be >= MAX(N,1): ldb=%d N=%d",
                                ldb, N);
    }
    else
        info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                            CblasRowMajor, CblasColMajor, Order);

    if (Uplo != CblasUpper && Uplo != CblasLower)
        info = cblas_errprn(3, info, "UPLO must be %d or %d, but is set to %d",
                            CblasUpper, CblasLower, Uplo);

    if (TA != AtlasNoTrans && TA != AtlasTrans && TA != AtlasConjTrans)
        info = cblas_errprn(4, info,
                            "TransA must be %d, %d or %d, but is set to %d",
                            CblasNoTrans, CblasTrans, CblasConjTrans, TA);

    if (Diag != CblasUnit && Diag != CblasNonUnit)
        info = cblas_errprn(5, info, "UPLO must be %d or %d, but is set to %d",
                            CblasUnit, CblasNonUnit, Diag);

    if (M < 0) info = cblas_errprn(6, info,
                                       "M cannot be less than zero; it is set to %d.", M);
    if (N < 0) info = cblas_errprn(7, info,
                                       "N cannot be less than zero; it is set to %d.", N);


    if (info != 2000)
    {
        cblas_xerbla(info, "cblas_ctrmm", "");
        return;
    }
#endif

    if (Order == CblasColMajor)
        ATL_ctrmm(Side, Uplo, TA, Diag, M, N, alpha, A, lda, B, ldb);
    else
    {
        if (Side == CblasLeft) side = CblasRight;
        else side = CblasLeft;
        if (Uplo == CblasUpper) uplo = CblasLower;
        else uplo = CblasUpper;
        ATL_ctrmm(side, uplo, TA, Diag, N, M, alpha, A, lda, B, ldb);
    }
}
Exemplo n.º 20
0
void cblas_cgbmv(const enum CBLAS_ORDER Order, const enum CBLAS_TRANSPOSE TA,
                 const int M, const int N, const int KL, const int KU,
                 const void *alpha, const void *A, const int lda,
                 const void *X, const int incX,
                 const void *beta, void *Y, const int incY)
{
   int info = 2000;
   const float *x = X;
   float *y = Y;

#ifndef NoCblasErrorChecks
   if (Order != CblasRowMajor && Order != CblasColMajor)
      info = cblas_errprn(1, info, "Order must be %d or %d, but is set to %d",
                          CblasRowMajor, CblasColMajor, Order);
   if (TA != CblasNoTrans && TA != CblasTrans && TA != CblasConjTrans)
      info = cblas_errprn(2, info,
                          "TransA must be %d, %d or %d, but is set to %d",
                          CblasNoTrans, CblasTrans, CblasConjTrans, TA);
   if (M < 0) info = cblas_errprn(3, info,
                        "M cannot be less than zero; is set to %d.", M);
   if (N < 0) info = cblas_errprn(4, info,
                        "N cannot be less than zero; is set to %d.", N);
   if (KL < 0) info = cblas_errprn(5, info,
                         "KL cannot be less than zero; is set to %d.", KL);
   if (KU < 0) info = cblas_errprn(6, info,
                         "KU cannot be less than zero; is set to %d.", KU);
   if (lda < (KL+KU+1))
      info = cblas_errprn(9, info, "lda must be >= KU+KL+1: lda=%d KU+KL+1=%d",
                          lda, KU+KL+1);
   if (!incX) info = cblas_errprn(11, info,
                                  "incX cannot be zero; is set to %d.", incX);
   if (!incY) info = cblas_errprn(14, info,
                                  "incY cannot be zero; is set to %d.", incY);
   if (info != 2000)
   {
      cblas_xerbla(info, "cblas_cgbmv", "");
      return;
   }
#endif

   if (TA == AtlasNoTrans)
   {
      if (incX < 0) x += (1-N)*incX<<1;
      if (incY < 0) y += (1-M)*incY<<1;
   }
   else
   {
      if (incX < 0) x += (1-M)*incX<<1;
      if (incY < 0) y += (1-N)*incY<<1;
   }
   if (Order == CblasColMajor)
      ATL_cgbmv(TA, M, N, KL, KU, alpha, A, lda, x, incX, beta, y, incY);
   else
   {
      if (TA == CblasNoTrans)
         ATL_cgbmv(CblasTrans, N, M, KU, KL, alpha, A, lda, x, incX,
                   beta, y, incY);
      else if (TA == CblasConjTrans)
         ATL_cgbmv(AtlasConj, N, M, KU, KL, alpha, A, lda, x, incX,
                   beta, y, incY);
      else ATL_cgbmv(CblasNoTrans, N, M, KU, KL, alpha, A, lda, x, incX,
                     beta, y, incY);
   }
}