void set_shading(EnvT* e)
{
DDoubleGDL *light;
static int lightIx=e->KeywordIx ( "LIGHT" );
if ( e->GetKW ( lightIx )!=NULL )
{
light=e->GetKWAs<DDoubleGDL>( lightIx );
if (light->N_Elements()>3) e->Throw("Keyword array parameter LIGHT must have from 1 to 3 elements.");
for (SizeT i=0; i< light->N_Elements(); ++i) lightSourcePos[i]=(*light)[i];
}
}
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)
{
//T3D?
static int t3dIx = e->KeywordIx( "T3D");
doT3d=(e->KeywordSet(t3dIx)|| T3Denabled());
//note: Z (VALUE) will be used uniquely if Z is not effectively defined.
static int zvIx = e->KeywordIx( "ZVALUE");
zValue=0.0;
e->AssureDoubleScalarKWIfPresent ( zvIx, zValue );
zValue=min(zValue,0.999999); //to avoid problems with plplot
zValue=max(zValue,0.0);
// system variable !P.NSUM first
DLong nsum=(*static_cast<DLongGDL*>(SysVar::P()-> GetTag(SysVar::P()->Desc()->TagIndex("NSUM"), 0)))[0];
static int NSUMIx = e->KeywordIx( "NSUM");
e->AssureLongScalarKWIfPresent( NSUMIx, nsum);
static int polarIx = e->KeywordIx( "POLAR");
bool polar = (e->KeywordSet(polarIx));
// DDoubleGDL *yValBis, *xValBis;
// Guard<BaseGDL> xvalBis_guard, yvalBis_guard;
//test and transform eventually if POLAR and/or NSUM!
if( nParam() == 1)
{
yTemp = e->GetParAs< DDoubleGDL>( 0);
if (yTemp->Rank() == 0)
e->Throw("Expression must be an array in this context: "+e->GetParString(0));
yEl=yTemp->N_Elements();
xEl=yEl;
xTemp = new DDoubleGDL( dimension( xEl), BaseGDL::INDGEN);
xtemp_guard.Reset( xTemp); // delete upon exit
}
else
{
xTemp = e->GetParAs< DDoubleGDL>( 0);
if (xTemp->Rank() == 0)
e->Throw("Expression must be an array in this context: "+e->GetParString(0));
xEl=xTemp->N_Elements();
yTemp = e->GetParAs< DDoubleGDL>( 1);
if (yTemp->Rank() == 0)
e->Throw("Expression must be an array in this context: "+e->GetParString(1));
yEl=yTemp->N_Elements();
//silently drop unmatched values
if (yEl != xEl)
{
SizeT size;
size = min(xEl, yEl);
xEl = size;
yEl = size;
}
}
//check nsum validity
nsum=max(1,nsum);
nsum=min(nsum,(DLong)xEl);
if (nsum == 1)
{
if (polar)
{
xVal = new DDoubleGDL(dimension(xEl), BaseGDL::NOZERO);
xval_guard.Reset(xVal); // delete upon exit
yVal = new DDoubleGDL(dimension(yEl), BaseGDL::NOZERO);
yval_guard.Reset(yVal); // delete upon exit
for (int i = 0; i < xEl; i++) (*xVal)[i] = (*xTemp)[i] * cos((*yTemp)[i]);
for (int i = 0; i < yEl; i++) (*yVal)[i] = (*xTemp)[i] * sin((*yTemp)[i]);
}
else
{ //careful about previously set autopointers!
if (nParam() == 1) xval_guard.Init( xtemp_guard.release());
xVal = xTemp;
yVal = yTemp;
}
}
else
{
int i, j, k;
DLong size = (DLong)xEl / nsum;
xVal = new DDoubleGDL(size, BaseGDL::ZERO); //SHOULD BE ZERO, IS NOT!
xval_guard.Reset(xVal); // delete upon exit
yVal = new DDoubleGDL(size, BaseGDL::ZERO); //IDEM
yval_guard.Reset(yVal); // delete upon exit
for (i = 0, k = 0; i < size; i++)
{
(*xVal)[i] = 0.0;
(*yVal)[i] = 0.0;
for (j = 0; j < nsum; j++, k++)
{
(*xVal)[i] += (*xTemp)[k];
(*yVal)[i] += (*yTemp)[k];
}
}
for (i = 0; i < size; i++) (*xVal)[i] /= nsum;
for (i = 0; i < size; i++) (*yVal)[i] /= nsum;
if (polar)
{
DDouble x, y;
for (i = 0; i < size; i++)
{
x = (*xVal)[i] * cos((*yVal)[i]);
y = (*xVal)[i] * sin((*yVal)[i]);
(*xVal)[i] = x;
(*yVal)[i] = y;
}
}
}
return false;
}