get_partial_lno_encode_poles_val Subroutine

pure subroutine get_partial_lno_encode_poles_val(this, upstream_grad, output)

dL/dmu_m per sample: output[m,s] = upstream[m,s] * sum_j (-t_j) * exp(-mu_m*t_j) * u[j,s]

Arguments

Type IntentOptional Attributes Name
class(array_type), intent(in) :: this
real(kind=real32), intent(in), dimension(:,:) :: upstream_grad
real(kind=real32), intent(out), dimension(:,:) :: output

Source Code

  pure subroutine get_partial_lno_encode_poles_val( &
       this, upstream_grad, output)
    !! dL/dmu_m per sample:
    !!   output[m,s] = upstream[m,s] * sum_j (-t_j) * exp(-mu_m*t_j) * u[j,s]
    implicit none
    class(array_type), intent(in) :: this
    real(real32), dimension(:,:), intent(in)  :: upstream_grad
    real(real32), dimension(:,:), intent(out) :: output

    integer :: n_in, num_modes, mode_index, j, s, num_samples
    real(real32) :: t, mu_m, accum

    n_in = this%indices(1)
    num_modes = this%indices(2)
    num_samples = size(upstream_grad, 2)

    output = 0.0_real32
    do s = 1, num_samples
       do mode_index = 1, num_modes
          mu_m = this%right_operand%val(mode_index, 1)
          accum = 0.0_real32
          do j = 1, n_in
             if(n_in .gt. 1)then
                t = real(j-1, real32) / real(n_in-1, real32)
             else
                t = 0.0_real32
             end if
             accum = accum + (-t) * exp(-mu_m * t) * &
                  this%left_operand%val(j, s)
          end do
          output(mode_index, s) = upstream_grad(mode_index, s) * accum
       end do
    end do

  end subroutine get_partial_lno_encode_poles_val