(git:58e3e09)
cp_external_control.F
Go to the documentation of this file.
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 ! **************************************************************************************************
16 
17  USE cp_files, ONLY: close_file,&
18  open_file
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  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  cpassert(in_external_master_id .GE. 0)
62 
63  external_comm = comm
64  external_master_id = in_external_master_id
65 
66  IF (PRESENT(in_scf_energy_message_tag)) &
67  scf_energy_message_tag = in_scf_energy_message_tag
68  IF (PRESENT(in_exit_tag)) THEN
69  ! the exit tag should be different from the mpi_probe tag default
70  cpassert(in_exit_tag .NE. -1)
71  exit_tag = in_exit_tag
72  END IF
73  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  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  CALL timeset(routinen, handle)
110 
111  logger => cp_get_default_logger()
112  should_stop = .false.
113 
114  IF (PRESENT(force_check)) THEN
115  IF (force_check) THEN
116  check_always = .true.
117  END IF
118  END IF
119 
120  exit_gname = "EXIT"
121  exit_gname_level = trim(exit_gname)//"_"//trim(flag)
122  exit_fname = trim(logger%iter_info%project_name)//"."//trim(exit_gname)
123  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  IF (exit_tag .NE. -1) THEN
127  i = external_master_id
128  CALL external_comm%probe(source=i, tag=tag)
129  IF (tag .EQ. exit_tag) should_stop = .true.
130  END IF
131 
132  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  t1 = m_walltime()
138  IF (t1 > t_last_file_check + 20.0_dp .OR. t1 <= t_last_file_check .OR. check_always) THEN
139 
140  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  INQUIRE (file="WAIT", exist=should_wait)
145  IF (should_wait) THEN
146  CALL open_file(file_name="WAITING", file_status="UNKNOWN", &
147  file_form="FORMATTED", file_action="WRITE", &
148  unit_number=unit_number)
149  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
150  "*** waiting till the file WAIT has been removed ***"
151  DO
152  ! sleep a bit (to save the file system)
153  t1 = m_walltime()
154  DO i = 1, 100000000
155  t2 = m_walltime()
156  IF (t2 - t1 > 1.0_dp) EXIT
157  END DO
158  ! and ask again
159  INQUIRE (file="WAIT", exist=should_wait)
160  IF (.NOT. should_wait) EXIT
161  END DO
162  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  IF (.NOT. should_stop) THEN
167  INQUIRE (file=exit_fname_level, exist=should_stop)
168  IF (should_stop) THEN
169  CALL open_file(file_name=exit_fname_level, unit_number=unit_number)
170  CALL close_file(unit_number=unit_number, file_status="DELETE")
171  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
172  "*** "//flag//" run terminated by external request ***"
173  END IF
174  END IF
175  ! Check for <PROJECT_NAME>.EXIT
176  IF (.NOT. should_stop) THEN
177  INQUIRE (file=exit_fname, exist=should_stop)
178  IF (should_stop) THEN
179  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
180  "*** "//trim(flag)//" run terminated by external request ***"
181  END IF
182  END IF
183  ! Check for EXIT_<FLAG>
184  IF (.NOT. should_stop) THEN
185  INQUIRE (file=exit_gname_level, exist=should_stop)
186  IF (should_stop) THEN
187  CALL open_file(file_name=exit_gname_level, unit_number=unit_number)
188  CALL close_file(unit_number=unit_number, file_status="DELETE")
189  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
190  "*** "//flag//" run terminated by external request ***"
191  END IF
192  END IF
193  ! Check for EXIT
194  IF (.NOT. should_stop) THEN
195  INQUIRE (file=exit_gname, exist=should_stop)
196  IF (should_stop) THEN
197  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
198  "*** "//trim(flag)//" run terminated by external request ***"
199  END IF
200  END IF
201  END IF
202 
203  IF (PRESENT(target_time)) THEN
204  my_target_time = target_time
205  my_start_time = start_time
206  ELSEIF (PRESENT(globenv)) THEN
207  my_target_time = globenv%cp2k_target_time
208  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  cpabort("")
212  END IF
213 
214  IF ((.NOT. should_stop) .AND. (my_target_time > 0.0_dp)) THEN
215  ! Check for execution time
216  time_check = m_walltime() - my_start_time
217  IF (time_check .GT. my_target_time) THEN
218  should_stop = .true.
219  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,f12.3,A)") &
220  "*** "//trim(flag)//" run terminated - exceeded requested execution time:", &
221  my_target_time, " seconds.", &
222  "*** Execution time now: ", time_check, " seconds."
223  END IF
224  END IF
225  END IF
226  CALL logger%para_env%bcast(should_stop)
227 
228  check_always = should_stop
229 
230  CALL timestop(handle)
231 
232  END SUBROUTINE external_control
233 
234 END MODULE cp_external_control
235 
Routines to handle the external control of CP2K.
subroutine, public external_control(should_stop, flag, globenv, target_time, start_time, force_check)
External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype command is sent the progr...
subroutine, public set_external_comm(comm, in_external_master_id, in_scf_energy_message_tag, in_exit_tag)
set the communicator to an external source or destination, to send messages (e.g. intermediate energi...
Utility routines to open and close files. Tracking of preconnections.
Definition: cp_files.F:16
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
Definition: cp_files.F:308
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Definition: cp_files.F:119
various routines to log and control the output. The idea is that decisions about where to log should ...
recursive integer function, public cp_logger_get_default_unit_nr(logger, local, skip_not_ionode)
asks the default unit number of the given logger. try to use cp_logger_get_unit_nr
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
Define type storing the global information of a run. Keep the amount of stored data small....
Definition: global_types.F:21
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
integer, parameter, public default_string_length
Definition: kinds.F:57
Machine interface based on Fortran 2003 and POSIX.
Definition: machine.F:17
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition: machine.F:123
Interface to the message passing library MPI.