MemoryManager_module.f90

Go to the documentation of this file.

! Copyright 2019
!
! For a comprehensive list of the developers that contributed to these codes
! see the UK-AMOR website.
!
! This file is part of UKRmol-in (UKRmol+ suite).
!
!     UKRmol-in is free software: you can redistribute it and/or modify
!     it under the terms of the GNU General Public License as published by
!     the Free Software Foundation, either version 3 of the License, or
!     (at your option) any later version.
!
!     UKRmol-in is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with  UKRmol-in (in source/COPYING). Alternatively, you can also visit
!     <https://www.gnu.org/licenses/>.
 
module memorymanager_module
 
    use precisn,   only: longint, wp
    use const_gbl, only: stdout
 
    implicit none
 
    public master_memory
 
    private
 
    type :: memorymanager
        private
        integer(longint) :: total_local_memory = 0
        integer(longint) :: available_local_memory = 0
        integer(longint) :: cached_tracked_memory = 0
        logical          :: initialized = .false.
    contains
        private
        procedure, public :: construct => memorymanager_ctor
        procedure, public :: init_memory
        procedure, public :: track_memory
        procedure, public :: free_memory
        procedure, public :: get_available_memory
        procedure, public :: get_scaled_available_memory
        procedure, public :: print_memory_report
    end type memorymanager
 
    type(memorymanager) :: master_memory
 
contains
 
    subroutine memorymanager_ctor (this, total_memory)
        class(memorymanager)         :: this
        integer(longint), intent(in) :: total_memory
 
        this % total_local_memory = total_memory
        this % available_local_memory = this % total_local_memory
        this % initialized  = .true.
        this % available_local_memory = this % available_local_memory - this % cached_tracked_memory
 
    end subroutine memorymanager_ctor
 
 
    subroutine init_memory (this, total_memory)
        class(memorymanager)         :: this
        integer(longint), intent(in) :: total_memory
 
        this % total_local_memory = total_memory
        this % available_local_memory = this % total_local_memory
        this % available_local_memory = this % available_local_memory - this % cached_tracked_memory
        this % initialized = .true.
 
    end subroutine init_memory
 
 
    subroutine track_memory (this, elem_size, nelem, stat, array_name)
        class(memorymanager)         :: this
        character(len=*), intent(in) :: array_name
        integer,          intent(in) :: elem_size,nelem,stat
        integer(longint)             :: total_mem
 
        !Check if allocation was successfull
        if (stat /= 0) then
            !If not print name and error stats
            write (stdout, "('Array : ',a)") array_name
            write (stdout, "('stat returned error ',i16,' when trying to allocate nelems ',i16,' of size ', i16)") &
                stat, nelem, elem_size
            !Halt the program
            stop "[Memory manager] Memory allocation error"
        end if
 
        ! calculate in bytes total memory used
        total_mem = elem_size * nelem
 
        !Remove from available memory
        !$OMP ATOMIC
        this % cached_tracked_memory = this % cached_tracked_memory + total_mem
        if (.not. this % initialized) return
        !$OMP ATOMIC
        this % available_local_memory = this % available_local_memory - total_mem
 
        !If we've hit negative then throw error
        if (this % available_local_memory < 0) then
            call this % print_memory_report()
            write (stdout, "('Array : ',a)") array_name
            write (stdout, "('Overrun allowed memory space when trying to allocate nelems ',i16,' of size ', 2i16,' vs',i16)") &
                nelem, elem_size, total_mem, this % get_available_memory()
            stop "[Memory manager] Overrun space"
        end if
    end subroutine track_memory
 
 
    subroutine free_memory (this, elem_size, nelem)
        class(memorymanager) :: this
        integer, intent(in)  :: elem_size, nelem
        integer(longint)     :: total_mem
 
        ! Calculate total deallocated
        total_mem = elem_size * nelem
        !$OMP ATOMIC
        this % cached_tracked_memory = this % cached_tracked_memory - total_mem
        !Add memory back to pool
        if (.not. this % initialized) return
        !$OMP ATOMIC
        this % available_local_memory = this % available_local_memory + total_mem
 
        !If we have more memory than available then flag as there is a mismatching of track and free
        if (this % available_local_memory > this % total_local_memory) then
            stop "Memory mismatch"
        end if
 
    end subroutine free_memory
 
 
    integer(longint) function get_available_memory (this)
        class(memorymanager) :: this
 
        get_available_memory = this % available_local_memory
 
    end function get_available_memory
 
 
    integer(longint) function get_scaled_available_memory (this, scale_)
        class(memorymanager) :: this
        real(wp), intent(in) :: scale_
        real(wp)             :: s
 
        !Clamp scale between 0.0 ad 1.0
        s = min(abs(scale_), 1.0_wp)
 
        !Return scaled
        get_scaled_available_memory = int(real(this % available_local_memory) * s, longint)
 
    end function get_scaled_available_memory
 
 
    subroutine print_memory_report (this)
        class(memorymanager) :: this
        real(wp) :: mem_total, mem_avail, percentage
 
        !Compute total in gibibytes
        mem_total = real(this % total_local_memory) / real(1024**3)
 
        !Compute available in gibibytes
        mem_avail = real(this % available_local_memory) / real(1024**3)
 
        !Compute percentage available
        percentage = mem_avail * 100.0 / mem_total
        write (stdout, "('Currently we have ',f18.8,'GB / ',f18.8,'GiB available')") mem_avail, mem_total
        write (stdout, "('Memory availability at ',f6.1,'%')") percentage
 
    end subroutine print_memory_report
 
end module memorymanager_module