MemUtils.F90

!------------------------------------------------------------------------------
!               Global Modeling and Assimilation Office (GMAO)                !
!                    Goddard Earth Observing System (GEOS)                    !
!                                 MAPL Component                              !
!------------------------------------------------------------------------------
#include "MAPL.h"

!>
!### MODULE: `MAPL_MemUtilsMod`
!
! Author: GMAO SI-Team
!
! `MAPL_MemUtilsMod` -- A Module to query/print memory use per processor (Adapted by WMP from FMS memuse utility)
!
module mapl_MemUtils_mod

  use ESMF
  use MAPL_CommsMod
  use mapl_Shmem_mod
  use mapl_ErrorHandling_mod
  use mapl_FileIO_mod, only: WRITE_PARALLEL
  use, intrinsic :: iso_fortran_env, only: INT64
  use, intrinsic :: iso_fortran_env, only: REAL64
  use mpi

!Author: Balaji (V.Balaji@noaa.gov)
!Various operations for memory management
!these currently include efficient methods for memory-to-memory copy
!including strided data and arbitrary gather-scatter vectors
!also various memory and cache inquiry operators
  implicit none
  private
  integer(kind=INT64) :: l1_cache_line_size, l1_cache_size, l1_associativity
  integer(kind=INT64) :: l2_cache_line_size, l2_cache_size, l2_associativity

  logical :: memutils_initialized=.FALSE.

  interface memcpy
     module procedure memcpy_r8
     module procedure memcpy_r8_gather
     module procedure memcpy_r8_scatter
     module procedure memcpy_r8_gather_scatter
  end interface

  interface MAPL_MemUtilsWrite
     module procedure MAPL_MemUtilsWriteVM
     module procedure MAPL_MemUtilsWriteComm
  end interface

  public MAPL_MemUtilsInit
  public MAPL_MemUtilsDisable
  public MAPL_MemUtilsWrite
  public MAPL_MemUtilsIsDisabled
  public MAPL_MemUtilsFree
  public MAPL_MemCommited
  public MAPL_MemUsed
  public MAPL_MemReport


#ifdef sysDarwin
  logical,    save :: DISABLED  = .true.
#else
  logical,    save :: DISABLED  = .false.
#endif

  integer, public, parameter :: MAPL_MemUtilsModeNode = 2
  integer, public, parameter :: MAPL_MemUtilsModeFull = 1
  integer, public, parameter :: MAPL_MemUtilsModeBase = 0
  integer, save      :: MAPL_MemUtilsMode
  real, save :: gmax_save

  contains

!********************************************************
    logical function MAPL_MemUtilsIsDisabled()
      MAPL_MemUtilsIsDisabled = DISABLED

    end function MAPL_MemUtilsIsDisabled

!********************************************************

    subroutine MAPL_MemUtilsDisable(RC)
      integer, optional, intent(OUT)   :: RC

      character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtilsDisable"

      DISABLED = .true.

      _RETURN(ESMF_SUCCESS)

    end subroutine MAPL_MemUtilsDisable

!********************************************************

!********************************************************

    subroutine MAPL_MemUtilsInit(mode,RC)
      integer, optional, intent(IN )   :: mode
      integer, optional, intent(OUT)   :: RC

      character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtilsInit"
!initialize memutils module
!currently sets default cache characteristics
!(will provide overrides later)
      l1_cache_line_size = 1
      l1_cache_size = 1
      l1_associativity = 1
      l2_cache_line_size = 1
      l2_cache_size = 1
      l2_associativity = 1
      memutils_initialized = .TRUE.

      gmax_save = 0.0
      if (present(mode)) then
         MAPL_MemUtilsMode=mode
      else
         MAPL_memUtilsMode=MAPL_MemUtilsModeBase
      endif

      _RETURN(ESMF_SUCCESS)
    end subroutine MAPL_MemUtilsInit

