Branch data Line data Source code
1 : : !!****m* ABINIT/m_pstat
2 : : !! NAME
3 : : !! m_pstat
4 : : !!
5 : : !! FUNCTION
6 : : !! Interface to the /proc/{pid}/status file available on Linux.
7 : : !!
8 : : !! COPYRIGHT
9 : : !! Copyright (C) 2017-2026 ABINIT group (MG)
10 : : !! This file is distributed under the terms of the
11 : : !! GNU General Public License, see ~abinit/COPYING
12 : : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : : !!
14 : : !! SOURCE
15 : :
16 : : #if defined HAVE_CONFIG_H
17 : : #include "config.h"
18 : : #endif
19 : :
20 : : #include "abi_common.h"
21 : :
22 : : module m_pstat
23 : :
24 : : use, intrinsic :: iso_c_binding
25 : : use defs_basis
26 : : use m_xmpi
27 : : use m_abicore
28 : : use m_errors
29 : : use m_yaml
30 : :
31 : : use m_fstrings, only : find_and_select, basename
32 : : use m_clib, only : clib_getpid
33 : :
34 : : implicit none
35 : :
36 : : private
37 : : !!***
38 : :
39 : : !----------------------------------------------------------------------
40 : :
41 : : !!****t* m_pstat/pstat_t
42 : : !! NAME
43 : : !! pstat_t
44 : : !!
45 : : !! FUNCTION
46 : : !! This object stores the most important quantites reported in the /proc/{pid}/status file
47 : : !! in particular the virtual memory VmRSS. See https://docs.kernel.org/filesystems/proc.html
48 : : !!
49 : : !! NB: This file is only available on Linux hence one should always check the value of pstat%ok
50 : : !! before using quantities such as vmrss_mb.
51 : : !!
52 : : !! SOURCE
53 : :
54 : : type, private :: pstat_t
55 : :
56 : : logical :: ok = .False.
57 : : ! False if stat file is not available
58 : :
59 : : integer :: pid = -1
60 : : ! Process identifier.
61 : :
62 : : integer :: threads = -1
63 : : ! number of threads.
64 : :
65 : : integer :: fdsize = -1
66 : : ! Number of file descriptor slots currently allocated.
67 : :
68 : : real(dp) :: vmrss_mb = -one
69 : : ! Actual physical RAM used. It contains the three following parts (VmRSS = RssAnon + RssFile + RssShmem)
70 : :
71 : : real(dp) :: vmpeak_mb = -one
72 : : ! Peak virtual memory size
73 : :
74 : : real(dp) :: vmstk_mb = -one
75 : : ! Size of stack segments
76 : :
77 : : character(len=fnlen) :: filepath = ""
78 : : ! Path of status file
79 : :
80 : : character(len=500) :: iomsg = ""
81 : : ! Error message returned when parsing filepath
82 : :
83 : : contains
84 : : procedure :: from_pid => pstat_from_pid ! Init object from process identifier (main entry point).
85 : : procedure :: from_file => pstat_from_file ! Init object from file (useful for debugging).
86 : : procedure :: print => pstat_print ! Print object.
87 : : procedure :: min_mem_mb_per_proc => pstat_min_mem_mb_per_proc
88 : : end type pstat_t
89 : : !!***
90 : :
91 : : type(pstat_t),save,public :: pstat_proc
92 : :
93 : : !----------------------------------------------------------------------
94 : :
95 : : contains
96 : : !!***
97 : :
98 : : !!****f* m_pstat/pstat_from_pid
99 : : !! NAME
100 : : !! pstat_from_pid
101 : : !!
102 : : !! FUNCTION
103 : : !! Init object from process identifier (main entry point for client code).
104 : : !!
105 : : !! SOURCE
106 : :
107 [ - + ]: 1448 : subroutine pstat_from_pid(pstat)
108 : :
109 : : !Arguments ------------------------------------
110 : : class(pstat_t),intent(out) :: pstat
111 : :
112 : : !Local variables-------------------------------
113 : : integer(c_int) :: pid
114 : : character(len=500) :: spid
115 : : ! *************************************************************************
116 : :
117 : 1448 : pid = clib_getpid()
118 : 1448 : write(spid, "(i0)") pid
119 : 1448 : spid = adjustl(spid)
120 [ + - ]: 1448 : call pstat%from_file("/proc/"//trim(spid)//"/status")
121 : :
122 : 1448 : end subroutine pstat_from_pid
123 : : !!***
124 : :
125 : : !!****f* m_pstat/pstat_from_file
126 : : !! NAME
127 : : !! pstat_from_file
128 : : !!
129 : : !! FUNCTION
130 : : !! Init object from file (useful for debugging).
131 : : !!
132 : : !! SOURCE
133 : :
134 : 38168 : subroutine pstat_from_file(pstat, filepath)
135 : :
136 : : !Arguments ------------------------------------
137 : : class(pstat_t),intent(inout) :: pstat
138 : : character(len=*),intent(in) :: filepath
139 : :
140 : : !Local variables-------------------------------
141 : : integer :: unit, ierr
142 : : character(len=500) :: line
143 : : integer :: istart, istop, iostat
144 : : ! *************************************************************************
145 : :
146 : 38168 : pstat%ok = .False.
147 : 38168 : pstat%filepath = filepath
148 : :
149 : 38168 : open(newunit=unit, file=trim(pstat%filepath), action="read", status="old", iostat=ierr, iomsg=pstat%iomsg)
150 [ - + ]: 38168 : if (ierr /= 0) then
151 : 0 : close(unit); return
152 : : end if
153 : :
154 : : do
155 [ + + ]: 2251912 : read(unit, "(a)", iostat=ierr, end=10, iomsg=pstat%iomsg) line
156 [ - + ]: 2213744 : if (ierr > 0) then ! EOF
157 : 0 : close(unit); return
158 : : end if
159 : :
160 : : ! Parse useful integers
161 [ + + ]: 2213744 : if (index(line, "Pid:") == 1) call get_int(line, pstat%pid)
162 [ + + ]: 2213744 : if (index(line, "Threads:") == 1) call get_int(line, pstat%threads)
163 [ + + ]: 2213744 : if (index(line, "FDSize:") == 1) call get_int(line, pstat%fdsize)
164 : :
165 : : ! Parse memory entries
166 [ + + ]: 2213744 : if (index(line, "VmRSS:") == 1) call get_mem_mb(line, pstat%vmrss_mb)
167 [ + + ]: 2213744 : if (index(line, "VmPeak:") == 1) call get_mem_mb(line, pstat%vmpeak_mb)
168 [ + + ]: 2213744 : if (index(line, "VmStk:") == 1) call get_mem_mb(line, pstat%vmstk_mb)
169 : : end do
170 : :
171 : 38168 : 10 close(unit)
172 : 38168 : pstat%ok = .True.
173 [ + + ]: 76336 : pstat%iomsg = ""
174 : :
175 : : contains
176 : :
177 : 114504 : subroutine get_mem_mb(str, mem_mb)
178 : :
179 : : character(len=*),intent(in) :: str
180 : : real(dp),intent(out) :: mem_mb
181 : :
182 : : ! Generic mem entry has format `VmRSS: 2492 kB`
183 : : real(dp) :: mem_fact
184 : 114504 : istart = index(str, ":") + 1
185 : : istop = find_and_select(str, &
186 : : ["kB", "mB"], &
187 [ + + ]: 343512 : [one/1024._dp, one], mem_fact, pstat%iomsg) !default=one,
188 [ - + ]: 114504 : ABI_CHECK(istop /= -1, pstat%iomsg)
189 : 114504 : read(str(istart+1:istop-1), fmt=*, iostat=iostat, iomsg=pstat%iomsg) mem_mb
190 [ - + ]: 114504 : ABI_CHECK(iostat == 0, pstat%iomsg)
191 : 114504 : mem_mb = mem_mb * mem_fact
192 : :
193 : 114504 : end subroutine get_mem_mb
194 : :
195 : 114504 : subroutine get_int(str, out_ival)
196 : :
197 : : character(len=*),intent(in) :: str
198 : : integer,intent(out) :: out_ival
199 : 114504 : istart = index(str, ":") + 1
200 : 114504 : read(str(istart+1:), fmt=*, iostat=iostat, iomsg=pstat%iomsg) out_ival
201 : : !ABI_CHECK(iostat == 0, pstat%iomsg)
202 : :
203 : 114504 : end subroutine get_int
204 : :
205 : : end subroutine pstat_from_file
206 : : !!***
207 : :
208 : : !!****f* m_pstat/pstat_print
209 : : !! NAME
210 : : !! pstat_print
211 : : !!
212 : : !! FUNCTION
213 : : !! Print object in Yaml format to std_out
214 : : !!
215 : : !! SOURCE
216 : :
217 : 36720 : subroutine pstat_print(pstat, comm, file, line)
218 : :
219 : : class(pstat_t),intent(inout) :: pstat
220 : : character(len=*),optional,intent(in) :: file
221 : : integer,optional,intent(in) :: line, comm
222 : :
223 : : !Local variables-------------------------------
224 : : integer :: units(1), ierr
225 : : integer :: f90line = 0
226 : : real(dp) :: min_mpicomm_vmrss_mb, max_mpicomm_vmrss_mb
227 : : character(len=500) :: f90name='Subroutine Unknown'
228 : : type(yamldoc_t) :: ydoc
229 : : ! *************************************************************************
230 : :
231 : 0 : if (pstat%pid == -1) return
232 : 36720 : units(1) = std_out
233 [ + - ]: 36720 : if (std_out < 1) return
234 : :
235 : 36720 : call pstat%from_file(pstat%filepath)
236 : :
237 [ + - ]: 36720 : if (present(line)) f90line = line
238 [ + - + - ]: 36720 : if (present(file)) f90name = basename(file)
239 : :
240 : 36720 : min_mpicomm_vmrss_mb = pstat%vmrss_mb
241 : 36720 : max_mpicomm_vmrss_mb = pstat%vmrss_mb
242 [ + + ]: 36720 : if (present(comm)) then
243 : 1432 : call xmpi_min(pstat%vmrss_mb, min_mpicomm_vmrss_mb, comm, ierr)
244 : 1432 : call xmpi_max(pstat%vmrss_mb, max_mpicomm_vmrss_mb, comm, ierr)
245 : : end if
246 : :
247 : : #ifndef FC_NVHPC
248 : 36720 : ydoc = yamldoc_open("PstatData")
249 : 36720 : call ydoc%add_int("pid", pstat%pid)
250 : 36720 : call ydoc%add_string("file", f90name)
251 : 36720 : call ydoc%add_int("line", f90line)
252 : 36720 : call ydoc%add_real("vmrss_mb", pstat%vmrss_mb)
253 : 36720 : call ydoc%add_real("min_mpicomm_vmrss_mb", min_mpicomm_vmrss_mb)
254 : 36720 : call ydoc%add_real("max_mpicomm_vmrss_mb", max_mpicomm_vmrss_mb)
255 : 36720 : call ydoc%add_real("vmpeak_mb", pstat%vmpeak_mb)
256 : 36720 : call ydoc%add_real("vmstk_mb", pstat%vmstk_mb)
257 [ - + - - ]: 36720 : if (len_trim(pstat%iomsg) > 0) call ydoc%add_string("iomsg", trim(pstat%iomsg))
258 : 36720 : call ydoc%write_units_and_free(units)
259 : : #else
260 : : ! Yet another wild NVHPC bug (only on eos_nvhpc_23.9_elpa)
261 : : write(std_out, "(a)")"--- !PstatData"
262 : : write(std_out, *)"vmrss_mb: ", pstat%vmrss_mb
263 : : write(std_out, *)"min_mpicomm_vmrss: ", min_mpicomm_vmrss_mb
264 : : write(std_out, *)"max_mpicomm_vmrss: ", max_mpicomm_vmrss_mb
265 : : write(std_out, "(a)")"..."
266 : : #endif
267 : :
268 [ + - ]: 36720 : end subroutine pstat_print
269 : : !!***
270 : :
271 : : !!****f* m_pstat/pstat_min_mem_mb_per_proc
272 : : !! NAME
273 : : !! pstat_min_mem_mb_per_proc
274 : : !!
275 : : !! FUNCTION
276 : : !! This function estimates the available memory (in MB) per process, within the MPI communicator comm
277 : : !! based on process statistics (pstat).
278 : : !!
279 : : !! SOURCE
280 : :
281 : 0 : real(dp) function pstat_min_mem_mb_per_proc(pstat, comm) result(min_mem_mb)
282 : :
283 : : !Arguments ------------------------------------
284 : : class(pstat_t),intent(inout) :: pstat
285 : : integer,intent(in) :: comm
286 : :
287 : : !Local variables-------------------------------
288 : : integer :: ierr
289 : : logical :: all_ok
290 : : ! *************************************************************************
291 : :
292 : 0 : call pstat%from_file(pstat%filepath)
293 : :
294 : 0 : all_ok = pstat%ok
295 : 0 : call xmpi_land(all_ok, comm)
296 : :
297 [ # # ]: 0 : if (.not. all_ok) then
298 : : ! Handle case in which pstat is not available or something went wrong when reading.
299 : 0 : min_mem_mb = mem_per_cpu_mb * half
300 : 0 : return
301 : : end if
302 : :
303 : : ! Compute min inside comm
304 : 0 : call xmpi_min(pstat%vmrss_mb, min_mem_mb, comm, ierr)
305 : :
306 : 0 : min_mem_mb = (mem_per_cpu_mb - min_mem_mb)
307 : :
308 : : ! Fallback for too small values
309 [ # # ]: 0 : if (min_mem_mb <= tol1) min_mem_mb = mem_per_cpu_mb * half
310 : :
311 : 0 : end function pstat_min_mem_mb_per_proc
312 : : !!***
313 : :
314 : 0 : end module m_pstat
315 : : !!***
|
