Line data Source code
1 : !!****m* ABINIT/m_exit
2 : !! NAME
3 : !! m_exit
4 : !!
5 : !! FUNCTION
6 : !!
7 : !! COPYRIGHT
8 : !! Copyright (C) 2008-2026 ABINIT group (MG, DCA, XG, GMR)
9 : !! This file is distributed under the terms of the
10 : !! GNU General Public License, see ~abinit/COPYING
11 : !! or http://www.gnu.org/copyleft/gpl.txt .
12 : !!
13 : !! SOURCE
14 :
15 : #if defined HAVE_CONFIG_H
16 : #include "config.h"
17 : #endif
18 :
19 : #include "abi_common.h"
20 :
21 : MODULE m_exit
22 :
23 : use defs_basis
24 : use m_xmpi
25 : use m_abicore
26 : use m_errors
27 :
28 : use m_time, only : abi_wtime, sec2str, timein
29 : use m_fstrings, only : inupper
30 : use m_io_tools, only : open_file
31 :
32 : implicit none
33 :
34 : private
35 : !!***
36 :
37 : public :: exit_init ! Initialize the global variables of the module
38 : public :: get_start_time ! Return the origin of time (begin of execution ) in seconds
39 : public :: have_timelimit_in ! True if the run must completed before timelimit.
40 : public :: disable_timelimit ! Disable time limit handlers.
41 : public :: enable_timelimit_in ! Eable time limit handler in the given function.
42 : public :: get_timelimit ! Return the time limit in seconds
43 : public :: get_timelimit_string ! Return the time limit in string form.
44 : public :: exit_check ! Test if we should try to stop the code gracefully and to create a restart point.
45 :
46 : real(dp),private,save :: WALL0
47 : ! Origin of time in seconds.
48 :
49 : real(dp),private,save :: WTIME_LIMIT=-one
50 : ! Wall time limit in seconds. Negative value if not set.
51 :
52 : character(len=fnlen),private,save :: TIMELIMIT_INABIFUNC = "__None__"
53 : ! Name of the abinit function in which the time limit is handled.
54 : ! Note that there's **only one caller** in charge of the check.
55 : ! In structure relaxations, for example, only mover decides whether the itime loop must be exited
56 : ! and similar time limit handlers located in the children (e.g. scfcv) are automatically deactivated.
57 : ! This approach facilitates the treatment of nested parallelism e.g. image parallelism and reduce the number of MPI synchronizations.
58 : ! The drawback is that we loose the possibility of controlling the exit at a fine-grained level.
59 : ! If, for example, mover underestimates the time needed to complete the itime step, scfcv wont' be
60 : ! able to return if the time limit is approaching.
61 :
62 : !----------------------------------------------------------------------
63 :
64 : CONTAINS
65 : !!***
66 :
67 : !!****f* m_exit/exit_init
68 : !! NAME
69 : !! exit_init
70 : !!
71 : !! FUNCTION
72 : !! Initialize the global variables of the modules.
73 : !! This is a collective function that should be called by all the nodes in COMM_WORLD
74 : !!
75 : !! INPUTS
76 : !!
77 : !! SOURCE
78 :
79 4 : subroutine exit_init(time_limit)
80 :
81 : !Arguments ------------------------------------
82 : real(dp),intent(in) :: time_limit
83 :
84 : ! *************************************************************************
85 :
86 4 : WTIME_LIMIT = time_limit
87 4 : WALL0 = abi_wtime()
88 :
89 4 : end subroutine exit_init
90 : !!***
91 :
92 : !----------------------------------------------------------------------
93 :
94 : !!****f* m_exit/disable_timelimit
95 : !! NAME
96 : !! disable_timelimit
97 : !!
98 : !! FUNCTION
99 : !! Disable the time limit handler. This function should be called by a driver
100 : !! routine that is not able to handle time limit events and wants to prevent
101 : !! its children from installing their handlers.
102 : !!
103 : !! SOURCE
104 :
105 490 : subroutine disable_timelimit()
106 :
107 : !Local variables-------------------------------
108 : !scalars
109 : character(len=500) :: msg
110 :
111 : ! *************************************************************************
112 :
113 490 : WTIME_LIMIT = -one
114 :
115 490 : if (TIMELIMIT_INABIFUNC /= "__None__") then
116 0 : msg = "Timelimit is already activated in function: "//trim(TIMELIMIT_INABIFUNC)
117 0 : ABI_WARNING(msg)
118 : !ABI_ERROR(msg)
119 : end if
120 :
121 490 : end subroutine disable_timelimit
122 : !!***
123 :
124 : !----------------------------------------------------------------------
125 :
126 : !!****f* m_exit/have_timelimit_in
127 : !! NAME
128 : !! have_timelimit_in
129 : !!
130 : !! FUNCTION
131 : !! Return .True. if timelimit is enabled in this caller
132 : !!
133 : !! SOURCE
134 :
135 60029 : logical pure function have_timelimit_in(abifunc) result(ans)
136 :
137 : !Arguments -----------------------------------
138 : character(len=*),intent(in) :: abifunc
139 :
140 : ! *************************************************************************
141 :
142 60029 : ans = WTIME_LIMIT > zero .and. abifunc == TIMELIMIT_INABIFUNC
143 :
144 60029 : end function have_timelimit_in
145 : !!***
146 :
147 : !----------------------------------------------------------------------
148 :
149 : !!****f* m_exit/enable_timelimit_in
150 : !! NAME
151 : !! enable_timelimit_in
152 : !!
153 : !! FUNCTION
154 : !! Eable time limit handler in the given function if not already done in one of the callers.
155 : !! Return the name of procedure that is handling the time limit.
156 : !! Example:
157 : !!
158 : !! ! enable time limit handler if not done in callers.
159 : !! if (enable_timelimit_in(FUNC_NAME) == FUNC_NAME) then
160 : !! write(std_out,*)"Enabling timelimit check in function: ",trim(FUNC_NAME)," with timelimit: ",trim(sec2str(get_timelimit()))
161 : !! end if
162 : !!
163 : !! SOURCE
164 :
165 9653 : function enable_timelimit_in(abifunc) result(prev_func)
166 :
167 : !Arguments -----------------------------------
168 : character(len=*),intent(in) :: abifunc
169 : character(len=fnlen) :: prev_func
170 :
171 : ! *************************************************************************
172 :
173 4 : if (WTIME_LIMIT > zero .and. TIMELIMIT_INABIFUNC == "__None__") TIMELIMIT_INABIFUNC = abifunc
174 9653 : prev_func = TIMELIMIT_INABIFUNC
175 :
176 9653 : end function enable_timelimit_in
177 : !!***
178 :
179 : !----------------------------------------------------------------------
180 :
181 : !!****f* m_exit/get_timelimit
182 : !! NAME
183 : !! get_timelimit
184 : !!
185 : !! FUNCTION
186 : !! Return the time limit in seconds
187 : !!
188 : !! SOURCE
189 :
190 2164 : real(dp) pure function get_timelimit()
191 :
192 2164 : get_timelimit = WTIME_LIMIT
193 :
194 1016 : end function get_timelimit
195 : !!***
196 :
197 : !----------------------------------------------------------------------
198 :
199 : !!****f* m_exit/get_timelimit_string
200 : !! NAME
201 : !! get_timelimit_string
202 : !!
203 : !! FUNCTION
204 : !! Return the time limit in string form.
205 : !!
206 : !! SOURCE
207 :
208 1148 : pure function get_timelimit_string() result(string)
209 :
210 : !Local variables-------------------------------
211 : !scalars
212 : real(dp) :: timelimit
213 : character(len=500) :: string
214 :
215 : ! *************************************************************************
216 :
217 : ! Handle negative values
218 1148 : timelimit = get_timelimit()
219 1148 : if (timelimit > zero) then
220 1 : string = sec2str(timelimit)
221 : else
222 1147 : string = "0"
223 : end if
224 :
225 1148 : end function get_timelimit_string
226 : !!***
227 :
228 : !!****f* m_exit/get_start_time
229 : !! NAME
230 : !! get_start_time
231 : !!
232 : !! FUNCTION
233 : !! Return the origin of execution time in seconds
234 : !!
235 : !! SOURCE
236 :
237 16 : real(dp) pure function get_start_time()
238 :
239 16 : get_start_time = WALL0
240 :
241 16 : end function get_start_time
242 : !!***
243 :
244 : !!****f* m_exit/exit_check
245 : !! NAME
246 : !! exit_check
247 : !!
248 : !! FUNCTION
249 : !! This routine checks whether the CPU time limit is exceeded or not.
250 : !! If openexit is non-zero, it also checks the "filename" file
251 : !! for the "exit" character string in its first line and returns the location
252 : !! of the string on the line (0 if not found). Maps both strings to upper case
253 : !! before attempting to match them. Also checks for the existence
254 : !! of the "abinit.exit" file in the directory where the job was started.
255 : !! Finally, checks whether the CPU time limit was not exceeded.
256 : !! If one of these conditions occurs, will induce graceful exit of iterations.
257 : !!
258 : !! INPUTS
259 : !! cpus = CPU time limit
260 : !! filename = character string giving name of file to be opened
261 : !! iout = unit number to print output to
262 : !! openexit = if 1, open the "filename" and "abinit.exit" files
263 : !! comm=MPI communicator.
264 : !!
265 : !! OUTPUT
266 : !! iexit = index of "exit" on first line of file (0 if not found),
267 : !! or -1 if the exit was ordered through the existence of the "exit" file
268 : !! or -2 if the exit was ordered through the CPU time limit.
269 : !!
270 : !! SOURCE
271 :
272 79343 : subroutine exit_check(cpus,filename,iexit,iout,comm,openexit)
273 :
274 : !Arguments ------------------------------------
275 : integer,intent(in) :: comm
276 : real(dp),intent(in) :: cpus
277 : character(len=*),intent(in) :: filename
278 : integer,intent(in) :: openexit,iout
279 : integer,intent(out) :: iexit
280 :
281 : !Local variables-------------------------------
282 : !scalars
283 : integer,parameter :: master=0
284 : integer,save :: iexit_save=0
285 : integer :: ierr,temp_unit,ierrmpi
286 : logical :: ex
287 : real(dp),save :: tcpu_last=zero
288 : character(len=500) :: message
289 : character(len=fnlen) :: line
290 : character(len=4), parameter :: string='EXIT'
291 : !arrays
292 : real(dp) :: tsec(2)
293 :
294 : ! *************************************************************************
295 :
296 79343 : if (iexit_save==0) then
297 : ! ABINIT will pass again in this routine even after exit call has been detected
298 :
299 79343 : if (xmpi_comm_rank(comm)==master) then
300 : ! Master tests and broadcast the result to others
301 64097 : iexit=0
302 :
303 : ! Is it worth to test the cpu time ?
304 64097 : tsec = zero
305 64097 : if (abs(cpus)>1.0d-5 .or. openexit==1) then
306 24 : call timein(tsec(1),tsec(2))
307 : end if
308 :
309 : ! A first way of exiting: the cpu time limit
310 64097 : if (abs(cpus)>1.0d-5) then
311 0 : if(cpus<tsec(1))iexit=-2
312 : end if
313 :
314 : ! Test the content of files only when sufficient time (2 sec) has elapsed from last time it was tested.
315 64097 : if (openexit==1 .and. iexit==0 .and. tsec(1)-tcpu_last>two ) then
316 : ! TODO Remove this approach. Use abinit.exit!
317 0 : tcpu_last=tsec(1)
318 : ! Open file and read first line as character string
319 0 : if (open_file(filename,message,newunit=temp_unit,form='formatted',status='old') /= 0) then
320 0 : ABI_ERROR(message)
321 : end if
322 0 : rewind (unit=temp_unit)
323 0 : read (unit=temp_unit,fmt='(a)',iostat=ierr) line
324 0 : if(ierr/=0)then
325 : write(message, '(a,a,a,i5,a,a)' )&
326 0 : & 'Problem when reading file=',TRIM(filename),'iostat =',ierr,ch10,&
327 0 : & 'Action: check whether this file is OK.'
328 0 : ABI_ERROR(message)
329 : end if
330 : ! Make a local copy of matching string of length equal to nonblank length of input string
331 : ! Map to upper case
332 0 : call inupper(line)
333 0 : iexit=index(line,string)
334 0 : close (unit=temp_unit)
335 :
336 : ! This is another way of exiting : the previous one does not work
337 : ! on some machines, may be because they keep a copy of the initial input file.
338 0 : if(iexit==0)then
339 0 : inquire(file='abinit.exit',exist=ex)
340 0 : if(ex)iexit=-1
341 : end if
342 :
343 : end if
344 : end if
345 :
346 79343 : call xmpi_bcast(iexit,master,comm,ierrmpi)
347 :
348 : else
349 : ! In case the exit mechanism has already been activated
350 0 : iexit=iexit_save
351 : end if
352 :
353 79343 : if (iexit/=0) then
354 0 : if (iexit>0) write(message, '(a,a,a,a,a,a,a)' ) ch10,&
355 0 : & ' chkexi: WARNING -',ch10,&
356 0 : & ' Exit has been requested from file ',trim(filename),'.',ch10
357 0 : if (iexit==-1) write(message, '(a,a,a,a,a)' ) ch10,&
358 0 : & ' chkexi: WARNING -',ch10,&
359 0 : & ' Exit has been requested from file "abinit.exit".',ch10
360 0 : if (iexit==-2) write(message, '(a,a,a,a,a)' ) ch10,&
361 0 : & ' chkexi: WARNING -',ch10,&
362 0 : & ' Exit due to cpu time limit exceeded.',ch10
363 0 : if (iout/=std_out) then
364 0 : call wrtout(iout,message,'COLL')
365 : end if
366 0 : call wrtout(std_out, message,'COLL')
367 : end if
368 :
369 79343 : iexit_save=iexit
370 :
371 79343 : end subroutine exit_check
372 : !!***
373 :
374 : END MODULE m_exit
375 : !!***
|
