/*
 * © Copyright 1996-2017 ECMWF.
 *
 * This software is licensed under the terms of the Apache Licence Version 2.0
 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
 * In applying this licence, ECMWF does not waive the privileges and immunities
 * granted to it by virtue of its status as an intergovernmental organisation nor
 * does it submit to any jurisdiction.
 */

/*

   B.Raoult
   ECMWF Oct-93

 */


#include "mars.h"
#include <math.h>
#include <errno.h>
#include <signal.h>
#include <ctype.h>
#include <stdlib.h>


static boolean comperr;
static char* form = NULL;

static math *readpower(void);
static math *readatom(void);
static math *readfactor(void);
static math *readterm(void);
static math *readtest(void);
static math *readlist(int*);
static void advance(void);

typedef real (*fop1)(real);
typedef real (*fop2)(real,real);


#ifdef notCRAY

#define BI_FUNC(a,b)	(a)+(b)
#define BI_NAME         v_add
#include "calc.h"

#define BI_FUNC(a,b)	(a)-(b)
#define BI_NAME         v_sub
#include "calc.h"

#define BI_FUNC(a,b)	(a)+(b)
#define BI_NAME         v_mul
#include "calc.h"

#define BI_FUNC(a,b)	(a)/(b)
#define BI_NAME         v_div
#include "calc.h"


#endif

/* save every 10 fields */
#define SAVE_CNT 10

static int merr = 0;


static real b_max(real a,real b) {
	return a>b?a:b;
}

static real b_min(real a,real b) {
	return a<b?a:b;
}

static real b_add(real a,real b) {
	return a+b;
}
static real b_sub(real a,real b) {
	return a-b;
}
static real b_div(real a,real b) {
	return a/b;
}
static real b_mul(real a,real b) {
	return a*b;
}

static real b_pow(real a,real b) {
	return pow(a,b);
}

static real b_mod(real a,real b) {
	return (long)a % (long)b;
}

static real b_idiv(real a,real b) {
	return (long)a / (long)b;
}

static real b_eq(real a,real b) {
	return (real)(a == b);
}

static real b_ne(real a,real b) {
	return (real)(a != b);
}

static real b_ge(real a,real b) {
	return (real)(a >= b);
}

static real b_gt(real a,real b) {
	return (real)(a > b);
}


static real b_le(real a,real b) {
	return (real)(a <= b);
}

static real b_lt(real a,real b) {
	return (real)(a < b);
}

static real b_and(real a,real b) {
	return (real)((a != 0)  &&  (b != 0));
}

static real b_or(real a,real b) {
	return (real)((a != 0)  ||  (b != 0));
}

static real m_sgn(real a)
{
	if(a>0.0) return  1.0;
	if(a<0.0) return -1.0;
	return 0;
}

static real m_int(real a)
{
	return (long)a;
}

static real m_neg(real a)
{
	return -a;
}

static real m_not(real a)
{
	/* return 1.0-(a != 0.0) ; */
	if(a != 0.0)
		return 0.0;
	else
		return 1.0;
}

static err f_count(math *p,void *data)
{
	variable *v = pop();
	if(!v) return -1;
	marslog(LOG_DBUG,"f_count");
	if(v->scalar) return push_scalar(0.0);
	return push_scalar(v->fs->count);
}

static err f_v_minmax(math *p,fop2 f)
{
	int i,j;
	variable *v = pop();
	real m;
	field *g;
	char formula[10240];

	if(!v) return -1;

	marslog(LOG_DBUG,"f_v_minmax: %s",p->name);

	sprintf(formula,"%s(%s)",p->name,v->name);

	if(v->scalar) return push_named_scalar(strcache(formula),v->val);

	g = get_nonmissing_field(v->fs,expand_mem);
	if(MISSING_FIELD(g))
	{
		inform_missing_fieldset(v->name);
		marslog(LOG_EROR,"Cannot continue COMPUTE of '%s'",formula);
		return -1;
	}
	else
	{
		m = g->values[0];
		if(FIELD_HAS_MISSING_VALS(g)) {
			int i = 0;
			while(MISSING_VALUE(m) && i != g->value_count)
				m = g->values[i++];
		}

		release_field(g);

		for(i=0;i<v->fs->count;i++)
		{
			field *g = get_field(v->fs,i,expand_mem);

			if(! MISSING_FIELD(g))
			{
				if(FIELD_HAS_MISSING_VALS(g))
				{
					for(j=0;j<g->value_count;j++)
						if( ! MISSING_VALUE(g->values[j]))
							m = f(m,g->values[j]);
				}
				else
					for(j=0;j<g->value_count;j++)
						m = f(m,g->values[j]);
			}


			release_field(g);
		}
	}
	return push_named_scalar(strcache(formula),m);
}

static err unop(math *p,fop1 f)
{
	variable *va;
	fieldset *vc;
	int i,j;
	char formula[10240];
	err e = NOERR;

	marslog(LOG_DBUG,"unop : %s ",p->name);

	if(!(va = pop()))
		return -1;

	sprintf(formula,"%s(%s)",p->name,va->name);

	if(va->scalar)
		return push_named_scalar(strcache(formula),f(va->val));

	vc     = new_fieldset(va->fs->count);

	for(i=0;i<va->fs->count;i++)
	{
		field *ga = get_field(va->fs,i,expand_mem);
		field *gc;

		if(MISSING_FIELD(ga))
		{
			gc = copy_field(ga,true);
		}
		else
		{
			gc = copy_field(ga,false);
			for(j=0;j<ga->value_count;j++)
				gc->values[j] = f(ga->values[j]);
			copy_missing_vals(gc,ga,0);
		}

		set_field(vc,gc,i);
		if( ((i+1) % SAVE_CNT) == 0)
			e = e | save_fieldset(vc);

		release_field(ga);

	}

	e = e | push_named_fieldset(strcache(formula),vc);
	return e;

}

