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, clib_get_rss_mb
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=24) :: rss_source = "unknown"
81 : : ! Source of the last value returned by get_rss_mb: "proc", "mach", "abimem" or "unknown"
82 : :
83 : : character(len=500) :: iomsg = ""
84 : : ! Error message returned when parsing filepath
85 : :
86 : : contains
87 : : procedure :: from_pid => pstat_from_pid ! Init object from process identifier (main entry point).
88 : : procedure :: from_file => pstat_from_file ! Init object from file (useful for debugging).
89 : : procedure :: print => pstat_print ! Print object.
90 : : procedure :: get_rss_mb => pstat_get_rss_mb ! Resident memory of the process in Mb (-1 if unknown).
91 : : procedure :: min_mem_mb_per_proc => pstat_min_mem_mb_per_proc
92 : : end type pstat_t
93 : : !!***
94 : :
95 : : type(pstat_t),save,public :: pstat_proc
96 : :
97 : : public :: chunk_from_budget ! Largest chunk of items whose memory fits in a budget.
98 : :
99 : : !----------------------------------------------------------------------
100 : :
101 : : contains
102 : : !!***
103 : :
104 : : !!****f* m_pstat/pstat_from_pid
105 : : !! NAME
106 : : !! pstat_from_pid
107 : : !!
108 : : !! FUNCTION
109 : : !! Init object from process identifier (main entry point for client code).
110 : : !!
111 : : !! SOURCE
112 : :
113 [ - + ]: 1460 : subroutine pstat_from_pid(pstat)
114 : :
115 : : !Arguments ------------------------------------
116 : : class(pstat_t),intent(out) :: pstat
117 : :
118 : : !Local variables-------------------------------
119 : : integer(c_int) :: pid
120 : : character(len=500) :: spid
121 : : ! *************************************************************************
122 : :
123 : 1460 : pid = clib_getpid()
124 : 1460 : write(spid, "(i0)") pid
125 : 1460 : spid = adjustl(spid)
126 [ + - ]: 1460 : call pstat%from_file("/proc/"//trim(spid)//"/status")
127 : :
128 : 1460 : end subroutine pstat_from_pid
129 : : !!***
130 : :
131 : : !!****f* m_pstat/pstat_from_file
132 : : !! NAME
133 : : !! pstat_from_file
134 : : !!
135 : : !! FUNCTION
136 : : !! Init object from file (useful for debugging).
137 : : !!
138 : : !! SOURCE
139 : :
140 : 38346 : subroutine pstat_from_file(pstat, filepath)
141 : :
142 : : !Arguments ------------------------------------
143 : : class(pstat_t),intent(inout) :: pstat
144 : : character(len=*),intent(in) :: filepath
145 : :
146 : : !Local variables-------------------------------
147 : : integer :: unit, ierr
148 : : character(len=500) :: line
149 : : integer :: istart, istop, iostat
150 : : ! *************************************************************************
151 : :
152 : 38346 : pstat%ok = .False.
153 : 38346 : pstat%filepath = filepath
154 : :
155 : 38346 : open(newunit=unit, file=trim(pstat%filepath), action="read", status="old", iostat=ierr, iomsg=pstat%iomsg)
156 : : ! If open fails, unit is undefined: closing it crashes gfortran (e.g. on macOS, where /proc does not exist).
157 [ + - ]: 38346 : if (ierr /= 0) return
158 : :
159 : : do
160 [ + + ]: 2262414 : read(unit, "(a)", iostat=ierr, end=10, iomsg=pstat%iomsg) line
161 [ - + ]: 2224068 : if (ierr > 0) then ! EOF
162 : 0 : close(unit); return
163 : : end if
164 : :
165 : : ! Parse useful integers
166 [ + + ]: 2224068 : if (index(line, "Pid:") == 1) call get_int(line, pstat%pid)
167 [ + + ]: 2224068 : if (index(line, "Threads:") == 1) call get_int(line, pstat%threads)
168 [ + + ]: 2224068 : if (index(line, "FDSize:") == 1) call get_int(line, pstat%fdsize)
169 : :
170 : : ! Parse memory entries
171 [ + + ]: 2224068 : if (index(line, "VmRSS:") == 1) call get_mem_mb(line, pstat%vmrss_mb)
172 [ + + ]: 2224068 : if (index(line, "VmPeak:") == 1) call get_mem_mb(line, pstat%vmpeak_mb)
173 [ + + ]: 2224068 : if (index(line, "VmStk:") == 1) call get_mem_mb(line, pstat%vmstk_mb)
174 : : end do
175 : :
176 : 38346 : 10 close(unit)
177 : 38346 : pstat%ok = .True.
178 [ + + ]: 76692 : pstat%iomsg = ""
179 : :
180 : : contains
181 : :
182 : 115038 : subroutine get_mem_mb(str, mem_mb)
183 : :
184 : : character(len=*),intent(in) :: str
185 : : real(dp),intent(out) :: mem_mb
186 : :
187 : : ! Generic mem entry has format `VmRSS: 2492 kB`
188 : : real(dp) :: mem_fact
189 : 115038 : istart = index(str, ":") + 1
190 : : istop = find_and_select(str, &
191 : : ["kB", "mB"], &
192 [ + + ]: 345114 : [one/1024._dp, one], mem_fact, pstat%iomsg) !default=one,
193 [ - + ]: 115038 : ABI_CHECK(istop /= -1, pstat%iomsg)
194 : 115038 : read(str(istart+1:istop-1), fmt=*, iostat=iostat, iomsg=pstat%iomsg) mem_mb
195 [ - + ]: 115038 : ABI_CHECK(iostat == 0, pstat%iomsg)
196 : 115038 : mem_mb = mem_mb * mem_fact
197 : :
198 : 115038 : end subroutine get_mem_mb
199 : :
200 : 115038 : subroutine get_int(str, out_ival)
201 : :
202 : : character(len=*),intent(in) :: str
203 : : integer,intent(out) :: out_ival
204 : 115038 : istart = index(str, ":") + 1
205 : 115038 : read(str(istart+1:), fmt=*, iostat=iostat, iomsg=pstat%iomsg) out_ival
206 : : !ABI_CHECK(iostat == 0, pstat%iomsg)
207 : :
208 : 115038 : end subroutine get_int
209 : :
210 : : end subroutine pstat_from_file
211 : : !!***
212 : :
213 : : !!****f* m_pstat/pstat_print
214 : : !! NAME
215 : : !! pstat_print
216 : : !!
217 : : !! FUNCTION
218 : : !! Print object in Yaml format to std_out
219 : : !!
220 : : !! SOURCE
221 : :
222 : 36886 : subroutine pstat_print(pstat, comm, file, line)
223 : :
224 : : class(pstat_t),intent(inout) :: pstat
225 : : character(len=*),optional,intent(in) :: file
226 : : integer,optional,intent(in) :: line, comm
227 : :
228 : : !Local variables-------------------------------
229 : : integer :: units(1), ierr
230 : : integer :: f90line = 0
231 : : real(dp) :: min_mpicomm_vmrss_mb, max_mpicomm_vmrss_mb, rss_mb
232 : : character(len=500) :: f90name='Subroutine Unknown'
233 : : type(yamldoc_t) :: ydoc
234 : : ! *************************************************************************
235 : :
236 : : ! Re-read /proc (Linux) or query the OS for the resident memory (macOS).
237 : 73772 : rss_mb = pstat%get_rss_mb()
238 [ - + - - ]: 36886 : if (pstat%pid == -1 .and. rss_mb < zero) return
239 : 36886 : units(1) = std_out
240 [ + - ]: 36886 : if (std_out < 1) return
241 : :
242 [ + - ]: 36886 : if (present(line)) f90line = line
243 [ + - + - ]: 36886 : if (present(file)) f90name = basename(file)
244 : :
245 : : ! NB: computed from rss_mb so that the min/max are also available on macOS (equal to VmRSS on Linux).
246 : 36886 : min_mpicomm_vmrss_mb = rss_mb
247 : 36886 : max_mpicomm_vmrss_mb = rss_mb
248 [ + + ]: 36886 : if (present(comm)) then
249 : 1444 : call xmpi_min(rss_mb, min_mpicomm_vmrss_mb, comm, ierr)
250 : 1444 : call xmpi_max(rss_mb, max_mpicomm_vmrss_mb, comm, ierr)
251 : : end if
252 : :
253 : : #ifndef FC_NVHPC
254 : 36886 : ydoc = yamldoc_open("PstatData")
255 : 36886 : call ydoc%add_int("pid", pstat%pid)
256 : 36886 : call ydoc%add_string("file", f90name)
257 : 36886 : call ydoc%add_int("line", f90line)
258 : 36886 : call ydoc%add_real("vmrss_mb", pstat%vmrss_mb)
259 : 36886 : call ydoc%add_real("min_mpicomm_vmrss_mb", min_mpicomm_vmrss_mb)
260 : 36886 : call ydoc%add_real("max_mpicomm_vmrss_mb", max_mpicomm_vmrss_mb)
261 : 36886 : call ydoc%add_real("vmpeak_mb", pstat%vmpeak_mb)
262 : 36886 : call ydoc%add_real("vmstk_mb", pstat%vmstk_mb)
263 : 36886 : call ydoc%add_real("rss_mb", rss_mb)
264 [ + - ]: 36886 : call ydoc%add_string("rss_source", trim(pstat%rss_source))
265 : 36886 : call ydoc%add_real("mem_per_rank_mb", mem_per_rank_mb())
266 [ + - ]: 36886 : call ydoc%add_string("mem_source", trim(mem_source))
267 : 36886 : call ydoc%add_int("cpus_per_task", cpus_per_task)
268 : : ! /proc is expected to be missing on macOS: report the error only if no other source worked.
269 [ - + - - : 36886 : if (len_trim(pstat%iomsg) > 0 .and. pstat%rss_source == "unknown") call ydoc%add_string("iomsg", trim(pstat%iomsg))
- - ]
270 : 36886 : call ydoc%write_units_and_free(units)
271 : : #else
272 : : ! Yet another wild NVHPC bug (only on eos_nvhpc_23.9_elpa)
273 : : write(std_out, "(a)")"--- !PstatData"
274 : : write(std_out, *)"vmrss_mb: ", pstat%vmrss_mb
275 : : write(std_out, *)"min_mpicomm_vmrss: ", min_mpicomm_vmrss_mb
276 : : write(std_out, *)"max_mpicomm_vmrss: ", max_mpicomm_vmrss_mb
277 : : write(std_out, "(a)")"..."
278 : : #endif
279 : :
280 : 36886 : end subroutine pstat_print
281 : : !!***
282 : :
283 : : !!****f* m_pstat/pstat_get_rss_mb
284 : : !! NAME
285 : : !! pstat_get_rss_mb
286 : : !!
287 : : !! FUNCTION
288 : : !! Resident set size of the process in Mb, from the first available source:
289 : : !! /proc/<pid>/status (Linux), Mach task_info (macOS), ABINIT allocation counters (only if memory profiling
290 : : !! is enabled, Fortran allocations only). Returns -1 if unknown. The source is stored in pstat%rss_source.
291 : : !!
292 : : !! SOURCE
293 : :
294 : 36886 : real(dp) function pstat_get_rss_mb(pstat) result(rss_mb)
295 : :
296 : : !Arguments ------------------------------------
297 : : class(pstat_t),intent(inout) :: pstat
298 : :
299 : : !Local variables-------------------------------
300 : : real(c_double) :: c_rss_mb
301 : : #ifdef HAVE_MEM_PROFILING
302 : : integer(i8b) :: nalloc, nfree, allocmemory, nalloc_c, nfree_c
303 : : #endif
304 : : ! *************************************************************************
305 : :
306 : 36886 : rss_mb = -one; pstat%rss_source = "unknown"
307 : :
308 : : ! Linux: /proc/<pid>/status
309 [ - + ]: 36886 : if (len_trim(pstat%filepath) == 0) call pstat%from_pid()
310 : 36886 : call pstat%from_file(pstat%filepath)
311 [ + - + - ]: 36886 : if (pstat%ok .and. pstat%vmrss_mb >= zero) then
312 : 36886 : rss_mb = pstat%vmrss_mb; pstat%rss_source = "proc"; return
313 : : end if
314 : :
315 : : ! macOS: Mach task_info (-1 on the other systems).
316 : 0 : call clib_get_rss_mb(c_rss_mb)
317 [ # # ]: 0 : if (c_rss_mb >= zero) then
318 : 0 : rss_mb = real(c_rss_mb, kind=dp); pstat%rss_source = "mach"; return
319 : : end if
320 : :
321 : : #ifdef HAVE_MEM_PROFILING
322 : : ! Last resort: memory allocated with ABI_MALLOC (underestimates the RSS: no C, MPI or library buffers).
323 : : call abimem_get_info(nalloc, nfree, allocmemory, nalloc_c, nfree_c)
324 : : rss_mb = allocmemory / (1024.0_dp ** 2); pstat%rss_source = "abimem"
325 : : #endif
326 : :
327 : : end function pstat_get_rss_mb
328 : : !!***
329 : :
330 : : !!****f* m_pstat/pstat_min_mem_mb_per_proc
331 : : !! NAME
332 : : !! pstat_min_mem_mb_per_proc
333 : : !!
334 : : !! FUNCTION
335 : : !! Estimate the memory (in Mb) that every process of the MPI communicator comm can still allocate:
336 : : !! the minimum over comm of (mem_per_rank_mb - resident memory - pending_mb).
337 : : !! If the resident memory is unknown on some process, return the conservative value
338 : : !! mem_per_rank_mb / 2 - pending_mb. The result is the same on all processes of comm.
339 : : !! Collective: must be called by all the processes of comm.
340 : : !!
341 : : !! INPUTS
342 : : !! comm: MPI communicator.
343 : : !! [pending_mb]: memory already allocated by the caller but not yet written (ABI_MALLOC does not touch
344 : : !! the pages, so they are not counted in the resident memory). Default: 0.
345 : : !!
346 : : !! SOURCE
347 : :
348 : 0 : real(dp) function pstat_min_mem_mb_per_proc(pstat, comm, pending_mb) result(min_mem_mb)
349 : :
350 : : !Arguments ------------------------------------
351 : : class(pstat_t),intent(inout) :: pstat
352 : : integer,intent(in) :: comm
353 : : real(dp),optional,intent(in) :: pending_mb
354 : :
355 : : !Local variables-------------------------------
356 : : integer :: ierr
357 : : logical :: all_ok
358 : : real(dp) :: rss_mb, pending, my_avail_mb
359 : : ! *************************************************************************
360 : :
361 [ # # ]: 0 : pending = zero; if (present(pending_mb)) pending = pending_mb
362 : :
363 : 0 : rss_mb = pstat%get_rss_mb()
364 : 0 : all_ok = rss_mb >= zero
365 : 0 : call xmpi_land(all_ok, comm)
366 : :
367 [ # # ]: 0 : if (.not. all_ok) then
368 : : ! Resident memory not available on some process: conservative fallback.
369 : 0 : min_mem_mb = mem_per_rank_mb() * half - pending
370 : 0 : return
371 : : end if
372 : :
373 : : ! The process with the least free memory sets the value.
374 : 0 : my_avail_mb = mem_per_rank_mb() - rss_mb - pending
375 : 0 : call xmpi_min(my_avail_mb, min_mem_mb, comm, ierr)
376 : :
377 : 0 : end function pstat_min_mem_mb_per_proc
378 : : !!***
379 : :
380 : : !!****f* m_pstat/chunk_from_budget
381 : : !! NAME
382 : : !! chunk_from_budget
383 : : !!
384 : : !! FUNCTION
385 : : !! Largest number of items, at most nitems, whose memory fits in budget_mb, and at least nmin.
386 : : !! Return -1 if even nmin items do not fit (or the input is invalid), so that the caller can stop
387 : : !! with a clear message.
388 : : !!
389 : : !! INPUTS
390 : : !! nitems: total number of items (e.g. bands).
391 : : !! bytes_per_item: memory of one item in bytes (e.g. npw * nspinor * 16).
392 : : !! budget_mb: memory available in Mb.
393 : : !! nmin: minimum acceptable chunk size.
394 : : !!
395 : : !! SOURCE
396 : :
397 : 0 : integer pure function chunk_from_budget(nitems, bytes_per_item, budget_mb, nmin) result(chunk)
398 : :
399 : : !Arguments ------------------------------------
400 : : integer,intent(in) :: nitems, nmin
401 : : integer(i8b),intent(in) :: bytes_per_item
402 : : real(dp),intent(in) :: budget_mb
403 : :
404 : : !Local variables-------------------------------
405 : : real(dp) :: nfit
406 : : ! *************************************************************************
407 : :
408 : 0 : chunk = -1
409 [ # # # # ]: 0 : if (nitems <= 0 .or. bytes_per_item <= 0) return
410 : :
411 : : ! Real arithmetic to avoid integer overflow.
412 : 0 : nfit = budget_mb * (1024.0_dp ** 2) / real(bytes_per_item, kind=dp)
413 [ # # ]: 0 : if (nfit >= real(nitems, kind=dp)) then
414 : : chunk = nitems
415 [ # # ]: 0 : else if (nfit >= real(min(nmin, nitems), kind=dp)) then
416 : 0 : chunk = int(nfit)
417 : : end if
418 : :
419 : : end function chunk_from_budget
420 : : !!***
421 : :
422 : 0 : end module m_pstat
423 : : !!***
|
