예제 #1
0
파일: storage.c 프로젝트: barak/lush
static void Number_setat(storage_t *st, size_t off, at *x)
{
   get_write_permit(st);
   ifn (NUMBERP(x))
      error(NIL, "not a number", x);
   void (*set)(gptr,size_t,real) = storage_setd[st->type];
   (*set)(st->data, off, Number(x));
}
예제 #2
0
void cg_grad_adaptor(double *g, double *x, int n)
{
   static at *call = NIL;
   static int nx = -1;
   static storage_t *stx = NULL;
   static storage_t *stg = NULL;
   static at *(*listeval)(at *, at *) = NULL;

   if (n == -1) {
      /* initialize */
      at *x0 = var_get(named("x0"));
      at *vargs = var_get(named("vargs"));
      at *g = var_get(named("g"));
      ifn (x0)
         error(NIL, "x0 not found", NIL);
      ifn (INDEXP(x0) && IND_STTYPE((index_t *)Mptr(x0)))
         error(NIL, "x0 not a double index", x0);
      ifn (g)
         error(NIL, "g not found", NIL);
      
      listeval = Class(g)->listeval;
      index_t *ind = Mptr(x0);
      nx = storage_nelems(IND_ST(ind));
      stx = new_storage(ST_DOUBLE);
      stx->flags = STS_FOREIGN;
      stx->size = nx;
      stx->data = (char *)-1;

      stg = new_storage(ST_DOUBLE);
      stg->flags = STS_FOREIGN;
      stg->size = nx;
      stg->data = (char *)-1;
      call = new_cons(g, 
                      new_cons(NEW_INDEX(stg, IND_SHAPE(ind)),
                               new_cons(NEW_INDEX(stx, IND_SHAPE(ind)),
                                        vargs)));
   } else {
      if (n != nx)
         error(NIL, "vector of different size expected", NEW_NUMBER(n));
      stx->data = x;
      stg->data = g;
      listeval(Car(call), call);
   }
}
예제 #3
0
static void 
clearconvert(void)
{       
  int i;
  ifn (netconvert)
    error(NIL,"you should perform (alloc-net xx xx)",NIL);
  for (i=1; i<neurnombre; i++)
    netconvert[i]= -1;
  netconvert[0]=0;
}
예제 #4
0
파일: oostruct.c 프로젝트: barak/lush
object_t *object_from_cobject(struct CClass_object *cobj)
{
   ifn (cobj->Vtbl && cobj->Vtbl->Cdoc && cobj->Vtbl->Cdoc->lispdata.atclass)
      error(NIL, "attempt to access instance of unlinked class", NIL);
   assert(cobj->Vtbl);
   
   object_t *obj = cobj->__lptr;
   ifn (obj) {
      class_t *cl = Mptr(cobj->Vtbl->Cdoc->lispdata.atclass);
      obj = _new_object(cl, cobj);
   }
   return obj;
}
예제 #5
0
파일: storage.c 프로젝트: barak/lush
static at *storage_listeval(at *p, at *q)
{
   storage_t *st = Mptr(p);
   
   if (!st->data)
      error(NIL, "unsized storage", p);
   
   q = eval_arglist(Cdr(q));
   ifn (CONSP(q) && Car(q) && NUMBERP(Car(q)))
      error(NIL, "illegal subscript", q);
   
   ssize_t off = Number(Car(q));
   if (off<0 || off>=st->size)
      error(NIL, "subscript out of range", q);
   
   if (Cdr(q)) {
      ifn (CONSP(Cdr(q)) && !Cddr(q))
         error(NIL, "one or two arguments expected",q);
      storage_setat[st->type](st, off, Cadr(q));
      return st->backptr;
   } else
      return storage_getat[st->type](st, off);
}
예제 #6
0
파일: oostruct.c 프로젝트: barak/lush
object_t *new_object(class_t *cl)
{
   int n = 0;
   while (unreachables && n++<2) {
      object_t *obj = unreachables;
      unreachables = obj->next_unreachable;
      object_class->dispose(obj);
   }

   ifn (cl->live)
      error(NIL, "class is obsolete", cl->classname);
   
   return _new_object(cl, NULL);
}
예제 #7
0
double cg_value_adaptor(double *x, int n)
{
   static at *call = NIL;
   static int nx = -1;
   static storage_t *st = NULL;
   static at *(*listeval)(at *, at *) = NULL;

   if (n == -1) {
      /* initialize */
      at *x0 = var_get(named("x0"));
      at *vargs = var_get(named("vargs"));
      at *f = var_get(named("f"));
      ifn (x0)
         error(NIL, "x0 not found", NIL);
      ifn (INDEXP(x0) && IND_STTYPE((index_t *)Mptr(x0)))
         error(NIL, "x0 not a double index", x0);
      ifn (f)
         error(NIL, "f not found", NIL);

      listeval = Class(f)->listeval;
      index_t *ind = Mptr(x0);
      nx = storage_nelems(IND_ST(ind));
      st = new_storage(ST_DOUBLE);
      st->flags = STS_FOREIGN;
      st->size = nx;
      st->data = (char *)-1;

      call = new_cons(f, new_cons(NEW_INDEX(st, IND_SHAPE(ind)), vargs));
      return NAN;
         
   } else {
      if (n != nx)
         error(NIL, "vector of different size expected", NEW_NUMBER(n));
      st->data = x;
      return Number(listeval(Car(call), call));
   }
}
예제 #8
0
/* interface calling into the fortran routine */
static int lbfgs(index_t *x0, at *f, at *g, double gtol, htable_t *p, at *vargs)
{
   /* argument checking and setup */

   extern void lbfgs_(int *n, int *m, double *x, double *fval, double *gval, \
                      int *diagco, double *diag, int iprint[2], double *gtol, \
                      double *xtol, double *w, int *iflag);

   ifn (IND_STTYPE(x0) == ST_DOUBLE)
      error(NIL, "not an array of doubles", x0->backptr);
   ifn (Class(f)->listeval)
      error(NIL, "not a function", f);
   ifn (Class(f)->listeval)
      error(NIL, "not a function", g);
   ifn (gtol > 0)
      error(NIL, "threshold value not positive", NEW_NUMBER(gtol));
   
   at *gx = copy_array(x0)->backptr;
   at *(*listeval_f)(at *, at *) = Class(f)->listeval;
   at *(*listeval_g)(at *, at *) = Class(g)->listeval;
   at *callf = new_cons(f, new_cons(x0->backptr, vargs));
   at *callg = new_cons(g, new_cons(gx, new_cons(x0->backptr, vargs)));

   htable_t *params = lbfgs_params();
   if (p) htable_update(params, p);
   int iprint[2];
   iprint[0] = (int)Number(htable_get(params, NEW_SYMBOL("iprint-1")));
   iprint[1] = (int)Number(htable_get(params, NEW_SYMBOL("iprint-2")));
   lb3_.gtol = Number(htable_get(params, NEW_SYMBOL("ls-gtol")));
   lb3_.stpmin = Number(htable_get(params, NEW_SYMBOL("ls-stpmin")));
   lb3_.stpmax = Number(htable_get(params, NEW_SYMBOL("ls-stpmax")));
   int m = (int)Number(htable_get(params, NEW_SYMBOL("lbfgs-m")));
   int n = index_nelems(x0);
   double *x = IND_ST(x0)->data;
   double  fval;
   double *gval = IND_ST(Mptr(gx))->data;
   int diagco = false;
   double *diag = mm_blob(n*sizeof(double));
   double *w = mm_blob((n*(m+m+1)+m+m)*sizeof(double));
   double xtol = eps(1); /* machine precision */
   int iflag = 0;

   ifn (n>0)
      error(NIL, "empty array", x0->backptr);
   ifn (m>0)
      error(NIL, "m-parameter must be positive", NEW_NUMBER(m));

   /* reverse communication loop */
   do {
      fval = Number(listeval_f(Car(callf), callf));
      listeval_g(Car(callg), callg);
      lbfgs_(&n, &m, x, &fval, gval, &diagco, diag, iprint, &gtol, &xtol, w, &iflag);
      assert(iflag<2);
   } while (iflag > 0);
   
   return iflag;
}
예제 #9
0
at *
new_string_bylen(int n)
{
    at *q;
    char *buffer;
    struct string *st;

    st = allocate(&alloc_string);
    ifn (buffer = malloc(n+1))
    error(NIL, "memory exhausted", NIL);
    buffer[0] = 0;
    buffer[n] = 0;
    st->flag = STRING_ALLOCATED;
    st->start = buffer;
    st->cptr = 0;
    q = new_extern(&string_class, st);
    q->flags |= X_STRING;
    return q;
}
예제 #10
0
inline void InsertHash(const STRPTR a, struct Hash *h)
{
    struct HashEntry **he, *newhe;

    if(!h->Index)
    {
        ifn((h->Index = calloc(HASH_SIZE, sizeof(struct HashEntry *))))
        PrintPrgErr(pmWordListErr);
    }

    he = &h->Index[HashWord(a) % HASH_SIZE];

    if((newhe = malloc(sizeof(struct HashEntry))))
    {
        newhe->Next = *he;
        newhe->Str = a;
        *he = newhe;
    }
    else
        PrintPrgErr(pmWordListErr);
}
예제 #11
0
파일: oostruct.c 프로젝트: barak/lush
at *oostruct_getslot(at *p, at *prop)
{
   at *slot = Car(prop);
   ifn (SYMBOLP(slot))
      error(NIL,"not a slot name", slot);
   prop = Cdr(prop);

   object_t *obj = Mptr(p);
   class_t *cl = Class(obj->backptr);
   for (int i=0; i<cl->num_slots; i++)
      if (slot == cl->slots[i]) {
         at *sloti = obj->slots[i];
         if (i<cl->num_cslots)
            sloti = eval(sloti);
         if (prop)
            return getslot(sloti, prop);
         else 
            return sloti;
      }
   error(NIL, "not a slot", slot);
}
예제 #12
0
파일: oostruct.c 프로젝트: barak/lush
void oostruct_setslot(at *p, at *prop, at *val)
{
   at *slot = Car(prop);
   ifn (SYMBOLP(slot))
      error(NIL, "not a slot name", slot);
   prop = Cdr(prop);

   object_t *obj = Mptr(p);
   class_t *cl = Class(obj->backptr);
   for(int i=0; i<cl->num_slots; i++)
      if (slot == cl->slots[i]) {
         if (prop)
            setslot(&obj->slots[i], prop, val);
         else if (i<cl->num_cslots) {
            class_t *cl = classof(obj->slots[i]);
            cl->setslot(obj->slots[i], NIL, val);
         } else
            obj->slots[i] = val;
         return;
      }
   error(NIL, "not a slot", slot);
}
예제 #13
0
    QStringList fieldList_indirect(QSettings *cfg, const QString& filename, const QString& type, QString *typeSuggestion, bool *complete) {
        if ((!type.isEmpty() && !provides_indirect().contains(type)) || !understands_indirect(cfg, filename)) {
            return QStringList();
        }

        QFile f(filename);
        if (!f.open(QIODevice::ReadOnly)) {
            return QStringList();
        }

        char* data;
        if (0 >= f.readLine(data, 1000)) {
            return QStringList();
        }
        QString ifn(data);
        KUrl url(ifn);
        if (url.isLocalFile() || url.protocol().isEmpty()) {
            if (QFileInfo(ifn).isRelative()) {
                ifn = QFileInfo(filename).absolutePath() + QDir::separator() + ifn;
            }
        }

        return KstDataSource::fieldListForSource(ifn.trimmed(), type, typeSuggestion, complete);
    }
