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