/*
 * © Copyright 1996-2012 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.
 */

#include "mars.h"

/*=====================================

 Mars to external routines communication

=====================================*/

#ifdef FORTRAN_UPPERCASE
#define marscnt_ MARSCNT  
#define marsarg_ MARSARG  
#define marsret_ MARSRET  
#define marsend_ MARSEND  
#define marsout_ MARSOUT  
#define gribnew_ GRIBNEW  
#define gribcnt_ GRIBCNT  
#define gribcopy_ GRIBCOPY 
#define gribdata_ GRIBDATA 
#define gribfile_ GRIBFILE 
#define gribfree_ GRIBFREE 
#define gribnext_ GRIBNEXT 
#define gribsave_ GRIBSAVE 
#define mfail_ MFAIL
#define mgetb_ MGETB
#define mgetb_ MGETB
#define mgetg_ MGETG
#define mgeti_ MGETI
#define mgetm_ MGETM
#define mgetn2_ MGETN2
#define mgetn_ MGETN
#define mgets_ MGETS
#define msetb_ MSETB
#define msetg_ MSETG
#define mseti_ MSETI
#define msetm_ MSETM
#define msetn2_ MSETN2
#define msetn_ MSETN
#define msets_ MSETS
#define mloadb_ MLOADB
#define mloadg_ MLOADG
#define mnewb_ MNEWB
#define mnewg_ MNEWG
#endif


typedef struct gribarg {
	FILE     *f;
	fieldset *v;
	int      cnt;
	char     *file;
}gribarg;

typedef struct bufrarg {
	FILE     *f;
	char     *file;
}bufrarg;

typedef struct arg {
	char    kind;
	union {
		double  dval;
		char    *sval;
		request *rval;
	} u;
}arg;


static int      argc = 0;
static int      argn = 0;
static arg     *args = NULL;
static boolean first = true;
static char    *name = NULL;
static char    *file = NULL;

static void mout(int lvl,char *msg)
{
}

static void the_end(int code,void *data)
{
	printf("end is %d\n",code);
}

static void minit(void)
{
	int      ac;
	char    *av;
	request *r,*s;
	int     i;

	if(!first) return;

	first = false;

	file = getenv("MREQUEST");
	name = getenv("MNAME");

	ac = 1;
	av = strcache(name?name:"external");

	marsinit(&ac,&av,0,0,0);

	if(!file) marslog(LOG_EXIT,
	    "Mars/Metview external environment not set");

	/* mars.outproc = mout; */

	s = r = read_request_file(file);
	while(s) {
		s = s->next;
		argc++;
	}

	/* empty file */
	fclose(fopen(file,"w"));

	if(argc == 0) return;

	args = NEW_ARRAY(arg,argc);
	i = 0;

	while(r)
	{
		const char *t = r->name;
		const char *v = get_value(r,"VALUE",0);

		if(t == NULL)
			marslog(LOG_EXIT,"No data type");
		else if( EQ(t,"NUMBER"))
		{
			args[i].kind = 'N';
			args[i].u.dval = v?atof(v):0.0;
		}
		else if( EQ(t,"STRING") )
		{
			args[i].kind = 'S';
			args[i].u.sval = strcache(v?v:"");
		}
		else if( EQ(t,"GRIB") )
		{
			args[i].kind = 'G';
			args[i].u.rval = r;
		}
		else if( EQ(t,"BUFR") )
		{
			args[i].kind = 'B';
			args[i].u.rval = r;
		}
		else if( EQ(t,"IMAGE") )
		{
			args[i].kind = 'I';
			args[i].u.rval = r;
		}
		else marslog(LOG_EXIT,"Unsupported type %s",t);

		r = r->next;
		i++;
	}

	/* install_exit_proc(the_end,NULL); */

}

static void mcheck(long *n,char kind, char *name)
{
	minit();

	if(*n == 0) *n = argn+1;

	if(*n < 1 || *n > argc)
		marslog(LOG_EXIT,"Parameter %d is is out of range."
		    " Only %d parameters where passed",*n,argc);
	if(args[*n-1].kind != kind)
		marslog(LOG_EXIT,"Parameter %d is not of type %s",*n,name);

	argn = *n;
}

