void field_mapLB(SCM dest, function f, SCM_list src)
{
field_smob *pd = assert_field_smob(dest);
field_smob **ps;
int i, j;
CHK_MALLOC(ps, field_smob *, src.num_items);
for (j = 0; j < src.num_items; ++j) {
ps[j] = assert_field_smob(src.items[j]);
CHECK(fields_conform(pd, ps[j]),
"fields for field-map! must conform");
}
for (i = 0; i < pd->N; ++i) {
list arg_list = SCM_EOL;
SCM result;
for (j = src.num_items - 1; j >= 0; --j) {
SCM item = SCM_EOL;
switch (ps[j]->type) {
case RSCALAR_FIELD_SMOB:
item = ctl_convert_number_to_scm(ps[j]->f.rs[i]);
break;
case CSCALAR_FIELD_SMOB:
item = cnumber2scm(cscalar2cnumber(ps[j]->f.cs[i]));
break;
case CVECTOR_FIELD_SMOB:
item =
cvector32scm(cscalar32cvector3(ps[j]->f.cv+3*i));
break;
}
arg_list = gh_cons(item, arg_list);
}
result = gh_apply(f, arg_list);
switch (pd->type) {
case RSCALAR_FIELD_SMOB:
pd->f.rs[i] = ctl_convert_number_to_c(result);
break;
case CSCALAR_FIELD_SMOB:
pd->f.cs[i] = cnumber2cscalar(scm2cnumber(result));
break;
case CVECTOR_FIELD_SMOB:
cvector32cscalar3(pd->f.cv+3*i, scm2cvector3(result));
break;
}
}
if (src.num_items == 1 && ps[0]->type == pd->type)
pd->type_char = ps[0]->type_char;
else if (src.num_items > 1)
switch (pd->type) {
case RSCALAR_FIELD_SMOB:
pd->type_char = 'R';
break;
case CSCALAR_FIELD_SMOB:
pd->type_char = 'C';
break;
case CVECTOR_FIELD_SMOB:
pd->type_char = 'c';
break;
}
free(ps);
update_curfield(pd);
}
SCM tortoise_move(SCM s_steps)
{
double oldX = currentX;
double oldY = currentY;
double newX, newY;
double steps;
SCM_ASSERT(SCM_NUMBERP(s_steps), s_steps, SCM_ARG1, "tortoise-move");
//steps = SCM_NUM2DOUBLE(s_steps);
steps = scm_to_double(s_steps);
/* first work out the new endpoint */
newX = currentX + sin(currentDirection*DEGREES_TO_RADIANS) * steps;
newY = currentY - cos(currentDirection*DEGREES_TO_RADIANS) * steps;
/* if the pen is down, draw a line */
if (penDown)
XDrawLine(theDisplay, theWindow, theGC,
(int)currentX, (int)currentY,
(int)newX, (int)newY);
/* in either case, move the tortoise */
currentX = newX;
currentY = newY;
return gh_cons(gh_double2scm(oldX), gh_cons(gh_double2scm(oldY), SCM_EOL));
}
SCM
gconf_value_to_scm(GConfValue* val)
{
SCM retval = SCM_EOL;
if (val == NULL)
return SCM_EOL;
switch (val->type)
{
case GCONF_VALUE_INVALID:
/* EOL */
break;
case GCONF_VALUE_STRING:
retval = gh_str02scm(gconf_value_get_string(val));
break;
case GCONF_VALUE_INT:
retval = gh_int2scm(gconf_value_get_int(val));
break;
case GCONF_VALUE_FLOAT:
retval = gh_double2scm(gconf_value_get_float(val));
break;
case GCONF_VALUE_BOOL:
retval = gh_bool2scm(gconf_value_get_bool(val));
break;
case GCONF_VALUE_SCHEMA:
/* FIXME this is more complicated, we need a smob or something */
break;
case GCONF_VALUE_LIST:
/* FIXME This is complicated too... */
break;
case GCONF_VALUE_PAIR:
retval = gh_cons(gconf_value_to_scm(gconf_value_get_car(val)),
gconf_value_to_scm(gconf_value_get_cdr(val)));
break;
default:
g_warning("Unhandled type in %s", G_STRFUNC);
break;
}
return retval;
}
/* Compute the integral of f(r, {fields}) over the cell. */
cnumber integrate_fieldL(function f, SCM_list fields)
{
int i, j, k, n1, n2, n3, n_other, n_last, rank, last_dim;
#ifdef HAVE_MPI
int local_n2, local_y_start, local_n3;
#endif
real s1, s2, s3, c1, c2, c3;
int ifield;
field_smob **pf;
cnumber integral = {0,0};
CHK_MALLOC(pf, field_smob *, fields.num_items);
for (ifield = 0; ifield < fields.num_items; ++ifield) {
pf[ifield] = assert_field_smob(fields.items[ifield]);
CHECK(fields_conform(pf[0], pf[ifield]),
"fields for integrate-fields must conform");
}
if (fields.num_items > 0) {
n1 = pf[0]->nx; n2 = pf[0]->ny; n3 = pf[0]->nz;
n_other = pf[0]->other_dims;
n_last = pf[0]->last_dim_size
/ (sizeof(scalar_complex)/sizeof(scalar));
last_dim = pf[0]->last_dim;
}
else {
n1 = mdata->nx; n2 = mdata->ny; n3 = mdata->nz;
n_other = mdata->other_dims;
n_last = mdata->last_dim_size
/ (sizeof(scalar_complex)/sizeof(scalar));
last_dim = mdata->last_dim;
}
rank = (n3 == 1) ? (n2 == 1 ? 1 : 2) : 3;
s1 = geometry_lattice.size.x / n1;
s2 = geometry_lattice.size.y / n2;
s3 = geometry_lattice.size.z / n3;
c1 = n1 <= 1 ? 0 : geometry_lattice.size.x * 0.5;
c2 = n2 <= 1 ? 0 : geometry_lattice.size.y * 0.5;
c3 = n3 <= 1 ? 0 : geometry_lattice.size.z * 0.5;
/* Here we have different loops over the coordinates, depending
upon whether we are using complex or real and serial or
parallel transforms. Each loop must define, in its body,
variables (i2,j2,k2) describing the coordinate of the current
point, and "index" describing the corresponding index in
the curfield array.
This was all stolen from maxwell_eps.c...it would be better
if we didn't have to cut and paste, sigh. */
#ifdef SCALAR_COMPLEX
# ifndef HAVE_MPI
for (i = 0; i < n1; ++i)
for (j = 0; j < n2; ++j)
for (k = 0; k < n3; ++k)
{
int i2 = i, j2 = j, k2 = k;
int index = ((i * n2 + j) * n3 + k);
# else /* HAVE_MPI */
if (fields.num_items > 0) {
local_n2 = pf[0]->local_ny;
local_y_start = pf[0]->local_y_start;
}
else {
local_n2 = mdata->local_ny;
local_y_start = mdata->local_y_start;
}
/* first two dimensions are transposed in MPI output: */
for (j = 0; j < local_n2; ++j)
for (i = 0; i < n1; ++i)
for (k = 0; k < n3; ++k)
{
int i2 = i, j2 = j + local_y_start, k2 = k;
int index = ((j * n1 + i) * n3 + k);
# endif /* HAVE_MPI */
#else /* not SCALAR_COMPLEX */
# ifndef HAVE_MPI
for (i = 0; i < n_other; ++i)
for (j = 0; j < n_last; ++j)
{
int index = i * n_last + j;
int i2, j2, k2;
switch (rank) {
case 2: i2 = i; j2 = j; k2 = 0; break;
case 3: i2 = i / n2; j2 = i % n2; k2 = j; break;
default: i2 = j; j2 = k2 = 0; break;
}
# else /* HAVE_MPI */
if (fields.num_items > 0) {
local_n2 = pf[0]->local_ny;
local_y_start = pf[0]->local_y_start;
}
else {
local_n2 = mdata->local_ny;
local_y_start = mdata->local_y_start;
}
/* For a real->complex transform, the last dimension is cut in
half. For a 2d transform, this is taken into account in local_ny
already, but for a 3d transform we must compute the new n3: */
if (n3 > 1) {
if (fields.num_items > 0)
local_n3 = pf[0]->last_dim_size / 2;
else
local_n3 = mdata->last_dim_size / 2;
}
else
local_n3 = 1;
/* first two dimensions are transposed in MPI output: */
for (j = 0; j < local_n2; ++j)
for (i = 0; i < n1; ++i)
for (k = 0; k < local_n3; ++k)
{
# define i2 i
int j2 = j + local_y_start;
# define k2 k
int index = ((j * n1 + i) * local_n3 + k);
# endif /* HAVE_MPI */
#endif /* not SCALAR_COMPLEX */
{
list arg_list = SCM_EOL;
cnumber integrand;
vector3 p;
p.x = i2 * s1 - c1; p.y = j2 * s2 - c2; p.z = k2 * s3 - c3;
for (ifield = fields.num_items - 1; ifield >= 0; --ifield) {
SCM item = SCM_EOL;
switch (pf[ifield]->type) {
case RSCALAR_FIELD_SMOB:
item = ctl_convert_number_to_scm(pf[ifield]->f.rs[index]);
break;
case CSCALAR_FIELD_SMOB:
item = cnumber2scm(cscalar2cnumber(
pf[ifield]->f.cs[index]));
break;
case CVECTOR_FIELD_SMOB:
item = cvector32scm(cscalar32cvector3(
pf[ifield]->f.cv+3*index));
break;
}
arg_list = gh_cons(item, arg_list);
}
arg_list = gh_cons(vector32scm(p), arg_list);
integrand = ctl_convert_cnumber_to_c(gh_apply(f, arg_list));
integral.re += integrand.re;
integral.im += integrand.im;
#ifndef SCALAR_COMPLEX
{
int last_index;
# ifdef HAVE_MPI
if (n3 == 1)
last_index = j + local_y_start;
else
last_index = k;
# else
last_index = j;
# endif
if (last_index != 0 && 2*last_index != last_dim) {
int i2c, j2c, k2c;
i2c = i2 ? (n1 - i2) : 0;
j2c = j2 ? (n2 - j2) : 0;
k2c = k2 ? (n3 - k2) : 0;
p.x = i2c * s1 - c1;
p.y = j2c * s2 - c2;
p.z = k2c * s3 - c3;
arg_list = SCM_EOL;
for (ifield = fields.num_items - 1;
ifield >= 0; --ifield) {
SCM item = SCM_UNDEFINED;
switch (pf[ifield]->type) {
case RSCALAR_FIELD_SMOB:
item = ctl_convert_number_to_scm(
pf[ifield]->f.rs[index]);
break;
case CSCALAR_FIELD_SMOB:
item = cnumber2scm(cscalar2cnumber(
pf[ifield]->f.cs[index]));
break;
case CVECTOR_FIELD_SMOB:
item = cvector32scm(
cvector3_conj(cscalar32cvector3(
pf[ifield]->f.cv+3*index)));
break;
}
arg_list = gh_cons(item, arg_list);
}
arg_list = gh_cons(vector32scm(p), arg_list);
integrand =
ctl_convert_cnumber_to_c(gh_apply(f, arg_list));
integral.re += integrand.re;
integral.im += integrand.im;
}
}
#endif
}
}
free(pf);
integral.re *= Vol / (n1 * n2 * n3);
integral.im *= Vol / (n1 * n2 * n3);
{
cnumber integral_sum;
mpi_allreduce(&integral, &integral_sum, 2, number,
MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
return integral_sum;
}
}
