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