Line data    Source code

       1             : ! Provides methods for querying memory use
       2             : 
       3             : MODULE ice_memusage
       4             : 
       5             : !-------------------------------------------------------------------------------
       6             : ! PURPOSE: memory use query methods
       7             : !    Should call ice_memusage_init once before calling other interfaces
       8             : !-------------------------------------------------------------------------------
       9             : 
      10             :    use ice_kinds_mod, only : dbl_kind, log_kind
      11             : 
      12             :    implicit none
      13             :    private
      14             : 
      15             : ! PUBLIC: Public interfaces
      16             : 
      17             :    public ::  ice_memusage_getusage, &
      18             :               ice_memusage_init, &   ! LCOV_EXCL_LINE
      19             :               ice_memusage_print
      20             : 
      21             :    logical(log_kind), public :: memory_stats
      22             : 
      23             : ! PRIVATE DATA:
      24             : 
      25             :    real(dbl_kind) :: mb_blk = 1.0_dbl_kind
      26             :    logical        :: initset = .false.
      27             : 
      28             : !===============================================================================
      29             : 
      30             : contains
      31             : 
      32             : !===============================================================================
      33             : ! Initialize memory conversion to MB
      34             : 
      35           7 : subroutine ice_memusage_init(iunit)
      36             : 
      37             :    implicit none
      38             : 
      39             :    !----- arguments -----
      40             : 
      41             :    integer, optional :: iunit   !< output unit number for optional writes
      42             : 
      43             :    !----- local -----
      44             : 
      45             :    ! --- Memory stats ---
      46             :    integer :: msize                   ! memory size (high water)
      47             :    integer :: mrss0,mrss1,mrss2       ! temporary rss
      48             :    integer :: mshare,mtext,mdatastack
      49             :    integer :: ierr
      50             : 
      51             :    integer :: ice_memusage_gptl
      52             : 
      53           7 :    real(dbl_kind),allocatable :: mem_tmp(:)
      54             :    character(*),parameter  :: subname = '(ice_memusage_init)'
      55             : 
      56             :    !---------------------------------------------------
      57             : 
      58             :    ! return if memory_stats are off
      59           7 :    if (.not. memory_stats) return
      60             : 
      61           0 :    ierr = ice_memusage_gptl (msize, mrss0, mshare, mtext, mdatastack)
      62           0 :    allocate(mem_tmp(1024*1024))    ! 1 MWord, 8 MB
      63           0 :    mem_tmp = -1.0
      64           0 :    ierr = ice_memusage_gptl (msize, mrss1, mshare, mtext, mdatastack)
      65           0 :    deallocate(mem_tmp)
      66           0 :    ierr = ice_memusage_gptl (msize, mrss2, mshare, mtext, mdatastack)
      67           0 :    mb_blk = 1.0_dbl_kind
      68           0 :    if (mrss1 - mrss0 > 0) then
      69           0 :       mb_blk = (8.0_dbl_kind)/((mrss1-mrss0)*1.0_dbl_kind)
      70           0 :       initset = .true.
      71             :    endif
      72             : 
      73           0 :    if (present(iunit)) then
      74           0 :       write(iunit,'(A,l4)')    subname//' Initset conversion flag is ',initset
      75           0 :       write(iunit,'(A,f16.2)') subname//' 8 MB memory   alloc in MB is ',(mrss1-mrss0)*mb_blk
      76           0 :       write(iunit,'(A,f16.2)') subname//' 8 MB memory dealloc in MB is ',(mrss1-mrss2)*mb_blk
      77           0 :       write(iunit,'(A,f16.2)') subname//' Memory block size conversion in bytes is ',mb_blk*1024_dbl_kind*1024.0_dbl_kind
      78             :    endif
      79             : 
      80           7 : end subroutine ice_memusage_init
      81             : 
      82             : !===============================================================================
      83             : ! Determine memory use
      84             : 
      85           0 : subroutine ice_memusage_getusage(r_msize,r_mrss)
      86             : 
      87             :    implicit none
      88             : 
      89             :    !----- arguments ---
      90             :    real(dbl_kind),intent(out) :: r_msize  !< memory usage value
      91             :    real(dbl_kind),intent(out) :: r_mrss   !< memory usage value
      92             : 
      93             :    !----- local ---
      94             :    integer :: msize,mrss
      95             :    integer :: mshare,mtext,mdatastack
      96             :    integer :: ierr
      97             :    integer :: ice_memusage_gptl
      98             :    character(*),parameter  :: subname = '(ice_memusage_getusage)'
      99             : 
     100             :    !---------------------------------------------------
     101             : 
     102             :    ! return if memory_stats are off
     103           0 :    if (.not. memory_stats) return
     104             : 
     105           0 :    ierr = ice_memusage_gptl (msize, mrss, mshare, mtext, mdatastack)
     106           0 :    r_msize = msize*mb_blk
     107           0 :    r_mrss  = mrss*mb_blk
     108             : 
     109             : end subroutine ice_memusage_getusage
     110             : 
     111             : !===============================================================================
     112             : ! Print memory use
     113             : 
     114         998 : subroutine ice_memusage_print(iunit,string)
     115             : 
     116             :    implicit none
     117             : 
     118             :    !----- arguments ---
     119             :    integer, intent(in) :: iunit    !< unit number to write to
     120             :    character(len=*),optional, intent(in) :: string  !< optional string
     121             : 
     122             :    !----- local ---
     123         364 :    real(dbl_kind)     :: msize,mrss
     124             :    character(len=128) :: lstring
     125             :    character(*),parameter  :: subname = '(ice_memusage_print)'
     126             : 
     127             :    !---------------------------------------------------
     128             : 
     129             :    ! return if memory_stats are off
     130         998 :    if (.not. memory_stats) return
     131             : 
     132           0 :    lstring = ' '
     133           0 :    if (present(string)) then
     134           0 :       lstring = string
     135             :    endif
     136             : 
     137           0 :    call ice_memusage_getusage(msize,mrss)
     138             : 
     139           0 :    if (initset) then
     140           0 :       write(iunit,'(2a,2f14.4,1x,a)') subname,' memory use (MB) = ',msize,mrss,trim(lstring)
     141             :    else
     142           0 :       write(iunit,'(2a,2f14.4,1x,a)') subname,' memory use (??) = ',msize,mrss,trim(lstring)
     143             :    endif
     144             : 
     145         998 : end subroutine ice_memusage_print
     146             : 
     147             : !===============================================================================
     148             : 
     149             : END MODULE ice_memusage