scale-rm_pp.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
program scalerm_launcher
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use dc_log, only: &
     loginit
  use gtool_file, only: &
     filecloseall
  use scale_precision
  use scale_stdio
  use scale_prof

  use scale_process, only: &
     prc_domain_nlim,     &
     prc_mpistart,        &
     prc_mpistop,         &
     prc_mpifinish,       &
     prc_mpisplit,        &
     prc_universal_setup, &
     prc_global_setup
  use mod_rm_prep, only: &
     scalerm_prep
  use mod_rm_driver, only: &
     scalerm
  !-----------------------------------------------------------------------------
  implicit none
  !-----------------------------------------------------------------------------
  !
  !++ included parameters
  !
  !-----------------------------------------------------------------------------
  !
  !++ parameters & variables
  !
  !=============================================================================

  logical               :: EXECUTE_PREPROCESS           = .true.  ! execute preprocess tools?
  logical               :: EXECUTE_MODEL                = .false. ! execute main model?
  integer               :: NUM_BULKJOB                  = 1       ! number of bulk jobs
  integer               :: NUM_DOMAIN                   = 1       ! number of domains
  integer               :: PRC_DOMAINS(prc_domain_nlim) = 0       ! number of total process in each domain
  character(len=H_LONG) :: CONF_FILES (prc_domain_nlim) = ""      ! name of configulation files
  logical               :: ABORT_ALL_JOBS               = .false. ! abort all jobs or not?
  logical               :: LOG_SPLIT                    = .false. ! log-output for mpi splitting?
  logical               :: COLOR_REORDER                = .true.  ! coloring reorder for mpi splitting?

  namelist / param_launcher / &
     execute_preprocess, &
     execute_model,      &
     num_bulkjob,        &
     num_domain,         &
     prc_domains,        &
     conf_files,         &
     abort_all_jobs,     &
     log_split,          &
     color_reorder

  integer               :: universal_comm                         ! universal communicator
  integer               :: universal_nprocs                       ! number of procs in universal communicator
  logical               :: universal_master                       ! master process  in universal communicator?
  character(len=H_LONG) :: universal_cnf_fname                    ! config file for launcher

  integer               :: global_comm                            ! communicator for each member
  integer               :: global_nprocs                          ! number of procs in global communicator
  integer               :: PRC_BULKJOB(prc_domain_nlim) = 0       ! = global_nprocs
  character(len=H_LONG) :: dummy1     (prc_domain_nlim) = ""
  integer               :: intercomm_parent_null                  ! NULL inter communicator with parent
  integer               :: intercomm_child_null                   ! NULL inter communicator with child
  character(len=H_LONG) :: bulk_prefix                            ! dirname of each member

  integer               :: local_comm       ! assigned local communicator
  integer               :: intercomm_parent ! inter communicator with parent
  integer               :: intercomm_child  ! inter communicator with child
  character(len=H_LONG) :: local_cnf_fname  ! config file for local domain

  integer :: fid, ierr
  !-----------------------------------------------------------

  ! start MPI
  call prc_mpistart( universal_comm ) ! [OUT]

  call prc_universal_setup( universal_comm,   & ! [IN]
                            universal_nprocs, & ! [OUT]
                            universal_master  ) ! [OUT]

  if( universal_master ) write(*,*) '*** Start Launch System for SCALE-RM'

  !--- read launcher config

  universal_cnf_fname = io_arg_getfname( universal_master )

  fid = io_cnf_open( universal_cnf_fname, & ! [IN]
                     universal_master     ) ! [IN]

  ! set default
  conf_files(1) = universal_cnf_fname

  ! read namelist
  rewind(fid)
  read(fid,nml=param_launcher,iostat=ierr)
  if ( ierr < 0 ) then !--- missing
     ! keep default setting (no members, no nesting)
  elseif( ierr > 0 ) then !--- fatal error
     if( universal_master ) write(*,*) 'xxx Not appropriate names in namelist PARAM_LAUNCHER. Check!'
     call prc_mpistop
  endif

  close(fid)

  if (      execute_preprocess &
       .OR. execute_model      ) then
     if( universal_master ) write(*,*) "*** Execute preprocess? : ", execute_preprocess
     if( universal_master ) write(*,*) "*** Execute model?      : ", execute_model
  else
     if( universal_master ) write(*,*) 'xxx No execution. please check PARAM_LAUNCHER. STOP'
     call prc_mpistop
  endif

  !--- split for bulk jobs

  if ( mod(universal_nprocs,num_bulkjob) /= 0 ) then !--- fatal error
     if( universal_master ) write(*,*) 'xxx Total Num of Processes must be divisible by NUM_BULKJOB. Check!'
     if( universal_master ) write(*,*) 'xxx Total Num of Processes = ', universal_nprocs
     if( universal_master ) write(*,*) 'xxx            NUM_BULKJOB = ', num_bulkjob
     call prc_mpistop
  endif

  global_nprocs = universal_nprocs / num_bulkjob
  prc_bulkjob(1:num_bulkjob) = global_nprocs
  if ( num_bulkjob > 1 ) then
     if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL BULK JOB NUMBER   = ", num_bulkjob
     if( universal_master ) write(*,'(1x,A,I5)') "*** PROCESS NUM of EACH JOB = ", global_nprocs
  endif

  ! communicator split for bulk/ensemble
  call prc_mpisplit( universal_comm,        & ! [IN]
                     num_bulkjob,           & ! [IN]
                     prc_bulkjob(:),        & ! [IN]
                     dummy1(:),            & ! [IN]  dummy
                     log_split,             & ! [IN]
                     .true.,                & ! [IN]  flag bulk_split
                     .false.,               & ! [IN]  no reordering
                     global_comm,           & ! [OUT]
                     intercomm_parent_null, & ! [OUT] null
                     intercomm_child_null,  & ! [OUT] null
                     bulk_prefix            ) ! [OUT] dir name instead of file name

  call prc_global_setup( abort_all_jobs, & ! [IN]
                         global_comm     ) ! [IN]

  !--- split for nesting

  if ( num_domain > 1 ) then
     if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL DOMAIN NUMBER     = ", num_domain
     if( universal_master ) write(*,'(1x,A,L5)') "*** Flag of ABORT ALL JOBS  = ", abort_all_jobs
  endif

  ! communicator split for nesting domains
  call prc_mpisplit( global_comm,      & ! [IN]
                     num_domain,       & ! [IN]
                     prc_domains(:),   & ! [IN]
                     conf_files(:),   & ! [IN]
                     log_split,        & ! [IN]
                     .false.,          & ! [IN] flag bulk_split
                     color_reorder,    & ! [IN]
                     local_comm,       & ! [OUT]
                     intercomm_parent, & ! [OUT]
                     intercomm_child,  & ! [OUT]
                     local_cnf_fname   ) ! [OUT]

  !--- start main routine

  if ( num_bulkjob > 1 ) then
     local_cnf_fname = trim(bulk_prefix)//"/"//trim(local_cnf_fname)
  endif

  if ( execute_preprocess ) then
     call scalerm_prep( local_comm,            & ! [IN]
                        intercomm_parent_null, & ! [IN]
                        intercomm_child_null,  & ! [IN]
                        local_cnf_fname        ) ! [IN]
  endif

  if ( execute_model ) then
     call scalerm     ( local_comm,            & ! [IN]
                        intercomm_parent, & ! [IN]
                        intercomm_child,  & ! [IN]
                        local_cnf_fname        ) ! [IN]
  endif

  ! stop MPI
  call prc_mpifinish

  stop
end program scalerm_launcher