subroutine LogMemDealloc(DeallocRoutine, tag, err)
! Log a memory deallocation.
! INPUT:
! DeallocRoutine - routine in which object is deallocated.
! tag - position in memory log the object is stored at.
! err (optional) - error output from deallocate statement (checked if present).
! OUTPUT:
! tag - 0 if successfully logged (or noted that it wasn't stored in
! the log in the first place).
character(len=*), intent(in) :: DeallocRoutine
integer(TagIntType), intent(inout) :: tag
integer, intent(in), optional :: err
integer :: i, ismallloc(1)
character(len=25) :: ObjectName
if (.not. initialised) then
if (err_output) write (stdout, *) 'Memory manager not initialised. Cannot log deallocation.'
return
end if
ObjectName = 'Unknown'
if (tag == 0) then
if (err_output) write (stdout, *) 'Warning: attempting to log deallocation but never logged allocation.'
tag = -1
else if (tag > MaxLen .or. tag < -1) then
if (err_output) write (stdout, *) 'Warning: attempting to log deallocation but tag does not exist: ', tag
tag = -1
else
if (MemoryUsed == MaxMemoryUsed) then
! Are at peak memory usage. Copy the memory log.
! Useful to see what's around when memory usage is at a maximum.
PeakMemLog(:) = MemLog(:)
end if
if (tag == -1) then
! No record of it in the log: can only print out a debug message.
if (debug) then
write (stdout, "(2A,I5)") 'Deallocating memory in: ', DeallocRoutine, tag
end if
else
MemoryUsed = MemoryUsed - MemLog(tag)%ObjectSize
MemoryLeft = MaxMemory - MemoryUsed
! Object was stored in the cache.
MemLog(tag)%DeallocRoutine = DeallocRoutine
ObjectName = MemLog(tag)%ObjectName
! Check to see if object is larger than the smallest of the large
! objects: if so, keep a record of it.
if (MemLog(tag)%ObjectSize > LargeObjLog(ismall)%ObjectSize) then
LargeObjLog(ismall) = MemLog(tag)
ismallloc = minloc(LargeObjLog(:)%ObjectSize)
ismall = ismallloc(1)
end if
if (CachingMemLog) then
! Then we free up this slot and slots of all objects directly below it in
! the log that have also been deallocated. This is not the most
! efficient storage (we still can have a fractured log) but
! works well for LIFO approaches, which are most common for us.
MemLog(tag)%ObjectSize = 0 ! Nothing to see here now.
if (tag == ipos - 1) then
do i = tag, 1, -1
if (MemLog(i)%ObjectSize == 0) then
ipos = ipos - 1
else
exit
end if
end do
end if
end if
if (debug) then
write (stdout, "(A,I5,' ',A,' ',A,' ',A,' ',I12)") 'Deallocating memory: ', tag, MemLog(tag)
end if
end if
! Set tag to zero: there was no problem with the logging deallocation
! (apart from maybe a too small cache).
tag = 0
end if
if (present(err)) then
if (err /= 0) then
call Stop_All('LogMemAlloc', 'Failed to deallocate array '//ObjectName//' in '//DeallocRoutine)
end if
end if
end subroutine LogMemDealloc