static err binop(math *p,fop2 f)
{
	variable *va,*vb;
	fieldset *vc;
	int i,j;
	char formula[10240];
	int missing = 0;
	err e = NOERR;

	marslog(LOG_DBUG,"binop : %s ",p->name);

	if(!(vb = pop()))
		return -1;

	if(!(va = pop()))
		return -1;

	sprintf(formula,"%s %s %s",va->name,p->name,vb->name);

	if(va->scalar && vb->scalar)
		return push_named_scalar(strcache(formula),f(va->val,vb->val));

	if(va->scalar)
	{
		real x = va->val;
		vc     = new_fieldset(vb->fs->count);

		for(i=0;i<vb->fs->count;i++)
		{
			field *gb = get_field(vb->fs,i,expand_mem);
			field *gc ;


			if(MISSING_FIELD(gb))
			{
				gc = copy_field(gb,true);
				missing++;
			}
			else
			{
				gc = copy_field(gb,false);
				for(j=0;j<gb->value_count;j++)
					gc->values[j] = f(x,gb->values[j]);
				copy_missing_vals(gc,0,gb);
			}

			set_field(vc,gc,i);

			if( ((i+1) % SAVE_CNT) == 0)
				e = e | save_fieldset(vc);

			release_field(gb);
		}
		if(missing == vb->fs->count)
		{
			inform_missing_fieldset(vb->name);
			marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		}
		e = e | push_named_fieldset(strcache(formula),vc);
		return e;
	}

	if(vb->scalar)
	{
		real x = vb->val;
		vc     = new_fieldset(va->fs->count);

		for(i=0;i<va->fs->count;i++)
		{
			field *ga = get_field(va->fs,i,expand_mem);
			field *gc;

			if(MISSING_FIELD(ga))
			{
				gc = copy_field(ga,true);
				missing++;
			}
			else
			{
				gc = copy_field(ga,false);
				for(j=0;j<ga->value_count;j++)
					gc->values[j] = f(ga->values[j],x);
				copy_missing_vals(gc,ga,0);
			}

			set_field(vc,gc,i);
			if( ((i+1) % SAVE_CNT) == 0)
				e = e | save_fieldset(vc);

			release_field(ga);
		}
		if(missing == va->fs->count)
		{
			inform_missing_fieldset(va->name);
			marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		}
		e = e | push_named_fieldset(strcache(formula),vc);
		return e;
	}

	if(va->fs->count != vb->fs->count)
	{
		marslog(LOG_EROR,
				"compute: function '%s' need the same number of fields",
				p->name);
		return -1;
	}

	vc  = new_fieldset(va->fs->count);
	for(i=0;i<va->fs->count;i++)
	{
		field *ga = get_field(va->fs,i,expand_mem);
		field *gb = get_field(vb->fs,i,expand_mem);
		field *gc;

		if(ga->value_count != gb->value_count)
		{
			marslog(LOG_EROR,
					"compute: function '%s' need the same number of grid points",
					p->name);
			return -1;
		}

		if(MISSING_FIELD(ga))
		{
			gc = copy_field(ga,true);
			missing++;
		}
		else if(MISSING_FIELD(gb))
		{
			gc = copy_field(gb,true);
			missing++;
		}
		else
		{
			gc = copy_field(ga,false);

			for(j=0;j<ga->value_count;j++)
				gc->values[j] = f(ga->values[j],gb->values[j]);

			copy_missing_vals(gc,ga,gb);
		}

		set_field(vc,gc,i);
		if( ((i+1) % SAVE_CNT) == 0)
			e = e | save_fieldset(vc);

		release_field(ga);
		release_field(gb);

	}
	if(missing == va->fs->count)
	{
		inform_missing_fieldset(formula);
	}
	e = e | push_named_fieldset(strcache(formula),vc);
	return e;

}

