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);
}
ALGEB getVector(MKernelVector kv, ALGEB* args)
{
// Get the key, declare variables
int key = MapleToInteger32(kv,args[1]), flag;
char err[] = "ERROR! The associated Vector object does not exist!";
M_INT index, bound[2];
RTableData d;
RTableSettings s;
ALGEB rtable, blank;
char MapleStatement[100] = "rtable(1..";
// Check to see if the object pointed to by key is in the type table. If not, panic
std::map<int,int>::iterator f_i = typeTable.find(key);
if(f_i == typeTable.end() ) {
MapleRaiseError(kv, err);
}
// Otherwise, we have our object
flag = f_i->second;
// Get a pointer to the actual data
std::map<int,void*>::iterator h_i = hashTable.find(key);
if(h_i != hashTable.end() ) {
// Diverge over whether we are using maple 7 or 8 ( and 5 & 6)
// in Maple, arg 3 is a flag indicating which method to use
switch( MapleToInteger32(kv, args[3])) {
// In this case, Maple 7 is being used, we have to construct a call using "EvalMapleStatement()"
// to call the RTable constructor
case 1:
switch(flag) {
case SmallV:{
// Get the vector
Vectorl* V = (Vectorl*) h_i->second;
Vectorl::const_iterator V_i;
// Create the Maple object
sprintf(MapleStatement + strlen(MapleStatement), "%d", V->size() );
strcat(MapleStatement, ", subtype=Vector[column], storage=sparse)");
rtable = kv->evalMapleStatement(MapleStatement);
// populate the Maple vector w/ the entries from V above
for(index = 1, V_i = V->begin(); V_i != V->end(); ++V_i, ++index) {
d.dag = ToMapleInteger(kv, *V_i); // d is a union, dag is the
// ALGEB union field
RTableAssign(kv, rtable, &index, d);
}
}
break;
case LargeV: {
// This part works the same way as above
VectorI* V = (VectorI*) h_i->second;
VectorI::const_iterator V_i;
sprintf(MapleStatement + strlen(MapleStatement), "%d", V->size() );
strcat(MapleStatement, ",subtype=Vector[column], storage=sparse)");
rtable = kv->evalMapleStatement(MapleStatement);
// Use maple callback to call the procedure from Maple that translates a gmp integer
// into a large maple integer. Then put this into the Maple vector
for(index = 1, V_i = V->begin(); V_i != V->end(); ++V_i, ++index) {
/* Okay, here's how this line works. Basically,
* in order to set the entries of this RTable to
* multi-precision integers, I have to first use my own conversion
* method, LiToM, to convert the integer entry to a ALGEB structure,
* then do a callback into Maple that calls the ExToM procedure,
* which converts the results of LiToM into a Maple multi-precision
* integer. At the moment, this is the best idea I've got as to
* how to convert a GMP integer into a Maple representation in one shot.
*/
d.dag = EvalMapleProc(kv,args[2],1,LiToM(kv, *V_i, blank));
RTableAssign(kv, rtable, &index, d);
}
}
break;
default:
MapleRaiseError(kv, err);
break;
}
break;
// In this case, use the simpler RTableCreate function, rather than building a string
// that must be parsed by maple
case 2:
kv->rtableGetDefaults(&s); // Get default settings - set datatype to Maple,
// DAGTAG to anything
s.subtype = 2; // Subtype set to column vector
s.storage = 4; // Storage set to rectangular
s.num_dimensions = 1; // What do you think this means :-)
bound[0] = 1; // Set the lower bounds of each dimension to 0
switch(flag) {// Switch on data type of vector
case SmallV:{ // single word integer entry vector
Vectorl* V = (Vectorl*) h_i->second;
Vectorl::const_iterator V_i;
bound[1] = V->size();
rtable = kv->rtableCreate(&s, NULL, bound); // Create the Maple vector
for(index = 1, V_i = V->begin(); V_i != V->end(); ++V_i, ++index) {
d.dag = ToMapleInteger(kv, *V_i); // d is a union, dag is the
// ALGEB union field
RTableAssign(kv, rtable, &index, d);
}
}
break;
case LargeV: { // Same as above for multi-word integer entry vector
VectorI* V = (VectorI*) h_i->second;
VectorI::const_iterator V_i;
bound[1] = V->size();
rtable = kv->rtableCreate(&s, NULL, bound);
for(index = 1, V_i = V->begin(); V_i != V->end(); ++V_i, ++index) {
/* Okay, here's how this line works. Basically,
* in order to set the entries of this RTable to
* multi-precision integers, I have to first use my own conversion
* method, LiToM, to convert the integer entry to a ALGEB structure,
* then do a callback into Maple that calls the ExToM procedure,
* which converts the results of LiToM into a Maple multi-precision
* integer. At the moment, this is the best idea I've got as to
* how to convert a GMP integer into a Maple representation in one shot.
*/
d.dag = EvalMapleProc(kv,args[2],1,LiToM(kv, *V_i, blank));
RTableAssign(kv, rtable, &index, d);
}
}
break;
default:
MapleRaiseError(kv, err);
break;
}
break; // breaks case 2.
// This was causing a wicked error :-)
default:
MapleRaiseError(kv, err);
break;
}
}
else {
MapleRaiseError(kv, err);
}
return rtable;
}
EXP ALGEB M_DECL SetKernelVector(MKernelVector kv_in, ALGEB args) {
kv=kv_in;
return(kv->toMapleNULL());
}
ALGEB getMatrix(MKernelVector kv, ALGEB* args)
{
// Get the key
int key = MapleToInteger32(kv,args[1]), flag;
char err[] = "ERROR! The associated BlackBox object does not exist!";
M_INT index[2], bound[4];
RTableData d;
ALGEB rtable, blank;
RTableSettings s;
std::vector<size_t> Row, Col;
std::vector<size_t>::const_iterator r_i, c_i;
char MapleStatement[100] = "rtable(1..";
// Get the data type of the blackbox
std::map<int,int>::iterator f_i = typeTable.find(key);
if( f_i == typeTable.end() ) // In case the blackbox isn't there
MapleRaiseError(kv,err);
flag = f_i->second; // Otherwise, get the blackbox type
// Check that the data is there
std::map<int,void*>::iterator h_i = hashTable.find(key);
if(h_i != hashTable.end() ) {
// Switch according to mode - regular or "special fix" mode
switch( MapleToInteger32(kv, args[3])) {
case 1: // This is the Maple 7 case, "special fix" mode
// Use the EvalMapleStatement() to call the rtable constructor in the
// Maple environment
// Switch according to the type
switch(flag) {
case BlackBoxi:{ // For single word entry matrices
// Extract the necessary data
TriplesBBi* BB = (TriplesBBi*) h_i->second;
Vectorl Data = BB->getData();
Row = BB->getRows();
Col = BB->getCols();
Vectorl::const_iterator d_i;
// Builds the statement that will be used in the Maple 7 callback
sprintf(MapleStatement + strlen(MapleStatement), "%d", BB->rowdim() );
strcat(MapleStatement, ",1..");
sprintf(MapleStatement + strlen(MapleStatement), "%d", BB->coldim() );
strcat(MapleStatement, ", subtype=Matrix, storage=sparse);");
// Perform the callback
rtable = kv->evalMapleStatement(MapleStatement);
// Insert each non-zero entry
for(d_i = Data.begin(), r_i = Row.begin(), c_i = Col.begin(); r_i != Row.end(); ++d_i, ++c_i, ++r_i) {
index[0] = *r_i; index[1] = *c_i;
d.dag = ToMapleInteger(kv, *d_i); // d is a union, dag is the
// ALGEB union field
RTableAssign(kv, rtable, index, d);
}
}
break;
case BlackBoxI: { // For multi-word size matrix types
TriplesBBI* BB = (TriplesBBI*) h_i->second;
VectorI Data = BB->getData();
VectorI::const_iterator d_i;
// Build and execute the Maple callback
sprintf(MapleStatement + strlen(MapleStatement), "%d", BB->rowdim() );
strcat(MapleStatement, ", 1..");
sprintf(MapleStatement + strlen(MapleStatement), "%d", BB->coldim() );
strcat(MapleStatement, ", subtype=Matrix, storage=sparse);");
rtable = kv->evalMapleStatement(MapleStatement);
for(d_i = Data.begin(), r_i = Row.begin(), c_i = Col.begin(); r_i != Row.end(); ++d_i, ++r_i, ++c_i) {
index[0] = *r_i; index[1] = *c_i;
// * Okay, here's how this line works. Basically,
// * in order to set the entries of this RTable to
// * multi-precision integers, I have to first use my own conversion
// * method, LiToM, to convert the integer entry to a ALGEB structure,
// * then do a callback into Maple that calls the ExToM procedure,
// * which converts the results of LiToM into a Maple multi-precision
// * integer. At the moment, this is the best idea I've got as to
// * how to convert a GMP integer into a Maple representation in one shot.
// *
d.dag = EvalMapleProc(kv,args[2],1,LiToM(kv, *d_i, blank));
RTableAssign(kv, rtable, index, d);
}
}
break;
// In this case the object is not a BlackBox type
default:
MapleRaiseError(kv,err);
break;
}
break;
case 2: // Okay, here is the normal case.
// Use RTableCreate to create a Maple rtable object
kv->rtableGetDefaults(&s);
// Get default settings - set datatype to Maple,
// DAGTAG to anything
s.subtype = RTABLE_MATRIX; // Subtype set to Matrix
s.storage = RTABLE_SPARSE; // Storage set to sparse
s.num_dimensions = 2; // What do you think this means :-)
bound[0] = bound[2] = 1; // Set the lower bounds of each dimension to 0, which for maple is 1
switch(flag) { // Switch on data type
case BlackBoxi:{ // word size entry Matrix
TriplesBBi* BB = (TriplesBBi*) h_i->second;
Vectorl Data = BB->getData();
Row = BB->getRows();
Col = BB->getCols();
Vectorl::const_iterator d_i;
bound[1] = BB->rowdim();
bound[3] = BB->coldim();
rtable = kv->rtableCreate(&s, NULL, bound); // This is the RTableCreate function, it's
// just the one that works
// Assign all the non-zero rows
for( d_i = Data.begin(), r_i = Row.begin(), c_i = Col.begin(); r_i != Row.end(); ++d_i, ++c_i, ++r_i) {
index[0] = *r_i; index[1] = *c_i;
d.dag = ToMapleInteger(kv, *d_i); // d is a union, dag is the
// ALGEB union field
RTableAssign(kv, rtable, index, d);
}
}
break;
case BlackBoxI: { // For multi-word entry Matrices
TriplesBBI* BB = (TriplesBBI*) h_i->second;
VectorI Data = BB->getData();
// Setup the Create() call
VectorI::const_iterator d_i;
Row = BB->getRows();
Col = BB->getCols();
bound[1] = BB->rowdim();
bound[3] = BB->coldim();
rtable = kv->rtableCreate(&s, NULL, bound); // Create an empty RTable
// Populate the RTable using the callback method described below
for(d_i = Data.begin(), r_i = Row.begin(), c_i = Col.begin(); r_i != Row.end(); ++d_i, ++r_i, ++c_i) {
index[0] = *r_i; index[1] = *c_i;
// * Okay, here's how this line works. Basically,
// * in order to set the entries of this RTable to
// * multi-precision integers, I have to first use my own conversion
// * method, LiToM, to convert the integer entry to a ALGEB structure,
// * then do a callback into Maple that calls the ExToM procedure,
// * which converts the results of LiToM into a Maple multi-precision
// * integer. At the moment, this is the best idea I've got as to
// * how to convert a GMP integer into a Maple representation in one shot.
d.dag = EvalMapleProc(kv,args[2],1,LiToM(kv, *d_i, blank));
RTableAssign(kv, rtable, index, d);
}
}
break;
}
}
}
else
MapleRaiseError(kv,err);
return rtable;
}
