Exemplo n.º 1
0
void CONJUGATE_GRADIENT_UPDATE(int N, double *q, double *prev_q_update, double *prev_q_first_stage, int INFO[])
{
    static int inc = 1;
    //determine beta
    double cg_beta = 1.0;
    if (INFO[11]  == 1)
    {
        if (INFO[2] == 0)
        {
            memcpy(prev_q_first_stage, q, sizeof(double)*N);
            memcpy(prev_q_update, q, sizeof(double)*N);
            return;
        }
        else
        {
            cg_beta = DDOT(&N, q, &inc, q, &inc);
            cg_beta /= std::fabs( cg_beta - DDOT(&N, q, &inc, prev_q_first_stage, &inc));
            memcpy(prev_q_first_stage, q, sizeof(double)*N);
        }
    }
    else
    {
        if (INFO[2] == 0)
        {
            memcpy(prev_q_update, q, sizeof(double)*N);
            return;
        }
    }
    //determine new q

    const double minus_one = -1.0;
    if (cg_beta != 1.0)
        DSCAL(&N, &cg_beta, prev_q_update, &inc);

    DAXPY(&N, &minus_one, prev_q_update, &inc, q, &inc);
    double quad_a = DDOT(&N, q, &inc, q, &inc);
    double quad_b = DDOT(&N, q, &inc, prev_q_update, &inc);
    double cg_lambda = -quad_b / quad_a;
    if (cg_lambda > 1)
        cg_lambda = 1;
    else if (cg_lambda < 0)
        cg_lambda = 0;

    static double one = 1.0;
    DSCAL(&N, &cg_lambda, q, &inc);
    DAXPY(&N, &one, prev_q_update, &inc, q, &inc);

    memcpy(prev_q_update, q, sizeof(double)*N);
}
Exemplo n.º 2
0
void 
F77_NAME(daxpy)(const int *n, const double *alpha,
		const double *dx, const int *incx,
		double *dy, const int *incy)
{
    DAXPY(n, alpha, dx, incx, dy, incy);
}
Exemplo n.º 3
0
  /* Interface to FORTRAN routine DAXPY. */
  void IpBlasDaxpy(Index size, Number alpha, const Number *x, Index incX, Number *y,
                   Index incY)
  {
    ipfint N=size, INCX=incX, INCY=incY;

    DAXPY(&N, &alpha, x, &INCX, y, &INCY);
  }
