stimulation_mod.f90

Go to the documentation of this file.

module stimulation_mod

  use choral_constants
  use basic_tools
  use real_type
  use abstract_interfaces
  use funclib
 
  implicit none

  public :: stimulation


  !       %----------------------------------------%
  !       |                                        |
  !       |          DERIVED TYPE                  |
  !       |                                        |
  !       %----------------------------------------%
  type stimulation

     procedure(rtor), nopass, pointer :: f => f_c3
     
     real(RP), dimension(3) :: x0 = 0._rp

     real(RP) :: t0 =  3._rp

     real(RP) :: rt  =  1._rp
     
     real(RP) :: rx =  0.15_rp

     real(RP) :: l =  1.0_rp

   contains

     procedure :: I_app => stim

  end type stimulation


  !       %----------------------------------------%
  !       |                                        |
  !       |       GENERIc SUBROUTINES              |
  !       |                                        |
  !       %----------------------------------------%
  interface stimulation
     module procedure  stimulation_create
  end interface stimulation


contains

  function stimulation_create(f, L, t0, Rt, Rx, x0) result(s)
    type(stimulation) :: s

    procedure(rtor)      :: F
    real(RP), intent(in) :: L
    real(RP), intent(in) :: t0
    real(RP), intent(in) :: Rt
    real(RP), intent(in) :: Rx
    real(RP), dimension(3), optional, intent(in) :: x0

    s%t0 =  t0
    s%Rt =  rt
    s%Rx =  rx
    s%L  =  l
    s%F  => f

    if (present(x0)) then
       s%x0 = x0
    else
       s%x0 = 0._rp
    end if

    if (.NOT.associated(s%f)) call quit("stimulation_mod:&
         & stimulation_create: invalid argument 'f'")
    if (.NOT.(s%Rt>0._rp)) call quit("stimulation_mod:&
         & stimulation_create: invalid argument 'Rt'")
    if (.NOT.(s%Rx>0._rp)) call quit("stimulation_mod:&
         & stimulation_create: invalid argument 'Rx'")

  end function stimulation_create


  function stim(s, x, t) result(res)
    class(stimulation)    , intent(in) :: s
    real(RP)                           :: res
    real(RP), dimension(3), intent(in) :: x
    real(RP)              , intent(in) :: t

    real(RP) :: t2, r

    t2 = abs( t - s%t0)/s%Rt

    r = sqrt(sum( (x-s%x0)**2 ))/s%Rx

    res = s%f(t2) * s%f(r) * s%L

  end function stim


end module stimulation_mod