RAMP_mapping_cpu.f90

Go to the documentation of this file.

 
!
module ramp_mapping_cpu
  use num_types, only: rp
  implicit none
  private
 
  public :: convex_down_ramp_mapping_apply_cpu
  public :: convex_down_ramp_mapping_apply_backward_cpu
  public :: convex_up_ramp_mapping_apply_cpu
  public :: convex_up_ramp_mapping_apply_backward_cpu
 
contains
 
  subroutine convex_down_ramp_mapping_apply_cpu(f_min, f_max, q, X_out, X_in, n)
    integer, intent(in) :: n
    real(kind=rp), intent(in) :: f_min, f_max, q
    real(kind=rp), dimension(n), intent(out) :: x_out
    real(kind=rp), dimension(n), intent(in) :: x_in
 
    x_out = convex_down_ramp_mapping_kernel(f_min, f_max, q, x_in)
 
  end subroutine convex_down_ramp_mapping_apply_cpu
 
  subroutine convex_down_ramp_mapping_apply_backward_cpu(f_min, f_max, q, &
       sens_out, sens_in, X_in, n)
    integer, intent(in) :: n
    real(kind=rp), intent(in) :: f_min, f_max, q
    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
 
    sens_out = convex_down_ramp_mapping_backward_kernel(f_min, f_max, q, &
         sens_in, x_in)
 
  end subroutine convex_down_ramp_mapping_apply_backward_cpu
 
  subroutine convex_up_ramp_mapping_apply_cpu(f_min, f_max, q, X_out, X_in, n)
    integer, intent(in) :: n
    real(kind=rp), intent(in) :: f_min, f_max, q
    real(kind=rp), dimension(n), intent(out) :: x_out
    real(kind=rp), dimension(n), intent(in) :: x_in
 
    x_out = convex_up_ramp_mapping_kernel(f_min, f_max, q, x_in)
 
  end subroutine convex_up_ramp_mapping_apply_cpu
 
  subroutine convex_up_ramp_mapping_apply_backward_cpu(f_min, f_max, q, &
       sens_out, sens_in, X_in, n)
    integer, intent(in) :: n
    real(kind=rp), intent(in) :: f_min, f_max, q
    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
 
    sens_out = convex_up_ramp_mapping_backward_kernel(f_min, f_max, q, &
         sens_in, x_in)
 
  end subroutine convex_up_ramp_mapping_apply_backward_cpu
 
  elemental function convex_down_ramp_mapping_kernel(f_min, f_max, q, X_in) &
       result(x_out)
    real(kind=rp), intent(in) :: f_min, f_max, q
    real(kind=rp), intent(in) :: x_in
    real(kind=rp) :: x_out
 
    x_out = f_min + (f_max - f_min) * x_in / (1.0_rp + q * (1.0_rp - x_in))
 
  end function convex_down_ramp_mapping_kernel
 
  elemental function convex_down_ramp_mapping_backward_kernel(f_min, f_max, q, &
       sens_in, X_in) result(sens_out)
    real(kind=rp), intent(in) :: f_min, f_max, q
    real(kind=rp), intent(in) :: sens_in, x_in
    real(kind=rp) :: sens_out
 
    sens_out = sens_in * (f_max - f_min) * (q + 1.0_rp) / &
         ((1.0_rp - q * (x_in - 1.0_rp))**2)
 
  end function convex_down_ramp_mapping_backward_kernel
 
  elemental function convex_up_ramp_mapping_kernel(f_min, f_max, q, X_in) &
       result(x_out)
    real(kind=rp), intent(in) :: f_min, f_max, q
    real(kind=rp), intent(in) :: x_in
    real(kind=rp) :: x_out
 
    x_out = f_min + (f_max - f_min) * x_in * (1.0_rp + q) / (x_in + q)
 
  end function convex_up_ramp_mapping_kernel
 
  elemental function convex_up_ramp_mapping_backward_kernel(f_min, f_max, q, &
       sens_in, X_in) result(sens_out)
    real(kind=rp), intent(in) :: f_min, f_max, q
    real(kind=rp), intent(in) :: sens_in, x_in
    real(kind=rp) :: sens_out
 
    sens_out = sens_in * (f_max - f_min) * (q + 1.0_rp) * q / ((x_in + q)**2)
 
  end function convex_up_ramp_mapping_backward_kernel
 
end module ramp_mapping_cpu