Exemplo n.º 4
0
void SpinAdapted::MatrixDiagonalScale(double d, const Matrix& a, double* b)
{
  //assert (a.Nrows () == a.Ncols () && a.Nrows () == b.Ncols ());
#ifdef BLAS
  int n = a.Nrows ();
  DAXPY (n, d, a.Store (), n+1, b, 1);
#else
  //b += d * a; Should add the non-blas analogue
#endif
}
Exemplo n.º 5
0
void SpinAdapted::MatrixScaleAdd (double d, const Matrix& a, Matrix& b)
{
  assert (a.Nrows () == b.Nrows () && a.Ncols () == b.Ncols ());
#ifdef BLAS
  int n = a.Nrows () * a.Ncols ();
  assert (n == (b.Nrows () * b.Ncols ()));
  DAXPY (n, d, a.Store (), 1, b.Store (), 1);
#else
  b += d * a;
#endif
}
Exemplo n.º 6
0
void HLBFGS_UPDATE_Second_Step(int N, int M, double *q, double *s, double *y,
                               double *rho, double *alpha, int bound, int cur_pos, int iter)
{
    if (M <= 0)
    {
        return;
    }

    int start;
    double tmp;
    static int inc = 1;

    for (int i = 0; i <= bound; i++)
    {
        start = iter<=M? i:(cur_pos+1+i)%M;
        tmp = alpha[i]-rho[start]*DDOT(&N, &y[start*N], &inc, q, &inc);
        DAXPY(&N, &tmp, &s[start*N], &inc, q, &inc);
    }
}
Exemplo n.º 7
0
void HLBFGS_UPDATE_First_Step(int N, int M, double *q, double *s, double *y,
                              double *rho, double *alpha, int bound, int cur_pos, int iter)
{
    if (M <= 0)
    {
        return;
    }

    int start;
    double tmp;
    static int inc = 1;

    for (int i = bound; i >= 0; i--)
    {
        start = iter<=M? cur_pos-bound+i:(cur_pos-(bound-i)+M)%M;
        alpha[i] = rho[start] * DDOT(&N, q, &inc, &s[start*N], &inc);
        tmp = -alpha[i];
        DAXPY(&N, &tmp, &y[start*N], &inc, q, &inc);
    }
}
Exemplo n.º 8
0
void SpinAdapted::MatrixTensorProduct (const Matrix& a_ref, char conjA, Real scaleA, const Matrix& b_ref, char conjB, Real scaleB, Matrix& c, int rowstride, int colstride, bool allocate)
{
#ifndef BLAS
  Matrix A;
  Matrix B;
#endif
  Matrix& a = const_cast<Matrix&>(a_ref); // for BLAS calls
  Matrix& b = const_cast<Matrix&>(b_ref);

  int arows = a.Nrows();
  int acols = a.Ncols();
  
  // some specialisations
#ifdef FAST_MTP
  //  if ((brows == 1) && (bcols == 1))
    {
      double b00 = *b.Store();
      if (conjA == 'n')
	{
	  double* cptr = c.Store()+ rowstride*c.Ncols() + colstride;
	  for (int i=0; i< a.Nrows();i++) 
	    DAXPY(a.Ncols(), scaleA * scaleB * b00, a.Store()+i*a.Ncols(), 1, cptr + i*c.Ncols(), 1);
	  return;
	}
      else 	
	{
	  double* aptr = a.Store();
	  double* cptr = c.Store() + rowstride*c.Ncols() + colstride;
	  for (int col = 0; col < acols; ++col)
	    {
	      DAXPY(arows, scaleA * scaleB * b00, aptr, acols, cptr, 1);
	      ++aptr;
	      cptr += c.Ncols();//arows;
	    }

	  return;
	}	
    }
    //  else
    //    abort();
#else 
      try
	{
	  if (conjA == 'n' && conjB == 'n')
	    {
	      if (allocate)
		{
		  c.ReSize (a.Nrows () * b.Nrows (), a.Ncols () * b.Ncols ());
		  Clear (c);
		}
	      //assert ((c.Nrows () == (a.Nrows () * b.Nrows ())) && (c.Ncols () == (a.Ncols () * b.Ncols ())));
#ifdef BLAS
	      int aRows = a.Nrows ();
	      int aCols = a.Ncols ();
	      int bRows = b.Nrows ();
	      int bCols = b.Ncols ();

	      for (int i = 0; i < aRows; ++i)
		for (int j = 0; j < aCols; ++j)
		  {
		    Real scale = scaleA * scaleB * a (i+1,j+1);
		    for (int k = 0; k < bRows; ++k)
		      GAXPY (bCols, scale, &b (k+1,1), 1, &c (i * bRows + k+1 +rowstride,j * bCols+1+colstride), 1);
		  }
	      return;
#else
	      A = a;
	      B = b;
#endif
	    }
	  else if (conjA == 't' && conjB == 'n')
	    {
	      if (allocate)
		{
		  c.ReSize (a.Ncols () * b.Nrows (), a.Nrows () * b.Ncols ());
		  Clear (c);
		}
	      //assert ((c.Nrows () == (a.Ncols () * b.Nrows ())) && (c.Ncols () == (a.Nrows () * b.Ncols ())));
#ifdef BLAS
	      int aRows = a.Ncols ();
	      int aCols = a.Nrows ();
	      int bRows = b.Nrows ();
	      int bCols = b.Ncols ();
	      
	      for (int i = 0; i < aRows; ++i)
		for (int j = 0; j < aCols; ++j)
		  {
		    Real scale = scaleA * scaleB * a (j+1,i+1);
		    for (int k = 0; k < bRows; ++k)
		      GAXPY (bCols, scale, &b (k+1,1), 1, &c (i * bRows + k+1+rowstride,j * bCols+1+colstride), 1);
		  }
	      return;
#else	  
	      A = a.t ();
	      B = b;
#endif
	    }
	  else if (conjA == 'n' && conjB == 't')
	    {
	      if (allocate)
		{
		  c.ReSize (a.Nrows () * b.Ncols (), a.Ncols () * b.Nrows ());
		  Clear (c);
		}
	      //assert ((c.Nrows () == (a.Nrows () * b.Ncols ())) && (c.Ncols () == (a.Ncols () * b.Nrows ())));
#ifdef BLAS
	      int aRows = a.Nrows ();
	      int aCols = a.Ncols ();
	      int bRows = b.Ncols ();
	      int bCols = b.Nrows ();
	      
	      for (int i = 0; i < aRows; ++i)
		for (int j = 0; j < aCols; ++j)
		  {
		    Real scale = scaleA * scaleB * a (i+1,j+1);
		    for (int k = 0; k < bRows; ++k)
		      GAXPY (bCols, scale, &b (1,k+1), bRows, &c (i * bRows + k+1+rowstride,j * bCols+1+colstride), 1);
		  }
	      return;
#else
	      A = a;
	      B = b.t ();
#endif
	    }
	  else if (conjA == 't' && conjB == 't')
	    {
	      if (allocate)
		{
		  c.ReSize (a.Ncols () * b.Ncols (), a.Nrows () * b.Nrows ());
		  Clear (c);
		}
	      //assert ((c.Nrows () == (a.Ncols () * b.Ncols ())) && (c.Ncols () == (a.Nrows () * b.Nrows ())));
#ifdef BLAS
	      int aRows = a.Ncols ();
	      int aCols = a.Nrows ();
	      int bRows = b.Ncols ();
	      int bCols = b.Nrows ();
	      
	      for (int i = 0; i < aRows; ++i)
		for (int j = 0; j < aCols; ++j)
		  {
		    Real scale = scaleA * scaleB * a (j+1,i+1);
		    for (int k = 0; k < bRows; ++k)
		      GAXPY (bCols, scaleA * scaleB * a (j+1,i+1), &b (1,k+1), bRows, &c (i * bRows + k+1+rowstride,j * bCols+1+colstride), 1);
		  }
	      return;
#else
	      A = a.t ();
	      B = b.t ();
#endif
	    }
	  else
	    abort ();
#ifndef BLAS
	  for (int i = 1; i <= A.Nrows (); ++i)
	    for (int j = 1; j <= A.Ncols (); ++j)
	      c.SubMatrix ((i - 1) * B.Nrows () + 1, i * B.Nrows (), (j - 1) * B.Ncols () + 1, j * B.Ncols ()) += (scaleA * scaleB) * A (i,j) * B; 
#endif
	  
	}
      catch (Exception)
	{
	  pout << Exception::what () << endl;
	  abort ();
	}   
#endif
}
Exemplo n.º 9
0
void denseREKBLAS (MAT * A, double *x, const double *b, double TOL){
    int m = A->m, n = A->n, k, i_k, j_k;
    double val, val2, *z, *rowProb, *colProb;
    unsigned int *rowSampl, *colSampl;
    
    z = (double *) malloc (m * sizeof (double));
    rowProb = (double *) malloc (m * sizeof (double));
    colProb = (double *) malloc (n * sizeof (double));
    rowSampl = (unsigned int *) malloc (BLOCKSIZE * sizeof (unsigned int));
    colSampl = (unsigned int *) malloc (BLOCKSIZE * sizeof (unsigned int));
    
    // Copy A to A_transpose
    MAT *Atransp = createTransp (A);
    
    // Compute the sampling probabilities and the samples
    computeColNorms (A, colProb);	// Compute the column probabilities
    computeColNorms (Atransp, rowProb);	// Compute the columns probabilities of Atransp (n x m matrix)
    
    // Init alias sampler
    ALIAS *asRow = createAliasSampler (rowProb, m);
    ALIAS *asCol = createAliasSampler (colProb, n);
    
    // Sample indices
    mySampler (rowSampl, BLOCKSIZE, asRow);
    mySampler (colSampl, BLOCKSIZE, asCol);
    
    memcpy (z, b, m * sizeof (double));	// Initialize z: z = y;
    
    for (k = 0; k < MAXITERS; k++){
        
        if ((k + 1) % BLOCKSIZE == 0 && residError (A, x, b, z) < TOL && residError(Atransp, z, b, b) < TOL){
            printf ("-->REK_Dense stopped at %d <--\n", (int)k);
            break;
        }
        else if ((k + 1) % BLOCKSIZE == 0){
            // Sample indices
            mySampler (rowSampl, BLOCKSIZE, asRow);
            mySampler (colSampl, BLOCKSIZE, asCol);
        }
        
        i_k = rowSampl[k % BLOCKSIZE];
        j_k = colSampl[k % BLOCKSIZE];
        
        val = DDOT (m, z, 1, &(A->val)[j_k * m], 1);
        val /= colProb[j_k];
        
        val = -val;
        DAXPY (m, val, &(A->val)[j_k * m], 1, z, 1);
        
        val2 =
        DDOT (n, x, 1, &(Atransp->val)[i_k * n], 1);
        
        val2 = b[i_k] - z[i_k] - val2;
        val2 /= rowProb[i_k];
        
        DAXPY (n, val2, &(Atransp->val)[i_k * n], 1, x, 1);
    }
    
    freeSampler (asRow);
    freeSampler (asCol);
    freeMAT (Atransp);
    
    free (z);
    free (rowProb);
    free (colProb);
    free (rowSampl);
    free (colSampl);
};
Exemplo n.º 10
0
void DCHDC(double *a, INT *plda, INT *pp, double *work, INT jpvt[],
		   INT *pjob, INT *info)
