Recursive helper using visit_tag for O(1) cycle detection Collects nodes to deallocate in a second pass
| Type | Intent | Optional | 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 |
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