static void SolverError(SolverStruct *S, char *errmsg)
{
sprintf(S->buf,"Error at t=%20.16e: %s\n",S->w[0],errmsg);
if(S->err==-1) kv->error(S->buf);
S->err=1;
}
EXP ALGEB M_DECL ParamDriver( MKernelVector kv_in, ALGEB *args )
{
double t0,tf,dt,*ic,*p,*out;
M_INT nargs,bounds[4],npts,naout,i;
RTableSettings s;
ALGEB outd;
char buf[1000];
kv=kv_in;
nargs=kv->numArgs((ALGEB)args);
if( nargs<5 || nargs>6 )
kv->error("incorrect number of arguments");
/* Process time vals */
if( !kv->isNumeric(args[1]) )
kv->error("argument #1, the initial time, must be numeric");
t0=kv->mapleToFloat64(args[1]);
if( !kv->isNumeric(args[2]) )
kv->error("argument #2, the final time, must be numeric");
tf=kv->mapleToFloat64(args[2]);
if( t0>=tf )
kv->error("the final time must be larger than the initial time");
if( !kv->isNumeric(args[3]) )
kv->error("argument #3, the time step, must be a positive numeric value");
dt=kv->mapleToFloat64(args[3]);
if(dt<=0)
kv->error("argument #3, the time step, must be a positive numeric value");
npts=(M_INT)ceil((tf+1e-10-t0)/dt)+1;
/* Processing ic in */
if( NDIFF==0 )
ic=NULL;
else if( kv->isInteger(args[4]) && kv->mapleToInteger32(args[4])==0 )
ic=NULL;
else if( !kv->isRTable(args[4]) ) {
ic=NULL;
kv->error("argument #4, the initial data, must be a 1..ndiff rtable");
}
else {
kv->rtableGetSettings(&s,args[4]);
if( s.storage != RTABLE_RECT || s.data_type != RTABLE_FLOAT64 ||
s.num_dimensions != 1 || kv->rtableLowerBound(args[4],1)!=1 ||
kv->rtableUpperBound(args[4],1) != NDIFF )
kv->error("argument #4, the initial data, must be a 1..ndiff rtable");
ic=(double *)kv->rtableData(args[4]);
}
/* Processing parameters in */
if( NPAR==0 )
p=NULL;
else if( kv->isInteger(args[5]) && kv->mapleToInteger32(args[5])==0 )
p=NULL;
else if( !kv->isRTable(args[5]) ) {
p=NULL;
kv->error("argument #5, the parameter data, must be a 1..npar rtable");
}
else {
kv->rtableGetSettings(&s,args[5]);
if( s.storage != RTABLE_RECT || s.data_type != RTABLE_FLOAT64 ||
s.num_dimensions != 1 || kv->rtableLowerBound(args[5],1)!=1 ||
kv->rtableUpperBound(args[5],1) != NPAR )
kv->error("argument #5, the parameter data, must be a 1..npar rtable");
p=(double *)kv->rtableData(args[5]);
}
/* Output data table */
if( nargs==6 ) {
outd=NULL;
if( !kv->isRTable(args[6]) ) {
out=NULL;
naout=0;
kv->error("argument #6, the output data, must be a 1..npts,1..nout+1 C_order rtable");
}
else {
kv->rtableGetSettings(&s,args[6]);
if( s.storage != RTABLE_RECT || s.data_type != RTABLE_FLOAT64 ||
s.order != RTABLE_C || s.num_dimensions != 2 ||
kv->rtableLowerBound(args[6],1)!=1 ||
kv->rtableLowerBound(args[6],2)!=1 ||
kv->rtableUpperBound(args[6],2) != NOUT+1 )
kv->error("argument #6, the output data, must be a 1..npts,1..nout+1 C_order rtable");
naout=kv->rtableUpperBound(args[6],1);
if( naout<1 )
kv->error("argument #6, the output data, must have at least 1 output slot");
out=(double *)kv->rtableData(args[6]);
if(naout<npts) npts=naout;
}
}
else {
kv->rtableGetDefaults(&s);
bounds[0]=1;
bounds[1]=npts;
bounds[2]=1;
bounds[3]=NOUT+1;
s.storage=RTABLE_RECT;
s.data_type=RTABLE_FLOAT64;
s.order=RTABLE_C;
s.num_dimensions=2;
s.subtype=RTABLE_ARRAY;
outd=kv->rtableCreate(&s,NULL,bounds);
out=(double *)kv->rtableData(outd);
naout=npts;
}
for(i=0; i<naout*(NOUT+1); i++) out[i]=*dsn_undef;
i=ParamDriverC(t0,dt,npts,ic,p,out,buf,1);
/* All done */
if(outd==NULL)
return(kv->toMapleInteger(i));
else
return(outd);
}