/*double a[lda][1], work[1];*/
{
	INT         pu, pl, j, k, l, maxl, jtemp;
	INT         inc = 1;
	double      temp;
	double      maxdia;
	double     *ak, *apl, *akk, *aj, *apu, *all, *amaxl;
	INT         swapk, negk, length;
	INT         lda = *plda, p = *pp, job = *pjob;

	/* ***first executable statement  dchdc */
	pl = 0;
	pu = -1;
	*info = p;

	if (job != 0)
	{
		/*         pivoting has been requested. rearrange the */
		/*         the elements according to jpvt. */

		ak = a;
		apl = a + pl*lda;
		for(k = 0;k < p ;k++)
		{
			akk = ak + k;
			swapk = jpvt[k] > 0;
			negk = jpvt[k] < 0;
			jpvt[k] = k+1;
			if (negk)
			{
				jpvt[k] = -jpvt[k];
			}

			if (swapk)
			{
				if (k != pl)
				{
					DSWAP(&pl, ak, &inc, apl, &inc);
					temp = *akk;
					*akk = apl[pl];
					apl[pl] = temp;
					aj = apl + lda;
					for(j = pl+1;j < p ;j++)
					{
						if (j < k)
						{
							temp = aj[pl];
							aj[pl] = ak[j];
							ak[j] = temp;
						}
						else if (j != k)
						{
							temp = aj[k];
							aj[k] = aj[pl];
							aj[pl] = temp;
						}
						aj += lda;
					} /*for(j = pl+1;j < p ;j++)*/

					jpvt[k] = jpvt[pl];
					jpvt[pl] = k + 1;
				} /*if (k != pl) */
				pl++;
				apl += lda;
			} /*if (swapk) */
			ak += lda;
		} /*for(k = 0;k < p ;k++)*/

		pu = p - 1;
		apu = ak = a + (p-1)*lda;

		for(k = p-1;k>=pl;k--)
		{
			akk = ak + k;
			if (jpvt[k] < 0)
			{
				jpvt[k] = -jpvt[k];
				if (pu != k)
				{
					DSWAP(&k, ak, &inc, apu, &inc);
					temp = *akk;
					*akk = apu[pu];
					apu[pu] = temp;
					aj = ak + lda;
					for(j = k+1;j < p ;j++)
					{
						if (j < pu)
						{
							temp = aj[k];
							aj[k] = apu[j];
							apu[j] = temp;
						}
						else if (j != pu)
						{
							temp = aj[k];
							aj[k] = aj[pu];
							aj[pu] = temp;
						}
						aj += lda;
					} /*for(j = k+1;j < p ;j++)*/

					jtemp = jpvt[k];
					jpvt[k] = jpvt[pu];
					jpvt[pu] = jtemp;
				} /*if (pu != k) */
				pu--;
				apu -= lda;
			} /*if (jpvt[k] < 0) */
			ak -= lda;
		} /*for(k = p-1;k>=pl;k--)*/
	} /*if (job != 0)*/

	ak = a;
	for(k = 0;k < p ;k++)
	{
		/*         reduction loop. */

		akk = ak + k;
		maxdia = *akk;
		maxl = k;

		/*         determine the pivot element. */

		if (k >= pl && k < pu)
		{
			all = akk + lda + 1;
			for(l = k+1;l <= pu ;l++)
			{
				if (*all > maxdia)
				{
					maxdia = *all;
					maxl = l;
				}
				all += lda + 1;
			}
		}

		/*         quit if the pivot element is not positive. */

		if (maxdia <= 0.0e0)
		{
			*info = k;
			break;
		}

		if (k != maxl)
		{
			amaxl = a + maxl*lda;
			/*            start the pivoting and update jpvt. */

			DSWAP(&k, ak, &inc, amaxl, &inc);
			amaxl[maxl] = *akk;
			*akk = maxdia;
			jtemp = jpvt[maxl];
			jpvt[maxl] = jpvt[k];
			jpvt[k] = jtemp;
		} /*if (k != maxl) */

		/*         reduction step. pivoting is contained across the rows. */

		work[k] = sqrt(*akk);
		*akk = work[k];
		aj = ak + lda;
		amaxl = a + maxl*lda;
		for(j = k+1;j < p ;j++)
		{
			if (k != maxl)
			{
				temp = aj[k];
				if (j < maxl)
				{
					aj[k] = amaxl[j];
					amaxl[j] = temp;
				}
				else if (j != maxl)
				{
					aj[k] = aj[maxl];
					aj[maxl] = temp;
				}
			} /*if (k != maxl)*/

			aj[k] /= work[k];
			work[j] = aj[k];
			temp = -aj[k];
			length = j - k;
			DAXPY(&length, &temp, work + k + 1, &inc, aj + k + 1, &inc);
			aj += lda;
		} /*for(j = k+1;j < p ;j++)*/
		incAndTest((p-k+3)*(p-k)/2,errorExit);
		ak += lda;
	}/*for(k = 0;k < p ;k++)*/
	/* fall through*/

  errorExit:
	;

} /*dchdc()*/
Exemplo n.º 11
0
Arquivo: rng.c Projeto: LuaDist/numlua
static int rmvnorm_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  nl_Matrix *m = nl_checkmatrix(L, 1);
  nl_Matrix *S = nl_checkmatrix(L, 2);
  nl_Matrix *u;
  int i, n = m->size;
  lua_Number *em, *ev, *eu;
  /* check args */
  checkrvector(L, m, 1);
  luaL_argcheck(L, !S->iscomplex, 2, "real matrix expected");
  if (S->ndims == 1) {
    luaL_argcheck(L, S->size == n, 2, "arguments are not conformable");
    for (i = 0, ev = S->data; i < n; i++, ev += S->stride)
      luaL_argcheck(L, *ev > 0, 2, "variance is not positive");
  }
  else
    luaL_argcheck(L, S->ndims == 2 && S->dim[0] == n && S->dim[1] == n, 2,
        "arguments are not conformable");
  /* setup destination */
  lua_settop(L, 3);
  if (lua_isnil(L, 3))
    u = nl_pushmatrix(L, 0, 1, &n, 1, n,
        lua_newuserdata(L, n * sizeof(lua_Number)));
  else {
    u = nl_checkmatrix(L, 3);
    checkrvector(L, u, 3);
    luaL_argcheck(L, u->size == n, 3, "arguments are not conformable");
  }
  /* sample */
  if (S->ndims == 1) {
    em = m->data; ev = S->data; eu = u->data;
    for (i = 0; i < n; i++) {
      *eu = gennor(r, *em, *ev);
      em += m->stride; ev += S->stride; eu += u->stride;
    }
  }
  else {
    char uplo = 'L', trans = 'N', diag = 'N';
    lua_Number one = 1.0;
    /* u ~ N(0, I_n) */
    eu = u->data;
    for (i = 0; i < n; i++, eu += u->stride)
      *eu = gennor(r, 0, 1);
    /* u = S * u */
    if (S->stride != 1 /* non-unitary stride? */
        || (S->section != NULL /* non-block section? */
          && (S->section[0].step != 1 || S->section[1].step != 1))) {
      nl_Buffer *buf = nl_getbuffer(L, n * n);
      /* copy S to buffer */
      for (i = 0; i < S->size; i++)
        buf->data.bnum[i] = S->data[nl_mshift(S, i)];
      DTRMV(&uplo, &trans, &diag, &n, buf->data.bnum, &n,
          u->data, &u->stride, 1, 1, 1);
      nl_freebuffer(buf);
    }
    else {
      int ld = S->section ? S->section[0].ld : S->dim[0];
      DTRMV(&uplo, &trans, &diag, &n, S->data, &ld,
          u->data, &u->stride, 1, 1, 1);
    }
    /* u = u + m */
    DAXPY(&n, &one, m->data, &m->stride, u->data, &u->stride);
  }
  return 1;
}