get_partial_power_base Function

function get_partial_power_base(this, upstream_grad) result(output)

Get the partial gradient with respect to the base of the power operation

Arguments

Type IntentOptional Attributes Name
class(array_type), intent(inout) :: this
type(array_type), intent(in) :: upstream_grad

Return Value type(array_type)


Source Code

  function get_partial_power_base(this, upstream_grad) result(output)
    !! Get the partial gradient with respect to the base of the power operation
    implicit none
    class(array_type), intent(inout) :: this
    type(array_type), intent(in) :: upstream_grad
    type(array_type) :: output
    logical :: left_is_temporary_local, right_is_temporary_local
    type(array_type), pointer :: ptr

    left_is_temporary_local = this%left_operand%is_temporary
    right_is_temporary_local = this%right_operand%is_temporary
    this%left_operand%is_temporary = .false.
    this%right_operand%is_temporary = .false.
    if(all(abs(this%right_operand%val - 1._real32).lt.1.E-6_real32))then
       output = upstream_grad
       return
    elseif(all(abs(this%right_operand%val - 2._real32).lt.1.E-6_real32))then
       ptr => upstream_grad * this%left_operand * 2._real32
    else
       if(this%right_operand%is_scalar)then
          ptr => upstream_grad * this%right_operand%val(1,1) * &
               this%left_operand ** ( this%right_operand%val(1,1) - 1.0_real32 )
       else
          ptr => upstream_grad * this%right_operand * &
               this%left_operand ** ( this%right_operand - 1.0_real32 )
       end if
    end if
    this%left_operand%is_temporary = left_is_temporary_local
    this%right_operand%is_temporary = right_is_temporary_local
    call output%assign_and_deallocate_source(ptr)
  end function get_partial_power_base