static void getn(long n,double *d)
{
	mcheck(&n,'N',"number");
	*d = args[n-1].u.dval;
}

void mgetn_(fortfloat *f)
{
	double d;
	getn(0,&d);
	*f = d;
}

void mgetn2_(double *d)
{
	getn(0,d);
}

void mgets_(char *s,long l_s)
{
	long n = 0;
	char *p;
	mcheck(&n,'S',"string");
	p = args[n-1].u.sval;
	n = strlen(p);
	memset(s,0,l_s);

	if(n > l_s)
	{
		marslog(LOG_WARN,"MGETS, string to small %d>%d",
		    n,l_s);
		n = l_s;
	}

	strncpy(s,p,n);
}


static fieldset *getg(long n)
{
	mcheck(&n,'G',"fieldset");
	return request_to_fieldset(args[n-1].u.rval);
}


void mgetg_(long *g,long  *c)
{
	fieldset *v = getg(0);
	gribarg  *a = NEW_CLEAR(gribarg);
	if(!v) marslog(LOG_EXIT,"MGETG, Cannot load grib file");
	*c = v->count;
	a->v = v;
	*g = (long)a;
}

static fieldset *geti(long n)
{
	mcheck(&n,'I',"image");
	return request_to_fieldset(args[n-1].u.rval);
}


void mfail_(char *msg,long l_msg);

void mnewb_()  { 
	mfail_("MNEWB is not yet implemeted",0); 
}
void mgetb_()  { 
	mfail_("MGETB is not yet implemeted",0); 
}
void msetb_()  { 
	mfail_("MSETB is not yet implemeted",0); 
}
void mloadb_() { 
	mfail_("MLOADB is not yet implemeted",0); 
}
void msaveb_() { 
	mfail_("MSAVEB is not yet implemeted",0); 
}
void mgetm_()  { 
	mfail_("MGETM is not yet implemeted",0); 
}
void msetm_()  { 
	mfail_("MSETM is not yet implemeted",0); 
}

void mgeti_(long *g,long  *c)
{
	fieldset *v = geti(0);
	gribarg  *a = NEW_CLEAR(gribarg);
	if(!v) marslog(LOG_EXIT,"MGETI, Cannot load image file");
	*c = v->count;
	a->v = v;
	*g = (long)a;
}

void mloadg_(long *g,char *p,long *c)
{
	gribarg *a  = (gribarg*)(*g);
	fieldset *v = a->v;

	int i = a->cnt++;

	minit();

	if(i < 0 || i >= v->count)
		marslog(LOG_EXIT,"MGRIB, No more fields");


	if( (*c) * sizeof(fortint) < v->fields[i]->length)
		marslog(LOG_EXIT,"MGRIB, Buffer to small %d words (should be %d words)",
		    *c,(v->fields[i]->length + (sizeof(fortint) - 1) )/ sizeof(fortint));

	if(a->f == NULL || a->file != v->fields[i]->file->fname)
	{
		if(a->f) fclose(a->f);
		strfree(a->file);
		a->file = strcache(v->fields[i]->file->fname);
		a->f = fopen(a->file,"r");
		if(a->f == NULL)
			marslog(LOG_EXIT|LOG_PERR,"MGRIB, cannot open %s",a->file);
	}

	if(fseek(a->f,v->fields[i]->offset,0) < 0)
		marslog(LOG_EXIT|LOG_PERR,"MGRIB, cannot position to grib");

	if(_readany(a->f,p,&v->fields[i]->length))
		marslog(LOG_EXIT|LOG_PERR,"MGRIB, cannot read grib");
}

void mnewg_(long *g)
{
	gribarg  *a ;
	minit();
	a = NEW_CLEAR(gribarg);
	*g = (long)a;
}

