cp_external_control.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \brief Routines to handle the external control of CP2K
!> \par History
!>      - Moved from MODULE termination to here (18.02.2011,MK)
!>      - add communication control (20.02.2013 Mandes)
!> \author Marcella Iannuzzi (10.03.2005,MI)
! **************************************************************************************************
MODULE cp_external_control
 
   USE cp_files,                        ONLY: close_file,&
                                              open_file
   USE cp_log_handling,                 ONLY: cp_get_default_logger,&
                                              cp_logger_get_default_unit_nr,&
                                              cp_logger_type
   USE global_types,                    ONLY: global_environment_type
   USE kinds,                           ONLY: default_string_length,&
                                              dp
   USE machine,                         ONLY: m_walltime
   USE message_passing,                 ONLY: mp_comm_type
#include "./base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
 
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_external_control'
 
   PUBLIC :: external_control
   PUBLIC :: set_external_comm
 
   TYPE(mp_comm_type), SAVE :: external_comm
   INTEGER, SAVE :: external_master_id = -1
   INTEGER, SAVE :: scf_energy_message_tag = -1
   INTEGER, SAVE :: exit_tag = -1
 
CONTAINS
 
! **************************************************************************************************
!> \brief set the communicator to an external source or destination,
!>        to send messages (e.g. intermediate energies during scf) or
!>        reveive commands (e.g. aborting the calculation)
!> \param comm ...
!> \param in_external_master_id ...
!> \param in_scf_energy_message_tag ...
!> \param in_exit_tag ...
!> \author Mandes 02.2013
! **************************************************************************************************
   SUBROUTINE set_external_comm(comm, in_external_master_id, &
                                in_scf_energy_message_tag, in_exit_tag)
      CLASS(mp_comm_type), INTENT(IN)                     :: comm
      INTEGER, INTENT(IN)                                :: in_external_master_id
      INTEGER, INTENT(IN), OPTIONAL                      :: in_scf_energy_message_tag, in_exit_tag
 
      cpassert(in_external_master_id .GE. 0)
 
      external_comm = comm
      external_master_id = in_external_master_id
 
      IF (PRESENT(in_scf_energy_message_tag)) &
         scf_energy_message_tag = in_scf_energy_message_tag
      IF (PRESENT(in_exit_tag)) THEN
         ! the exit tag should be different from the mpi_probe tag default
         cpassert(in_exit_tag .NE. -1)
         exit_tag = in_exit_tag
      END IF
   END SUBROUTINE set_external_comm
 
