heaviside_mapping_cpu.f90

Go to the documentation of this file.

 
!
module heaviside_mapping_cpu
  use num_types, only: rp
  implicit none
  private
 
  public :: heaviside_mapping_apply_cpu, &
       heaviside_mapping_apply_backward_cpu
 
contains
 
  subroutine heaviside_mapping_apply_cpu(beta, eta, X_out, X_in, n)
    integer, intent(in) :: n
    real(kind=rp), intent(in) :: beta, eta
    real(kind=rp), dimension(n), intent(out) :: x_out
    real(kind=rp), dimension(n), intent(in) :: x_in
    real(kind=rp) :: den, tanh_beta_eta
 
    tanh_beta_eta = tanh(beta * eta)
    den = tanh_beta_eta + tanh(beta * (1.0_rp - eta))
 
    x_out = heaviside_mapping_kernel(beta, eta, den, tanh_beta_eta, x_in)
 
  end subroutine heaviside_mapping_apply_cpu
 
  subroutine heaviside_mapping_apply_backward_cpu(beta, eta, &
       sens_out, sens_in, X_in, n)
    integer, intent(in) :: n
    real(kind=rp), intent(in) :: beta, eta
    real(kind=rp), dimension(n), intent(out) :: sens_out
    real(kind=rp), dimension(n), intent(in) :: sens_in
    real(kind=rp), dimension(n), intent(in) :: x_in
    real(kind=rp) :: den
 
    den = tanh(beta * eta) + tanh(beta * (1.0_rp - eta))
 
    sens_out = heaviside_mapping_backward_kernel(beta, eta, den, &
         sens_in, x_in)
 
  end subroutine heaviside_mapping_apply_backward_cpu
 
  elemental function heaviside_mapping_kernel(beta, eta, den, &
       tanh_beta_eta, X_in) result(X_out)
    real(kind=rp), intent(in) :: beta, eta, den, tanh_beta_eta
    real(kind=rp), intent(in) :: x_in
    real(kind=rp) :: x_out
 
    x_out = (tanh_beta_eta + tanh(beta * (x_in - eta))) / den
 
  end function heaviside_mapping_kernel
 
  elemental function heaviside_mapping_backward_kernel(beta, eta, den, &
       sens_in, X_in) result(sens_out)
    real(kind=rp), intent(in) :: beta, eta, den
    real(kind=rp), intent(in) :: sens_in, x_in
    real(kind=rp) :: sens_out, arg, tanh_arg
 
    arg = beta * (x_in - eta)
    tanh_arg = tanh(arg)
    sens_out = beta * (1.0_rp - tanh_arg * tanh_arg) / den * sens_in
 
  end function heaviside_mapping_backward_kernel
 
end module heaviside_mapping_cpu