!-----------------------------------------------------------------------
!                                                                      !
!MEMCPY routines: <nelems> real*8 words are copied from RHS to LHS     !
!  Either side can have constant stride (lhs_stride, rhs_stride)       !
!      or indexed by a gather/scatter array (lhs_indx, rhs_indx)       !
! index arrays are 0-based (i.e C-like not fortran-like)                !
!                                                                      !
! EXAMPLES:                                                            !
!                                                                      !
!Replace                                                               !
!  a(0:n-1) = b(0:n-1)                                                 !
!with                                                                  !
!  call memcpy(a,b,n)                                                  !
!                                                                      !
!Replace                                                               !
!  a(0:2*n-1:2) = b(0:3*n-1:3)                                         !
!with                                                                  !
!  call memcpy(a,b,dim,n,2,3)    !dim.GE.3*n                           !
!                                                                      !
!Replace                                                               !
!  a(0:n-1) = b(indx(1:n))                                             !
!with                                                                  !
!  call memcpy(a,b,dim,n,1,indx) !dim.GE.max(indx)                     !
!                                                                      !
!Replace                                                               !
!  a(indx(1:n)) = b(0:n-1)                                             !
!with                                                                  !
!  call memcpy(a,b,dim,n,indx,1) !dim.GE.max(indx)                     !
!                                                                      !
!Replace                                                               !
!  a(indxa(1:n)) = b(indxb(1:n))                                       !
!with                                                                  !
!  call memcpy(a,b,dim,n,indx,indxb) !dim.GE.max(indxa,indxb)          !
!                                                                      !
!  There are no error checks!!! (routines are built for speed)         !
!  Specifically there is no bounds-checking: if the stride or          !
!  indexing causes you to exceed <dim> you will have done a            !
!  potentially unsafe memory load                                      !
!                                                                      !
!-----------------------------------------------------------------------
    subroutine memcpy_r8( lhs, rhs, dim, nelems, lhs_stride, rhs_stride )
!base routine: handles constant stride memcpy
!default strides are of course 1
      integer, intent(in) :: dim
      real(kind=REAL64), dimension(0:dim-1), intent(in)  :: rhs
      real(kind=REAL64), dimension(0:dim-1), intent(out) :: lhs
      integer, intent(in), optional :: nelems, lhs_stride, rhs_stride
      integer :: n, rs, ls

!defaults
      n = dim
      ls = 1
      rs = 1
      if( PRESENT(nelems) )then
          n = nelems
!only check for stride if nelems is present
          if( PRESENT(lhs_stride) )ls = lhs_stride
          if( PRESENT(rhs_stride) )rs = rhs_stride
      endif
      if( ls.EQ.1 .AND. rs.EQ.1 )then
          lhs(0:n-1) = rhs(0:n-1)
      else
          lhs(0:n*ls-1:ls) = rhs(0:n*rs-1:rs)
      endif
      return
    end subroutine memcpy_r8

    subroutine memcpy_r8_gather( lhs, rhs, dim, nelems, lhs_stride, rhs_indx )
!memcpy routine with gather: copies nelems words from rhs(indx(:)) to lhs(:)
      integer, intent(in) :: dim, nelems, lhs_stride
      real(kind=REAL64), dimension(0:dim-1), intent(in)  :: rhs
      real(kind=REAL64), dimension(0:dim-1), intent(out) :: lhs
      integer, intent(in), dimension(nelems) :: rhs_indx
      lhs(0:nelems*lhs_stride-1:lhs_stride) = rhs(rhs_indx(1:nelems))
      return
    end subroutine memcpy_r8_gather

    subroutine memcpy_r8_scatter( lhs, rhs, dim, nelems, lhs_indx, rhs_stride )
!memcpy routine with scatter: copies nelems words from rhs(:) to lhs(indx(:))
      integer, intent(in) :: dim, nelems, rhs_stride
      real(kind=REAL64), dimension(0:dim-1), intent(in)  :: rhs
      real(kind=REAL64), dimension(0:dim-1), intent(out) :: lhs
      integer, intent(in), dimension(nelems) :: lhs_indx
      lhs(lhs_indx(1:nelems)) = rhs(0:nelems*rhs_stride-1:rhs_stride)
      return
    end subroutine memcpy_r8_scatter

    subroutine memcpy_r8_gather_scatter( lhs, rhs, dim, nelems, lhs_indx, rhs_indx )
