Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 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 .GE. 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)) &
67 0 : scf_energy_message_tag = in_scf_energy_message_tag
68 14 : IF (PRESENT(in_exit_tag)) THEN
69 : ! the exit tag should be different from the mpi_probe tag default
70 14 : CPASSERT(in_exit_tag .NE. -1)
71 14 : exit_tag = in_exit_tag
72 : END IF
73 14 : END SUBROUTINE set_external_comm
74 :
75 : ! **************************************************************************************************
76 : !> \brief External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype
77 : !> command is sent the program stops at the level of $runtype
78 : !> when a general <PROJECT_NAME>.EXIT command is sent the program is stopped
79 : !> at all levels (at least those that call this function)
80 : !> if the file WAIT exists, the program waits here till it disappears
81 : !> \param should_stop ...
82 : !> \param flag ...
83 : !> \param globenv ...
84 : !> \param target_time ...
85 : !> \param start_time ...
86 : !> \param force_check ...
87 : !> \author MI (10.03.2005)
88 : ! **************************************************************************************************
89 606389 : SUBROUTINE external_control(should_stop, flag, globenv, target_time, start_time, force_check)
90 :
91 : LOGICAL, INTENT(OUT) :: should_stop
92 : CHARACTER(LEN=*), INTENT(IN) :: flag
93 : TYPE(global_environment_type), OPTIONAL, POINTER :: globenv
94 : REAL(dp), OPTIONAL :: target_time, start_time
95 : LOGICAL, OPTIONAL :: force_check
96 :
97 : CHARACTER(LEN=*), PARAMETER :: routineN = 'external_control'
98 :
99 : CHARACTER(LEN=default_string_length) :: exit_fname, exit_fname_level, &
100 : exit_gname, exit_gname_level
101 : INTEGER :: handle, i, tag, unit_number
102 : LOGICAL :: should_wait
103 : LOGICAL, SAVE :: check_always = .FALSE.
104 : REAL(KIND=dp) :: my_start_time, my_target_time, t1, t2, &
105 : time_check
106 : REAL(KIND=dp), SAVE :: t_last_file_check = 0.0_dp
107 : TYPE(cp_logger_type), POINTER :: logger
108 :
109 606389 : CALL timeset(routineN, handle)
110 :
111 606389 : logger => cp_get_default_logger()
112 606389 : should_stop = .FALSE.
113 :
114 606389 : IF (PRESENT(force_check)) THEN
115 0 : IF (force_check) THEN
116 0 : check_always = .TRUE.
117 : END IF
118 : END IF
119 :
120 606389 : exit_gname = "EXIT"
121 606389 : exit_gname_level = TRIM(exit_gname)//"_"//TRIM(flag)
122 606389 : exit_fname = TRIM(logger%iter_info%project_name)//"."//TRIM(exit_gname)
123 606389 : exit_fname_level = TRIM(logger%iter_info%project_name)//"."//TRIM(exit_gname_level)
124 :
125 : ! check for incomming messages and if it is tagged with the exit tag
126 606389 : IF (exit_tag .NE. -1) THEN
127 0 : i = external_master_id
128 0 : CALL external_comm%probe(source=i, tag=tag)
129 0 : IF (tag .EQ. exit_tag) should_stop = .TRUE.
130 : END IF
131 :
132 606389 : IF (logger%para_env%is_source()) THEN
133 : ! files will only be checked every 20 seconds, or if the clock wraps/does not exist,
134 : ! otherwise 64 waters on 64 cores can spend up to 10% of time here, on lustre
135 : ! however, if should_stop has been true, we should always check
136 : ! (at each level scf, md, ... the file must be there to guarantee termination)
137 442184 : t1 = m_walltime()
138 442184 : IF (t1 > t_last_file_check + 20.0_dp .OR. t1 <= t_last_file_check .OR. check_always) THEN
139 :
140 3428 : t_last_file_check = t1
141 : ! allows for halting execution for a while
142 : ! this is useful to copy a consistent snapshot of the output
143 : ! while a simulation is running
144 3428 : INQUIRE (FILE="WAIT", EXIST=should_wait)
145 3428 : IF (should_wait) THEN
146 : CALL open_file(file_name="WAITING", file_status="UNKNOWN", &
147 : file_form="FORMATTED", file_action="WRITE", &
148 0 : unit_number=unit_number)
149 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
150 0 : "*** waiting till the file WAIT has been removed ***"
151 : DO
152 : ! sleep a bit (to save the file system)
153 0 : t1 = m_walltime()
154 0 : DO I = 1, 100000000
155 0 : t2 = m_walltime()
156 0 : IF (t2 - t1 > 1.0_dp) EXIT
157 : END DO
158 : ! and ask again
159 0 : INQUIRE (FILE="WAIT", EXIST=should_wait)
160 0 : IF (.NOT. should_wait) EXIT
161 : END DO
162 0 : CALL close_file(unit_number=unit_number, file_status="DELETE")
163 : END IF
164 : ! EXIT control sequence
165 : ! Check for <PROJECT_NAME>.EXIT_<FLAG>
166 3428 : IF (.NOT. should_stop) THEN
167 3428 : INQUIRE (FILE=exit_fname_level, EXIST=should_stop)
168 3428 : IF (should_stop) THEN
169 0 : CALL open_file(file_name=exit_fname_level, unit_number=unit_number)
170 0 : CALL close_file(unit_number=unit_number, file_status="DELETE")
171 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
172 0 : "*** "//flag//" run terminated by external request ***"
173 : END IF
174 : END IF
175 : ! Check for <PROJECT_NAME>.EXIT
176 3428 : IF (.NOT. should_stop) THEN
177 3428 : INQUIRE (FILE=exit_fname, EXIST=should_stop)
178 3428 : IF (should_stop) THEN
179 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
180 0 : "*** "//TRIM(flag)//" run terminated by external request ***"
181 : END IF
182 : END IF
183 : ! Check for EXIT_<FLAG>
184 3428 : IF (.NOT. should_stop) THEN
185 3428 : INQUIRE (FILE=exit_gname_level, EXIST=should_stop)
186 3428 : IF (should_stop) THEN
187 0 : CALL open_file(file_name=exit_gname_level, unit_number=unit_number)
188 0 : CALL close_file(unit_number=unit_number, file_status="DELETE")
189 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
190 0 : "*** "//flag//" run terminated by external request ***"
191 : END IF
192 : END IF
193 : ! Check for EXIT
194 3428 : IF (.NOT. should_stop) THEN
195 3428 : INQUIRE (FILE=exit_gname, EXIST=should_stop)
196 3428 : IF (should_stop) THEN
197 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,/)") &
198 0 : "*** "//TRIM(flag)//" run terminated by external request ***"
199 : END IF
200 : END IF
201 : END IF
202 :
203 442184 : IF (PRESENT(target_time)) THEN
204 141496 : my_target_time = target_time
205 141496 : my_start_time = start_time
206 300688 : ELSEIF (PRESENT(globenv)) THEN
207 300688 : my_target_time = globenv%cp2k_target_time
208 300688 : my_start_time = globenv%cp2k_start_time
209 : ELSE
210 : ! If none of the two arguments is present abort.. This routine should always check about time.
211 0 : CPABORT("")
212 : END IF
213 :
214 442184 : IF ((.NOT. should_stop) .AND. (my_target_time > 0.0_dp)) THEN
215 : ! Check for execution time
216 269284 : time_check = m_walltime() - my_start_time
217 269284 : IF (time_check .GT. my_target_time) THEN
218 0 : should_stop = .TRUE.
219 : WRITE (UNIT=cp_logger_get_default_unit_nr(logger), FMT="(/,T2,A,f12.3,A)") &
220 0 : "*** "//TRIM(flag)//" run terminated - exceeded requested execution time:", &
221 0 : my_target_time, " seconds.", &
222 0 : "*** Execution time now: ", time_check, " seconds."
223 : END IF
224 : END IF
225 : END IF
226 606389 : CALL logger%para_env%bcast(should_stop)
227 :
228 606389 : check_always = should_stop
229 :
230 606389 : CALL timestop(handle)
231 :
232 606389 : END SUBROUTINE external_control
233 :
234 : END MODULE cp_external_control
235 :
|
