get_partial_power_base_val_sum Subroutine

pure subroutine get_partial_power_base_val_sum(this, upstream_grad, output)

Fused partial+sum for power base: output(:,1) = sum_s(d(a^n)/da * upstream)

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_power_base_val_sum(this, upstream_grad, output)
    !! Fused partial+sum for power base: output(:,1) = sum_s(d(a^n)/da * upstream)
    implicit none
    class(array_type), intent(in) :: this
    real(real32), dimension(:,:), intent(in) :: upstream_grad
    real(real32), dimension(:), intent(out) :: output

    integer :: s, n_samples
    real(real32) :: exp_val

    n_samples = size(upstream_grad, 2)
    if(all(abs(this%right_operand%val - 1._real32).lt.1.E-6_real32))then
       output(:) = upstream_grad(:,1)
       do s = 2, n_samples
          output(:) = output(:) + upstream_grad(:,s)
       end do
    elseif(all(abs(this%right_operand%val - 2._real32).lt.1.E-6_real32))then
       if(.not.this%left_operand%is_sample_dependent)then
          output(:) = upstream_grad(:,1)
          do s = 2, n_samples
             output(:) = output(:) + upstream_grad(:,s)
          end do
          output(:) = output(:) * this%left_operand%val(:,1) * 2._real32
       else
          output(:) = upstream_grad(:,1) * this%left_operand%val(:,1) * 2._real32
          do s = 2, n_samples
             output(:) = output(:) + &
                  upstream_grad(:,s) * this%left_operand%val(:,s) * 2._real32
          end do
       end if
    else
       exp_val = this%right_operand%val(1,1)
       if(this%right_operand%is_scalar)then
          if(.not.this%left_operand%is_sample_dependent)then
             output(:) = upstream_grad(:,1)
             do s = 2, n_samples
                output(:) = output(:) + upstream_grad(:,s)
             end do
             output(:) = output(:) * exp_val * &
                  this%left_operand%val(:,1) ** (exp_val - 1._real32)
          else
             output(:) = upstream_grad(:,1) * exp_val * &
                  this%left_operand%val(:,1) ** (exp_val - 1._real32)
             do s = 2, n_samples
                output(:) = output(:) + upstream_grad(:,s) * exp_val * &
                     this%left_operand%val(:,s) ** (exp_val - 1._real32)
             end do
          end if
       else
          output(:) = upstream_grad(:,1) * this%right_operand%val(:,1) * &
               this%left_operand%val(:,1) ** (this%right_operand%val(:,1) - 1._real32)
          do s = 2, n_samples
             output(:) = output(:) + upstream_grad(:,s) * &
                  this%right_operand%val(:,s) * &
                  this%left_operand%val(:,s) ** ( &
                       this%right_operand%val(:,s) - 1._real32 &
                  )
          end do
       end if
    end if
  end subroutine get_partial_power_base_val_sum