!memcpy routine with gather/scatter: copies nelems words from rhs(indx(:)) to lhs(indx(:))
      integer, intent(in) :: dim, nelems
      real(kind=REAL64), dimension(0:dim-1), intent(in)  :: rhs
      real(kind=REAL64), dimension(0:dim-1), intent(out) :: lhs
      integer, intent(in), dimension(nelems) :: lhs_indx, rhs_indx
      lhs(lhs_indx(1:nelems)) = rhs(rhs_indx(1:nelems))
      return
    end subroutine memcpy_r8_gather_scatter


  subroutine MAPL_MemUtilsWriteVM( vm, text, always, RC )
    type(ESMF_VM) :: vm
    character(len=*), intent(in) :: text
    logical, intent(in), optional :: always
    integer, optional, intent(OUT  ) :: RC

    character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtilsWriteVM"
    integer :: status

    integer :: comm

    call ESMF_VMGet(vm,mpicommunicator=comm,rc=status)
    _VERIFY(status)

    if( PRESENT(always) )then
        if( .NOT.always ) then
            _RETURN(ESMF_SUCCESS)
        endif
        call MAPL_MemUtilsWriteComm(text,comm=comm,always=always,rc=status)
        _VERIFY(STATUS)
    else
        if( DISABLED ) then
            _RETURN(ESMF_SUCCESS)
        endif
        call MAPL_MemUtilsWriteComm(text,comm=comm,rc=status)
        _VERIFY(STATUS)
    end if


    _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_MemUtilsWriteVM

  subroutine MAPL_MemUtilsWriteComm( text, comm, always, RC )
    character(len=*), intent(in) :: text
    integer, optional  :: Comm
    logical, intent(in), optional :: always
    integer, optional, intent(OUT  ) :: RC

    real :: mhwm, mrss, memused, swapused
    real :: mmin, mmax, mavg, mstd
    real :: gmin, gmax, gavg, gstd
    real :: lhwm, ghwm
    real :: lmem, gmem, lswap, gswap
    real :: commitlimit, committed_as
     real :: lcommitlimit, lcommitted_as
    real :: gcommitlimit, gcommitted_as
    integer :: npes

    character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtilsWriteComm"
    integer :: status

    character(len=ESMF_MAXSTR) :: outString
    integer :: comm_

    if (present(comm)) then
       comm_=comm
    else
       comm_=MPI_COMM_WORLD
    end if

    if( PRESENT(always) )then
        if( .NOT.always ) then
            _RETURN(ESMF_SUCCESS)
        endif
    else
        if( DISABLED ) then
            _RETURN(ESMF_SUCCESS)
        endif
    end if
    call mem_dump(mhwm, mrss, memused, swapused, commitlimit, committed_as, _RC)
    call MPI_Comm_Size(comm_,npes,status)
    _VERIFY(status)
    if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then
       lhwm = mhwm; call MPI_AllReduce(lhwm,ghwm,1,MPI_REAL,MPI_MAX,comm_,status)
       _VERIFY(STATUS)
       mmin = mrss; call MPI_AllReduce(mmin,gmin,1,MPI_REAL,MPI_MIN,comm_,status)
       _VERIFY(STATUS)
       mmax = mrss; call MPI_AllReduce(mmax,gmax,1,MPI_REAL,MPI_MAX,comm_,status)
       _VERIFY(STATUS)
       mavg = mrss; call MPI_AllReduce(mavg,gavg,1,MPI_REAL,MPI_SUM,comm_,status)
       _VERIFY(STATUS)
       gavg = gavg/npes
       mstd = (mrss-gavg)**2; call MPI_AllReduce(mstd,gstd,1,MPI_REAL,MPI_SUM,comm_,status)
       _VERIFY(STATUS)
       gstd = sqrt( gstd/npes )
       gmax_save = gmax
       lcommitlimit  = commitlimit;  call MPI_AllReduce(lcommitlimit,gcommitlimit,1,MPI_REAL,MPI_MAX,comm_,status)
       _VERIFY(STATUS)
       lcommitted_as = committed_as; call MPI_AllReduce(lcommitted_as,gcommitted_as,1,MPI_REAL,MPI_MAX,comm_,status)
       _VERIFY(STATUS)
    end if

    if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull .or. MAPL_MemUtilsMode == MAPL_MemUtilsModeBase) then
       lmem  = memused;  call MPI_AllReduce(lmem,gmem,1,MPI_REAL,MPI_MAX,comm_,status)
       _VERIFY(STATUS)
       lswap = swapused; call MPI_AllReduce(lswap,gswap,1,MPI_REAL,MPI_MAX,comm_,status)
       _VERIFY(STATUS)
    end if

    if (MAPL_MemUtilsMode == MAPL_MemUtilsModeBase) then
       write(outString,'(a64,2es11.3)') &
            'Mem/Swap Used (MB) at '//trim(text)//'=', gmem, gswap
       call WRITE_PARALLEL(trim(outString),format='(a132)')
    end if

    if (MAPL_MemUtilsMode == MAPL_MemUtilsModeFull) then
       write(outString,'(a64,5es11.3)') &
            'Memuse(MB) at '//trim(text)//'=', ghwm, gmax, gmin, gavg, gmax-gmax_save
       gmax_save = gmax
       call WRITE_PARALLEL(trim(outString),format='(a132)')
       write(outString,'(a64,2es11.3)') &
            'Mem/Swap Used (MB) at '//trim(text)//'=', gmem, gswap
       call WRITE_PARALLEL(trim(outString),format='(a132)')
       write(outString,'(a64,2es11.3)') &
            'CommitLimit/Committed_AS (MB) at '//trim(text)//'=', gcommitlimit, gcommitted_as
       call WRITE_PARALLEL(trim(outString),format='(a132)')
    end if

    if (MAPL_MemUtilsMode == MAPL_MemUtilsModeNode) then
       if (MAPL_AmNodeRoot) then
          write(*,'(a64,i3,a2,es11.3)')'Memory use at '//trim(text)//' on node ',MAPL_MyNodeNum,': ',memused
       end if

    end if

    _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_MemUtilsWriteComm

