module FPM More...

Functions/Subroutines
subroutine, public	fpm_init (max_failure, polling_freq, universal_comm, global_comm, local_comm, num_member, global_root, use_fpm)
	Initialize FPM. More...

subroutine, public	fpm_polling (run_stat, stop_signal)
	Main system of FPM. More...

Variables
integer, public	fpm_max_failure = 1

integer, public	fpm_polling_freq = 5

logical, public	fpm_alive

Detailed Description

module FPM

Description: Failure Process Management module

Author: Team SCALE

Function/Subroutine Documentation

◆ fpm_init()

subroutine, public scale_fpm::fpm_init	(	integer, intent(in)	max_failure,
		integer, intent(in)	polling_freq,
		integer, intent(in)	universal_comm,
		integer, intent(in)	global_comm,
		integer, intent(in)	local_comm,
		integer, intent(in)	num_member,
		integer, dimension(:), intent(in)	global_root,
		logical, intent(in)	use_fpm
	)

Initialize FPM.

Parameters

[in]	max_failure	threshold of failure procs
[in]	polling_freq	polling frequency per time step (0: no polling)
[in]	universal_comm	communicator
[in]	global_comm	communicator
[in]	local_comm	communicator
[in]	num_member	number of members (NUM_BULKJOB)
[in]	global_root	root ranks of global comms
[in]	use_fpm	fpm switch

Definition at line 79 of file scale_fpm.F90.

     implicit none
     integer, intent(in) :: max_failure
     integer, intent(in) :: polling_freq
     integer, intent(in) :: universal_comm
     integer, intent(in) :: global_comm
     integer, intent(in) :: local_comm
     integer, intent(in) :: num_member
     integer, intent(in) :: global_root(:)
     logical, intent(in) :: use_fpm
  
     integer, allocatable :: manager_list(:)
     integer, allocatable :: exclude_list(:)
     integer :: num_exclude
     integer :: group_univ
     integer :: group_manager
     integer :: i, j, k
     integer :: ierr
  
     !---------------------------------------------------------------------------
  
     fpm_alive       = use_fpm
     fpm_master      = .false.
     fpm_manager     = .false.
     fpm_num_member  = num_member
     fpm_max_failure = max_failure
     fpm_polling_freq = polling_freq
  
     if ( fpm_alive ) then
        fpm_universal_comm = universal_comm
        call mpi_comm_rank( fpm_universal_comm, fpm_unv_myproc, ierr )
        call mpi_comm_size( fpm_universal_comm, fpm_unv_nprocs, ierr )
        fpm_global_comm    = global_comm
        call mpi_comm_rank( fpm_global_comm, fpm_glb_myproc, ierr )
        call mpi_comm_size( fpm_global_comm, fpm_glb_nprocs, ierr )
        fpm_local_comm     = local_comm
        fpm_local_master   = 0
        call mpi_comm_rank( fpm_local_comm, fpm_lcl_myproc, ierr )
        call mpi_comm_size( fpm_local_comm, fpm_lcl_nprocs, ierr )
  
        if ( fpm_unv_myproc == fpm_manager_master ) fpm_master = .true.
        if ( fpm_master ) write(*,*) ''
        if ( fpm_master ) write(*,*) '*** Failure Procs Manager: available'
        if ( fpm_master ) write(*,*) '*** Threshold of Failure Procs = ', fpm_max_failure
        if ( fpm_master ) then
           if ( fpm_polling_freq > 0 ) then
              write(*,*) '*** FPM Polling Frequency per DT = ', fpm_polling_freq
           else
              write(*,*) '*** FPM: NO Polling'
           endif
        endif
  
        ! create manager communicator
        allocate( manager_list(fpm_num_member) )
        do i=1, fpm_num_member
           manager_list(i) = global_root(i)
           if ( fpm_unv_myproc == manager_list(i) ) fpm_manager = .true.
        enddo
  
        num_exclude = fpm_unv_nprocs - fpm_num_member
        allocate( exclude_list(num_exclude) )
        j = 1
        k = 1
        do i=0, fpm_unv_nprocs-1
           if ( i == manager_list(j) ) then
              if ( j < fpm_num_member ) j = j + 1
           else
              exclude_list(k) = i
              if ( k < num_exclude ) k = k + 1
           endif
        enddo
  
        call mpi_comm_group( fpm_universal_comm, &
                             group_univ,         &
                             ierr                )
        call mpi_group_excl( group_univ,         &
                             num_exclude,        &
                             exclude_list,       &
                             group_manager,      &
                             ierr                )
        call mpi_comm_create( fpm_universal_comm, &
                              group_manager,      &
                              fpm_manager_comm,   &
                              ierr                )
  
        allocate( fpm_running(fpm_num_member) )
        allocate( fpm_lcl_running(fpm_lcl_nprocs) )
        fpm_running(:) = .true.
        fpm_lcl_running(:) = .true.
     endif
  

References fpm_alive, fpm_max_failure, and fpm_polling_freq.

Referenced by mod_launcher::launcher().

Here is the caller graph for this function:

◆ fpm_polling()

subroutine, public scale_fpm::fpm_polling	(	logical, intent(in)	run_stat,
		logical, intent(out)	stop_signal
	)

Main system of FPM.

Parameters

[in]	run_stat	running status
[out]	stop_signal	exit sign

Definition at line 176 of file scale_fpm.F90.

     implicit none
     logical, intent(in ) :: run_stat
     logical, intent(out) :: stop_signal
  
     integer :: sendcounts, recvcounts
     integer :: failcount
     integer :: i
     integer :: ierr
  
     logical :: local_stat
     logical :: sendbuff
     !---------------------------------------------------------------------------
  
     sendcounts  = 1
     recvcounts  = 1
     stop_signal = .false.
     local_stat  = .true.
  
     ! participants level
     sendbuff = run_stat
     call mpi_gather( sendbuff,           &
                      sendcounts,         &
                      mpi_logical,        &
                      fpm_lcl_running(:), &
                      recvcounts,         &
                      mpi_logical,        &
                      fpm_local_master,   &
                      fpm_local_comm,     &
                      ierr                )
  
     ! manager level
     !-------------------------------------------<<<
     if ( fpm_manager ) then
        do i=1, fpm_lcl_nprocs
           if ( .NOT. fpm_lcl_running(i) ) then
              local_stat = .false.
              exit
           endif
        enddo
  
        !call MPI_BARRIER(FPM_MANAGER_COMM, ierr)
        sendbuff = local_stat
        call mpi_gather( sendbuff,           &
                         sendcounts,         &
                         mpi_logical,        &
                         fpm_running(:),     &
                         recvcounts,         &
                         mpi_logical,        &
                         fpm_manager_master, &
                         fpm_manager_comm,   &
                         ierr                )
  
        ! master level
        !=======================================<<<
        if ( fpm_master ) then
           failcount = 0
           do i=1, fpm_num_member
              if ( .NOT. fpm_running(i) ) then
                 failcount = failcount + 1
              endif
           enddo
  
           if ( failcount >= fpm_max_failure ) then
              stop_signal = .true.
           else
              stop_signal = .false.
           endif
        endif
        !========================================>>>
     endif
     !------------------------------------------->>>
  
     ! broadcast signal
     call mpi_bcast( stop_signal,        &
                     sendcounts,         &
                     mpi_logical,        &
                     fpm_manager_master, &
                     fpm_universal_comm, &
                     ierr                )
  