void SetFuncValue( const DString& funcvalue){funcValue = StrUpCase(funcvalue);}
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
void SetProValue( const DString& provalue){proValue = StrUpCase(provalue);}
void SetKillNotify( const DString& eKN) { killNotify = StrUpCase( eKN);}
void SetNotifyRealize( const DString& eNR) { notifyRealize = StrUpCase( eNR);}
void SetEventFun( const DString& eFun) { eventFun = StrUpCase( eFun);}
void SetEventPro( const DString& ePro) { eventPro = StrUpCase( ePro);}