The main documentation of the Finalize_Integer Procedure contains additional explanation of this code listing.
subroutine Finalize_Integer_0 (I, status)
! Use association information.
use Caesar_Flags_Module, only: finalize_integer_flag
! Input/Output variable.
type(integer), intent(inout) :: I ! Variable to be finalized.
! Output variable.
type(Status_type), intent(out), optional :: status ! Exit status.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements - none.
! Finalization.
I = finalize_integer_flag
! No errors for finalization possible for scalars.
if (PRESENT(status)) status = 'Success'
! Verify guarantees - none.
return
end subroutine Finalize_Integer_0
define([REPLICATE_ROUTINE],[
subroutine Finalize_Integer_$1 (I, status)
! Input/Output variable.
type(integer,$1) :: I ! Variable to be finalized.
! Output variable.
type(Status_type), intent(out), optional :: status ! Exit status.
! Internal variable.
type(integer) :: deallocate_status ! Deallocation Status.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Verify requirements.
VERIFY(ASSOCIATED(I),0) ! I should be associated.
! Deallocation.
DEALLOCATE(I, stat=deallocate_status)
! Finalization and nullification.
NULLIFY(I)
! Verify guarantees and/or set status flag.
if (PRESENT(status)) then
WARN_IF(deallocate_status /= 0, 3) ! Deallocation error check.
WARN_IF(ASSOCIATED(I),3) ! I is now unassociated.
if (deallocate_status == 0 .and. .not.ASSOCIATED(I)) then
status = 'Success'
else
status = 'Memory Error'
end if
else
VERIFY(deallocate_status == 0, 0) ! Deallocation error check.
VERIFY(.not.ASSOCIATED(I), 0) ! I is now unassociated.
end if
return
end subroutine Finalize_Integer_$1
])
REPLICATE_ARRAYS