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