!#######################################################################

  subroutine MAPL_MemUsed ( memtotal, used, percent_used, RC )
     use mapl_ErrorHandling_mod, only: MAPL_RTRN
     real, intent(out) :: memtotal, used, percent_used
     integer, optional, intent(OUT  ) :: RC

     ! This routine returns the memory usage on Linux systems.
     ! It does this by querying a system file (file_name below).

     character(len=32) :: meminfo   = '/proc/meminfo'
     character(len=32) :: string
     integer :: mem_unit
     real    :: multiplier, available

     character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtils:MAPL_MemUsed"
     integer :: status

#ifdef sysDarwin
     memtotal = 0.0
     used = 0.0
     percent_used = 0.0
     RETURN_(ESMF_SUCCESS)
#else
     available = -1
     memtotal = -1
#endif


     call get_unit(mem_unit)
     open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',ACTION='READ',IOSTAT=STATUS)
     !_VERIFY(STATUS)

     ! Note: On at least one CircleCI compute machine, this was returning IOSTAT=9, with an IOMSG of:
     !          permission to access file denied, unit 100, file /proc/meminfo
     !       So, instead, if we get this issue, just act like macOS and not return useful info rather
     !       than crashing the model
     if (STATUS /= 0) then
        memtotal = 0.0
        used = 0.0
        percent_used = 0.0
        RETURN_(ESMF_SUCCESS)
     end if

     do
        read (mem_unit,'(a)', end=20) string
        if ( index ( string, 'MemTotal:' ) == 1 ) then  ! High Water Mark
           read (string(10:LEN_trim(string)-2),*) memtotal
           multiplier = 1.0
           if (trim(string(LEN_trim(string)-1:)) == "kB" ) &
                multiplier = 1.0/1024. ! Convert from kB to MB
           memtotal = memtotal * multiplier
        endif
        if ( index ( string, 'MemAvailable:' ) == 1 ) then  ! Resident Memory
           multiplier = 1.0
           read (string(14:LEN_trim(string)-2),*) available
           if (trim(string(LEN_trim(string)-1:)) == "kB" ) &
                multiplier = 1.0/1024. ! Convert from kB to MB
           available = available * multiplier
        endif
     enddo
20   close(mem_unit)

     if (memtotal >= 0 .and. available >= 0) then
        used = memtotal-available
        percent_used = 100.0*(used/memtotal)
     else
        ! fail, but don't crash
        used = -1
        percent_used = -1
     end if

     _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_MemUsed

