subroutine LogMemAlloc_int64(ObjectName, ObjectSize, ElementSize, AllocRoutine, tag, err, nCalls)
character(len=*), intent(in) :: ObjectName, AllocRoutine
integer(int64), intent(in) :: ObjectSize
integer(int64), intent(in) :: ElementSize
integer(TagIntType), intent(out) :: tag
integer, intent(in), optional :: err
integer, intent(inout), optional :: nCalls
integer(int64) :: ObjectSizeBytes
integer :: ismallloc(1)
character(*), parameter :: this_routine = 'LogMemAlloc'
if (present(nCalls)) nCalls = nCalls + 1
if (.not. initialised) then
write (stdout, *) 'Memory manager not initialised. Doing so now with 1GB limit.'
call InitMemoryManager()
end if
ObjectSizeBytes = ObjectSize * ElementSize
MemoryUsed = MemoryUsed + ObjectSizeBytes
MaxMemoryUsed = max(MemoryUsed, MaxMemoryUsed)
MemoryLeft = MaxMemory - MemoryUsed
if (MemoryLeft < 0 .and. nWarn < MaxWarn) then
if (err_output) write (stdout, *) 'WARNING: Memory used exceeds maximum memory set', MemoryLeft
nWarn = nWarn + 1
end if
if (present(err)) then
if (err /= 0) then
call stop_all(this_routine, 'Failure to allocate array '//ObjectName//' in '//AllocRoutine)
end if
end if
if (ipos > MaxLen) then
if (.not. warned) then
warned = .true.
if (err_output) then
write (stdout, *) 'Warning: Array capacity of memory manager exceeded.'
write (stdout, *) 'Required array length is ', ipos
write (stdout, *) 'Max memory used is likely to be incorrect.'
end if
end if
tag = -1
! If we're not putting it in the log, test if it's a huge array:
! it's always the biggest fishes that get away!
if (ObjectSizeBytes > LargeObjLog(ismall)%ObjectSize) then
LargeObjLog(ismall)%ObjectName = ObjectName
LargeObjLog(ismall)%AllocRoutine = AllocRoutine
LargeObjLog(ismall)%ObjectSize = ObjectSizeBytes
ismallloc = minloc(LargeObjLog(:)%ObjectSize)
ismall = ismallloc(1)
end if
else
MemLog(ipos)%ObjectName = ObjectName
MemLog(ipos)%AllocRoutine = AllocRoutine
MemLog(ipos)%DeallocRoutine = 'not deallocated' ! In case this slot has already been used and abandoned.
MemLog(ipos)%ObjectSize = ObjectSizeBytes
tag = ipos
ipos = ipos + 1
end if
if (debug) then
write (stdout, "(A,I6,I12,' ',A,' ',A,' ',I12)") 'Allocating memory: ', tag, ObjectSizeBytes, ObjectName, AllocRoutine, MemoryUsed
end if
end subroutine LogMemAlloc_int64