Branch data 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 : 495 : subroutine disable_timelimit()
106 : :
107 : : !Local variables-------------------------------
108 : : !scalars
109 : : character(len=500) :: msg
110 : :
111 : : ! *************************************************************************
112 : :
113 : 495 : WTIME_LIMIT = -one
114 : :
115 [ - + ]: 495 : 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 : 495 : 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 : 60595 : logical pure function have_timelimit_in(abifunc) result(ans)
136 : :
137 : : !Arguments -----------------------------------
138 : : character(len=*),intent(in) :: abifunc
139 : :
140 : : ! *************************************************************************
141 : :
142 [ + + - + ]: 60595 : ans = WTIME_LIMIT > zero .and. abifunc == TIMELIMIT_INABIFUNC
143 : :
144 : 60595 : 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 : 9700 : 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 : 9700 : prev_func = TIMELIMIT_INABIFUNC
175 : :
176 [ + + ]: 9700 : 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 : 2187 : real(dp) pure function get_timelimit()
191 : :
192 : 2187 : get_timelimit = WTIME_LIMIT
193 : :
194 : 1029 : 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 : 1158 : 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 : 1158 : timelimit = get_timelimit()
219 [ + + ]: 1158 : if (timelimit > zero) then
220 : 1 : string = sec2str(timelimit)
221 : : else
222 : 1157 : string = "0"
223 : : end if
224 : :
225 : 1158 : 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 : 80053 : 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 [ + - ]: 80053 : if (iexit_save==0) then
297 : : ! ABINIT will pass again in this routine even after exit call has been detected
298 : :
299 [ + + ]: 80053 : if (xmpi_comm_rank(comm)==master) then
300 : : ! Master tests and broadcast the result to others
301 : 64657 : iexit=0
302 : :
303 : : ! Is it worth to test the cpu time ?
304 : 64657 : tsec = zero
305 [ + - + + ]: 64657 : 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 [ - + ]: 64657 : 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 [ + + + - : 64657 : 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 : 80053 : 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 [ - + ]: 80053 : 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 : 80053 : iexit_save=iexit
370 : :
371 : 80053 : end subroutine exit_check
372 : : !!***
373 : :
374 : : END MODULE m_exit
375 : : !!***
|
