FMS  2025.04
Flexible Modeling System
mpp_memutils.F90
1 !***********************************************************************
2 !* Apache License 2.0
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* Licensed under the Apache License, Version 2.0 (the "License");
7 !* you may not use this file except in compliance with the License.
8 !* You may obtain a copy of the License at
9 !*
10 !* http://www.apache.org/licenses/LICENSE-2.0
11 !*
12 !* FMS is distributed in the hope that it will be useful, but WITHOUT
13 !* WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied;
14 !* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
15 !* PARTICULAR PURPOSE. See the License for the specific language
16 !* governing permissions and limitations under the License.
17 !***********************************************************************
18 !> @defgroup mpp_memutils_mod mpp_memutils_mod
19 !> @ingroup mpp
20 !> @brief Routines to initialize and report on memory usage during the model run.
21 
22 !> @addtogroup mpp_memutils_mod
23 !> @{
24 module mpp_memutils_mod
25 
26  use mpp_mod, only: mpp_min, mpp_max, mpp_sum, mpp_pe, mpp_root_pe
27  use mpp_mod, only: mpp_error, fatal, stderr, mpp_npes
28  use platform_mod
29 
30  implicit none
31  private
32 
35 
36  real :: begin_memuse
37  logical :: memuse_started = .false.
38 
39 contains
40 
41  !#######################################################################
42  !> Initialize the memory module, and record the initial memory use.
43  subroutine mpp_memuse_begin
44  if(memuse_started) then
45  call mpp_error(fatal, "mpp_memutils_mod: mpp_memuse_begin was already called")
46  endif
47  memuse_started = .true.
48 
49  call mpp_mem_dump(begin_memuse)
50  end subroutine mpp_memuse_begin
51 
52  !#######################################################################
53  !> End the memory collection, and report on total memory used during the
54  !! execution of the model run.
55  subroutine mpp_memuse_end(text, unit)
56  character(len=*), intent(in) :: text !< Text to include in memory use statement
57  integer, intent(in), optional :: unit !< Fortran unit number where memory report should go.
58  !! Default is stderr.
59  real :: m, mmin, mmax, mavg, mstd, end_memuse
60  integer :: mu
61 
62  if(.NOT.memuse_started) then
63  call mpp_error(fatal, "mpp_memutils_mod: mpp_memuse_begin must be called before calling mpp_memuse_being")
64  endif
65  memuse_started = .false.
66 
67  call mpp_mem_dump(end_memuse)
68 
69  mu = stderr(); if( PRESENT(unit) )mu = unit
70  m = end_memuse - begin_memuse
71  mmin = m; call mpp_min(mmin)
72  mmax = m; call mpp_max(mmax)
73  mavg = m; call mpp_sum(mavg); mavg = mavg/mpp_npes()
74  mstd = (m-mavg)**2; call mpp_sum(mstd); mstd = sqrt( mstd/mpp_npes() )
75  if( mpp_pe().EQ.mpp_root_pe() )write( mu,'(a64,4es11.3)' ) &
76  'Memory(MB) used in '//trim(text)//'=', mmin, mmax, mstd, mavg
77 
78  return
79  end subroutine mpp_memuse_end
80 
81  !#######################################################################
82  !> Print the current memory high water mark to stderr, or the unit
83  !! specified.
84  subroutine mpp_print_memuse_stats(text, unit)
85  character(len=*), intent(in) :: text !< Text to include in memory print statement
86  integer, intent(in), optional :: unit !< Fortran unit number where print statement should go.
87  !! Default is stderr.
88  real :: m, mmin, mmax, mavg, mstd
89  integer :: mu
90 
91  mu = stderr(); if( PRESENT(unit) )mu = unit
92  call mpp_mem_dump(m)
93 
94  mmin = m; call mpp_min(mmin)
95  mmax = m; call mpp_max(mmax)
96  mavg = m; call mpp_sum(mavg); mavg = mavg/mpp_npes()
97  mstd = (m-mavg)**2; call mpp_sum(mstd); mstd = sqrt( mstd/mpp_npes() )
98  if( mpp_pe().EQ.mpp_root_pe() )write( mu,'(a64,4es11.3)' ) &
99  'Memuse(MB) at '//trim(text)//'=', mmin, mmax, mstd, mavg
100 
101  return
102  end subroutine mpp_print_memuse_stats
103 
104  !#######################################################################
105 
106  !> \brief Return the memory high water mark in MiB
107  !!
108  !! Query the system for the memory high water mark, return the result in MiB.
109  subroutine mpp_mem_dump(memuse)
110  real, intent(out) :: memuse !< Memory, high water mark, in MiB
111 
112  interface
113  integer(KIND=c_size_t) function getpeakrss() bind(c, name="getpeakrss")
114  use, intrinsic :: iso_c_binding
115  end function getpeakrss
116  end interface
117 
118  ! Value of Bytes to Mebibytes
119  real, parameter :: b_to_mib = 1048576.0
120 
121  ! Get the max memory use, convert to MiB
122  memuse = real(getpeakrss())/b_to_mib
123 
124  return
125  end subroutine mpp_mem_dump
126 end module mpp_memutils_mod
127 !> @}
128 ! close documentation grouping
subroutine, public mpp_memuse_end(text, unit)
End the memory collection, and report on total memory used during the execution of the model run.
subroutine, public mpp_memuse_begin
Initialize the memory module, and record the initial memory use.
subroutine, public mpp_mem_dump(memuse)
Return the memory high water mark in MiB.
subroutine, public mpp_print_memuse_stats(text, unit)
Print the current memory high water mark to stderr, or the unit specified.
integer function stderr()
This function returns the current standard fortran unit numbers for error messages.
Definition: mpp_util.inc:50
integer function mpp_npes()
Returns processor count for current pelist.
Definition: mpp_util.inc:420
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:406
Error handler.
Definition: mpp.F90:381
Reduction operations. Find the max of scalar a from the PEs in pelist result is also automatically br...
Definition: mpp.F90:537
Reduction operations. Find the min of scalar a from the PEs in pelist result is also automatically br...
Definition: mpp.F90:559
Reduction operation.
Definition: mpp.F90:596