scale_comm_ensemble.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_comm_ensemble
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use mpi
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: comm_ensemble_setup
  public :: comm_ensemble_finalize
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer, public :: comm_ensemble_world
  integer, public :: comm_ensemble_myrank
  integer, public :: comm_ensemble_nprocs
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine comm_ensemble_setup
    use scale_prc, only: &
       prc_universal_comm_world, &
       prc_global_myrank,        &
       prc_global_nprocs,        &
       prc_local_comm_world,     &
       prc_nprocs,               &
       prc_myrank,               &
       prc_abort
    implicit none
 
    integer, allocatable :: ensemble2color(:)
    integer, allocatable :: ensemble2key  (:)
 
    integer :: n
    integer :: myrank, nprocs
    integer :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("COMM_ENSEMBLE_setup",*) 'Setup'
 
    !!--- read namelist
    !rewind(IO_FID_CONF)
    !read(IO_FID_CONF,nml=PARAM_COMM_ENSEMBLE,iostat=ierr)
    !if( ierr < 0 ) then !--- missing
    !   LOG_INFO("COMM_ENSEMBLE_setup",*) 'Not found namelist. Default used.'
    !elseif( ierr > 0 ) then !--- fatal error
    !   LOG_ERROR("COMM_ENSEMBLE_setup",*) 'Not appropriate names in namelist PARAM_COMM_ENSEMBLE. Check!'
    !   call PRC_abort
    !endif
    !LOG_NML(PARAM_COMM_ENSEMBLE)
 
    ! [global] -> [ensemble]
    if( prc_global_nprocs < 2 ) then
       log_error("COMM_ENSEMBLE_setup",*) 'PRC_GLOBAL_nprocs must be greater than or equal to 2:', prc_global_nprocs
       call prc_abort
    end if
 
    allocate( ensemble2color(0:prc_global_nprocs-1) )
    allocate( ensemble2key(0:prc_global_nprocs-1) )
 
    do n = 0, prc_global_nprocs-1
       ensemble2color(n) = n
       ensemble2key(n) = n
    end do
 
    call mpi_comm_split( prc_universal_comm_world,          & ! [IN]
                         ensemble2color(prc_global_myrank), & ! [IN]
                         ensemble2key(prc_global_myrank), & ! [IN]
                         comm_ensemble_world,               & ! [OUT]
                         ierr                               ) ! [OUT]
 
    call mpi_comm_rank( comm_ensemble_world, comm_ensemble_myrank, ierr )
    call mpi_comm_size( comm_ensemble_world, comm_ensemble_nprocs, ierr )
 
    deallocate( ensemble2color )
    deallocate( ensemble2key   )
 
    return
  end subroutine comm_ensemble_setup
 
  !-----------------------------------------------------------------------------
  subroutine comm_ensemble_finalize
    implicit none
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call mpi_comm_free( comm_ensemble_world, ierr )
 
    return
  end subroutine comm_ensemble_finalize
 
end module scale_comm_ensemble