terminationcheck.F90

Go to the documentation of this file.

 
module terminationcheck_mod
  use datadefn_mod, only : default_precision, string_length
  use monc_component_mod, only : component_descriptor_type
  use state_mod, only : model_state_type, time_termination_reason, timestep_termination_reason, message_termination_reason, &
       walltime_termination_reason
  use conversions_mod, only : conv_single_real_to_double, conv_to_integer, conv_to_string
  use optionsdatabase_mod, only : options_get_integer, options_has_key, options_get_real, options_add, options_get_string
  use logging_mod, only : log_warn, log_master_log
  use mpi, only : mpi_int, mpi_logical, mpi_in_place, mpi_lor, mpi_wtime
  implicit none
 
#ifndef TEST_MODE
  private
#endif
 
  integer, parameter :: file_line_len=100, file_unit=10
  integer :: max_timesteps, check_messages_file_frequency, check_walltime_frequency, max_walltime_secs
  real(kind=default_precision) :: termination_time
  character(len=STRING_LENGTH) :: messages_file_name
  logical :: check_for_walltime
 
  public terminationcheck_get_descriptor
 
  contains
 
  type(component_descriptor_type) function terminationcheck_get_descriptor()
    terminationcheck_get_descriptor%name="termination_check"
    terminationcheck_get_descriptor%version=0.1
    terminationcheck_get_descriptor%initialisation=>init_callback
    terminationcheck_get_descriptor%timestep=>timestep_callback
  end function terminationcheck_get_descriptor
 
  subroutine init_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state
    integer :: i, idx, pidx, walltime_secs, walltime_mins, walltime_hours
    character(len=STRING_LENGTH) :: walltime_string
    logical :: mangled
 
    max_timesteps=options_get_integer(current_state%options_database, "nn_timesteps")
    termination_time=options_get_real(current_state%options_database, "termination_time")
    check_messages_file_frequency=options_get_integer(current_state%options_database, "check_msg_frequency")
    messages_file_name=options_get_string(current_state%options_database, "msg_filename")
    check_walltime_frequency=options_get_integer(current_state%options_database, "check_walltime_frequency")
    walltime_string=options_get_string(current_state%options_database, "walltime_limit")
    check_for_walltime=trim(walltime_string) /= "none"
    if (check_for_walltime) then
      pidx=1
      mangled=.false.
      do i=1, 2
        idx=index(walltime_string(pidx:), ":")
        if (idx .gt. 0) then
          if (i==1) walltime_hours=conv_to_integer(walltime_string(pidx:pidx+idx-2))
          if (i==2) walltime_mins=conv_to_integer(walltime_string(pidx:pidx+idx-2))
          pidx=pidx+idx
        else
          call log_master_log(log_warn, "Walltime limit of  `"//trim(walltime_string)//&
               "` does not contains hh:mm:ss, defaulting to no limit")
          check_for_walltime=.false.
          exit
        end if
      end do            
      if (check_for_walltime) then
         walltime_secs=conv_to_integer(walltime_string(pidx:))
        if (walltime_mins .lt. 0 .or. walltime_mins .gt. 59) then
          walltime_mins=0
          mangled=.true.
        end if
        if (walltime_secs .lt. 0 .or. walltime_secs .gt. 59) then
          walltime_secs=0
          mangled=.true.
        end if
        if (mangled) then
          call log_master_log(log_warn, "Walltime limit of `"//trim(walltime_string)//"` mangled, defaulting to "//&
               trim(conv_to_string(walltime_hours))//":"//trim(conv_to_string(walltime_mins))//":"//&
               trim(conv_to_string(walltime_secs)))
        end if
        max_walltime_secs=(walltime_hours*60*60)+(walltime_mins*60)+walltime_secs
      end if
    end if    
  end subroutine init_callback
 
  subroutine timestep_callback(current_state)
    type(model_state_type), target, intent(inout) :: current_state
 
    integer :: ierr, file_message_status
 
    if (max_timesteps .gt. 0) then
      current_state%continue_timestep=mod(current_state%timestep, max_timesteps) /= 0
      if (.not. current_state%continue_timestep) current_state%termination_reason=timestep_termination_reason
    else
      current_state%continue_timestep=.true.
    end if
    if (current_state%continue_timestep) then
      current_state%continue_timestep = current_state%time .lt. termination_time
      if (.not. current_state%continue_timestep) current_state%termination_reason=time_termination_reason
    end if
    if (current_state%continue_timestep .and. check_for_walltime .and. &
         mod(current_state%timestep, check_walltime_frequency) == 0) then
      current_state%continue_timestep=int(mpi_wtime() - current_state%model_start_wtime) .lt. max_walltime_secs
      call mpi_allreduce(mpi_in_place, current_state%continue_timestep, 1, mpi_logical, mpi_lor, &
           current_state%parallel%monc_communicator, ierr)
      if (.not. current_state%continue_timestep) current_state%termination_reason=walltime_termination_reason
    end if    
 
    if (current_state%continue_timestep .and. mod(current_state%timestep, check_messages_file_frequency) == 0) then
      if (current_state%parallel%my_rank == 0) then
        file_message_status=check_messages_file(current_state)
        call mpi_bcast(file_message_status, 1, mpi_int, 0, current_state%parallel%monc_communicator, ierr)
      else
        call mpi_bcast(file_message_status, 1, mpi_int, 0, current_state%parallel%monc_communicator, ierr)
        if (file_message_status == 1) current_state%continue_timestep=.false.
      end if
      if (.not. current_state%continue_timestep) current_state%termination_reason=message_termination_reason
    end if    
  end subroutine timestep_callback
 
  integer function check_messages_file(current_state)
    type(model_state_type), target, intent(inout) :: current_state
 
    character(len=FILE_LINE_LEN) :: msg_line
    integer :: ierr
 
    check_messages_file=0
    open (unit=file_unit, file=messages_file_name, status='OLD', iostat=ierr)
    if (ierr == 0) then
      read(file_unit,"(A)",iostat=ierr) msg_line
      if (ierr == 0) then
        if (trim(msg_line) .eq. "terminate") then
          check_messages_file=1
          current_state%continue_timestep=.false.
        end if
      end if      
    end if    
    close(file_unit)
  end function check_messages_file  
end module terminationcheck_mod