static err f_sum(math *p,void *data)
{
	variable *vin;
	fieldset *vout;
	int i,j;
	field *gin,*gout;
	char formula[10240];

	marslog(LOG_DBUG,"f_sum");

	if(!(vin = pop()))
		return -1;

	if(vin->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}

	sprintf(formula,"%s(%s)",p->name,vin->name);

	vout = new_fieldset(1);

	gin  = get_nonmissing_field(vin->fs,expand_mem);
	if(MISSING_FIELD(gin))
	{
		gout = copy_field(gin,true);
		release_field(gin);
		inform_missing_fieldset(vin->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
	}
	else
	{
		gout = copy_field(gin,false);
		for(j=0;j<gin->value_count;j++)
			gout->values[j] = 0;
		release_field(gin);

		for(i=0;i<vin->fs->count;i++)
		{
			gin  = get_field(vin->fs,i,expand_mem);

			if(! MISSING_FIELD(gin))
				for(j=0;j<gin->value_count;j++)
					gout->values[j] += gin->values[j];

			copy_missing_vals(gout,gin,0);
			release_field(gin);

		}
	}

	set_field(vout,gout,0);
	return push_named_fieldset(strcache(formula),vout);

}

static err f_mean(math *p,void *data)
{
	variable *vin;
	fieldset *vout;
	int i,j;
	field *gin,*gout;
	int missing = 0;
	char formula[10240];
	err e = 0;

	marslog(LOG_DBUG,"f_mean");

	if(!(vin = pop()))
		return -1;

	if(vin->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}

	sprintf(formula,"%s(%s)",p->name,vin->name);
	vout = new_fieldset(1);

	gin  = get_nonmissing_field(vin->fs,expand_mem);
	if(MISSING_FIELD(gin))
	{
		gout = copy_field(gin,true);
		release_field(gin);
		inform_missing_fieldset(vin->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
	}
	else
	{
		gout = copy_field(gin,false);
		for(j=0;j<gin->value_count;j++)
			gout->values[j] = 0;
		release_field(gin);

		for(i=0;i<vin->fs->count && e == 0;i++)
		{
			gin  = get_field(vin->fs,i,expand_mem);

			if(! MISSING_FIELD(gin))
			{
				if(gin->value_count != gout->value_count)
				{
					marslog(LOG_EROR,
							"compute: function '%s', not all fields have the same number of values ",
							p->name);
					e = -1;
				}
				else
					for(j=0;j<gin->value_count;j++)
						gout->values[j] += gin->values[j];
			}
			else
				missing++;

			if(e == 0)
				copy_missing_vals(gout,gin,0);
			release_field(gin);

		}

		for(j=0;j<gout->value_count;j++)
			if( ! MISSING_VALUE(gout->values[j]))
				gout->values[j] /= (vin->fs->count - missing);
	}

	set_field(vout,gout,0);
	return e ? e : push_named_fieldset(strcache(formula),vout);

}

static err f_rms(math *p,void *data)
{
	variable *vin;
	fieldset *vout;
	int i,j;
	field *gin,*gout;
	int missing = 0;
	char formula[10240];

	marslog(LOG_DBUG,"f_rms");

	if(!(vin = pop()))
		return -1;

	if(vin->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}
	sprintf(formula,"%s(%s)",p->name,vin->name);
	vout = new_fieldset(1);

	gin  = get_nonmissing_field(vin->fs,expand_mem);
	if(MISSING_FIELD(gin))
	{
		gout = copy_field(gin,true);
		release_field(gin);
		inform_missing_fieldset(vin->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
	}
	else
	{
		gout = copy_field(gin,false);

		for(j=0;j<gin->value_count;j++)
			gout->values[j] = 0;

		release_field(gin);


		for(i=0;i<vin->fs->count;i++)
		{
			gin  = get_field(vin->fs,i,expand_mem);

			if(! MISSING_FIELD(gin))
				for(j=0;j<gin->value_count;j++)
					gout->values[j] += (gin->values[j]*gin->values[j]);
			else
				missing++;

			copy_missing_vals(gout,gin,0);
			release_field(gin);

		}

		for(j=0;j<gout->value_count;j++)
			if( ! MISSING_VALUE(gout->values[j]))
			{
				gout->values[j] /= (vin->fs->count - missing);
				gout->values[j]  = sqrt(gout->values[j]);
			}
	}

	set_field(vout,gout,0);
	return push_named_fieldset(strcache(formula),vout);

}

static err f_minmax(math *p,fop2 f)
{
	variable *vin;
	fieldset *vout;
	int i,j;
	field *gin,*gout;
	char formula[10240];

	marslog(LOG_DBUG,"f_minmax");

	if(p->arity == 1)
	{
		if(!(vin = pop()))
			return -1;

		if(vin->scalar)
		{
			marslog(LOG_EROR,
					"compute: function '%s' works only on fields",p->name);
			return -1;
		}
		sprintf(formula,"%s(%s)",p->name,vin->name);
		vout = new_fieldset(1);

		gin  = get_nonmissing_field(vin->fs,expand_mem);
		gout = copy_field(gin,true);
		release_field(gin);

		if(MISSING_FIELD(gout))
		{
			inform_missing_fieldset(vin->name);
			marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		}
		else
			for(i=0;i<vin->fs->count;i++)
			{
				gin  = get_field(vin->fs,i,expand_mem);

				if(! MISSING_FIELD(gin))
				{
					if(FIELD_HAS_MISSING_VALS(gin) || FIELD_HAS_MISSING_VALS(gout))
					{
						for(j=0;j<gin->value_count;j++)
							if( ! (MISSING_VALUE(gin->values[j]) || MISSING_VALUE(gout->values[j])) )
								gout->values[j] = f(gin->values[j],gout->values[j]);
						copy_missing_vals(gout,gin,0);

					}
					for(j=0;j<gin->value_count;j++)
						gout->values[j] = f(gin->values[j],gout->values[j]);
				}

				release_field(gin);

			}

		set_field(vout,gout,0);
		return push_named_fieldset(strcache(formula),vout);
	}
	else {
		int n = p->arity-1;
		int m = 0;
		fieldset *fs = 0;
		err e;
		while(n--) {

			variable *v = stack_top();
			fs = v->scalar?0:v->fs;

			if( (e = binop(p,f)) )
				return e;

			if(m && n && fs)
				free_fieldset(fs);

			m++;

		}
		if(p->arity>2 && fs) free_fieldset(fs);
		return NOERR;
	}

}

static int cmp_double(const void *a, const void *b)
{
	double x =  *(double*)a;
	double y =  *(double*)b;

	if(x == y)
		return 0;

	if(x < y)
		return -1;

	return 1;
}

static err f_distribution(math *p,void *data)
{
	variable *v;
	int cnt = p->arity;
	int i,j,k;
	int size = 0;
	int n;
	field **g;
	err e = 0;
	fieldset *w;
	double *tmp;


	marslog(LOG_DBUG,"f_distribution");

	if(cnt != 1 && cnt != 2)
	{
		marslog(LOG_EROR,
				"compute: function '%s' needs one or two arguments",p->name);
		return -1;
	}

	if(!(v = pop()))
		return -1;

	if(cnt == 2)
	{
		if(!v->scalar)
		{
			marslog(LOG_EROR,
					"compute: function '%s' second argument must be a scalar",p->name);
			return -1;
		}

		size = v->val;
		if(!(v = pop()))
			return -1;

	}

	if(v->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' first argument must be a field",p->name);
		return -1;
	}

	if(cnt == 1)
		size = v->fs->count;

	if(size < 1)
	{
		marslog(LOG_EROR,
				"compute: function '%s', invalid size %d",p->name,size);
		return -1;
	}

	if((v->fs->count/size)*size != v->fs->count)
	{
		marslog(LOG_EROR,
				"compute: function '%s', invalid size %d, fieldset is %d long",
				p->name,size,v->fs->count);
		return -1;
	}

	w = new_fieldset(v->fs->count);
	g = NEW_ARRAY_CLEAR(field*,size);
	tmp = NEW_ARRAY_CLEAR(double,size);
	n = 0;

	for(i = 0,n = 0; i < v->fs->count/size ; i++, n+=size)
	{
		int count = 0;
		int bitmap = 0;
		for(j = 0; j < size ; j++)
		{
			field *f = get_field(v->fs,n+j,expand_mem);

			if(MISSING_FIELD(f))
			{
				marslog(LOG_EROR,
						"compute: function '%s', field %d is missing",p->name,n+j+1);
				e = -1;
			}

			if(FIELD_HAS_MISSING_VALS(f))
				bitmap++;

			if(count && count != f->value_count)
			{
				marslog(LOG_EROR,
						"compute: function '%s', not all fields have the same number of values ",
						p->name);
			}
			count = f->value_count;

			g[j] = copy_field(f,true);
			set_field(w,g[j],n+j);
			release_field(f);
		}

		if(bitmap)
			for(j = 0; j < size ; j++)
				set_bitmap(g[j]);



		for(k = 0; k < count ; k++)
		{
			for(j = 0; j < size ; j++)
				tmp[j] = g[j]->values[k];

			qsort(tmp,size,sizeof(double),cmp_double);

			for(j = 0; j < size ; j++)
				g[j]->values[k] = tmp[j];

			if(bitmap) {
				int ok = 0;
				for(j = 0; j < size ; j++)
					if(MISSING_VALUE(tmp[j]))
						ok++;

				if(ok)
					for(j = 0; j < size ; j++)
						g[j]->values[k]  = mars.grib_missing_value;


			}

		}


		save_fieldset(w);


	}
	FREE(g);
	FREE(tmp);

	return e ? e : push_fieldset(w);

}

static err f_merge(math *p,void *data)
{
	variable *v;
	fieldset *z;
	fieldset *w = NULL;
	int cnt = p->arity;


	marslog(LOG_DBUG,"f_merge");

	if(cnt < 2)
	{
		marslog(LOG_EROR,
				"compute: function '%s' needs at least two arguments",p->name);
		return -1;
	}

	while(cnt--)
	{

		if(!(v = pop())) return -1;

		if(v->scalar) {
			marslog(LOG_EROR,
					"compute: function '%s' works only on fields",p->name);
			return -1;
		}

		z = w;
		w = merge_fieldsets(v->fs,w);
		if(z) free_fieldset(z);
	}

	return push_fieldset(w);

}

static err f_stdev(math *p,void *data)
{
	variable *vin;
	fieldset *vout;
	int i,j;
	field *gin,*gout;
	double *x;
	double *y;
	double d;
	int missing = 0;
	char formula[10240];


	marslog(LOG_DBUG,"f_stdev");

	if(!(vin = pop()))
		return -1;

	if(vin->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}

	sprintf(formula,"%s(%s)",p->name,vin->name);

	vout = new_fieldset(1);

	gin  = get_nonmissing_field(vin->fs,expand_mem);
	if(MISSING_FIELD(gin))
	{
		gout = copy_field(gin,true);
		release_field(gin);
		inform_missing_fieldset(vin->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
	}
	else
	{
		gout = copy_field(gin,false);

		x = NEW_ARRAY_CLEAR(double,gin->value_count);
		y = NEW_ARRAY_CLEAR(double,gin->value_count);

		for(j=0;j<gin->value_count;j++)
			gout->values[j] = 0;

		release_field(gin);


		for(i=0;i<vin->fs->count;i++)
		{
			gin  = get_field(vin->fs,i,expand_mem);


			if( ! MISSING_FIELD(gin))
				for(j=0;j<gin->value_count;j++)
				{
					x[j] += gin->values[j];
					y[j] += (gin->values[j]*gin->values[j]);
				}
			else
				missing++;

			copy_missing_vals(gout,gin,0);
			release_field(gin);

		}

		for(j=0;j<gout->value_count;j++)
			if( ! MISSING_VALUE(gout->values[j]))
			{
				x[j]     /= (vin->fs->count - missing);
				y[j]     /= (vin->fs->count - missing);
				d         = y[j] - x[j]*x[j];
				if(d<0) d = 0;

				gout->values[j] = sqrt(d);
			}

		FREE(x);
		FREE(y);
	}

	set_field(vout,gout,0);
	return push_named_fieldset(strcache(formula),vout);

}

static err f_var(math *p,void *data)
{
	variable *vin;
	fieldset *vout;
	int i,j;
	field *gin,*gout;
	double *x;
	int missing = 0;
	char formula[10240];

	marslog(LOG_DBUG,"f_var");

	if(!(vin = pop()))
		return -1;

	if(vin->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}

	sprintf(formula,"%s(%s)",p->name,vin->name);
	vout = new_fieldset(1);

	gin  = get_nonmissing_field(vin->fs,expand_mem);
	if(MISSING_FIELD(gin))
	{
		gout = copy_field(gin,true);
		release_field(gin);
		inform_missing_fieldset(vin->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
	}
	else
	{
		gout = copy_field(gin,false);

		x = NEW_ARRAY_CLEAR(double,gin->value_count);

		for(j=0;j<gin->value_count;j++)
			gout->values[j] = 0;

		release_field(gin);


		for(i=0;i<vin->fs->count;i++)
		{
			gin  = get_field(vin->fs,i,expand_mem);

			if(!gin->missing)
				for(j=0;j<gin->value_count;j++)
				{
					x[j]           += gin->values[j];
					gout->values[j] += (gin->values[j]*gin->values[j]);
				}
			else
				missing++;

			copy_missing_vals(gout,gin,0);

			release_field(gin);

		}

		for(j=0;j<gout->value_count;j++)
			if( ! MISSING_VALUE(gout->values[j]))
			{
				x[j]           /= (vin->fs->count-missing);
				gout->values[j] /= (vin->fs->count-missing);

				gout->values[j] = gout->values[j] - x[j]*x[j];
			}

		FREE(x);

	}
	set_field(vout,gout,0);
	return push_named_fieldset(strcache(formula),vout);

}

/*****************************************************************************

  Co-Variance

 *****************************************************************************/

static err f_covar(math *p,void *data)
{
	variable *vx,*vy;
	fieldset *vout;
	int i,j;
	field *gx,*gy,*gout;
	double *x;
	double *y;
	int missing = 0;
	char formula[10240];

	marslog(LOG_DBUG,"f_covar");

	if(!(vx = pop()))
		return -1;

	if(!(vy = pop()))
		return -1;

	if(vx->scalar || vy->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}

	if(vx->fs->count != vy->fs->count)
	{
		marslog(LOG_EROR,
				"compute: function '%s' need the same number of fields",
				p->name);
		return -1;
	}

	sprintf(formula,"%s %s %s",vx->name,p->name,vy->name);
	vout = new_fieldset(1);

	gx  = get_nonmissing_field(vx->fs,expand_mem);
	gy  = get_nonmissing_field(vy->fs,expand_mem);

	if(gx->value_count != gy->value_count)
	{
		marslog(LOG_EROR,
				"compute: function '%s' need the same number of grid points",
				p->name);
		return -1;
	}

	if(MISSING_FIELD(gx) || MISSING_FIELD(gy))
	{
		copy_field(gx,true);

		if(MISSING_FIELD(gx))
			inform_missing_fieldset(vx->name);
		if(MISSING_FIELD(gy))
			inform_missing_fieldset(vy->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		release_field(gx);
		release_field(gy);
	}
	else
	{
		gout = copy_field(gx,false);

		x  = NEW_ARRAY_CLEAR(double,gx->value_count);
		y  = NEW_ARRAY_CLEAR(double,gy->value_count);

		for(j=0;j<gx->value_count;j++)
			gout->values[j] = 0;
		copy_missing_vals(gout,gx,gy);

		release_field(gx);
		release_field(gy);


		for(i=0;i<vx->fs->count;i++)
		{
			gx  = get_field(vx->fs,i,expand_mem);
			gy  = get_field(vy->fs,i,expand_mem);

			if(gx->value_count != gy->value_count)
			{
				marslog(LOG_EROR,
						"compute: function '%s' need the same number of grid points",
						p->name);
				FREE(x);
				FREE(y);
				return -1;
			}

			if(gx->missing || gy->missing)
				missing++;
			else
				for(j=0;j<gx->value_count;j++)
				{
					x[j]           += gx->values[j];
					y[j]           += gy->values[j];
					gout->values[j] += (gx->values[j] * gy->values[j]);
				}

			copy_missing_vals(gout,gx,gy);

			release_field(gx);
			release_field(gy);

		}

		for(j=0;j<gout->value_count;j++)
			if( ! MISSING_VALUE(gout->values[j]))
			{
				x[j]           /= (vx->fs->count - missing);
				y[j]           /= (vx->fs->count - missing);
				gout->values[j] /= (vx->fs->count - missing);

				gout->values[j] = gout->values[j] - x[j]*y[j];
			}

	}

	FREE(x);
	FREE(y);

	set_field(vout,gout,0);
	return push_named_fieldset(strcache(formula),vout);
}

static err f_rms2(math *p,void *data)
{
	variable *vx,*vy;
	int i,j;
	field *gx,*gy;
	int missing = 0;
	char formula[10240];
	double result = 0;
	int count = 0;

	marslog(LOG_DBUG,"f_rms2");

	if(!(vx = pop()))
		return -1;

	if(!(vy = pop()))
		return -1;

	if(vx->scalar || vy->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' works only on fields",p->name);
		return -1;
	}

	if(vx->fs->count != vy->fs->count)
	{
		marslog(LOG_EROR,
				"compute: function '%s' need the same number of fields",
				p->name);
		return -1;
	}

	if(vx->fs->count != 1)
	{
		marslog(LOG_EROR,
				"compute: function '%s' takes only one field per fieldset",
				p->name);
		return -1;
	}

	sprintf(formula,"%s %s %s",vx->name,p->name,vy->name);

	gx  = get_nonmissing_field(vx->fs,expand_mem);
	gy  = get_nonmissing_field(vy->fs,expand_mem);

	if(gx->value_count != gy->value_count)
	{
		marslog(LOG_EROR,
				"compute: function '%s' need the same number of grid points",
				p->name);
		return -1;
	}

	if(MISSING_FIELD(gx) || MISSING_FIELD(gy))
	{
		copy_field(gx,true);

		if(MISSING_FIELD(gx))
			inform_missing_fieldset(vx->name);
		if(MISSING_FIELD(gy))
			inform_missing_fieldset(vy->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		release_field(gx);
		release_field(gy);
	}
	else
	{
		gx  = get_field(vx->fs,0,expand_mem);
		gy  = get_field(vy->fs,0,expand_mem);

		if(gx->value_count != gy->value_count)
		{
			marslog(LOG_EROR,
					"compute: function '%s' need the same number of grid points",
					p->name);
			return -1;
		}

		if(!gx->missing && !gy->missing)
			for(j=0;j<gx->value_count;j++)
				if(!MISSING_VALUE(gx->values[j]))
					if(!MISSING_VALUE(gy->values[j]))
					{
						double d = gx->values[j] - gy->values[j];
						count++;
						result  += d*d;
					}

		release_field(gx);
		release_field(gy);

	}

	if(count == 0)
	{
		marslog(LOG_EROR, "compute: function '%s' no grid points", p->name);
		return -1;
	}

	return push_scalar(sqrt(result/count));

}

/******************************************************

  x = bitmap(y,n), creates a fieldset 'x' with the same
  number of fields than 'y', setting grib_missing_value
  for those points on 'y' with value n (depending on
  parameter).

  x = bitmap(y,z) [count(y) == count(z)], creates a fieldset 'x', where
  x[i] = bitmap of z[i] applied to y[i].

  x = bitmap(y,z) [count(z) == 1], creates a fieldset 'x', where
  x[i] = bitmap of z applied to y[i].

 *******************************************************/

static err f_bitmap(math *p,void *data)
{
	variable *vx,*vy;
	fieldset *vout;
	field *gx;
	int i,j;
	char formula[10240];
	err e = NOERR;

	marslog(LOG_DBUG,"f_bitmap");

	if(!(vy = pop()))
		return -1;

	if(!(vx = pop()))
		return -1;

	if(vx->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' needs a fieldset as 1st parameter",p->name);
		return -1;
	}

	if(!vy->scalar && (vx->fs->count != vy->fs->count) && (vy->fs->count != 1))
	{
		marslog(LOG_EROR,
				"fieldset %s has %d fields and fieldset %s has %d",
				vx->name,vx->fs->count,vy->name,vy->fs->count);
		return -1;
	}


	sprintf(formula,"%s(%s,%s)",p->name,vx->name,vy->name);
	vout = new_fieldset(1);

	gx = get_nonmissing_field(vx->fs,expand_mem);
	if(MISSING_FIELD(gx))
	{
		field *gout = copy_field(gx,true);
		release_field(gx);
		inform_missing_fieldset(vx->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		set_field(vout,gout,0);
	}
	else 		/* Start function */
	{
		if(vy->scalar)
		{
			/* Second parameter is a scalar */
			for(i=0;i<vx->fs->count;i++)
			{
				field *ga = get_field(vx->fs,i,expand_mem);
				field *gc;
				if(MISSING_FIELD(ga))
					gc = copy_field(ga,true);
				else
				{
					gc = copy_field(ga,true);
					for(j=0;j<ga->value_count;j++)
						if(ga->values[j] == vy->val)
						{
							gc->values[j] = mars.grib_missing_value;
							set_bitmap(gc);
						}
				}
				set_field(vout,gc,i);
				if( ((i+1) % SAVE_CNT) == 0)
					e = e | save_fieldset(vout);

				release_field(ga);
			}
		}
		else if(vx->fs->count == vy->fs->count)
		{
			/* Both fieldsets have the same number of fields */
			for(i=0;i<vx->fs->count;i++)
			{
				field *ga = get_field(vx->fs,i,expand_mem);
				field *gb = get_field(vy->fs,i,expand_mem);
				field *gc;

				if(ga->value_count != gb->value_count)
				{
					marslog(LOG_EROR,
							"compute: function '%s' need the same number of grid points",
							p->name);
					return -1;
				}

				if(MISSING_FIELD(ga))
					gc = copy_field(ga,true);
				else if(MISSING_FIELD(gb))
					gc = copy_field(gb,true);
				else
				{
					gc = copy_field(ga,true);
					if(FIELD_HAS_MISSING_VALS(gb))
						copy_missing_vals(gc,gb,0);
				}

				set_field(vout,gc,i);
				if( ((i+1) % SAVE_CNT) == 0)
					e = e | save_fieldset(vout);

				release_field(ga);
				release_field(gb);
			}
		}
		else
		{
			/* second parameter has 1 field */
			field *gb = get_field(vy->fs,0,expand_mem);
			if(MISSING_FIELD(gb))
			{
				for(i=0;i<vx->fs->count;i++)
				{
					set_field(vout,copy_field(gb,true),i);
					if( ((i+1) % SAVE_CNT) == 0)
						e = e | save_fieldset(vout);
				}
			}
			for(i=0;i<vx->fs->count;i++)
			{
				field *ga = get_field(vx->fs,i,expand_mem);
				field *gc;

				if(MISSING_FIELD(ga))
					gc = copy_field(ga,true);
				else
				{
					if(ga->value_count != gb->value_count)
					{
						marslog(LOG_EROR,
								"compute: function '%s' need the same number of grid points",
								p->name);
						return -1;
					}
					gc = copy_field(ga,true);
					if(FIELD_HAS_MISSING_VALS(gb))
						copy_missing_vals(gc,gb,0);
				}
				set_field(vout,gc,i);
				if( ((i+1) % SAVE_CNT) == 0)
					e = e | save_fieldset(vout);

				release_field(ga);
			}
			release_field(gb);
		}
	}

	e = e | push_named_fieldset(strcache(formula),vout);
	return e;
}

/******************************************************

  x = nobitmap(y,n), creates a fieldset 'x' with the same
  number of fields than 'y', setting n as value
  for those points on 'y' with grib_missing_value
  (i.e., for those points of the bitmap).

 *******************************************************/

static err f_nobitmap(math *p,void *data)
{
	variable *vx,*vy;
	fieldset *vout;
	field *gx;
	int i,j;
	char formula[10240];
	err e = NOERR;

	marslog(LOG_DBUG,"f_bitmap");

	if(!(vy = pop()))
		return -1;

	if(!(vx = pop()))
		return -1;

	if(vx->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' needs a fieldset as 1st parameter",p->name);
		return -1;
	}

	if(!vy->scalar)
	{
		marslog(LOG_EROR,
				"compute: function '%s' needs a scalar as 2nd parameter",p->name);
		return -1;
	}

	sprintf(formula,"%s(%s,%s)",p->name,vx->name,vy->name);
	vout = new_fieldset(1);

	gx = get_nonmissing_field(vx->fs,expand_mem);
	if(MISSING_FIELD(gx))
	{
		field *gout = copy_field(gx,true);
		release_field(gx);
		inform_missing_fieldset(vx->name);
		marslog(LOG_WARN,"COMPUTE of '%s' not done",formula);
		set_field(vout,gout,0);
	}
	else 		/* Start function */
	{
		/* Second parameter is a scalar */
		for(i=0;i<vx->fs->count;i++)
		{
			field *ga = get_field(vx->fs,i,expand_mem);
			field *gc = copy_field(ga,true);
			if(FIELD_HAS_MISSING_VALS(ga))
			{
				for(j=0;j<ga->value_count;j++)
					if(MISSING_VALUE(ga->values[j]))
						gc->values[j] = vy->val;
				remove_bitmap(gc);
			}

			set_field(vout,gc,i);
			if( ((i+1) % SAVE_CNT) == 0)
				e = e | save_fieldset(vout);

			release_field(ga);
		}
	}

	e = e | push_named_fieldset(strcache(formula),vout);
	return e;
}

static err f_duplicate(math *p,void* data)
{
	variable *va,*vb;
	fieldset *vc;
	int i;
	char formula[10240];
	err e = NOERR;
	field *f;


	if(!(vb = pop()))
		return -1;

	if(!(va = pop()))
		return -1;

	sprintf(formula,"%s(%s,%s)",p->name,va->name,vb->name);

	if(!vb->scalar)
	{
		marslog(LOG_EROR, "duplicate: parameter 2 should be a scalar");
		return -1;
	}

	if(va->scalar)
	{
		marslog(LOG_EROR, "duplicate: parameter 1 should be a fieldset");
		return -1;
	}

	if(va->fs->count != 1)
	{
		marslog(LOG_EROR, "duplicate: parameter 1 should be a fieldset with 1 field");
		return -1;
	}

	vc  = new_fieldset(vb->val);
	f   = get_field(va->fs,0,packed_file);

	for(i=0;i<vb->val;i++)
		set_field(vc,f,i);

	release_field(f);
	e = e | push_named_fieldset(strcache(formula),vc);
	return e;

}


static err notimp(math *p)
{
	marslog(LOG_EROR,"Function '%s' not yet implemented",p->name);
	return -1;
}

static func builtins[] = {

#ifdef notCRAY
	{"+",   (funcproc)v_add,(mathproc)NULL,2,},
	{"-",   (funcproc)v_sub,(mathproc)NULL,2,},
	{"*",   (funcproc)v_mul,(mathproc)NULL,2,},
	{"/",   (funcproc)v_div,(mathproc)NULL,2,},
#else
	{"+",   (funcproc)binop,(mathproc)b_add,2,},
	{"-",   (funcproc)binop,(mathproc)b_sub,2,},
	{"*",   (funcproc)binop,(mathproc)b_mul,2,},
	{"/",   (funcproc)binop,(mathproc)b_div,2,},
#endif


	{"^",   (funcproc)binop,(mathproc)b_pow,2,},
	{"=",   (funcproc)binop,(mathproc)b_eq,2,},
	{"<",   (funcproc)binop,(mathproc)b_lt,2,},
	{">",   (funcproc)binop,(mathproc)b_gt,2,},
	{"<=",  (funcproc)binop,(mathproc)b_le,2,},
	{">=",  (funcproc)binop,(mathproc)b_ge,2,},
	{"<>",  (funcproc)binop,(mathproc)b_ne,2,},
	{"and",  (funcproc)binop,(mathproc)b_and,2,},
	{"or",  (funcproc)binop,(mathproc)b_or,2,},
	{"mod",  (funcproc)binop,(mathproc)b_mod,2,},
	{"div",  (funcproc)binop,(mathproc)b_idiv,2,},
	{"max", (funcproc)f_minmax,(mathproc)b_max,-1,"Maximum"},
	{"min", (funcproc)f_minmax,(mathproc)b_min,-1,"Minimum"},
	{"maxvalue", (funcproc)f_v_minmax,(mathproc)b_max,-1,"Maximum value of a variable"},
	{"minvalue", (funcproc)f_v_minmax,(mathproc)b_min,-1,"Minimum value of a variable"},
	/* {"meanvalue", (funcproc)f_v_mean,(mathproc)NULL,-1,"Mean value of a variable"}, */
	{"neg", (funcproc)unop,(mathproc)m_neg,1,},
	{"sgn", (funcproc)unop,(mathproc)m_sgn,1, "Signe"},
	{"not", (funcproc)unop,(mathproc)m_not,1,},
	{"int",  (funcproc)unop, (mathproc)m_int,1,"Integer part" },
	{"exp",  (funcproc)unop, (mathproc)exp,1, "Exponatial"},
	{"log",  (funcproc)unop, (mathproc)log,1, "Natural logarythme"},
	{"log10",(funcproc)unop, (mathproc)log10,1, "Base 10 logarythme"},
	{"sin",  (funcproc)unop, (mathproc)sin,1, "Sine"},
	{"cos",  (funcproc)unop, (mathproc)cos,1, "Cosine"},
	{"tan",  (funcproc)unop, (mathproc)tan,1, "Tangent" },
	{"asin", (funcproc)unop, (mathproc)asin,1, "Arc sine"},
	{"acos", (funcproc)unop, (mathproc)acos,1, "Arc cosine"},
	{"atan", (funcproc)unop, (mathproc)atan,1, "Arc tangent"},
	{"atan2", (funcproc)binop, (mathproc)atan2,2, "Arc tangent of 2 variables"},
	{"abs",  (funcproc)unop, (mathproc)fabs,1, "Absolute value"},
	{"sqrt", (funcproc)unop, (mathproc)sqrt,1,"Square root" },
	{"count",(funcproc)f_count, (mathproc)NULL,1,
		"Returns the number of fields in a variable"},
		{"sum",  (funcproc)f_sum, (mathproc)NULL,1,
			"Returns a field sum of all the fields of a variable"},
			{"mean",  (funcproc)f_mean, (mathproc)NULL,1,
				"Returns the mean of all the fields"},

				{"rms",  (funcproc)f_rms2, (mathproc)NULL,2,
					"Returns the rms of two fieldsets"},

					{"rms",  (funcproc)f_rms, (mathproc)NULL,1,
						"Returns the root mean square of all the fields of a variable"},
						{"stdev",  (funcproc)f_stdev, (mathproc)NULL,1,
							"Returns the standard deviation of all the fields of a variable"},
							{"var",  (funcproc)f_var, (mathproc)NULL,1,
								"Returns the variance of all the fields of a variable"},

								{"covar",  (funcproc)f_covar, (mathproc)NULL,2,
									"Returns the covariance of all two fieldsets"},

									{"distribution",  (funcproc)f_distribution, (mathproc)NULL,2,
										"Returns the distribution of fields"},

										{"duplicate",  (funcproc)f_duplicate, (mathproc)NULL,2,
											"Duplicates a field N times"},
											{"repeat",  (funcproc)f_duplicate, (mathproc)NULL,2,
												"Repeats a field N times"},

												{"merge", (funcproc)f_merge, (mathproc)NULL,-1, "Merge several fieldsets"},
												{"&",     (funcproc)f_merge, (mathproc)NULL,-1, "Merge several fieldsets"},
												{"bitmap",(funcproc)f_bitmap, (mathproc)NULL,2,
													"Apply bitmap of 2nd fieldset to 1st fieldset"},
													{"nobitmap",(funcproc)f_nobitmap, (mathproc)NULL,2,
														"Clear bitmap of 1st fieldset assigning value instead"},

														{ NULL,},
};

func *mars_functions(void)
{
	return builtins;
}
/* to do : ceil an friends erf dran48 lgamma */

static void list_funcs()
{
	int i;
	marslog(LOG_INFO,"These functions are now implented:");
	for(i=0;builtins[i].name;i++)
		if(builtins[i].arity<0)
			printf("%-8s any number of arguments : %s\n",builtins[i].name,
					builtins[i].info?builtins[i].info:"No information available");
		else
			printf("%-8s %d argument(s)          : %s\n",builtins[i].name,
					builtins[i].arity,builtins[i].info?builtins[i].info:
					"No information available");

}

static err call_math_func(math *p,void *data)
{
	int i;
	funcproc  f =  (funcproc)extern_func;
	mathproc  d = NULL;

	for(i=0;builtins[i].name;i++)
		if(strcasecmp(builtins[i].name,p->name)==0)
			if((builtins[i].arity < 0) || (builtins[i].arity == p->arity))
		{
			f = builtins[i].addr;
			d = builtins[i].proc;
			return f(p,d);
		}

	for(i=0;builtins[i].name;i++)
		if(strcasecmp(builtins[i].name,p->name)==0)
		{
			f = builtins[i].addr;
			d = builtins[i].proc;
			if(builtins[i].arity >= 0)
				if(builtins[i].arity != p->arity)
				{
					marslog(LOG_EROR,"Function '%s' is expecting %d argument(s)"
							,builtins[i].name,builtins[i].arity);
					return -1;
				}
			break;
		}
	return f(p,d);
}

static err call_load(math *p,void *data)
{
	variable *v;

	marslog(LOG_DBUG,"Loading '%s'",p->name);
	if(is_number(p->name))
		return push_named_scalar(p->name,atof(p->name));
	else
	{
		int	args[3];
		int i;
		int arity = -p->arity;

		if(arity > 3)
		{
			marslog(LOG_EROR,"Wrong number of indices for field name '%s'",
					p->name);
			return -1;
		}

		args[0] = args[1] = args[2] = 0;

		for(i=0;i<arity;i++)
		{
			if(!(v = pop())) return -1;
			if(!v->scalar)
			{
				marslog(LOG_EROR,"Bad index for field name '%s': not a scalar",
						p->name);
				return -1;
			}

			args[arity - i - 1] = (int)v->val;
		}

		v = find_variable(p->name);
		if(v == NULL)
		{
			marslog(LOG_EROR,"Cannot find variable %s",p->name);
			return -2;
		}
		if(v->name)
			return push_named_fieldset(v->name,sub_fieldset(v->fs,args[0],args[1],args[2]));
		return push_fieldset(sub_fieldset(v->fs,args[0],args[1],args[2]));
	}
}


static void advance(void)
{
	form++;
	while(isspace(*form)) form++;
}

static math *readatom()
{
	math *p;
	int i;
	char buf[1024];

	switch(*form)
	{
		case '(':
			advance();
			p = readtest();
			if(*form != ')')
			{
				marslog(LOG_EROR,"Formula: missing )");
				comperr = 1;
			}
			advance();
			break;

		case '-':
			p        = NEW_CLEAR(math);
			p->arity = 1;
			p->name  = strcache("neg");
			advance();
			p->left  = readatom();
			break;

		case '\0':
			marslog(LOG_EROR,"Formula: syntax error");
			comperr = 1;
			return NULL;
			/*NOTREACHED*/
			break;

		default:
			i = 0;

			if(*form == '\'' || *form == '"')
			{
				char c = *form++;
				while(*form && *form != c)
					buf[i++] = *form++;
				if(*form) form++;
			}
			else while(isalpha(*form)||isdigit(*form)||*form =='.'
					||*form == '_')
				buf[i++] = *form++;

			buf[i] = 0;
			if(isspace(*form)) advance();

			p = NEW_CLEAR(math);
			p->name  = strcache(buf);

			switch(*form)
			{
				case '(':
					advance();
					p->arity = 0;
					p->left = readlist(&p->arity);
					if(*form != ')')
					{
						marslog(LOG_EROR,"Formula: missing )");
						comperr = 1;
					}
					advance();
					break;

				case '[':
					advance();
					p->arity = 0;
					p->left = readlist(&p->arity);
					if(*form != ']')
					{
						marslog(LOG_EROR,"Formula: missing ]");
						comperr = 1;
					}
					p->arity = -p->arity;
					advance();
					break;

				default:
					p->arity = 0;
					break;
			}

			break;
	}

	return p;
}

static char *opname(char *p,int n)
{
	char buf[5];
	strncpy(buf,p,n);
	buf[n] = 0;
	return strcache(buf);
}

void print_math(math *m)
{
	if(m)
	{
		putchar('(');
		print_math(m->left);
		printf("%s",m->name);
		print_math(m->right);
		putchar(')');
	}
}

static math *readpower()
{
	math *p = readatom();

	while(*form == '^' || (*form == '*' && *(form + 1) == '*') )
	{
		math *q  = NEW_CLEAR(math);
		q->left  = p;
		q->arity = 2;

		if(*form == '*') { advance(); *form = '^'; }

		q->name     = opname(form,1);
		advance();
		q->right    = readatom();
		p = q;
	}
	return p;
}

static math *readlist(int *n)
{
	math *p;

	if(*form == ')') return NULL;

	p  = readtest();
	*n = 1;

	while(*form == ',')
	{
		math *q = NEW_CLEAR(math);


		(*n)++;

		q->left  = p;

		advance();

		q->right    = readtest();

		p = q;
	}
	return p;
}


static math *readfactor()
{
	math *p = readpower();
	while(*form == '*' || *form == '/')
	{
		math *q = NEW_CLEAR(math);


		q->arity    = 2;
		q->left     = p;
		q->name     = opname(form,1);

		advance();

		q->right    = readpower();

		p = q;
	}
	return p;
}

static math *readterm()
{
	math *p = readfactor();
	while(*form == '+' || *form == '-')
	{
		math *q = NEW_CLEAR(math);


		q->arity    = 2;
		q->left     = p;
		q->name     = opname(form,1);

		advance();

		q->right    = readfactor();

		p = q;

	}
	return p;
}

static math *readtest()
{
	math *p = readterm();
	while(*form == '<' || *form == '>' || *form == '=')
	{
		math *q = NEW_CLEAR(math);
		char *x = form;
		int   n = 1;


		q->arity    = 2;
		q->left     = p;

		advance();
		if(*form == '=' || *form == '>')
		{
			n = 2;
			advance();
		}

		q->name = opname(x,n);

		q->right    = readterm();

		p = q;

	}
	return p;
}

math *clone_math(math *m)
{
	math *n = NULL;
	if(m)
	{
		n = NEW_CLEAR(math);
		n->arity = m->arity;
		n->name  = strcache(m->name);
		n->left  = clone_math(m->left);
		n->right = clone_math(m->right);
	}
	return n;
}

math *compmath(const char*formula)
{
	math *x;
	char buf[1024];

	strcpy(buf,formula);
	form = buf;

	comperr = 0;
	x = readtest();
	if(comperr)
		return NULL;

	if(*form)
	{
		marslog(LOG_EROR,"Part of the formula was not processed: '%s'",form);
		return NULL;
	}


	return x;
}

static err compute(math *p,void *data)
{
	err e = NOERR;
	if(p)
	{
		if( (e = compute(p->left,data)))
			return e;

		if( (e = compute(p->right,data)) )
			return e;

		if(p->name) {
			if(p->arity <= 0) {
				return call_load(p,data);
			}
			else {
				return call_math_func(p,data);
			}
		}

	}
	return NOERR;
}

static void fpe(int sig)
{
	merr++;
	signal(SIGFPE,fpe);
}

void free_math(math *m)
{
	if(m)
	{
		free_math(m->left);
		free_math(m->right);
		strfree(m->name);
		FREE(m);
	}
}


err calculate(math *c,const char *f,void *data)
{
	int saveerrno = errno;
	int savemerr  = merr ;
	err e = 0;
	variable *v ;

	if(mars.debug)
	{
		marslog(LOG_DBUG|LOG_NOCR,"Formula is : ");
		print_math(c);
		putchar('\n');
	}

	/* signal(SIGFPE,fpe); */
	merr = 0;
	errno = 0;
	e = compute(c,data);

	if(merr)  marslog(LOG_WARN,"%d math error(s) where reported",merr);

	if(e == NOERR)
	{
		v = pop();
		if(v) if(v->scalar)
			marslog(LOG_INFO,"The result of compute is a scalar: %g",v->val);
		else
			marslog(LOG_INFO,"%d resulting field(s) put in fieldset '%s'",
					v->fs->count,f);
		new_variable(f,v->fs,v->val);
	}

	errno = saveerrno;
	merr  = savemerr;
	return e;
}

err handle_compute(request *r,void *data)
{
	const char *s = get_value(r,"FORMULA",0);
	const char *f = get_value(r,"FIELDSET",0);
	const char *tgt = get_value(r,"TARGET",0);
	math *c = compmath(no_quotes(s));
	err  e;



#ifndef METVIEW
	timer *t;
	char buf[1024];
	sprintf(buf,"Computing %s",s);
	t=get_timer(buf,NULL,false);
	timer_start(t);
#endif

    if(mars.webmars_target && tgt) {
        tgt = mars.webmars_target;
    }

	marslog(LOG_DBUG,"Formula is: %s",s);
	if(!c) { free_math(c); return -1; }

	e = calculate(c,f,data);
	free_math(c);

#ifndef METVIEW
	timer_stop(t,0);

	if((e == NOERR) && tgt)
	{
		extern base_class *targetbase;
		variable *v = find_variable(f);
		database *target;

		if(!v) {
			marslog(LOG_EROR,"Fieldset not found: '%s'",f);
			return -1;
		}

		if(v->scalar)
		{
			marslog(LOG_EROR,"WRITE failed. Field '%s' is a scalar (%g)",
					s,v->val);
			return -1;
		}

		target = database_open(targetbase,NULL,r,NULL,WRITE_MODE);

		if(target == NULL)
			return -1;

		e = write_fieldset(v->fs,target);

		database_close(target);

		if(e) return e;

		marslog(LOG_INFO,"WRITE %d field(s) from fieldset %s to file '%s'", v->fs->count,f,tgt);
		return NOERR;
	}

#endif

	return e;
}
