nullify_graph_recursive Subroutine

recursive subroutine nullify_graph_recursive(this, dealloc_list, dealloc_count, ignore_ownership, visit_id, dealloc_id)

Recursive helper using visit_tag for O(1) cycle detection Collects nodes to deallocate in a second pass

Arguments

Type IntentOptional Attributes Name
class(array_type), intent(inout), target :: this
type(array_ptr), intent(inout), allocatable :: dealloc_list(:)
integer, intent(inout) :: dealloc_count
logical, intent(in) :: ignore_ownership
integer, intent(in) :: visit_id
integer, intent(in) :: dealloc_id

Source Code

  recursive subroutine nullify_graph_recursive(this, dealloc_list, dealloc_count, &
       ignore_ownership, visit_id, dealloc_id &
  )
    !! Recursive helper using visit_tag for O(1) cycle detection
    !! Collects nodes to deallocate in a second pass
    implicit none
    class(array_type), intent(inout), target :: this
    type(array_ptr), allocatable, intent(inout) :: dealloc_list(:)
    integer, intent(inout) :: dealloc_count
    logical, intent(in) :: ignore_ownership
    integer, intent(in) :: visit_id, dealloc_id

    ! O(1) visited check via tag
    if(this%visit_tag .eq. visit_id) return
    this%visit_tag = visit_id

    ! Recurse into children
    if(ignore_ownership)then
       if(associated(this%left_operand))then
          call nullify_graph_recursive( &
               this%left_operand, dealloc_list, dealloc_count, &
               ignore_ownership, visit_id, dealloc_id &
          )
       end if
       if(associated(this%right_operand))then
          call nullify_graph_recursive( &
               this%right_operand, dealloc_list, dealloc_count, &
               ignore_ownership, visit_id, dealloc_id &
          )
       end if
       if(associated(this%grad))then
          call nullify_graph_recursive( &
               this%grad, dealloc_list, dealloc_count, &
               ignore_ownership, visit_id, dealloc_id &
          )
       end if
    else
       if(associated(this%left_operand).and.this%owns_left_operand)then
          call nullify_graph_recursive( &
               this%left_operand, dealloc_list, dealloc_count, &
               ignore_ownership, visit_id, dealloc_id &
          )
       end if
       if(associated(this%right_operand).and.this%owns_right_operand)then
          call nullify_graph_recursive( &
               this%right_operand, dealloc_list, dealloc_count, &
               ignore_ownership, visit_id, dealloc_id &
          )
       end if
       if(associated(this%grad).and.this%owns_gradient)then
          call nullify_graph_recursive( &
               this%grad, dealloc_list, dealloc_count, &
               ignore_ownership, visit_id, dealloc_id &
          )
       end if
    end if

    ! Collect nodes for deallocation (use dealloc_id tag to avoid duplicates)
    if(associated(this%left_operand))then
       if(.not.this%left_operand%fix_pointer .and. this%owns_left_operand)then
          if(this%left_operand%visit_tag .ne. dealloc_id)then
             this%left_operand%visit_tag = dealloc_id
             call dealloc_list_append(dealloc_list, dealloc_count, this%left_operand)
          end if
       end if
       nullify(this%left_operand)
    end if

    if(associated(this%right_operand))then
       if(.not.this%right_operand%fix_pointer .and. this%owns_right_operand)then
          if(this%right_operand%visit_tag .ne. dealloc_id)then
             this%right_operand%visit_tag = dealloc_id
             call dealloc_list_append(dealloc_list, dealloc_count, this%right_operand)
          end if
       end if
       nullify(this%right_operand)
    end if

    if(associated(this%grad))then
       if(.not.this%grad%fix_pointer .and. this%owns_gradient)then
          if(this%grad%visit_tag .ne. dealloc_id)then
             this%grad%visit_tag = dealloc_id
             call dealloc_list_append(dealloc_list, dealloc_count, this%grad)
          end if
       end if
       nullify(this%grad)
    end if

    ! Reset ownership and procedure pointers
    this%owns_left_operand = .false.
    this%owns_right_operand = .false.
    this%owns_gradient = .false.
    nullify(this%get_partial_left)
    nullify(this%get_partial_right)
    nullify(this%get_partial_left_val)
    nullify(this%get_partial_right_val)
    nullify(this%get_partial_left_val_sum)
    nullify(this%get_partial_right_val_sum)

  end subroutine nullify_graph_recursive