subroutine MAPL_MemCommited ( memtotal, committed_as, percent_committed, RC )

real, intent(out) :: memtotal, committed_as, percent_committed
integer, optional, intent(OUT  ) :: RC

! This routine returns the memory usage on Linux systems.
! It does this by querying a system file (file_name below).

character(len=32) :: meminfo   = '/proc/meminfo'
character(len=32) :: string
integer :: mem_unit
real    :: multiplier

character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtils:MAPL_MemCommited"
integer :: status

#ifdef sysDarwin
  memtotal = 0.0
  committed_as = 0.0
  percent_committed = 0.0
  _RETURN(ESMF_SUCCESS)
#endif

  multiplier = 1.0

  call get_unit(mem_unit)
  open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',ACTION='READ',IOSTAT=STATUS)
  !_VERIFY(STATUS)

  ! Note: On at least one CircleCI compute machine, this was returning IOSTAT=9, with an IOMSG of:
  !          permission to access file denied, unit 100, file /proc/meminfo
  !       So, instead, if we get this issue, just act like macOS and not return useful info rather
  !       than crashing the model
  if (STATUS /= 0) then
     memtotal = 0.0
     committed_as = 0.0
     percent_committed = 0.0
     RETURN_(ESMF_SUCCESS)
  end if

  do; read (mem_unit,'(a)', end=20) string
    if ( INDEX ( string, 'MemTotal:' ) == 1 ) then  ! High Water Mark
      read (string(10:LEN_TRIM(string)-2),*) memtotal
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      memtotal = memtotal * multiplier
    endif
    if ( INDEX ( string, 'Committed_AS:' ) == 1 ) then  ! Resident Memory
      read (string(14:LEN_TRIM(string)-2),*) committed_as
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      committed_as = committed_as * multiplier
    endif
  enddo
20 close(mem_unit)

   percent_committed = 100.0*(committed_as/memtotal)

   _RETURN(ESMF_SUCCESS)
end subroutine MAPL_MemCommited


subroutine mem_dump ( memhwm, memrss, memused, swapused, commitlimit, committed_as, RC )

real, intent(out) :: memhwm, memrss, memused, swapused, commitlimit, committed_as
integer, optional, intent(OUT  ) :: RC

! This routine returns the memory usage on Linux systems.
! It does this by querying a system file (file_name below).

character(len=32) :: proc_self = '/proc/self/status'
character(len=32) :: meminfo   = '/proc/meminfo'
character(len=32) :: string
integer(kind=INT64) :: memtot, memfree, swaptot, swapfree
integer :: mem_unit
real    :: multiplier

character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtils:mem_dump"
integer :: status

  memhwm = 0.0
  memrss = 0.0
  multiplier = 1.0

  call get_unit(mem_unit)
  open(UNIT=mem_unit,FILE=proc_self,FORM='formatted',ACTION='READ',IOSTAT=STATUS)
  _VERIFY(STATUS)
  do; read (mem_unit,'(a)', end=10) string
    if ( INDEX ( string, 'VmHWM:' ) == 1 ) then  ! High Water Mark
      read (string(7:LEN_TRIM(string)-2),*) memhwm
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      memhwm = memhwm * multiplier
    endif
    if ( INDEX ( string, 'VmRSS:' ) == 1 ) then  ! Resident Memory
      read (string(7:LEN_TRIM(string)-2),*) memrss
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      memrss = memrss * multiplier
    endif
  enddo
10 close(mem_unit)

  call get_unit(mem_unit)
  open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',ACTION='READ',IOSTAT=STATUS)
  _VERIFY(STATUS)
  do; read (mem_unit,'(a)', end=20) string
    if ( INDEX ( string, 'MemTotal:' ) == 1 ) then  ! High Water Mark
      read (string(10:LEN_TRIM(string)-2),*) memtot
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      memtot = memtot * multiplier
    endif
    if ( INDEX ( string, 'MemFree:' ) == 1 ) then  ! High Water Mark
      read (string(9:LEN_TRIM(string)-2),*) memfree
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      memfree = memfree * multiplier
    endif
    if ( INDEX ( string, 'SwapTotal:' ) == 1 ) then  ! Resident Memory
      read (string(11:LEN_TRIM(string)-2),*) swaptot
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      swaptot = swaptot * multiplier
    endif
    if ( INDEX ( string, 'SwapFree:' ) == 1 ) then  ! Resident Memory
      read (string(10:LEN_TRIM(string)-2),*) swapfree
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      swapfree = swapfree * multiplier
    endif
    if ( INDEX ( string, 'CommitLimit:' ) == 1 ) then  ! Resident Memory
      read (string(13:LEN_TRIM(string)-2),*) commitlimit
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      commitlimit = commitlimit * multiplier
    endif
    if ( INDEX ( string, 'Committed_AS:' ) == 1 ) then  ! Resident Memory
      read (string(14:LEN_TRIM(string)-2),*) committed_as
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      committed_as = committed_as * multiplier
    endif
  enddo
