sll_m_control_variate.F90

Go to the documentation of this file.

 
 
module sll_m_control_variate
 
#include "sll_working_precision.h"
#include "sll_memory.h"
 
  use sll_m_initial_distribution, only : &
       sll_c_distribution_params
 
  implicit none
  private
 
  public :: sll_i_control_variate, &
       sll_t_control_variate, &
       sll_t_control_variates
 
 
  type :: sll_t_control_variate
 
     sll_real64, pointer :: control_variate_parameters(:) => null() 
     class(sll_c_distribution_params), pointer :: control_variate_distribution_params => null() 
 
     procedure(sll_i_control_variate), pointer :: control_variate => null() 
 
   contains
 
     procedure :: update_df_weight
     procedure :: init => init_control_variate 
     procedure :: free => free_control_variate 
 
  end type sll_t_control_variate
 
 
  type :: sll_t_control_variates
 
     class(sll_t_control_variate), allocatable :: cv(:)
     
  end type sll_t_control_variates
  
  abstract interface
 
     function sll_i_control_variate(self, xi, vi, time)
       use sll_m_working_precision 
       import sll_t_control_variate
       class(sll_t_control_variate)       :: self
       sll_real64, optional, intent( in ) :: xi(:) 
       sll_real64, optional, intent( in ) :: vi(:) 
       sll_real64, optional, intent( in ) :: time  
       sll_real64                         :: sll_i_control_variate
 
     end function sll_i_control_variate
  end interface
 
 
  contains
    
    function update_df_weight(self, xi, vi, time, weight_ff, g0) result(weight_df)
      class(sll_t_control_variate) :: self
      sll_real64, intent( in ) :: xi(:) 
      sll_real64, intent( in ) :: vi(:) 
      sll_real64, intent( in ) :: time  
      sll_real64, intent( in ) :: weight_ff 
      sll_real64, intent( in ) :: g0 
      sll_real64 :: weight_df 
 
      weight_df = weight_ff - self%control_variate(xi, vi, time)/g0
 
    end function update_df_weight
 
    subroutine init_control_variate( self, control_function, parameters, distribution_params ) 
      class(sll_t_control_variate), intent(out) :: self
      procedure(sll_i_control_variate) :: control_function
      sll_real64, target,optional,  intent(in) :: parameters(:) 
      class(sll_c_distribution_params), target, optional, intent(in) :: distribution_params
 
      self%control_variate => control_function
      
      if (present(parameters)) self%control_variate_parameters => parameters
      
      if (present(distribution_params)) self%control_variate_distribution_params => distribution_params
 
      
    end subroutine init_control_variate
 
 
    subroutine free_control_variate( self ) 
      class(sll_t_control_variate), intent(inout) :: self
     
      self%control_variate_parameters => null()
      self%control_variate_distribution_params => null()
 
    end subroutine free_control_variate
 
 
 
end module sll_m_control_variate