int main(int argc, char *argv[]) {
	int taskId, totaltasks, i, j;
	int chunk;
	MPI_Init(&argc, &argv);
	MPI_Comm_rank(MPI_COMM_WORLD, &taskId);
	MPI_Comm_size(MPI_COMM_WORLD, &totaltasks);

	chunk = NGRID / totaltasks;

	FP_PREC xc[chunk + 2];
	FP_PREC yc[chunk + 2];
	FP_PREC dyc[chunk + 2];
	FP_PREC derr[chunk + 2];

	FP_PREC intg;
	FP_PREC dx;

	int prev_task = (taskId - 1) < 0 ? totaltasks - 1 : taskId - 1;
	int next_task = (taskId + 1) % totaltasks;

	MPI_Request reqs[4];
	MPI_Status stats[4];

	MPI_Irecv(&yc[0], 1, MPI_DOUBLE, prev_task, prev_task * 1000 + taskId,
	MPI_COMM_WORLD, &reqs[0]);

	MPI_Irecv(&yc[chunk + 1], 1, MPI_DOUBLE, next_task,
			next_task * 1000 + taskId, MPI_COMM_WORLD, &reqs[1]);

	for (i = 1; i <= chunk + 1; i++) {
		xc[i] = (XI + (XF - XI) * (FP_PREC) (i - 1) / (FP_PREC) (NGRID - 1))
				+ taskId * chunk;
	}

	//define the function
	for (i = 1; i <= chunk; i++) {
		yc[i] = fn(xc[i]);
	}

	MPI_Isend(&yc[chunk], 1, MPI_DOUBLE, next_task, taskId * 1000 + next_task,
			MPI_COMM_WORLD, &reqs[3]);

	MPI_Isend(&yc[1], 1, MPI_DOUBLE, prev_task, taskId * 1000 + prev_task,
	MPI_COMM_WORLD, &reqs[2]);

	MPI_Waitall(4, reqs, stats);
	dx = xc[2] - xc[1];
	if (taskId == ROOT) {
		xc[0] = xc[1] - dx;
		yc[0] = fn(xc[0]);
	}

	if (taskId == totaltasks - 1) {
		xc[chunk + 1] = xc[chunk] + dx;
		yc[chunk + 1] = fn(xc[chunk + 1]);
	}

	//compute the derivative using first-order finite differencing
	for (i = 1; i <= chunk; i++) {
		dyc[i] = (yc[i + 1] - yc[i - 1]) / (2.0 * dx);
	}

	//compute the integral using Trapazoidal rule
	intg = 0.0;
	for (i = 1; i <= chunk; i++) {
		if (taskId == totaltasks - 1 && i == chunk)
			continue;
		intg += 0.5 * (xc[i + 1] - xc[i]) * (yc[i + 1] + yc[i]);
	}

	//compute the errors
	for (i = 1; i <= chunk; i++) {
		if (i - 1 != chunk - 1)
			derr[i] = fabs((dyc[i] - dfn(xc[i])) / dfn(xc[i]));
	}

	if (taskId != ROOT) {

		MPI_Request nreqs[2];
		MPI_Status nstats[2];

		MPI_Isend(derr + 1, chunk, MPI_DOUBLE, ROOT, taskId * 1000 + ROOT,
		MPI_COMM_WORLD, &nreqs[0]);
		MPI_Isend(&intg, 1, MPI_DOUBLE, ROOT, taskId * 1000 + ROOT,
		MPI_COMM_WORLD, &nreqs[1]);
		MPI_Waitall(2, nreqs, nstats);
	}

	else {

		FP_PREC allxc[NGRID];
		FP_PREC allderr[NGRID];
		FP_PREC allintg[totaltasks];
		FP_PREC davg_err = 0.0;
		FP_PREC dstd_dev = 0.0;
		FP_PREC intg_err = 0.0;
		MPI_Request nreqs[2 * (totaltasks - 1)];
		MPI_Status nstats[2 * (totaltasks - 1)];

		for (i = 1; i < totaltasks; i++) {
			MPI_Irecv(allderr + (i * chunk), chunk,
			MPI_DOUBLE, i, i * 1000 + ROOT, MPI_COMM_WORLD,
					&nreqs[2 * (i - 1)]);

			MPI_Irecv(allintg + i, 1, MPI_DOUBLE, i, i * 1000 + ROOT,
			MPI_COMM_WORLD, &nreqs[2 * (i - 1) + 1]);
		}

		for (i = 0; i < chunk; i++) {
			allderr[i] = derr[i + 1];
		}

		MPI_Waitall(2 * (totaltasks - 1), nreqs, nstats);

		//find the average error
		for (i = 0; i < NGRID; i++)
			davg_err += allderr[i];

		for (i = 1; i < totaltasks; i++) {
			intg += allintg[i];
		}

		davg_err /= (FP_PREC) NGRID;

		dstd_dev = 0.0;
		for (i = 0; i < NGRID; i++) {
			dstd_dev += pow(allderr[i] - davg_err, 2);
		}
		dstd_dev = sqrt(dstd_dev / (FP_PREC) NGRID);

		intg_err = fabs((ifn(XI, XF) - intg) / ifn(XI, XF));

		for (i = 0; i < NGRID; i++) {
			allxc[i] = XI + (XF - XI) * (FP_PREC) i / (FP_PREC) (NGRID - 1);
		}

		//print_error_data(NGRID, davg_err, dstd_dev, &xc[1], derr, intg_err);
		print_error_data(NGRID, davg_err, dstd_dev, allxc, allderr, intg_err);
	}

	MPI_Finalize();
}
예제 #15
0
파일: oostruct.c 프로젝트: barak/lush
class_t *new_ooclass(at *classname, at *atsuper, at *new_slots, at *defaults)
{
   ifn (SYMBOLP(classname))
      error(NIL, "not a valid class name", classname);
   ifn (length(new_slots) == length(defaults))
      error(NIL, "number of slots must match number of defaults", NIL);
   ifn (CLASSP(atsuper))
      error(NIL, "not a class", atsuper);

   class_t *super = Mptr(atsuper);
   if (builtin_class_p(super))
      error(NIL, "superclass not descendend of class <object>", atsuper);

   at *p = new_slots;
   at *q = defaults;
   int n = 0;
   while (CONSP(p) && CONSP(q)) {
      ifn (SYMBOLP(Car(p)))
         error(NIL, "not a symbol", Car(p));
      for (int i=0; i<super->num_slots; i++)
         if (Car(p) == super->slots[i])
            error(NIL, "a superclass has slot of this name", Car(p));
      p = Cdr(p);
      q = Cdr(q);
      n++;
   }
   assert(!p && !q);
  
   /* builds the new class */
   class_t *cl = mm_alloc(mt_class);
   *cl = *object_class;
   if (new_slots) {
      int num_slots = n + super->num_slots;
      cl->slots = mm_allocv(mt_refs, num_slots*sizeof(at *));
      cl->defaults = mm_allocv(mt_refs, num_slots*sizeof(at *));
      int i = 0;
      for (; i<super->num_slots; i++) {
         cl->slots[i] = super->slots[i];
         cl->defaults[i] = super->defaults[i];
      }
      for (at *s = new_slots, *d = defaults; CONSP(s); i++, s = Cdr(s), d = Cdr(d)) {
         cl->slots[i] = Car(s);
         cl->defaults[i] = Car(d);
      }
      assert(i == num_slots);
      cl->num_slots = num_slots;
   } else {
      cl->slots = super->slots;
      cl->defaults = super->defaults;
      cl->num_slots = super->num_slots;
   }

   /* Sets up classname */
   cl->classname = classname;
   cl->priminame = classname;
   
   /* Sets up lists */
   cl->super = super;
   cl->atsuper = atsuper;
   cl->nextclass = super->subclasses;
   cl->subclasses = 0L;
   super->subclasses = cl;
  
   /* Initialize the slots */
   cl->myslots = new_slots;
   cl->mydefaults = defaults;
   
   /* Initialize the methods and hash table */
   cl->methods = NIL;
   cl->hashtable = 0L;
   cl->hashsize = 0;
   cl->hashok = 0;
   
   /* Initialize DHCLASS stuff */
   cl->has_compiled_part = super->has_compiled_part;
   cl->num_cslots = super->num_cslots;
   cl->classdoc = 0;
   cl->kname = 0;
   
   /* Create AT and returns it */
   assert(class_class);
   cl->backptr = new_at(class_class, cl);
   return cl;
}
예제 #16
0
파일: ksmem.c 프로젝트: macx0r/dias-inet
void* _ksmem_mbat_alloc (client* c, memunit* unit, uvar32_64 size) {
	struct timeb tb;
	svar32_64 no, pf, pu, nf, nu, tmp; /* prevoius and next free and used block numbers corresopndevly */
	isclientn (c);

	ismemunitn (unit, c);
	isvalidn (size, c, KSERR_MEMZEROSIZE);
	isownern (c, unit);

	/* no = index of free and suitable unit->mbat[] entry */
	ifn ((no = _ksmem_mbat_find_free (c, unit, size)) == -1);
	_ksmem_mbat_neighboors (unit, no, unit->ffb, unit->lfb, &pf, &nf);
	_ksmem_mbat_neighboors (unit, no, unit->fub, unit->lub, &pu, &nu);

	/* Allocated new block */
atomic(unit)
	if (unit->maxfb == unit->mbat[no].size) {
		unit->maxfb = 0;
		for (tmp = unit->ffb; tmp != -1; tmp = unit->mbat[tmp].next)
			if (unit->maxfb < unit->mbat[tmp].size)
				unit->maxfb = unit->mbat[tmp].size;
		if (unit->maxfb < unit->psize - unit->pbottom)
			unit->maxfb = unit->psize - unit->pbottom;
	}
	if (unit->minfb == unit->mbat[no].size) {
		unit->minfb = (uvar32_64)-1;
		for (tmp = unit->ffb; tmp != -1; tmp = unit->mbat[tmp].next)
			if (unit->minfb > unit->mbat[tmp].size)
				unit->minfb = unit->mbat[tmp].size;
		if (unit->minfb > unit->psize - unit->pbottom)
			unit->minfb = unit->psize - unit->pbottom;
	}
	if (no == unit->ffb)
		unit->ffb = unit->mbat[no].next;

	if (no == (svar32_64)unit->tbottom) {
		unit->mbat[no].offset = unit->pbottom;
		unit->mbat[no].size = size;
		unit->pbottom += size;
		unit->tbottom++;
		unit->tfree--;
	} else if (unit->mbat[no].size != size && unit->tbottom < unit->tsize) {
		unit->mbat[unit->tbottom].size = unit->mbat[no].size - size;
		unit->mbat[unit->tbottom].offset = unit->mbat[no].offset + size;
		unit->mbat[unit->tbottom].next = -1;
		unit->mbat[no].size = size;
		if (unit->mbat[unit->tbottom].size < unit->minfb)
			unit->minfb = unit->mbat[unit->tbottom].size;
		if (unit->mbat[unit->tbottom].size > unit->maxfb)
			unit->maxfb = unit->mbat[unit->tbottom].size;
		if (unit->lfb != -1) {
			unit->mbat[unit->lfb].next = unit->tbottom;
			unit->lfb = unit->tbottom;
		} else
			unit->lfb = unit->tbottom;
		if (unit->ffb == -1)
			unit->ffb = unit->tbottom;
		if (nf == -1)
			nf = unit->tbottom;
		unit->tbottom++;
	}
	if (unit->lfb == no)
		unit->lfb = pf;
	if (unit->fub > no || unit->fub == -1)
		unit->fub = no;
	if (unit->lub < no || unit->lub == -1)
		unit->lub = no;

	if (pu != -1)
		unit->mbat[pu].next = no;
	if (pf != -1)
		unit->mbat[pf].next = nf;
	unit->mbat[no].next = nu;

	ftime (&tb);
	unit->modified = tb.time;
	unit->pfree -= size;
	unit->maxfb -= size;
	unit->minfb = (unit->minfb < unit->maxfb) ? unit->minfb : unit->maxfb;
endatomic

	return ((void *)((uvar32_64)(unit->mpage) + unit->mbat[no].offset));
}
예제 #17
0
int main (int argc, char *argv[])
{
    int  numproc, rank, len,i;
    char hostname[MPI_MAX_PROCESSOR_NAME];
    MPI_Init(&argc, &argv);
    MPI_Comm_size(MPI_COMM_WORLD, &numproc);
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    MPI_Get_processor_name(hostname, &len);
    
    FP_PREC *yc, *dyc, *derr, *fullerr;
    FP_PREC *xc, dx, intg, davg_err, dstd_dev, intg_err;
    FP_PREC globalSum = 0.0;

    // MPI vailables 
    MPI_Request *requestList,request;
    MPI_Status  *status;

    //"real" grid indices
    int imin, imax;
    
    imin = 1 + (rank * (NGRID/numproc));
    
    if(rank == numproc - 1)
    imax = NGRID;
    
    else
    imax = (rank+1) * (NGRID/numproc);
       
    int range = imax - imin + 1;
    
    xc =  (FP_PREC*) malloc((range + 2) * sizeof(FP_PREC));
    yc =  (FP_PREC*) malloc((range + 2) * sizeof(FP_PREC));
    dyc =  (FP_PREC*) malloc((range + 2) * sizeof(FP_PREC));
    dx = (XF - XI)/(double)NGRID;
    for (i = 1; i <= range ; i++)
    {
        //xc[i] = imin + (XF - XI) * (FP_PREC)(i - 1)/(FP_PREC)(NGRID - 1);
        xc[i] = XI + dx * (imin + i - 2);
    }
    
    xc[0] = xc[1] - dx;
    xc[range + 1] = xc[range] + dx;
    
    for( i = 1; i <= range; i++ )
    {
        yc[i] = fn(xc[i]);
    }
    
    yc[0] = fn(xc[0]);
    yc[range + 1] = fn(xc[range + 1]);
    
    for (i = 1; i <= range; i++)
    {
        dyc[i] = (yc[i + 1] - yc[i - 1])/(2.0 * dx);
    }
    
    intg = 0.0;
    for (i = 1; i <= range; i++)
    {
        intg += 0.5 * (xc[i + 1] - xc[i]) * (yc[i + 1] + yc[i]);
    }
    
    MPI_Reduce(&intg, &globalSum, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
    
    
    //compute the error, average error of the derivatives
    derr = (FP_PREC*)malloc((range + 2) * sizeof(FP_PREC));
    
    //compute the errors
    for(i = 1; i <= range; i++)
    {
        derr[i] = fabs((dyc[i] - dfn(xc[i]))/dfn(xc[i]));
    }
    
    derr[0] = derr[range + 1] = 0.0;
    
    if(rank == 0)
    {
        fullerr = (FP_PREC *)malloc(sizeof(FP_PREC)*NGRID);
        requestList =(MPI_Request*)malloc((numproc-1)*sizeof(MPI_Request));
        for(i = 0;i<range;i++)
        {
            fullerr[i] = derr[i+1];
        }
        for(i = 1; i<numproc; i++)
        {
            int rmin, rmax, *indx;
            rmin = 1 + (i * (NGRID/numproc));
            if(i == numproc - 1)
                rmax = NGRID;
            else
                rmax = (i+1) * (NGRID/numproc);
            MPI_Irecv(fullerr+rmin-1, rmax-rmin+1, MPI_DOUBLE, i, 1, MPI_COMM_WORLD, &(requestList[i-1]));
        }
        double sum = 0.0;
        for(i=0; i<NGRID; i++)
        {
            sum+=fullerr[i];
        }
        davg_err = sum/(FP_PREC)NGRID;
        dstd_dev = 0.0;
        for(i = 0; i< NGRID; i++)
        {
            dstd_dev += pow(derr[i] - davg_err, 2);
        }
        dstd_dev = sqrt(dstd_dev/(FP_PREC)NGRID);
        
        intg_err = fabs((ifn(XI, XF) - globalSum)/ifn(XI, XF));
        printf("%0.4e: %0.4e: %0.4e\n", davg_err, dstd_dev, intg_err);

    }
    else
    {
        MPI_Isend(derr+1, imax-imin+1, MPI_DOUBLE, 0, rank, MPI_COMM_WORLD, &request);
        fflush(stdout);
    }
    
    MPI_Finalize();
}
예제 #18
0
파일: p2_mpi.c 프로젝트: atapie/ncsu
int main (int argc, char *argv[])
{
  int procid, num_procs;
  MPI_Status status;
  // derivative_time, integral_time, err_time is the local sum of runtime for each computation
  // tick is used to mark time
  double derivative_time = 0, integral_time = 0, err_time = 0, tick;

  MPI_Init(&argc, &argv);
  MPI_Comm_rank(MPI_COMM_WORLD, &procid);
  MPI_Comm_size(MPI_COMM_WORLD, &num_procs);

  // Calculate grid-points per process
  if(NGRID % num_procs > 0)
  {
	if(procid == 0) printf("NGRID should be divisible by the number of processes!");
	MPI_Finalize();
	return 1;
  }
  int points_per_node = NGRID / num_procs;

  //loop index
  int i;

  //domain array and step size
  FP_PREC xc[points_per_node], dx;

  //function array and derivative
  //the size will be dependent on the
  //number of processors used
  //to the program
  FP_PREC yc[points_per_node], dyc[points_per_node];
  
  //integration values
  FP_PREC local_intg, intg;

  //error analysis array
  FP_PREC derr[points_per_node];

  //error analysis values
  FP_PREC dlocal_sum_err, davg_err, dlocal_std_dev, dstd_dev, intg_err;

  //calculate dx
  dx = (FP_PREC)(XF - XI)/(FP_PREC)(NGRID - 1);

  // get start X for each process (my_XI)
  int bins_before_me = procid * points_per_node;
  FP_PREC my_XI = XI + bins_before_me * dx;

  //construct grid
  for (i = 0; i < points_per_node; ++i)
  {
    xc[i] = my_XI + i * dx;
  }

  //define the function
  for(i = 0; i < points_per_node; ++i)
  {
    yc[i] = fn(xc[i]);
  }

  //define holders for left and right bound value
  FP_PREC left_bound_yc, right_bound_yc;
  if(procid == 0) left_bound_yc = fn(XI-dx);
  if(procid == num_procs - 1) right_bound_yc = fn(XF+dx);

  tick = MPI_Wtime();
#if BLOCKING
  if(procid == 0) printf("Using blocking message! \n");
  //Step 1: even nodes send to the right then receive back
  //Step 2: even nodes receive from the left then send back
  if(procid % 2 == 0)
  {
    if(procid < num_procs - 1)
    {
	MPI_Send(&yc[points_per_node-1], 1, MPI_DOUBLE, procid+1, 0, MPI_COMM_WORLD);
	MPI_Recv(&right_bound_yc, 1, MPI_DOUBLE, procid+1, 0, MPI_COMM_WORLD, &status);
    }
    if(procid > 0)
    {
	MPI_Recv(&left_bound_yc, 1, MPI_DOUBLE, procid-1, 0, MPI_COMM_WORLD, &status);
	MPI_Send(&yc[0], 1, MPI_DOUBLE, procid-1, 0, MPI_COMM_WORLD);
    }
  } else
  {
    MPI_Recv(&left_bound_yc, 1, MPI_DOUBLE, procid-1, 0, MPI_COMM_WORLD, &status);
    MPI_Send(&yc[0], 1, MPI_DOUBLE, procid-1, 0, MPI_COMM_WORLD);
    if(procid < num_procs - 1)
    {
    	MPI_Send(&yc[points_per_node-1], 1, MPI_DOUBLE, procid+1, 0, MPI_COMM_WORLD);
    	MPI_Recv(&right_bound_yc, 1, MPI_DOUBLE, procid+1, 0, MPI_COMM_WORLD, &status);
    }
  }
#else
  if(procid == 0) printf("Using non-blocking message! \n");
  MPI_Request request[4];
  int current_request = 0;
  if(procid < num_procs - 1)
  { // receive right bound yc
      MPI_Irecv(&right_bound_yc, 1, MPI_DOUBLE, procid+1, 0, MPI_COMM_WORLD, &request[current_request]);
      ++current_request;
  }
  if(procid > 0)
  { // receive left bound yc
      MPI_Irecv(&left_bound_yc, 1, MPI_DOUBLE, procid-1, 0, MPI_COMM_WORLD, &request[current_request]);
      ++current_request;
  }
  if(procid < num_procs - 1)
  { // send right bound yc to right node
      MPI_Isend(&yc[points_per_node-1], 1, MPI_DOUBLE, procid+1, 0, MPI_COMM_WORLD, &request[current_request]);
      ++current_request;
  }
  if(procid > 0)
  { // send left bound yc to left node
      MPI_Isend(&yc[0], 1, MPI_DOUBLE, procid-1, 0, MPI_COMM_WORLD, &request[current_request]);
      ++current_request;
  }
#endif
  derivative_time += MPI_Wtime() - tick;
  integral_time += MPI_Wtime() - tick;

  // Overlap computation and communication BEGIN
  //compute the derivative using first-order finite differencing
  tick = MPI_Wtime();
  for (i = 1; i < points_per_node-1; ++i)
  {
    dyc[i] = (yc[i + 1] - yc[i - 1])/(2.0 * dx);
  }
  derivative_time += MPI_Wtime() - tick;

  //compute the integral using Trapazoidal rule
  tick = MPI_Wtime();
  local_intg = 0.0;
  for (i = 0; i < points_per_node-1; ++i)
  {
    local_intg += 0.5 * (yc[i] + yc[i + 1]) * dx;
  }
  integral_time += MPI_Wtime() - tick;
  // Overlap computation and communication END

  // WAIT for non-blocking message complete before continue
#if !BLOCKING
  tick = MPI_Wtime();
  MPI_Waitall(current_request, request, MPI_STATUSES_IGNORE);
  derivative_time += MPI_Wtime() - tick;
  integral_time += MPI_Wtime() - tick;
#endif

  // compute derivative of boundary points, runtime is not counted because it's quite small
  dyc[0] = (yc[1] - left_bound_yc)/(2.0 * dx);
  dyc[points_per_node-1] = (right_bound_yc - yc[points_per_node-2])/(2.0 * dx);

  // compute integral at right boundary point, runtime is not counted because it's quite small
  if(procid < num_procs-1) local_intg += 0.5 * (yc[points_per_node-1] + right_bound_yc) * dx;

  tick = MPI_Wtime();
  //compute the error, average error of the derivatives
  for(i = 0; i < points_per_node; ++i)
  {
    if(dfn(xc[i]) == 0)
    {
      printf("WARNING: derivative at point %d on process %d is zero.\n", i, procid);
      derr[i] = 0;
    }
    else derr[i] = fabs((dyc[i] - dfn(xc[i]))/dfn(xc[i]));
  }

  //find the local average error
  dlocal_sum_err = 0.0;
  for(i = 0; i < points_per_node; ++i)
  {
    dlocal_sum_err += derr[i];
  }

  //calculate and output errors
#if SINGLE_CALL_REDUCTION
  if(procid == 0) printf("Using single call reduction! \n");
  //all nodes collect sum err and convert it to the mean value
  MPI_Allreduce(&dlocal_sum_err, &davg_err, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
  davg_err /= (FP_PREC)NGRID; // each process calculates global average
#else
  if(procid == 0) printf("Using manual call reduction! \n");
  //all nodes collect sum err and convert it to the mean value
  if(procid != 0) MPI_Send(&dlocal_sum_err, 1, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD);
  else if(procid == 0)
  {
    davg_err = dlocal_sum_err;
    for(i = 1; i < num_procs; ++i)
    {
      MPI_Recv(&dlocal_sum_err, 1, MPI_DOUBLE, MPI_ANY_SOURCE, 0, MPI_COMM_WORLD, &status);
      davg_err += dlocal_sum_err;
    }
    davg_err /= (FP_PREC)NGRID;
  }
  MPI_Bcast(&davg_err, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
#endif

  //now all nodes have davg_err, find sum squared differences of local derr
  dlocal_std_dev = 0.0;
  for(i = 0; i < points_per_node; ++i)
  {
    dlocal_std_dev += pow(derr[i] - davg_err, 2);
  }
  err_time += MPI_Wtime() - tick;

#if SINGLE_CALL_REDUCTION
  //reduce local integral & local (sum squared differences of derr) to root
  tick = MPI_Wtime();
  MPI_Reduce(&dlocal_std_dev, &dstd_dev, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
  err_time += MPI_Wtime() - tick;
  tick = MPI_Wtime();
  MPI_Reduce(&local_intg, &intg, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
  integral_time += MPI_Wtime() - tick;
#else
  //reduce local integral & local (sum squared differences of derr) to root
  if(procid != 0)
  {
    tick = MPI_Wtime();
    MPI_Send(&dlocal_std_dev, 1, MPI_DOUBLE, 0, 0, MPI_COMM_WORLD);
    err_time += MPI_Wtime() - tick;
    tick = MPI_Wtime();
    MPI_Send(&local_intg, 1, MPI_DOUBLE, 0, 1, MPI_COMM_WORLD);
    integral_time += MPI_Wtime() - tick;
  } else if(procid == 0)
  {
    dstd_dev = dlocal_std_dev;
    intg = local_intg;
    tick = MPI_Wtime();
    for(i = 1; i < num_procs; ++i)
    {
      MPI_Recv(&dlocal_std_dev, 1, MPI_DOUBLE, MPI_ANY_SOURCE, 0, MPI_COMM_WORLD, &status);
      dstd_dev += dlocal_std_dev;
    }
    err_time += MPI_Wtime() - tick;
    tick = MPI_Wtime();
    for(i = 1; i < num_procs; ++i)
    {
      MPI_Recv(&local_intg, 1, MPI_DOUBLE, MPI_ANY_SOURCE, 1, MPI_COMM_WORLD, &status);
      intg+= local_intg;
    }
    integral_time += MPI_Wtime() - tick;
  }
#endif

  // print out the max runtime for each calculation
  double max_derivative_time, max_integral_time, max_err_time;
  MPI_Reduce(&derivative_time, &max_derivative_time, 1, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD);
  MPI_Reduce(&integral_time, &max_integral_time, 1, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD);
  MPI_Reduce(&err_time, &max_err_time, 1, MPI_DOUBLE, MPI_MAX, 0, MPI_COMM_WORLD);
  if(procid == 0)
  {
    printf("Max runtime to calculate derivatives is %e\n", max_derivative_time);
    printf("Max runtime to calculate integral is %e\n", max_integral_time);
    printf("Max runtime to calculate derivative errors is %e\n", max_err_time);
  }

  //gather derivative results & errors for output
  //this part shouldn't be included in running time measurements
  FP_PREC *final_dyc = NULL;
  FP_PREC *final_derr = NULL;
  if(procid == 0)
  {
    final_dyc = (FP_PREC*)malloc(NGRID * sizeof(FP_PREC));
    final_derr = (FP_PREC*)malloc(NGRID * sizeof(FP_PREC));
  }
  MPI_Gather(dyc, points_per_node, MPI_DOUBLE, final_dyc, points_per_node, MPI_DOUBLE, 0, MPI_COMM_WORLD);
  MPI_Gather(derr, points_per_node, MPI_DOUBLE, final_derr, points_per_node, MPI_DOUBLE, 0, MPI_COMM_WORLD);

  //final output at root node (rank 0)
  if(procid == 0)
  {
    dstd_dev = sqrt(dstd_dev/(FP_PREC)NGRID);
    if(ifn(XI, XF) == 0) {
      printf("WARNING: true integral value from XI to XF is equal zero.\n");
      intg_err = 0;
    } else {
      intg_err = fabs((ifn(XI, XF) - intg)/ifn(XI, XF));
    }

    print_function_data(NGRID, dx, final_dyc);
    print_error_data(NGRID, davg_err, dstd_dev, intg_err, dx, final_derr);

    free(final_dyc);
    free(final_derr);
  }

  MPI_Finalize();
  return 0;
}
예제 #19
0
파일: list.c 프로젝트: barak/lush
at *cdr(at *q)
{
   ifn (LISTP(q))
      RAISEF("not a list", q);
   return q ? Cdr(q) : q;
}