duplicate_pointer Function

recursive function duplicate_pointer(input_ptr, src_map, dst_map, owns_self) result(output_ptr)

Arguments

Type IntentOptional Attributes Name
type(array_type), target :: input_ptr
type(array_ptr), allocatable :: src_map(:)
type(array_ptr), allocatable :: dst_map(:)
logical, intent(out) :: owns_self

Return Value type(array_type), pointer


Source Code

  recursive function duplicate_pointer(input_ptr, src_map, dst_map, owns_self) &
       result(output_ptr)
    implicit none
    type(array_type), target :: input_ptr
    type(array_ptr), allocatable :: src_map(:), dst_map(:)
    type(array_type), pointer :: output_ptr
    logical, intent(out):: owns_self
    integer :: idx
    logical :: tmp_logical

    owns_self = .false.
    idx = map_find(src_map, input_ptr)
    if(idx .ne. 0)then
       output_ptr => dst_map(idx)%p
       return
    elseif(input_ptr%fix_pointer)then
       ! If pointer is fixed, do not duplicate; just return original
       output_ptr => input_ptr
       return
    end if

    ! Create duplicate node (caller may want ownership policies)
    allocate(output_ptr)
    call output_ptr%assign_shallow(input_ptr)
    ! Mark that output_ptr is a duplicate (so callers can deallocate later)
    owns_self = .true.
    output_ptr%is_temporary = .true.

    ! Add to map BEFORE recursing to handle cycles / shared nodes
    call double_map_add(src_map, dst_map, input_ptr, output_ptr)

    ! Now recursively duplicate children (use pointer assignment to map results)
    if(associated(input_ptr%left_operand))then
       output_ptr%left_operand => duplicate_pointer( &
            input_ptr%left_operand, src_map, dst_map, tmp_logical &
       )
       output_ptr%owns_left_operand = tmp_logical
    end if
    if(associated(input_ptr%right_operand))then
       output_ptr%right_operand => duplicate_pointer( &
            input_ptr%right_operand, src_map, dst_map, tmp_logical &
       )
       output_ptr%owns_right_operand = tmp_logical
    end if
    if(associated(input_ptr%grad))then
       output_ptr%grad => duplicate_pointer(&
            input_ptr%grad, src_map, dst_map, tmp_logical &
       )
       output_ptr%owns_gradient = .true.
    end if

  end function duplicate_pointer