! **************************************************************************************************
!> \brief External manipulations during a run : when the <PROJECT_NAME>.EXIT_$runtype
!>      command is sent the program stops at the level of $runtype
!>      when a general <PROJECT_NAME>.EXIT command is sent the program is stopped
!>      at all levels (at least those that call this function)
!>      if the file WAIT exists, the program waits here till it disappears
!> \param should_stop ...
!> \param flag ...
!> \param globenv ...
!> \param target_time ...
!> \param start_time ...
!> \param force_check ...
!> \author MI (10.03.2005)
! **************************************************************************************************
   SUBROUTINE external_control(should_stop, flag, globenv, target_time, start_time, force_check)
 
      LOGICAL, INTENT(OUT)                               :: should_stop
      CHARACTER(LEN=*), INTENT(IN)                       :: flag
      TYPE(global_environment_type), OPTIONAL, POINTER   :: globenv
      REAL(dp), OPTIONAL                                 :: target_time, start_time
      LOGICAL, OPTIONAL                                  :: force_check
 
      CHARACTER(LEN=*), PARAMETER                        :: routinen = 'external_control'
 
      CHARACTER(LEN=default_string_length)               :: exit_fname, exit_fname_level, &
                                                            exit_gname, exit_gname_level
      INTEGER                                            :: handle, i, tag, unit_number
      LOGICAL                                            :: should_wait
      LOGICAL, SAVE                                      :: check_always = .false.
      REAL(kind=dp)                                      :: my_start_time, my_target_time, t1, t2, &
                                                            time_check
      REAL(kind=dp), SAVE                                :: t_last_file_check = 0.0_dp
      TYPE(cp_logger_type), POINTER                      :: logger
 
      CALL timeset(routinen, handle)
 
      logger => cp_get_default_logger()
      should_stop = .false.
 
      IF (PRESENT(force_check)) THEN
         IF (force_check) THEN
            check_always = .true.
         END IF
      END IF
 
      exit_gname = "EXIT"
      exit_gname_level = trim(exit_gname)//"_"//trim(flag)
      exit_fname = trim(logger%iter_info%project_name)//"."//trim(exit_gname)
      exit_fname_level = trim(logger%iter_info%project_name)//"."//trim(exit_gname_level)
 
      ! check for incomming messages and if it is tagged with the exit tag
      IF (exit_tag .NE. -1) THEN
         i = external_master_id
         CALL external_comm%probe(source=i, tag=tag)
         IF (tag .EQ. exit_tag) should_stop = .true.
      END IF
 
      IF (logger%para_env%is_source()) THEN
         ! files will only be checked every 20 seconds, or if the clock wraps/does not exist,
         ! otherwise 64 waters on 64 cores can spend up to 10% of time here, on lustre
         ! however, if should_stop has been true, we should always check
         ! (at each level scf, md, ... the file must be there to guarantee termination)
         t1 = m_walltime()
         IF (t1 > t_last_file_check + 20.0_dp .OR. t1 <= t_last_file_check .OR. check_always) THEN
 
            t_last_file_check = t1
            ! allows for halting execution for a while
            ! this is useful to copy a consistent snapshot of the output
            ! while a simulation is running
            INQUIRE (file="WAIT", exist=should_wait)
            IF (should_wait) THEN
               CALL open_file(file_name="WAITING", file_status="UNKNOWN", &
                              file_form="FORMATTED", file_action="WRITE", &
                              unit_number=unit_number)
               WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
                  "*** waiting till the file WAIT has been removed ***"
               DO
                  ! sleep a bit (to save the file system)
                  t1 = m_walltime()
                  DO i = 1, 100000000
                     t2 = m_walltime()
                     IF (t2 - t1 > 1.0_dp) EXIT
                  END DO
                  ! and ask again
                  INQUIRE (file="WAIT", exist=should_wait)
                  IF (.NOT. should_wait) EXIT
               END DO
               CALL close_file(unit_number=unit_number, file_status="DELETE")
            END IF
            ! EXIT control sequence
            ! Check for <PROJECT_NAME>.EXIT_<FLAG>
            IF (.NOT. should_stop) THEN
               INQUIRE (file=exit_fname_level, exist=should_stop)
               IF (should_stop) THEN
                  CALL open_file(file_name=exit_fname_level, unit_number=unit_number)
                  CALL close_file(unit_number=unit_number, file_status="DELETE")
                  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
                     "*** "//flag//" run terminated by external request ***"
               END IF
            END IF
            ! Check for <PROJECT_NAME>.EXIT
            IF (.NOT. should_stop) THEN
               INQUIRE (file=exit_fname, exist=should_stop)
               IF (should_stop) THEN
                  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
                     "*** "//trim(flag)//" run terminated by external request ***"
               END IF
            END IF
            ! Check for EXIT_<FLAG>
            IF (.NOT. should_stop) THEN
               INQUIRE (file=exit_gname_level, exist=should_stop)
               IF (should_stop) THEN
                  CALL open_file(file_name=exit_gname_level, unit_number=unit_number)
                  CALL close_file(unit_number=unit_number, file_status="DELETE")
                  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
                     "*** "//flag//" run terminated by external request ***"
               END IF
            END IF
            ! Check for EXIT
            IF (.NOT. should_stop) THEN
               INQUIRE (file=exit_gname, exist=should_stop)
               IF (should_stop) THEN
                  WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,/)") &
                     "*** "//trim(flag)//" run terminated by external request ***"
               END IF
            END IF
         END IF
 
         IF (PRESENT(target_time)) THEN
            my_target_time = target_time
            my_start_time = start_time
         ELSEIF (PRESENT(globenv)) THEN
            my_target_time = globenv%cp2k_target_time
            my_start_time = globenv%cp2k_start_time
         ELSE
            ! If none of the two arguments is present abort.. This routine should always check about time.
            cpabort("")
         END IF
 
         IF ((.NOT. should_stop) .AND. (my_target_time > 0.0_dp)) THEN
            ! Check for execution time
            time_check = m_walltime() - my_start_time
            IF (time_check .GT. my_target_time) THEN
               should_stop = .true.
               WRITE (unit=cp_logger_get_default_unit_nr(logger), fmt="(/,T2,A,f12.3,A)") &
                  "*** "//trim(flag)//" run terminated - exceeded requested execution time:", &
                  my_target_time, " seconds.", &
                  "*** Execution time now: ", time_check, " seconds."
            END IF
         END IF
      END IF
      CALL logger%para_env%bcast(should_stop)
 
      check_always = should_stop
 
      CALL timestop(handle)
 
   END SUBROUTINE external_control
 
END MODULE cp_external_control