SCALE-RM
scale-rm_init.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
11 !-------------------------------------------------------------------------------
12 program scalerm_init
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20 
21  use scale_prc, only: &
23  prc_comm_null, &
24  prc_abort, &
25  prc_mpistart, &
26  prc_mpifinish, &
33  use scale_fpm, only: &
34  fpm_init
35  use mod_rm_prep, only: &
36  rm_prep
37  use mod_rm_driver, only: &
38  rm_driver
39  !-----------------------------------------------------------------------------
40  implicit none
41  !-----------------------------------------------------------------------------
42  !
43  !++ included parameters
44  !
45  !-----------------------------------------------------------------------------
46  !
47  !++ parameters & variables
48  !
49  !=============================================================================
50 
51  logical :: execute_preprocess = .true. ! execute preprocess tools?
52  logical :: execute_model = .false. ! execute main model?
53  integer :: num_bulkjob = 1 ! number of bulk jobs
54  integer :: num_domain = 1 ! number of domains
55  integer :: num_fail_tolerance = 1 ! tolerance number of failure processes
56  integer :: freq_fail_check = 0 ! FPM polling frequency per DT (0: no polling)
57  integer :: prc_domains(prc_domain_nlim) = 0 ! number of total process in each domain
58  character(len=H_LONG) :: conf_files (prc_domain_nlim) = "" ! name of configulation files
59  logical :: abort_all_jobs = .false. ! abort all jobs or not?
60  logical :: log_split = .false. ! log-output for mpi splitting?
61  logical :: color_reorder = .true. ! coloring reorder for mpi splitting?
62  logical :: failure_prc_manage = .false. ! use failure process management?
63 
64  namelist / param_launcher / &
65 ! EXECUTE_PREPROCESS, &
66 ! EXECUTE_MODEL, &
67  num_bulkjob, &
68  num_domain, &
69  num_fail_tolerance, &
70  freq_fail_check, &
71  prc_domains, &
72  conf_files, &
73  abort_all_jobs, &
74  log_split, &
75  color_reorder, &
76  failure_prc_manage
77 
78  integer :: universal_comm ! universal communicator
79  integer :: universal_nprocs ! number of procs in universal communicator
80  integer :: universal_myrank ! my rank in universal communicator
81  logical :: universal_master ! master process in universal communicator?
82  character(len=H_LONG) :: universal_cnf_fname ! config file for launcher
83 
84  integer :: global_comm ! communicator for each member
85  integer :: global_nprocs ! number of procs in global communicator
86  integer :: prc_bulkjob(prc_domain_nlim) = 0 ! number of procs in each bulk job = global_nprocs
87  integer :: id_bulkjob ! bulk job ID
88 
89  logical :: use_fpm = .false. ! switch for fpm module
90 
91  integer :: local_comm ! assigned local communicator
92  integer :: id_domain ! domain ID
93  integer :: intercomm_parent ! inter communicator with parent
94  integer :: intercomm_child ! inter communicator with child
95  character(len=H_LONG) :: local_cnf_fname ! config file for local domain
96 
97  integer :: fid, ierr
98  !-----------------------------------------------------------
99 
100  ! start MPI
101  call prc_mpistart( universal_comm ) ! [OUT]
102 
103  call prc_universal_setup( universal_comm, & ! [IN]
104  universal_nprocs, & ! [OUT]
105  universal_myrank, & ! [OUT]
106  universal_master ) ! [OUT]
107 
108  if( universal_master ) write(*,*) '*** Start Launch System for SCALE-RM'
109 
110  !--- read launcher config
111 
112  universal_cnf_fname = io_arg_getfname( universal_master )
113 
114  fid = io_cnf_open( universal_cnf_fname, & ! [IN]
115  universal_master ) ! [IN]
116 
117  ! set default
118  conf_files(1) = universal_cnf_fname
119 
120  ! read namelist
121  rewind(fid)
122  read(fid,nml=param_launcher,iostat=ierr)
123  if ( ierr < 0 ) then !--- missing
124  ! keep default setting (no members, no nesting)
125  elseif( ierr > 0 ) then !--- fatal error
126  if( universal_master ) write(*,*) 'xxx Not appropriate names in namelist PARAM_LAUNCHER. Check!'
127  call prc_abort
128  endif
129 
130  close(fid)
131  freq_fail_check = 0 ! force 0, coz no time integrations
132 
133  if ( execute_preprocess &
134  .OR. execute_model ) then
135  if( universal_master ) write(*,*) "*** Execute preprocess? : ", execute_preprocess
136  if( universal_master ) write(*,*) "*** Execute model? : ", execute_model
137  else
138  if( universal_master ) write(*,*) 'xxx No execution. please check PARAM_LAUNCHER. STOP'
139  call prc_abort
140  endif
141 
142  !--- split for bulk jobs
143 
144  if ( mod(universal_nprocs,num_bulkjob) /= 0 ) then !--- fatal error
145  if( universal_master ) write(*,*) 'xxx Total Num of Processes must be divisible by NUM_BULKJOB. Check!'
146  if( universal_master ) write(*,*) 'xxx Total Num of Processes = ', universal_nprocs
147  if( universal_master ) write(*,*) 'xxx NUM_BULKJOB = ', num_bulkjob
148  call prc_abort
149  endif
150 
151  global_nprocs = universal_nprocs / num_bulkjob
152  prc_bulkjob(1:num_bulkjob) = global_nprocs
153  if ( num_bulkjob > 1 ) then
154  if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL BULK JOB NUMBER = ", num_bulkjob
155  if( universal_master ) write(*,'(1x,A,I5)') "*** PROCESS NUM of EACH JOB = ", global_nprocs
156 
157  if ( failure_prc_manage ) then
158  if( universal_master ) write(*,'(1x,A)') "*** Available: Failure Process Management"
159  use_fpm = .true. !--- available only in bulk job
160  if ( num_fail_tolerance <= 0 ) then !--- fatal error
161  if( universal_master ) write(*,*) 'xxx Num of Failure Processes must be positive number. Check!'
162  if( universal_master ) write(*,*) 'xxx NUM_FAIL_TOLERANCE = ', num_fail_tolerance
163  call prc_abort
164  endif
165 
166  if ( num_fail_tolerance > num_bulkjob ) then !--- fatal error
167  write(*,*) 'xxx NUM_FAIL_TOLERANCE is bigger than NUM_BLUKJOB number'
168  write(*,*) ' set to be: NUM_FAIL_TOLERANCE <= NUM_BLUKJOB'
169  call prc_abort
170  endif
171  endif
172  endif
173 
174  ! communicator split for bulk/ensemble
175  call prc_mpisplit_bulk( universal_comm, & ! [IN]
176  num_bulkjob, & ! [IN]
177  prc_bulkjob(:), & ! [IN]
178  log_split, & ! [IN]
179  global_comm, & ! [OUT]
180  id_bulkjob ) ! [OUT]
181 
182  call prc_global_setup( abort_all_jobs, & ! [IN]
183  global_comm ) ! [IN]
184 
185  !--- split for nesting
186 
187  if ( num_domain > 1 ) then
188  if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL DOMAIN NUMBER = ", num_domain
189  if( universal_master ) write(*,'(1x,A,L5)') "*** Flag of ABORT ALL JOBS = ", abort_all_jobs
190  endif
191 
192  ! communicator split for nesting domains
193  call prc_mpisplit_nest( global_comm, & ! [IN]
194  num_domain, & ! [IN]
195  prc_domains(:), & ! [IN]
196  log_split, & ! [IN]
197  color_reorder, & ! [IN]
198  local_comm, & ! [OUT]
199  id_domain, & ! [OUT]
200  intercomm_parent, & ! [OUT]
201  intercomm_child ) ! [OUT]
202 
203  !--- initialize FPM module & error handler
204  call fpm_init( num_fail_tolerance, & ! [IN]
205  freq_fail_check, & ! [IN]
206  universal_comm, & ! [IN]
207  global_comm, & ! [IN]
208  local_comm, & ! [IN]
209  num_bulkjob, & ! [IN]
210  prc_global_root, & ! [IN]
211  use_fpm ) ! [IN]
212 
213  call prc_errhandler_setup( use_fpm, universal_master )
214 
215  call io_set_universalrank( universal_myrank, & ! [IN]
216  id_bulkjob, & ! [IN]
217  id_domain ) ! [IN]
218 
219  !--- start main routine
220 
221  if ( num_bulkjob > 1 ) then
222  write(local_cnf_fname,'(I4.4,2A)') id_bulkjob, "/", trim(conf_files(id_domain))
223  else
224  local_cnf_fname = trim(conf_files(id_domain))
225  endif
226 
227  if ( execute_preprocess ) then
228  call rm_prep( local_comm, & ! [IN]
229  prc_comm_null, & ! [IN]
230  prc_comm_null, & ! [IN]
231  local_cnf_fname ) ! [IN]
232  endif
233 
234  if ( execute_model ) then
235  call rm_driver( local_comm, & ! [IN]
236  intercomm_parent, & ! [IN]
237  intercomm_child, & ! [IN]
238  local_cnf_fname ) ! [IN]
239  endif
240 
241  ! stop MPI
242  call prc_mpifinish
243 
244  if( universal_master ) write(*,*) '*** End Launch System for SCALE-RM'
245 
246  stop
247 end program scalerm_init
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_prc::prc_universal_setup
subroutine, public prc_universal_setup(comm, nprocs, myrank, ismaster)
setup MPI in universal communicator
Definition: scale_prc.F90:148
scale_prc::prc_mpisplit_bulk
subroutine, public prc_mpisplit_bulk(ORG_COMM_WORLD, NUM_BULKJOB, PRC_BULKJOB, debug, SUB_COMM_WORLD, ID_BULKJOB)
MPI Communicator Split (bulk job)
Definition: scale_prc.F90:415
mod_rm_prep::rm_prep
subroutine, public rm_prep(comm_world, intercomm_parent, intercomm_child, cnf_fname)
Setup.
Definition: mod_rm_prep.F90:59
scale_prc::prc_global_setup
subroutine, public prc_global_setup(abortall, comm)
setup MPI in global communicator
Definition: scale_prc.F90:188
scale_io::io_set_universalrank
subroutine, public io_set_universalrank(myrank, jobid, domainid)
Put for error log.
Definition: scale_io.F90:345
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_prc::prc_mpistart
subroutine, public prc_mpistart(comm)
Start MPI.
Definition: scale_prc.F90:122
scale_fpm::fpm_init
subroutine, public fpm_init(max_failure, polling_freq, universal_comm, global_comm, local_comm, num_member, global_root, use_fpm)
Initialize FPM.
Definition: scale_fpm.F90:79
mod_rm_prep
module SCALE-RM prep
Definition: mod_rm_prep.F90:14
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scalerm_init
program scalerm_init
Program SCALE-RM (a launcher of main routine)
Definition: scale-rm_init.F90:12
scale_io
module STDIO
Definition: scale_io.F90:10
scale_prc::prc_comm_null
integer, parameter, public prc_comm_null
Definition: scale_prc.F90:68
scale_prc::prc_errhandler_setup
subroutine, public prc_errhandler_setup(use_fpm, master)
Setup MPI error handler.
Definition: scale_prc.F90:305
scale_prc::prc_global_root
integer, dimension(prc_domain_nlim), public prc_global_root
root processes in global members
Definition: scale_prc.F90:85
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_prc::prc_domain_nlim
integer, parameter, public prc_domain_nlim
max depth of domains
Definition: scale_prc.F90:67
scale_prc::prc_mpisplit_nest
subroutine, public prc_mpisplit_nest(ORG_COMM_WORLD, NUM_DOMAIN, PRC_DOMAIN, debug, color_reorder, SUB_COMM_WORLD, ID_DOMAIN, INTERCOMM_parent, INTERCOMM_child)
MPI Communicator Split (nesting)
Definition: scale_prc.F90:520
mod_rm_driver
module SCALE-RM (a main routine of regional model)
Definition: mod_rm_driver.F90:13
scale_fpm
module FPM
Definition: scale_fpm.F90:10
scale_prc::prc_mpifinish
subroutine, public prc_mpifinish
Stop MPI peacefully.
Definition: scale_prc.F90:358
mod_rm_driver::rm_driver
subroutine, public rm_driver(comm_world, intercomm_parent, intercomm_child, cnf_fname)
Setup.
Definition: mod_rm_driver.F90:58
scale_io::io_arg_getfname
character(len=h_long) function, public io_arg_getfname(is_master, allow_noconf)
get config filename from argument
Definition: scale_io.F90:393
scale_io::io_cnf_open
integer function, public io_cnf_open(fname, is_master)
open config file
Definition: scale_io.F90:425