LogMemAlloc_int64 Subroutine

private subroutine LogMemAlloc_int64(ObjectName, ObjectSize, ElementSize, AllocRoutine, tag, err, nCalls)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: ObjectName
integer(kind=int64), intent(in) :: ObjectSize
integer(kind=int64), intent(in) :: ElementSize
character(len=*), intent(in) :: AllocRoutine
integer(kind=TagIntType), intent(out) :: tag
integer, intent(in), optional :: err
integer, intent(inout), optional :: nCalls

Contents

Source Code


Source Code

    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