bool handle_args (EnvT* e)
{
// handle Log options passing via Keywords
// note: undocumented keywords [xyz]type still exist and
// have priority on [xyz]log !
static int xTypeIx = e->KeywordIx( "XTYPE" );
static int yTypeIx = e->KeywordIx( "YTYPE" );
static int zTypeIx = e->KeywordIx( "ZTYPE" );
static int xLogIx = e->KeywordIx( "XLOG" );
static int yLogIx = e->KeywordIx( "YLOG" );
static int zLogIx = e->KeywordIx( "ZLOG" );
static int xTickunitsIx = e->KeywordIx( "XTICKUNITS" );
static int yTickunitsIx = e->KeywordIx( "YTICKUNITS" );
static int zTickunitsIx = e->KeywordIx( "ZTICKUNITS" );
if ( e->KeywordPresent( xTypeIx ) ) xLog = e->KeywordSet( xTypeIx ); else xLog = e->KeywordSet( xLogIx );
if ( e->KeywordPresent( yTypeIx ) ) yLog = e->KeywordSet( yTypeIx ); else yLog = e->KeywordSet( yLogIx );
if ( e->KeywordPresent( zTypeIx ) ) zLog = e->KeywordSet( zTypeIx ); else zLog = e->KeywordSet( zLogIx );
if ( xLog && e->KeywordSet( xTickunitsIx ) ) {
Message( "PLOT: LOG setting ignored for Date/Time TICKUNITS." );
xLog = FALSE;
}
if ( yLog && e->KeywordSet( yTickunitsIx ) ) {
Message( "PLOT: LOG setting ignored for Date/Time TICKUNITS." );
yLog = FALSE;
}
if ( zLog && e->KeywordSet( zTickunitsIx ) ) {
Message( "PLOT: LOG setting ignored for Date/Time TICKUNITS." );
zLog = FALSE;
}
if ( nParam ( )==1 )
{
if ( (e->GetNumericArrayParDefined ( 0 ))->Rank ( )!=2 )
e->Throw ( "Array must have 2 dimensions: "
+e->GetParString ( 0 ) );
BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL );
zVal=static_cast<DDoubleGDL*>
( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) );
p0_guard.reset ( p0 ); // delete upon exit
if ( zVal->Rank ( )!=2 )
e->Throw ( "Array must have 2 dimensions: "
+e->GetParString ( 0 ) );
xEl=zVal->Dim ( 1 );
yEl=zVal->Dim ( 0 );
xVal=new DDoubleGDL ( dimension ( xEl ), BaseGDL::INDGEN );
xval_guard.reset ( xVal ); // delete upon exit
if (xLog) xVal->Inc();
yVal=new DDoubleGDL ( dimension ( yEl ), BaseGDL::INDGEN );
yval_guard.reset ( yVal ); // delete upon exit
if (yLog) yVal->Inc();
}
else if ( nParam ( )==2||nParam ( )>3 )
{
e->Throw ( "Incorrect number of arguments." );
}
else
{
BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL );
zVal=static_cast<DDoubleGDL*>
( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) );
p0_guard.reset ( p0 ); // delete upon exit
if ( zVal->Rank ( )!=2 )
e->Throw ( "Array must have 2 dimensions: "
+e->GetParString ( 0 ) );
xVal=e->GetParAs< DDoubleGDL>( 1 );
yVal=e->GetParAs< DDoubleGDL>( 2 );
if ( xVal->Rank ( )!=1 )
e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" );
if ( yVal->Rank ( )!=1 )
e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" );
if ( xVal->Rank ( )==1 )
{
xEl=xVal->Dim ( 0 );
if ( xEl!=zVal->Dim ( 1 ) )
e->Throw ( "X, Y, or Z array dimensions are incompatible." );
}
if ( yVal->Rank ( )==1 )
{
yEl=yVal->Dim ( 0 );
if ( yEl!=zVal->Dim ( 0 ) )
e->Throw ( "X, Y, or Z array dimensions are incompatible." );
}
}
GetMinMaxVal ( xVal, &xStart, &xEnd );
GetMinMaxVal ( yVal, &yStart, &yEnd );
//XRANGE and YRANGE overrides all that, but Start/End should be recomputed accordingly
DDouble xAxisStart, xAxisEnd, yAxisStart, yAxisEnd;
bool setx=gdlGetDesiredAxisRange(e, "X", xAxisStart, xAxisEnd);
bool sety=gdlGetDesiredAxisRange(e, "Y", yAxisStart, yAxisEnd);
if(setx && sety)
{
xStart=xAxisStart;
xEnd=xAxisEnd;
yStart=yAxisStart;
yEnd=yAxisEnd;
}
else if (sety)
{
yStart=yAxisStart;
yEnd=yAxisEnd;
}
else if (setx)
{
xStart=xAxisStart;
xEnd=xAxisEnd;
//must compute min-max for other axis!
{
gdlDoRangeExtrema(xVal,yVal,yStart,yEnd,xStart,xEnd);
}
}
#undef UNDEF_RANGE_VALUE
// z range
datamax=0.0;
datamin=0.0;
GetMinMaxVal ( zVal, &datamin, &datamax );
zStart=datamin;
zEnd=datamax;
setZrange = gdlGetDesiredAxisRange(e, "Z", zStart, zEnd);
//SHADES: Doing the job will be for nothing since plplot does not give the functionality.
static int shadesIx=e->KeywordIx ( "SHADES" ); doShade=false;
if ( e->GetKW ( shadesIx )!=NULL )
{
shades=e->GetKWAs<DLongGDL>( shadesIx ); doShade=true;
} else {
// Get COLOR from PLOT system variable
static DStructGDL* pStruct=SysVar::P();
shades=new DLongGDL( 1, BaseGDL::NOZERO );
shades_guard.Init ( shades ); // delete upon exit
shades=static_cast<DLongGDL*>(pStruct->GetTag(pStruct->Desc()->TagIndex("COLOR"), 0)); doShade=false;
}
if (doShade) Warning ( "SHADE_SURF: SHADES array ignored, shading with current color table." );
return false;
}
BaseGDL* rk4_fun(EnvT* e)
{
SizeT nParam = e->NParam();
if( nParam != 5)
e->Throw(" Invalid Number of arguments in RK4 ");
//----------------------------- ACQUISITION DES PARAMETRES ------------------//
//"Y" input array a vector of values for Y at X value
//DDoubleGDL* Yvals = new DDoubleGDL(e->GetParAs<DDoubleGDL>(0)->N_Elements(),BaseGDL::NOZERO);
DDoubleGDL* Yvals = e->GetParAs<DDoubleGDL>(0);
if(e->GetParDefined(0)->Type() == GDL_COMPLEX || e->GetParDefined(0)->Type() == GDL_COMPLEXDBL)
cout<<" If RK4 is complex then only the real part is used for the computation "<< endl;
//"dydx" input value or array
//DDoubleGDL* dydxvals = new DDoubleGDL(e->GetParAs<DDoubleGDL>(1)->N_Elements(),BaseGDL::NOZERO);
DDoubleGDL* dydxvals = e->GetParAs<DDoubleGDL>(1);
if(e->GetParDefined(1)->Type() == GDL_COMPLEX || e->GetParDefined(1)->Type() == GDL_COMPLEXDBL)
cout<<" If RK4 is complex then only the real part is used for the computation "<< endl;
if(dydxvals->N_Elements()!=Yvals->N_Elements())e->Throw(" Y and DYDX dimensions have to match ");
// "X" input value
DDoubleGDL* X = e->GetParAs<DDoubleGDL>(2);
if(e->GetParDefined(2)->Type() == GDL_COMPLEX || e->GetParDefined(2)->Type() == GDL_COMPLEXDBL)
cout<<" If RK4 is complex then only the real part is used for the computation "<< endl;
// "H" input value
DDoubleGDL* H = e->GetParAs<DDoubleGDL>(3);
if(e->GetParDefined(3)->Type() == GDL_COMPLEX || e->GetParDefined(3)->Type() == GDL_COMPLEXDBL)
cout<<" If RK4 is complex then only the real part is used for the computation "<< endl;
// Differentiate User's Function string name
DStringGDL* init = e->GetParAs<DStringGDL>(4);
if(e->GetParDefined(4)->Type() != GDL_STRING )
e->Throw(" Fifth value must be a function name string ");
//-------------------------------- Allocation -----------------------------------//
BaseGDL *Steptwo,*Stepthree,*Stepfour;
SizeT i;
DDoubleGDL *HH,*H6,*XplusH,*Ytampon,*XH,*Yout,* dym,* dyt;
Ytampon = new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO);
Yout = new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO);
HH = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO);
H6 = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO);
XH = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO);
BaseGDL* XHO=static_cast<BaseGDL*>(XH);
XplusH = new DDoubleGDL(H->Dim(),BaseGDL::NOZERO);
BaseGDL* XplusHO=static_cast<BaseGDL*>(XplusH);
dym= new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO);
dyt= new DDoubleGDL(Yvals->Dim(),BaseGDL::NOZERO);
//-------------------------------- Init FIRST STEP -----------------------------------//
(*HH)[0]=(*H)[0]*0.50000;
(*H6)[0]=(*H)[0]/6.00000;
(*XH)[0] = (*X)[0] + (*HH)[0];
// marc: probably an error
// XplusH[0] = (*X)[0] + (*H)[0];
(*XplusH)[0] = (*X)[0] + (*H)[0];
//dym=static_cast<DDoubleGDL*>(dymO);
//dyt=static_cast<DDoubleGDL*>(dytO);
//---------------------------- Init Call function -------------------------------------//
DString RK_Diff;
e->AssureScalarPar<DStringGDL>( 4, RK_Diff);
// this is a function name -> convert to UPPERCASE
RK_Diff = StrUpCase( RK_Diff);
// first search library funcedures
int funIx=LibFunIx( RK_Diff);
StackGuard<EnvStackT> guard( e->Interpreter()->CallStack());
if( funIx != -1)
{
e->Throw(" String function name is intrinsic function name please change it ");
}
else
{
// Search in user proc and function
funIx = GDLInterpreter::GetFunIx(RK_Diff );
//-----------------FIRST STEP-------------------//
for (i=0;i<Yvals->N_Elements();++i)
(*Ytampon)[i]=(*Yvals)[i]+(*HH)[0]*(*dydxvals)[i];
BaseGDL* Ytmp=static_cast<BaseGDL*>(Ytampon);
// 1st CALL to user function "differentiate"
PushNewEnvRK(e, funList[ funIx],&XHO,&Ytmp);
EnvUDT* newEnv = static_cast<EnvUDT*>(e->Interpreter()->CallStack().back());
StackGuard<EnvStackT> guard1 ( e->Interpreter()->CallStack());
BaseGDL* Steptwo = e->Interpreter()->call_fun(static_cast<DSubUD*>(newEnv->GetPro())->GetTree());
//Conversion BaseGDL*-> DDoubleGDL* in order to use the RK_Diff function result.
dyt= static_cast<DDoubleGDL*>(Steptwo->Convert2(GDL_DOUBLE,BaseGDL::CONVERT));
//-------------SECOND STEP-------------------//
for (i=0;i<Yvals->N_Elements();++i)
(*Ytampon)[i]=(*Yvals)[i]+(*HH)[0]*(*dyt)[i];
// 2nd CALL to user function "differentiate"
PushNewEnvRK(e, funList[ funIx],&XHO,&Ytmp);
StackGuard<EnvStackT> guard2 ( newEnv->Interpreter()->CallStack());
BaseGDL* Stepthree = e->Interpreter()->call_fun(static_cast<DSubUD*>(newEnv->GetPro())->GetTree());
//Conversion BaseGDL*-> DDoubleGDL* in order to use the RK_Diff function result.
dym = static_cast<DDoubleGDL*>(Stepthree->Convert2(GDL_DOUBLE,BaseGDL::CONVERT));
//--------------THIRD STEP-------------------//
for (i=0;i<Yvals->N_Elements();++i)
{
(*Ytampon)[i]=(*Yvals)[i]+ (*H)[0]*(*dym)[i];
(*dym)[i] += (*dyt)[i];
}
// 3rd CALL to user function "differentiate"
PushNewEnvRK(e, funList[ funIx],&XplusHO,&Ytmp);
StackGuard<EnvStackT> guard3 ( newEnv->Interpreter()->CallStack());
BaseGDL* Stepfour = e->Interpreter()->call_fun(static_cast<DSubUD*>(newEnv->GetPro())->GetTree());
dyt= static_cast<DDoubleGDL*>(Stepfour->Convert2(GDL_DOUBLE,BaseGDL::CONVERT));
//--------------FOURTH STEP-------------------//
for (i=0;i<Yvals->N_Elements();++i)
(*Yout)[i]= (*Yvals)[i] + (*H6)[0] * ( (*dydxvals)[i]+(*dyt)[i]+ 2.00000*(*dym)[i] );
static DInt doubleKWIx = e->KeywordIx("DOUBLE");
//if need, convert things back
if( !e->KeywordSet(doubleKWIx))
return Yout->Convert2(GDL_FLOAT,BaseGDL::CONVERT);
else
return Yout;
}
assert( false);
}// RK4_fun
bool handle_args (EnvT* e)
{
xLog=e->KeywordSet ( "XLOG" );
yLog=e->KeywordSet ( "YLOG" );
zLog=e->KeywordSet ( "ZLOG" );
if ( nParam ( )==1 )
{
if ( (e->GetNumericArrayParDefined ( 0 ))->Rank ( )!=2 )
e->Throw ( "Array must have 2 dimensions: "
+e->GetParString ( 0 ) );
BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL );
zVal=static_cast<DDoubleGDL*>
( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) );
p0_guard.reset ( p0 ); // delete upon exit
if ( zVal->Rank ( )!=2 )
e->Throw ( "Array must have 2 dimensions: "
+e->GetParString ( 0 ) );
xEl=zVal->Dim ( 1 );
yEl=zVal->Dim ( 0 );
xVal=new DDoubleGDL ( dimension ( xEl ), BaseGDL::INDGEN );
xval_guard.reset ( xVal ); // delete upon exit
if (xLog) xVal->Inc();
yVal=new DDoubleGDL ( dimension ( yEl ), BaseGDL::INDGEN );
yval_guard.reset ( yVal ); // delete upon exit
if (yLog) yVal->Inc();
}
else if ( nParam ( )==2||nParam ( )>3 )
{
e->Throw ( "Incorrect number of arguments." );
}
else
{
BaseGDL* p0=e->GetNumericArrayParDefined ( 0 )->Transpose ( NULL );
zVal=static_cast<DDoubleGDL*>
( p0->Convert2 ( GDL_DOUBLE, BaseGDL::COPY ) );
p0_guard.reset ( p0 ); // delete upon exit
if ( zVal->Rank ( )!=2 )
e->Throw ( "Array must have 2 dimensions: "
+e->GetParString ( 0 ) );
xVal=e->GetParAs< DDoubleGDL>( 1 );
yVal=e->GetParAs< DDoubleGDL>( 2 );
if ( xVal->Rank ( )!=1 )
e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" );
if ( yVal->Rank ( )!=1 )
e->Throw ( "Unable to handle non-vectorial array "+e->GetParString ( 1 )+" (FIXME!)" );
if ( xVal->Rank ( )==1 )
{
xEl=xVal->Dim ( 0 );
if ( xEl!=zVal->Dim ( 1 ) )
e->Throw ( "X, Y, or Z array dimensions are incompatible." );
}
if ( yVal->Rank ( )==1 )
{
yEl=yVal->Dim ( 0 );
if ( yEl!=zVal->Dim ( 0 ) )
e->Throw ( "X, Y, or Z array dimensions are incompatible." );
}
}
GetMinMaxVal ( xVal, &xStart, &xEnd );
GetMinMaxVal ( yVal, &yStart, &yEnd );
//XRANGE and YRANGE overrides all that, but Start/End should be recomputed accordingly
DDouble xAxisStart, xAxisEnd, yAxisStart, yAxisEnd;
bool setx=gdlGetDesiredAxisRange(e, "X", xAxisStart, xAxisEnd);
bool sety=gdlGetDesiredAxisRange(e, "Y", yAxisStart, yAxisEnd);
if(setx && sety)
{
xStart=xAxisStart;
xEnd=xAxisEnd;
yStart=yAxisStart;
yEnd=yAxisEnd;
}
else if (sety)
{
yStart=yAxisStart;
yEnd=yAxisEnd;
}
else if (setx)
{
xStart=xAxisStart;
xEnd=xAxisEnd;
//must compute min-max for other axis!
{
gdlDoRangeExtrema(xVal,yVal,yStart,yEnd,xStart,xEnd);
}
}
#undef UNDEF_RANGE_VALUE
// z range
datamax=0.0;
datamin=0.0;
GetMinMaxVal ( zVal, &datamin, &datamax );
zStart=datamin;
zEnd=datamax;
setZrange = gdlGetDesiredAxisRange(e, "Z", zStart, zEnd);
return false;
}