int main()
{
DCMF_Messager_initialize();
init();
barrier_init(DCMF_DEFAULT_GLOBALBARRIER_PROTOCOL);
allreduce_init(DCMF_DEFAULT_GLOBALALLREDUCE_PROTOCOL);
control_init(DCMF_DEFAULT_CONTROL_PROTOCOL, DCMF_DEFAULT_NETWORK);
memregion_init(MAX_MSG_SIZE * ITERATIONS * 2);
get_init(DCMF_DEFAULT_PUT_PROTOCOL, DCMF_TORUS_NETWORK);
if (myrank == 0)
{
printf("Get Bandwidth - All processes communication in pairs \n");
fflush(stdout);
}
get_contention();
if (myrank == 0)
{
printf("Benchmark Complete \n");
fflush(stdout);
}
memregion_finalize();
DCMF_Messager_finalize();
return 0;
}
s4u::CommPtr Mailbox::get_async(void** data)
{
s4u::CommPtr res = get_init();
res->set_dst_data(data, sizeof(*data));
res->start();
return res;
}
SEXP bcplm_mcmc (SEXP da){
/* get dimensions */
int *dm = DIMS_SLOT(da) ;
int nR = dm[rpt_POS];
SEXP ans, ans_tmp;
/* tune the scale parameter for M-H update */
if (dm[tnit_POS]) {
update_mu(da); /* update eta mu*/
tune_mcmc(da);
}
/* run Markov chains */
PROTECT(ans = allocVector(VECSXP, dm[chn_POS])) ;
for (int k = 0; k < dm[chn_POS]; k++){
if (nR) Rprintf(_("Start Markov chain %d\n"), k + 1);
get_init(da, k) ; /* initialize the chain */
update_mu(da) ; /* update eta and mu */
/* run MCMC and store result */
PROTECT(ans_tmp = allocMatrix(REALSXP, dm[kp_POS], dm[nA_POS]));
do_mcmc(da, dm[itr_POS], dm[bun_POS], dm[thn_POS],
dm[kp_POS], nR, REAL(ans_tmp));
SET_VECTOR_ELT(ans, k, ans_tmp);
UNPROTECT(1) ;
if (nR) print_line();
}
UNPROTECT(1) ;
if (nR) Rprintf(_("Markov Chain Monte Carlo ends!\n"));
return ans ;
}
void
edit_typeset_rep::get_data (new_data& data) {
data->style= get_style ();
data->init = get_init ();
data->fin = get_fin ();
data->att = get_att ();
}
int main(int argc, char** argv) {
usage_info *ptr = get_init();
usage_info **ptr2 = executeCommand(argv+1, ptr);
ptr = ptr2[0];
print_info(ptr2[1]);
}
void* Mailbox::get(double timeout)
{
void* res = nullptr;
CommPtr c = get_init();
c->set_dst_data(&res, sizeof(res));
c->wait(timeout);
return res;
}
void
edit_main_rep::print (url name, bool conform, int first, int last) {
if (inside ("screens")) {
tree style= copy (get_style ());
tree init = copy (get_init ());
tree t = copy (subtree (et, rp));
call ("dynamic-make-slides");
apply_changes ();
print_bis (name, conform, first, last);
set_style (style);
set_init (init);
assign (rp, t);
apply_changes ();
}
else print_bis (name, conform, first, last);
}
paralist *pj_expand_init(PJ_CONTEXT *ctx, paralist *init) {
/******************************************************************************
Append expansion of <key> to the paralist <init>. The expansion is appended,
rather than inserted at <init>'s place, since <init> may contain
overrides to the expansion. These must take precedence, and hence come first
in the expanded list.
Consider e.g. the key 'foo:bar' which (hypothetically) expands to 'proj=utm
zone=32 ellps=GRS80', i.e. a UTM projection on the GRS80 ellipsoid.
The expression 'init=foo:bar ellps=intl' will then expand to:
'init=foo:bar ellps=intl proj=utm zone=32 ellps=GRS80',
where 'ellps=intl' precedes 'ellps=GRS80', and hence takes precedence,
turning the expansion into an UTM projection on the Hayford ellipsoid.
Note that 'init=foo:bar' stays in the list. It is ignored after expansion.
******************************************************************************/
paralist *last;
paralist *expn;
/* Nowhere to start? */
if (0==init)
return 0;
expn = get_init(ctx, init->param);
/* Nothing in expansion? */
if (0==expn)
return 0;
/* Locate the end of the list */
for (last = init; last && last->next; last = last->next);
/* Then append and return */
last->next = expn;
return init;
}
PJ *
pj_init(int argc, char **argv) {
char *s, *name;
paralist *start = NULL;
PJ *(*proj)(PJ *);
paralist *curr;
int i;
PJ *PIN = 0;
const char *old_locale;
errno = pj_errno = 0;
start = NULL;
old_locale = setlocale(LC_NUMERIC, NULL);
setlocale(LC_NUMERIC,"C");
/* put arguments into internal linked list */
if (argc <= 0) { pj_errno = -1; goto bum_call; }
for (i = 0; i < argc; ++i)
if (i)
curr = curr->next = pj_mkparam(argv[i]);
else
start = curr = pj_mkparam(argv[i]);
if (pj_errno) goto bum_call;
/* check if +init present */
if (pj_param(start, "tinit").i) {
paralist *last = curr;
if (!(curr = get_init(&start, curr, pj_param(start, "sinit").s)))
goto bum_call;
if (curr == last) { pj_errno = -2; goto bum_call; }
}
/* find projection selection */
if (!(name = pj_param(start, "sproj").s))
{ pj_errno = -4; goto bum_call; }
for (i = 0; (s = pj_list[i].id) && strcmp(name, s) ; ++i) ;
if (!s) { pj_errno = -5; goto bum_call; }
/* set defaults, unless inhibited */
if (!pj_param(start, "bno_defs").i)
curr = get_defaults(&start, curr, name);
proj = (PJ *(*)(PJ *)) pj_list[i].proj;
/* allocate projection structure */
if (!(PIN = (*proj)(0))) goto bum_call;
PIN->params = start;
PIN->is_latlong = 0;
PIN->is_geocent = 0;
PIN->long_wrap_center = 0.0;
/* set datum parameters */
if (pj_datum_set(start, PIN)) goto bum_call;
/* set ellipsoid/sphere parameters */
if (pj_ell_set(start, &PIN->a, &PIN->es)) goto bum_call;
PIN->a_orig = PIN->a;
PIN->es_orig = PIN->es;
PIN->e = sqrt(PIN->es);
PIN->ra = 1. / PIN->a;
PIN->one_es = 1. - PIN->es;
if (PIN->one_es == 0.) { pj_errno = -6; goto bum_call; }
PIN->rone_es = 1./PIN->one_es;
/* Now that we have ellipse information check for WGS84 datum */
if( PIN->datum_type == PJD_3PARAM
&& PIN->datum_params[0] == 0.0
&& PIN->datum_params[1] == 0.0
&& PIN->datum_params[2] == 0.0
&& PIN->a == 6378137.0
&& ABS(PIN->es - 0.006694379990) < 0.000000000050 )/*WGS84/GRS80*/
{
PIN->datum_type = PJD_WGS84;
}
/* set PIN->geoc coordinate system */
PIN->geoc = (PIN->es && pj_param(start, "bgeoc").i);
/* over-ranging flag */
PIN->over = pj_param(start, "bover").i;
/* longitude center for wrapping */
PIN->long_wrap_center = pj_param(start, "rlon_wrap").f;
/* central meridian */
PIN->lam0=pj_param(start, "rlon_0").f;
/* central latitude */
PIN->phi0 = pj_param(start, "rlat_0").f;
/* false easting and northing */
PIN->x0 = pj_param(start, "dx_0").f;
PIN->y0 = pj_param(start, "dy_0").f;
/* general scaling factor */
if (pj_param(start, "tk_0").i)
PIN->k0 = pj_param(start, "dk_0").f;
else if (pj_param(start, "tk").i)
PIN->k0 = pj_param(start, "dk").f;
else
PIN->k0 = 1.;
if (PIN->k0 <= 0.) {
pj_errno = -31;
goto bum_call;
}
/* set units */
s = 0;
if ((name = pj_param(start, "sunits").s)) {
for (i = 0; (s = pj_units[i].id) && strcmp(name, s) ; ++i) ;
if (!s) { pj_errno = -7; goto bum_call; }
s = pj_units[i].to_meter;
}
if (s || (s = pj_param(start, "sto_meter").s)) {
PIN->to_meter = strtod(s, &s);
if (*s == '/') /* ratio number */
PIN->to_meter /= strtod(++s, 0);
PIN->fr_meter = 1. / PIN->to_meter;
} else
PIN->to_meter = PIN->fr_meter = 1.;
/* prime meridian */
s = 0;
if ((name = pj_param(start, "spm").s)) {
const char *value = NULL;
char *next_str = NULL;
for (i = 0; pj_prime_meridians[i].id != NULL; ++i )
{
if( strcmp(name,pj_prime_meridians[i].id) == 0 )
{
value = pj_prime_meridians[i].defn;
break;
}
}
if( value == NULL
&& (dmstor(name,&next_str) != 0.0 || *name == '0')
&& *next_str == '\0' )
value = name;
if (!value) { pj_errno = -46; goto bum_call; }
PIN->from_greenwich = dmstor(value,NULL);
}
else
PIN->from_greenwich = 0.0;
/* projection specific initialization */
if (!(PIN = (*proj)(PIN)) || errno || pj_errno) {
bum_call: /* cleanup error return */
if (!pj_errno)
pj_errno = errno;
if (PIN)
pj_free(PIN);
else
for ( ; start; start = curr) {
curr = start->next;
pj_dalloc(start);
}
PIN = 0;
}
setlocale(LC_NUMERIC,old_locale);
return PIN;
}
static paralist *append_defaults_to_paralist (PJ_CONTEXT *ctx, paralist *start, char *key) {
paralist *defaults, *last = 0;
char keystring[ID_TAG_MAX + 20];
paralist *next, *proj;
int err;
if (0==start)
return 0;
if (strlen(key) > ID_TAG_MAX)
return 0;
/* Set defaults, unless inhibited (either explicitly through a "no_defs" token */
/* or implicitly, because we are initializing a pipeline) */
if (pj_param_exists (start, "no_defs"))
return start;
proj = pj_param_exists (start, "proj");
if (0==proj)
return start;
if (strlen (proj->param) < 6)
return start;
if (0==strcmp ("pipeline", proj->param + 5))
return start;
err = pj_ctx_get_errno (ctx);
pj_ctx_set_errno (ctx, 0);
/* Locate end of start-list */
for (last = start; last->next; last = last->next);
strcpy (keystring, "proj_def.dat:");
strcat (keystring, key);
defaults = get_init (ctx, keystring);
/* Defaults are optional - so we don't care if we cannot open the file */
pj_ctx_set_errno (ctx, err);
if (!defaults)
return last;
/* Loop over all default items */
for (next = defaults; next; next = next->next) {
/* Don't override existing parameter value of same name */
if (pj_param_exists (start, next->param))
continue;
/* Don't default ellipse if datum, ellps or any ellipsoid information is set */
if (0==strncmp(next->param,"ellps=", 6)) {
if (pj_param_exists (start, "datum")) continue;
if (pj_param_exists (start, "ellps")) continue;
if (pj_param_exists (start, "a")) continue;
if (pj_param_exists (start, "b")) continue;
if (pj_param_exists (start, "rf")) continue;
if (pj_param_exists (start, "f")) continue;
if (pj_param_exists (start, "e")) continue;
if (pj_param_exists (start, "es")) continue;
}
/* If we're here, it's OK to append the current default item */
last = last->next = pj_mkparam(next->param);
}
last->next = 0;
pj_dealloc_params (ctx, defaults, 0);
return last;
}
PJ *
pj_init_ctx(projCtx ctx, int argc, char **argv) {
char *s, *name;
paralist *start = NULL;
PJ *(*proj)(PJ *);
paralist *curr;
int i;
PJ *PIN = 0;
char *old_locale;
ctx->last_errno = 0;
start = NULL;
old_locale = strdup(setlocale(LC_NUMERIC, NULL));
if( strcmp(old_locale,"C") != 0 )
setlocale(LC_NUMERIC,"C");
/* put arguments into internal linked list */
if (argc <= 0) { pj_ctx_set_errno( ctx, -1 ); goto bum_call; }
for (i = 0; i < argc; ++i)
if (i)
curr = curr->next = pj_mkparam(argv[i]);
else
start = curr = pj_mkparam(argv[i]);
if (ctx->last_errno) goto bum_call;
/* check if +init present */
if (pj_param(ctx, start, "tinit").i) {
paralist *last = curr;
if (!(curr = get_init(ctx,&start, curr, pj_param(ctx, start, "sinit").s)))
goto bum_call;
if (curr == last) { pj_ctx_set_errno( ctx, -2); goto bum_call; }
}
/* find projection selection */
if (!(name = pj_param(ctx, start, "sproj").s))
{ pj_ctx_set_errno( ctx, -4 ); goto bum_call; }
for (i = 0; (s = pj_list[i].id) && strcmp(name, s) ; ++i) ;
if (!s) { pj_ctx_set_errno( ctx, -5 ); goto bum_call; }
/* set defaults, unless inhibited */
if (!pj_param(ctx, start, "bno_defs").i)
curr = get_defaults(ctx,&start, curr, name);
proj = (PJ *(*)(PJ *)) pj_list[i].proj;
/* allocate projection structure */
if (!(PIN = (*proj)(0))) goto bum_call;
PIN->ctx = ctx;
PIN->params = start;
PIN->is_latlong = 0;
PIN->is_geocent = 0;
PIN->is_long_wrap_set = 0;
PIN->long_wrap_center = 0.0;
strcpy( PIN->axis, "enu" );
PIN->gridlist = NULL;
PIN->gridlist_count = 0;
PIN->vgridlist_geoid = NULL;
PIN->vgridlist_geoid_count = 0;
/* set datum parameters */
if (pj_datum_set(ctx, start, PIN)) goto bum_call;
/* set ellipsoid/sphere parameters */
if (pj_ell_set(ctx, start, &PIN->a, &PIN->es)) goto bum_call;
PIN->a_orig = PIN->a;
PIN->es_orig = PIN->es;
PIN->e = sqrt(PIN->es);
PIN->ra = 1. / PIN->a;
PIN->one_es = 1. - PIN->es;
if (PIN->one_es == 0.) { pj_ctx_set_errno( ctx, -6 ); goto bum_call; }
PIN->rone_es = 1./PIN->one_es;
/* Now that we have ellipse information check for WGS84 datum */
if( PIN->datum_type == PJD_3PARAM
&& PIN->datum_params[0] == 0.0
&& PIN->datum_params[1] == 0.0
&& PIN->datum_params[2] == 0.0
&& PIN->a == 6378137.0
&& ABS(PIN->es - 0.006694379990) < 0.000000000050 )/*WGS84/GRS80*/
{
PIN->datum_type = PJD_WGS84;
}
/* set PIN->geoc coordinate system */
PIN->geoc = (PIN->es && pj_param(ctx, start, "bgeoc").i);
/* over-ranging flag */
PIN->over = pj_param(ctx, start, "bover").i;
/* vertical datum geoid grids */
PIN->has_geoid_vgrids = pj_param(ctx, start, "tgeoidgrids").i;
if( PIN->has_geoid_vgrids ) /* we need to mark it as used. */
pj_param(ctx, start, "sgeoidgrids");
/* longitude center for wrapping */
PIN->is_long_wrap_set = pj_param(ctx, start, "tlon_wrap").i;
if (PIN->is_long_wrap_set)
PIN->long_wrap_center = pj_param(ctx, start, "rlon_wrap").f;
/* axis orientation */
if( (pj_param(ctx, start,"saxis").s) != NULL )
{
static const char *axis_legal = "ewnsud";
const char *axis_arg = pj_param(ctx, start,"saxis").s;
if( strlen(axis_arg) != 3 )
{
pj_ctx_set_errno( ctx, PJD_ERR_AXIS );
goto bum_call;
}
if( strchr( axis_legal, axis_arg[0] ) == NULL
|| strchr( axis_legal, axis_arg[1] ) == NULL
|| strchr( axis_legal, axis_arg[2] ) == NULL)
{
pj_ctx_set_errno( ctx, PJD_ERR_AXIS );
goto bum_call;
}
/* it would be nice to validate we don't have on axis repeated */
strcpy( PIN->axis, axis_arg );
}
PIN->is_long_wrap_set = pj_param(ctx, start, "tlon_wrap").i;
if (PIN->is_long_wrap_set)
PIN->long_wrap_center = pj_param(ctx, start, "rlon_wrap").f;
/* central meridian */
PIN->lam0=pj_param(ctx, start, "rlon_0").f;
/* central latitude */
PIN->phi0 = pj_param(ctx, start, "rlat_0").f;
/* false easting and northing */
PIN->x0 = pj_param(ctx, start, "dx_0").f;
PIN->y0 = pj_param(ctx, start, "dy_0").f;
/* general scaling factor */
if (pj_param(ctx, start, "tk_0").i)
PIN->k0 = pj_param(ctx, start, "dk_0").f;
else if (pj_param(ctx, start, "tk").i)
PIN->k0 = pj_param(ctx, start, "dk").f;
else
PIN->k0 = 1.;
if (PIN->k0 <= 0.) {
pj_ctx_set_errno( ctx, -31 );
goto bum_call;
}
/* set units */
s = 0;
if ((name = pj_param(ctx, start, "sunits").s) != NULL) {
for (i = 0; (s = pj_units[i].id) && strcmp(name, s) ; ++i) ;
if (!s) { pj_ctx_set_errno( ctx, -7 ); goto bum_call; }
s = pj_units[i].to_meter;
}
if (s || (s = pj_param(ctx, start, "sto_meter").s)) {
PIN->to_meter = strtod(s, &s);
if (*s == '/') /* ratio number */
PIN->to_meter /= strtod(++s, 0);
PIN->fr_meter = 1. / PIN->to_meter;
} else
PIN->to_meter = PIN->fr_meter = 1.;
/* set vertical units */
s = 0;
if ((name = pj_param(ctx, start, "svunits").s) != NULL) {
for (i = 0; (s = pj_units[i].id) && strcmp(name, s) ; ++i) ;
if (!s) { pj_ctx_set_errno( ctx, -7 ); goto bum_call; }
s = pj_units[i].to_meter;
}
if (s || (s = pj_param(ctx, start, "svto_meter").s)) {
PIN->vto_meter = strtod(s, &s);
if (*s == '/') /* ratio number */
PIN->vto_meter /= strtod(++s, 0);
PIN->vfr_meter = 1. / PIN->vto_meter;
} else {
PIN->vto_meter = PIN->to_meter;
PIN->vfr_meter = PIN->fr_meter;
}
/* prime meridian */
s = 0;
if ((name = pj_param(ctx, start, "spm").s) != NULL) {
const char *value = NULL;
char *next_str = NULL;
for (i = 0; pj_prime_meridians[i].id != NULL; ++i )
{
if( strcmp(name,pj_prime_meridians[i].id) == 0 )
{
value = pj_prime_meridians[i].defn;
break;
}
}
if( value == NULL
&& (dmstor_ctx(ctx,name,&next_str) != 0.0 || *name == '0')
&& *next_str == '\0' )
value = name;
if (!value) { pj_ctx_set_errno( ctx, -46 ); goto bum_call; }
PIN->from_greenwich = dmstor_ctx(ctx,value,NULL);
}
else
PIN->from_greenwich = 0.0;
/* projection specific initialization */
if (!(PIN = (*proj)(PIN)) || ctx->last_errno) {
bum_call: /* cleanup error return */
if (PIN)
pj_free(PIN);
else
for ( ; start; start = curr) {
curr = start->next;
pj_dalloc(start);
}
PIN = 0;
}
if( strcmp(old_locale,"C") != 0 )
setlocale(LC_NUMERIC,old_locale);
free( (char*)old_locale );
return PIN;
}
int main(int argc, void* argv[])
{
DCMF_Configure_t config;
config.thread_level = DCMF_THREAD_MULTIPLE;
DCMF_Messager_initialize();
DCMF_Messager_configure(&config, &config);
init();
if (nranks != (THREAD_NUM + 1))
{
printf("This test requires only %d processes \n", (THREAD_NUM + 1));
fflush(stdout);
return -1;
}
barrier_init(DCMF_DEFAULT_GLOBALBARRIER_PROTOCOL);
control_init(DCMF_DEFAULT_CONTROL_PROTOCOL, DCMF_DEFAULT_NETWORK);
memregion_init(LOCAL_MAX_BUF_SIZE * THREAD_NUM);
get_init(DCMF_DEFAULT_PUT_PROTOCOL, DCMF_TORUS_NETWORK);
source = (char *) malloc(LOCAL_MAX_BUF_SIZE * THREAD_NUM);
target = (char *) malloc(LOCAL_MAX_BUF_SIZE * THREAD_NUM);
send_init(DCMF_DEFAULT_SEND_PROTOCOL, DCMF_TORUS_NETWORK);
int status;
long i;
if (myrank == 0)
{
pthread_t threads[THREAD_NUM];
pthread_barrier_init(&ptbarrier, NULL, THREAD_NUM);
pthread_barrier_init(&ptbarrier1, NULL, THREAD_NUM);
for (i = 0; i < THREAD_NUM; i++)
{
pthread_create(&threads[i], NULL, mrate_test, (void *) i);
}
for (i = 0; i < THREAD_NUM; i++)
{
pthread_join(threads[i], (void *) &status);
}
}
else
{
snd_rcv_active += LOCAL_ITERATIONS;
while (snd_rcv_active > 0)
DCMF_Messager_advance();
}
barrier();
DCMF_Messager_finalize();
if (myrank == 0)
{
printf("Benchmark Complete \n");
fflush(stdout);
}
return (0);
}
