Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Routines to handle the external control of CP2K
10 : !> \par History
11 : !> - Moved from MODULE termination to here (18.02.2011,MK)
12 : !> - add communication control (20.02.2013 Mandes)
13 : !> \author Marcella Iannuzzi (10.03.2005,MI)
14 : ! **************************************************************************************************
15 : MODULE cp_external_control
16 :
17 : USE cp_files, ONLY: close_file,&
18 : open_file
19 : USE cp_log_handling, ONLY: cp_get_default_logger,&
20 : cp_logger_get_default_unit_nr,&
21 : cp_logger_type
22 : USE global_types, ONLY: global_environment_type
23 : USE kinds, ONLY: default_string_length,&
24 : dp
25 : USE machine, ONLY: m_walltime
26 : USE message_passing, ONLY: mp_comm_type
27 : #include "./base/base_uses.f90"
28 :
29 : IMPLICIT NONE
30 :
31 : PRIVATE
32 :
33 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_external_control'
34 :
35 : PUBLIC :: external_control
36 : PUBLIC :: set_external_comm
37 :
38 : TYPE(mp_comm_type), SAVE :: external_comm
39 : INTEGER, SAVE :: external_master_id = -1
40 : INTEGER, SAVE :: scf_energy_message_tag = -1
41 : INTEGER, SAVE :: exit_tag = -1
42 :
43 : CONTAINS
44 :
45 : ! **************************************************************************************************
46 : !> \brief set the communicator to an external source or destination,
47 : !> to send messages (e.g. intermediate energies during scf) or
48 : !> reveive commands (e.g. aborting the calculation)
49 : !> \param comm ...
50 : !> \param in_external_master_id ...
51 : !> \param in_scf_energy_message_tag ...
52 : !> \param in_exit_tag ...
53 : !> \author Mandes 02.2013
54 : ! **************************************************************************************************
55 14 : SUBROUTINE set_external_comm(comm, in_external_master_id, &
56 : in_scf_energy_message_tag, in_exit_tag)
57 : CLASS(mp_comm_type), INTENT(IN) :: comm
58 : INTEGER, INTENT(IN) :: in_external_master_id
59 : INTEGER, INTENT(IN), OPTIONAL :: in_scf_energy_message_tag, in_exit_tag
60 :
61 14 : CPASSERT(in_external_master_id >= 0)
62 :
63 14 : external_comm = comm
64 14 : external_master_id = in_external_master_id
65 :
66 14 : IF (PRESENT(in_scf_energy_message_tag)) THEN
67 0 : scf_energy_message_tag = in_scf_energy_message_tag
68 : END IF
69 14 : IF (PRESENT(in_exit_tag)) THEN
70 : ! the exit tag should be different from the mpi_probe tag default
71 14 : CPASSERT(in_exit_tag /= -1)
72 14 : exit_tag = in_exit_tag
73 : END IF
74 14 : END SUBROUTINE set_external_comm
75 :
76 : ! **************************************************************************************************
77 : !> \brief External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype
78 : !> command is sent the program stops at the level of $runtype
79 : !> when a general <PROJECT_NAME>.EXIT command is sent the program is stopped
80 : !> at all levels (at least those that call this function)
81 : !> if the file WAIT exists, the program waits here till it disappears
82 : !> \param should_stop ...
83 : !> \param flag ...
84 : !> \param globenv ...
85 : !> \param target_time ...
86 : !> \param start_time ...
87 : !> \param force_check ...
88 : !> \author MI (10.03.2005)
89 : ! **************************************************************************************************
90 666335 : SUBROUTINE external_control(should_stop, flag, globenv, target_time, start_time, force_check)
91 :
92 : LOGICAL, INTENT(OUT) :: should_stop
93 : CHARACTER(LEN=*), INTENT(IN) :: flag
94 : TYPE(global_environment_type), OPTIONAL, POINTER :: globenv
95 : REAL(dp), OPTIONAL :: target_time, start_time
96 : LOGICAL, OPTIONAL :: force_check
97 :
98 : CHARACTER(LEN=*), PARAMETER :: routineN = 'external_control'
99 :
100 : CHARACTER(LEN=default_string_length) :: exit_fname, exit_fname_level, &
101 : exit_gname, exit_gname_level
102 : INTEGER :: handle, i, tag, unit_number
103 : LOGICAL :: should_wait
104 : LOGICAL, SAVE :: check_always = .FALSE.
105 : REAL(KIND=dp) :: my_start_time, my_target_time, t1, t2, &
106 : time_check
107 : REAL(KIND=dp), SAVE :: t_last_file_check = 0.0_dp
108 : TYPE(cp_logger_type), POINTER :: logger
109 :
110 666335 : CALL timeset(routineN, handle)
111 :
112 666335 : logger => cp_get_default_logger()
113 666335 : should_stop = .FALSE.
114 :
115 666335 : IF (PRESENT(force_check)) THEN
116 0 : IF (force_check) THEN
117 0 : check_always = .TRUE.
118 : END IF
119 : END IF
120 :
121 666335 : exit_gname = "EXIT"
122 666335 : exit_gname_level = TRIM(exit_gname)//"_"//TRIM(flag)
123 666335 : exit_fname = TRIM(logger%iter_info%project_name)//"."//TRIM(exit_gname)
124 666335 : exit_fname_level = TRIM(logger%iter_info%project_name)//"."//TRIM(exit_gname_level)
125 :
126 : ! check for incomming messages and if it is tagged with the exit tag
127 666335 : IF (exit_tag /= -1) THEN
128 0 : i = external_master_id
129 0 : CALL external_comm%probe(source=i, tag=tag)
130 0 : IF (tag == exit_tag) should_stop = .TRUE.
131 : END IF
132 :
133 666335 : IF (logger%para_env%is_source()) THEN
134 : ! files will only be checked every 20 seconds, or if the clock wraps/does not exist,
135 : ! otherwise 64 waters on 64 cores can spend up to 10% of time here, on lustre
136 : ! however, if should_stop has been true, we should always check
137 : ! (at each level scf, md, ... the file must be there to guarantee termination)
138 465035 : t1 = m_walltime()
139 465035 : IF (t1 > t_last_file_check + 20.0_dp .OR. t1 <= t_last_file_check .OR. check_always) THEN
140 :
141 4103 : t_last_file_check = t1
142 : ! allows for halting execution for a while
143 : ! this is useful to copy a consistent snapshot of the output
144 : ! while a simulation is running
145 4103 : INQUIRE (FILE="WAIT", EXIST=should_wait)
146 4103 : IF (should_wait) THEN
147 : CALL open_file(file_name="WAITING", file_status="UNKNOWN", &
148 : file_form="FORMATTED", file_action="WRITE", &
149 0 : unit_number=unit_number)
150 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
151 0 : "*** waiting till the file WAIT has been removed ***"
152 : DO
153 : ! sleep a bit (to save the file system)
154 0 : t1 = m_walltime()
155 0 : DO I = 1, 100000000
156 0 : t2 = m_walltime()
157 0 : IF (t2 - t1 > 1.0_dp) EXIT
158 : END DO
159 : ! and ask again
160 0 : INQUIRE (FILE="WAIT", EXIST=should_wait)
161 0 : IF (.NOT. should_wait) EXIT
162 : END DO
163 0 : CALL close_file(unit_number=unit_number, file_status="DELETE")
164 : END IF
165 : ! EXIT control sequence
166 : ! Check for <PROJECT_NAME>.EXIT_<FLAG>
167 4103 : IF (.NOT. should_stop) THEN
168 4103 : INQUIRE (FILE=exit_fname_level, EXIST=should_stop)
169 4103 : IF (should_stop) THEN
170 0 : CALL open_file(file_name=exit_fname_level, unit_number=unit_number)
171 0 : CALL close_file(unit_number=unit_number, file_status="DELETE")
172 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
173 0 : "*** "//flag//" run terminated by external request ***"
174 : END IF
175 : END IF
176 : ! Check for <PROJECT_NAME>.EXIT
177 4103 : IF (.NOT. should_stop) THEN
178 4103 : INQUIRE (FILE=exit_fname, EXIST=should_stop)
179 4103 : IF (should_stop) THEN
180 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
181 0 : "*** "//TRIM(flag)//" run terminated by external request ***"
182 : END IF
183 : END IF
184 : ! Check for EXIT_<FLAG>
185 4103 : IF (.NOT. should_stop) THEN
186 4103 : INQUIRE (FILE=exit_gname_level, EXIST=should_stop)
187 4103 : IF (should_stop) THEN
188 0 : CALL open_file(file_name=exit_gname_level, unit_number=unit_number)
189 0 : CALL close_file(unit_number=unit_number, file_status="DELETE")
190 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
191 0 : "*** "//flag//" run terminated by external request ***"
192 : END IF
193 : END IF
194 : ! Check for EXIT
195 4103 : IF (.NOT. should_stop) THEN
196 4103 : INQUIRE (FILE=exit_gname, EXIST=should_stop)
197 4103 : IF (should_stop) THEN
198 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
199 0 : "*** "//TRIM(flag)//" run terminated by external request ***"
200 : END IF
201 : END IF
202 : END IF
203 :
204 465035 : IF (PRESENT(target_time)) THEN
205 179546 : my_target_time = target_time
206 179546 : my_start_time = start_time
207 285489 : ELSE IF (PRESENT(globenv)) THEN
208 285489 : my_target_time = globenv%cp2k_target_time
209 285489 : my_start_time = globenv%cp2k_start_time
210 : ELSE
211 : ! If none of the two arguments is present abort.. This routine should always check about time.
212 0 : CPABORT("Neither target_time nor globenv exists for external_control")
213 : END IF
214 :
215 465035 : IF ((.NOT. should_stop) .AND. (my_target_time > 0.0_dp)) THEN
216 : ! Check for execution time
217 257313 : time_check = m_walltime() - my_start_time
218 257313 : IF (time_check > my_target_time) THEN
219 0 : should_stop = .TRUE.
220 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,F12.3,A)") &
221 0 : "*** "//TRIM(flag)//" run terminated - exceeded requested execution time:", &
222 0 : my_target_time, " seconds", &
223 0 : "*** Execution time now: ", time_check, " seconds"
224 : END IF
225 : END IF
226 : END IF
227 666335 : CALL logger%para_env%bcast(should_stop)
228 :
229 666335 : check_always = should_stop
230 :
231 666335 : CALL timestop(handle)
232 :
233 666335 : END SUBROUTINE external_control
234 :
235 : END MODULE cp_external_control
236 :
|
