B.4.2 Finalize_Logical Procedure

The main documentation of the Finalize_Logical Procedure contains additional explanation of this code listing.

  subroutine Finalize_Logical_0 (L, status)

    ! Use association information.

    use Caesar_Flags_Module, only: finalize_logical_flag 

    ! Input/Output variable.

    type(logical), intent(inout) :: L    ! Variable to be finalized.

    ! Output variable.

    type(Status_type), intent(out), optional :: status  ! Exit status.

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ! Verify requirements - none.

    ! Finalization.

    L = finalize_logical_flag

    ! No errors for finalization possible for scalars.

    if (PRESENT(status)) status = 'Success'

    ! Verify guarantees - none.

    return
  end subroutine Finalize_Logical_0

  define([REPLICATE_ROUTINE],[
    subroutine Finalize_Logical_$1 (L, status)
  
      ! Input/Output variable.
  
      type(logical,$1) :: L              ! 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(L),0)           ! L should be associated.
  
      ! Deallocation.
  
      DEALLOCATE(L, stat=deallocate_status)
  
      ! Finalization and nullification.
  
      NULLIFY(L)
  
      ! Verify guarantees and/or set status flag.
  
      if (PRESENT(status)) then
        WARN_IF(deallocate_status /= 0, 3)  ! Deallocation error check.
        WARN_IF(ASSOCIATED(L),3)            ! L is now unassociated.
        if (deallocate_status == 0 .and. .not.ASSOCIATED(L)) then
          status = 'Success'
        else
          status = 'Memory Error'
        end if
      else
        VERIFY(deallocate_status == 0, 0)  ! Deallocation error check.
        VERIFY(.not.ASSOCIATED(L), 0)      ! L is now unassociated.
      end if
  
      return
    end subroutine Finalize_Logical_$1
  ])

  REPLICATE_ARRAYS