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 1442 : 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 1442 : pid = clib_getpid()
118 1442 : write(spid, "(i0)") pid
119 1442 : spid = adjustl(spid)
120 1442 : call pstat%from_file("/proc/"//trim(spid)//"/status")
121 :
122 1442 : 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 38033 : 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 38033 : pstat%ok = .False.
147 38033 : pstat%filepath = filepath
148 :
149 38033 : open(newunit=unit, file=trim(pstat%filepath), action="read", status="old", iostat=ierr, iomsg=pstat%iomsg)
150 38033 : if (ierr /= 0) then
151 0 : close(unit); return
152 : end if
153 :
154 : do
155 2243947 : read(unit, "(a)", iostat=ierr, end=10, iomsg=pstat%iomsg) line
156 2205914 : if (ierr > 0) then ! EOF
157 0 : close(unit); return
158 : end if
159 :
160 : ! Parse useful integers
161 2205914 : if (index(line, "Pid:") == 1) call get_int(line, pstat%pid)
162 2205914 : if (index(line, "Threads:") == 1) call get_int(line, pstat%threads)
163 2205914 : if (index(line, "FDSize:") == 1) call get_int(line, pstat%fdsize)
164 :
165 : ! Parse memory entries
166 2205914 : if (index(line, "VmRSS:") == 1) call get_mem_mb(line, pstat%vmrss_mb)
167 2205914 : if (index(line, "VmPeak:") == 1) call get_mem_mb(line, pstat%vmpeak_mb)
168 2205914 : if (index(line, "VmStk:") == 1) call get_mem_mb(line, pstat%vmstk_mb)
169 : end do
170 :
171 38033 : 10 close(unit)
172 38033 : pstat%ok = .True.
173 76066 : pstat%iomsg = ""
174 :
175 : contains
176 :
177 114099 : 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 114099 : istart = index(str, ":") + 1
185 : istop = find_and_select(str, &
186 : ["kB", "mB"], &
187 342297 : [one/1024._dp, one], mem_fact, pstat%iomsg) !default=one,
188 114099 : ABI_CHECK(istop /= -1, pstat%iomsg)
189 114099 : read(str(istart+1:istop-1), fmt=*, iostat=iostat, iomsg=pstat%iomsg) mem_mb
190 114099 : ABI_CHECK(iostat == 0, pstat%iomsg)
191 114099 : mem_mb = mem_mb * mem_fact
192 :
193 114099 : end subroutine get_mem_mb
194 :
195 114099 : subroutine get_int(str, out_ival)
196 :
197 : character(len=*),intent(in) :: str
198 : integer,intent(out) :: out_ival
199 114099 : istart = index(str, ":") + 1
200 114099 : read(str(istart+1:), fmt=*, iostat=iostat, iomsg=pstat%iomsg) out_ival
201 : !ABI_CHECK(iostat == 0, pstat%iomsg)
202 :
203 114099 : 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 36591 : 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 36591 : units(1) = std_out
233 36591 : if (std_out < 1) return
234 :
235 36591 : call pstat%from_file(pstat%filepath)
236 :
237 36591 : if (present(line)) f90line = line
238 36591 : if (present(file)) f90name = basename(file)
239 :
240 36591 : min_mpicomm_vmrss_mb = pstat%vmrss_mb
241 36591 : max_mpicomm_vmrss_mb = pstat%vmrss_mb
242 36591 : if (present(comm)) then
243 1426 : call xmpi_min(pstat%vmrss_mb, min_mpicomm_vmrss_mb, comm, ierr)
244 1426 : call xmpi_max(pstat%vmrss_mb, max_mpicomm_vmrss_mb, comm, ierr)
245 : end if
246 :
247 : #ifndef FC_NVHPC
248 36591 : ydoc = yamldoc_open("PstatData")
249 36591 : call ydoc%add_int("pid", pstat%pid)
250 36591 : call ydoc%add_string("file", f90name)
251 36591 : call ydoc%add_int("line", f90line)
252 36591 : call ydoc%add_real("vmrss_mb", pstat%vmrss_mb)
253 36591 : call ydoc%add_real("min_mpicomm_vmrss_mb", min_mpicomm_vmrss_mb)
254 36591 : call ydoc%add_real("max_mpicomm_vmrss_mb", max_mpicomm_vmrss_mb)
255 36591 : call ydoc%add_real("vmpeak_mb", pstat%vmpeak_mb)
256 36591 : call ydoc%add_real("vmstk_mb", pstat%vmstk_mb)
257 36591 : if (len_trim(pstat%iomsg) > 0) call ydoc%add_string("iomsg", trim(pstat%iomsg))
258 36591 : 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 36591 : 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 : !!***
|
