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
Exemplo n.º 3
0
  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;
    }
    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;
    } 
Exemplo n.º 5
0
    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;
    }