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