LeaveMemoryManager Subroutine

public subroutine LeaveMemoryManager()

Arguments

None

Contents

Source Code


Source Code

    subroutine LeaveMemoryManager()
        ! Call this to print out the largest memory allocations.
        ! If debug flag is on, then the full memory log is dumped to file.

        integer :: iunit, iobjloc(1), iobj, i
        integer(int64), allocatable :: ObjectSizes(:)
        type(MemLogEl), allocatable :: AllMemEl(:)
        character(len=*), parameter :: memoryfile = 'TMPMemoryusage.dat'
        character(len=*), parameter :: fmt1 = '(3a19)'

        if (.not. initialised) then
            if (err_output) write (stdout, *) 'Memory manager not initialised. Cannot leave memory manager.'
            return
        end if

        allocate (ObjectSizes(nLargeObjects + MaxLen))
        allocate (AllMemEl(nLargeObjects + MaxLen))

        if (MemoryUsed == MaxMemoryUsed) then
            ! Peak memory usage is now.
            PeakMemLog(:) = MemLog(:)
        end if

        call writememlogheader(stdout)

        if (CachingMemLog) then
            ! Large objects might be residing in the MemLog, but not deallocated
            ! (and so haven't been moved to the large object store).
            AllMemEl(1:MaxLen) = MemLog
            AllMemEl(MaxLen + 1:MaxLen + nLargeObjects) = LargeObjLog
        else
            ! Everything really ought to be held in just the MemLog: if not, then
            ! this is a "feature".
            AllMemEl(1:MaxLen) = MemLog(:)
        end if

        ! Copy the sizes to an integer array: we use maxloc on the copy.  This
        ! allows us to check for arrays of the same size without writing over
        ! information in our log.
        ObjectSizes(:) = AllMemEl(:)%ObjectSize
        iobjloc(:) = maxloc(ObjectSizes)
        iobj = iobjloc(1)
        ObjectSizes(iobj) = ObjectSizes(iobj) + 1
        do i = 2, nLargeObjects + 1
            ! Print out i-1 large object.
            write (stdout, fmt1, advance='no') ' '//AllMemEl(iobj)%ObjectName, AllMemEl(iobj)%AllocRoutine, AllMemEl(iobj)%DeallocRoutine
            call WriteMemSize(6, AllMemEl(iobj)%ObjectSize)
            ! Find the next large object.
            iobjloc = maxloc(ObjectSizes, mask=ObjectSizes < ObjectSizes(iobj))
            iobj = iobjloc(1)
            if (AllMemEl(iobj)%ObjectName == '' &
                .and. AllMemEl(iobj)%AllocRoutine == '' &
                .and. AllMemEl(iobj)%DeallocRoutine == 'not deallocated' &
                .and. AllMemEl(iobj)%ObjectSize == 0) then
                ! Have logged less than nLargeObjects allocations.
                exit
            end if
            ObjectSizes(iobj) = ObjectSizes(iobj) + 1 ! So we don't find this object next time round.
        end do
        if (warned) then
            write (stdout, *) '== NOTE: Length of logging arrays exceeded. Length needed is ', ipos
        endif
        write (stdout, *) '================================================================'

        if (debug) then
            ! Dump entire memory log to file.
            iunit = 93
!        call get_free_unit(iunit)  !Avoid circular dependancies - hack.
            open (unit=iunit, file=memoryfile, form='formatted', status='unknown')
            call PrintMemory(.true., iunit)
            close (iunit)
        end if

        initialised = .false.
        deallocate (MemLog)
        deallocate (PeakMemLog)
        deallocate (LookupPointer)

        deallocate (ObjectSizes)
        deallocate (AllMemEl)
    end subroutine LeaveMemoryManager