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