void msaveg_(long *g,char *p,long *c)
{
	gribarg *a  = (gribarg*)(*g);
	int j,length, pad;
	char x;
	minit();

	if(a->f == NULL)
	{
		a->file = strcache(marstmp());
		a->f = fopen(a->file,"w");
		if(a->f == NULL)
			marslog(LOG_EXIT|LOG_PERR,"MGRIB, cannot open %s",a->file);
	}

	length = (*c) * sizeof(fortint);
	pad    = ((length + 119)/120) * 120 - length;

	if(fwrite(p,1,length,a->f) != length)
		marslog(LOG_EXIT|LOG_PERR,"Error while writing to disk");

	x = 0;
	for(j=0;j<pad;j++)
		if(fwrite(&x,1,1,a->f) != 1)
			marslog(LOG_EXIT|LOG_PERR,"Error while writing to disk");


}

void msetg_(long *g)
{
	gribarg *a = (gribarg*)(*g);
	FILE *f ;

	minit();

	if(a->f) fclose(a->f); 
	a->f = NULL;

	f = fopen(file,"a+");
	fprintf(f,"GRIB,TEMPORARY=1,PATH='%s'\n",
	    a->file);
	fclose(f);

}

void mseti_(long *g)
{
	gribarg *a = (gribarg*)(*g);
	FILE *f ;

	minit();

	if(a->f) fclose(a->f); 
	a->f = NULL;

	f = fopen(file,"a+");
	fprintf(f,"IMAGE,TEMPORARY=1,PATH='%s'\n",
	    a->file);
	fclose(f);
}

void msets_(char *s,long l_s)
{
	FILE *f;
	int space = 0;
	minit();
	f = fopen(file,"a+");
	fprintf(f,"STRING,VALUE=\"");

	space = 0;

	while(*s && l_s--)
	{
		if(*s == '"' || *s == '\\')  fputc('\\',f);
		if(*s == ' ') space++;
		else
		{
			while(space-->0) fputc(' ',f);
			fputc(*s,f);
		}
		s++;
	}
	fprintf(f,"\"\n");
	fclose(f);
}

void msetn2_(double *d)
{
	FILE *f;
	minit();
	f = fopen(file,"a+");
	fprintf(f,"NUMBER,VALUE=%g\n",*d);
	fclose(f);
}

void msetn_(fortfloat *f)
{
	double d = *f;
	msetn2_(&d);
}

void mfail_(char *msg,long l_msg)
{
	minit();
	marslog(LOG_EXIT,"%s",msg);
}

void margs_(long *cnt,char *types,long l_types)
{
	int i,n;

	minit();
	*cnt = argc;

	memset(types,0,l_types);
	n = argc;

	if(n > l_types)
	{
		marslog(LOG_WARN,"MARGS, string to small %d>%d",
		    n,l_types);
		n = l_types;
	}

	for(i=0;i<n;i++)
		types[i] = args[i].kind;
}


/* Versions with no underscore */
void mgetn(fortfloat *f) { mgetn_(f); }
void mgetn2(double *d) { mgetn2_(d); }
void mgets(char *s, long l_s) { mgets_(s,l_s); }
void mgetg(long *g, long *c) { mgetg_(g,c); }
void mnewb(void) { mnewb_(); }
void mgetb(void) { mgetb_(); }
void msetb(void) { msetb_(); }
void mloadb(void) { mloadb_(); }
void msaveb(void) { msaveb_(); }
void mgetm(void) { mgetm_(); }
void msetm(void) { msetm_(); }
void mgeti(long *g, long *c) { mgeti_(g,c); }
void mloadg(long *g, char *p, long *c) { mloadg_(g,p,c); }
void mnewg(long *g) { mnewg_(g); }
void msaveg(long *g, char *p, long *c) { msaveg_(g,p,c); }
void msetg(long *g) { msetg_(g); }
void mseti(long *g) { mseti_(g); }
void msets(char *s, long l_s) { msets_(s,l_s); }
void msetn2(double *d) { msetn2_(d); }
void msetn(fortfloat *f) { msetn_(f); }
void mfail(char *msg, long l_msg) { mfail_(msg,l_msg); }
void margs(long *cnt, char *types, long l_types) { margs_(cnt,types,l_types); }