20 close(mem_unit)

   memused = memtot-memfree
   swapused = swaptot-swapfree

   _RETURN(ESMF_SUCCESS)
end subroutine mem_dump

subroutine MAPL_MemUtilsFree ( totmemfree, RC )

real, intent(out) :: totmemfree
integer, optional, intent(OUT  ) :: RC

! This routine returns the amount of free memory on Linux systems.
! It does this by querying a system file (file_name below).

character(len=32) :: meminfo   = '/proc/meminfo'
character(len=32) :: string
real    :: memfree, buffers, cached
integer :: mem_unit
real    :: multiplier

character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtilsFree"
integer :: status

  totmemfree = 0.0
  memfree = 0.0
  buffers = 0.0
  cached = 0.0
  multiplier = 1.0

  call get_unit(mem_unit)
  open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',ACTION='READ',IOSTAT=STATUS)
  _VERIFY(STATUS)
  do; read (mem_unit,'(a)', end=20) string
    if ( INDEX ( string, 'MemFree:' ) == 1 ) then  ! Free memory
      read (string(9:LEN_TRIM(string)-2),*) memfree
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      memfree = memfree * multiplier
    endif
    if ( INDEX ( string, 'Buffers:' ) == 1 ) then  ! Buffers
      read (string(9:LEN_TRIM(string)-2),*) buffers
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      buffers = buffers * multiplier
    endif
    if ( INDEX ( string, 'Cached:' ) == 1 ) then  ! Cached
      read (string(8:LEN_TRIM(string)-2),*) cached
      if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) &
        multiplier = 1.0/1024. ! Convert from kB to MB
      cached = cached * multiplier
    endif
  enddo
20 close(mem_unit)

  totmemfree = memfree + cached + buffers

   _RETURN(ESMF_SUCCESS)
end subroutine MAPL_MemUtilsFree

subroutine get_unit ( iunit )
  implicit none
!
  integer i
  integer ios
  integer iunit
  logical lopen

  iunit = 0

  do i = 1, 99

    if ( i /= 5 .and. i /= 6 ) then

      inquire ( unit = i, opened = lopen, iostat = ios )

      if ( ios == 0 ) then
        if ( .not. lopen ) then
          iunit = i
          return
        end if
      end if

    end if

  end do

  return
end subroutine get_unit

subroutine MAPL_MemReport(comm,file_name,line,decorator,rc)
   integer, intent(in) :: comm
   character(len=*), intent(in) :: file_name
   integer, intent(in) :: line
   character(len=*), intent(in), optional :: decorator
   integer, intent(out), optional :: rc

    real :: mem_total,mem_used,percent_used
    real :: committed_total,committed,percent_committed
    integer :: rank,status
    character(len=:), allocatable :: extra_message

#ifdef sysDarwin
    _RETURN(ESMF_SUCCESS)
#endif
    call MPI_Barrier(comm,status)
    _VERIFY(status)
    if (present(decorator)) then
       extra_message = decorator
    else
       extra_message = ""
    end if
    call MAPL_MemUsed(mem_total,mem_used,percent_used)
    call MAPL_MemCommited(committed_total,committed,percent_committed)
    call MPI_Comm_Rank(comm,rank,status)
    _VERIFY(status)
    if (rank == 0) write(*,'("Mem report ",A20," ",A30," ",i7," ",f5.1,"% : ",f5.1,"% Mem Comm:Used")')trim(extra_message),file_name,line,percent_committed,percent_used

end subroutine

end module mapl_MemUtils_mod