SCALE-RM
scale-rm.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
11 !-------------------------------------------------------------------------------
12 program scalerm
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20 
21  use scale_prc, only: &
22  prc_domain_nlim, &
23  prc_comm_null, &
24  prc_abort, &
25  prc_mpistart, &
26  prc_mpifinish, &
27  prc_mpisplit_bulk, &
28  prc_mpisplit_nest, &
29  prc_universal_setup, &
30  prc_global_setup, &
31  prc_global_root, &
32  prc_errhandler_setup
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 = .false. ! execute preprocess tools?
52  logical :: execute_model = .true. ! 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 = 5 ! 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 
132  if ( execute_preprocess &
133  .OR. execute_model ) then
134  if( universal_master ) write(*,*) "*** Execute preprocess? : ", execute_preprocess
135  if( universal_master ) write(*,*) "*** Execute model? : ", execute_model
136  else
137  if( universal_master ) write(*,*) 'xxx No execution. please check PARAM_LAUNCHER. STOP'
138  call prc_abort
139  endif
140 
141  !--- split for bulk jobs
142 
143  if ( mod(universal_nprocs,num_bulkjob) /= 0 ) then !--- fatal error
144  if( universal_master ) write(*,*) 'xxx Total Num of Processes must be divisible by NUM_BULKJOB. Check!'
145  if( universal_master ) write(*,*) 'xxx Total Num of Processes = ', universal_nprocs
146  if( universal_master ) write(*,*) 'xxx NUM_BULKJOB = ', num_bulkjob
147  call prc_abort
148  endif
149 
150  global_nprocs = universal_nprocs / num_bulkjob
151  prc_bulkjob(1:num_bulkjob) = global_nprocs
152  if ( num_bulkjob > 1 ) then
153  if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL BULK JOB NUMBER = ", num_bulkjob
154  if( universal_master ) write(*,'(1x,A,I5)') "*** PROCESS NUM of EACH JOB = ", global_nprocs
155 
156  if ( failure_prc_manage ) then
157  if( universal_master ) write(*,'(1x,A)') "*** Available: Failure Process Management"
158  use_fpm = .true. !--- available only in bulk job
159  if ( num_fail_tolerance <= 0 ) then !--- fatal error
160  if( universal_master ) write(*,*) 'xxx Num of Failure Processes must be positive number. Check!'
161  if( universal_master ) write(*,*) 'xxx NUM_FAIL_TOLERANCE = ', num_fail_tolerance
162  call prc_abort
163  endif
164 
165  if ( num_fail_tolerance > num_bulkjob ) then !--- fatal error
166  write(*,*) 'xxx NUM_FAIL_TOLERANCE is bigger than NUM_BLUKJOB number'
167  write(*,*) ' set to be: NUM_FAIL_TOLERANCE <= NUM_BLUKJOB'
168  call prc_abort
169  endif
170 
171  if ( num_domain > 1 ) then !--- avoid error in the current implementation
172  if ( freq_fail_check >= 1 .or. num_fail_tolerance /= num_bulkjob ) then
173  write(*,*) 'xxx Full function of FPM is not available with online nesting.'
174  write(*,*) ' You can use this only to avoid job stop until all members finish.'
175  write(*,*) ' for this purpose, set: FREQ_FAIL_CHECK = 0'
176  write(*,*) ' NUM_FAIL_TOLERANCE == NUM_BULKJOB'
177  call prc_abort
178  endif
179  endif
180  endif
181  endif
182 
183  ! communicator split for bulk/ensemble
184  call prc_mpisplit_bulk( universal_comm, & ! [IN]
185  num_bulkjob, & ! [IN]
186  prc_bulkjob(:), & ! [IN]
187  log_split, & ! [IN]
188  global_comm, & ! [OUT]
189  id_bulkjob ) ! [OUT]
190 
191  call prc_global_setup( abort_all_jobs, & ! [IN]
192  global_comm ) ! [IN]
193 
194  !--- split for nesting
195 
196  if ( num_domain > 1 ) then
197  if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL DOMAIN NUMBER = ", num_domain
198  if( universal_master ) write(*,'(1x,A,L5)') "*** Flag of ABORT ALL JOBS = ", abort_all_jobs
199  endif
200 
201  ! communicator split for nesting domains
202  call prc_mpisplit_nest( global_comm, & ! [IN]
203  num_domain, & ! [IN]
204  prc_domains(:), & ! [IN]
205  log_split, & ! [IN]
206  color_reorder, & ! [IN]
207  local_comm, & ! [OUT]
208  id_domain, & ! [OUT]
209  intercomm_parent, & ! [OUT]
210  intercomm_child ) ! [OUT]
211 
212  !--- initialize FPM module & error handler
213  call fpm_init( num_fail_tolerance, & ! [IN]
214  freq_fail_check, & ! [IN]
215  universal_comm, & ! [IN]
216  global_comm, & ! [IN]
217  local_comm, & ! [IN]
218  num_bulkjob, & ! [IN]
219  prc_global_root, & ! [IN]
220  use_fpm ) ! [IN]
221 
222  call prc_errhandler_setup( use_fpm, universal_master )
223 
224  call io_set_universalrank( universal_myrank, & ! [IN]
225  id_bulkjob, & ! [IN]
226  id_domain ) ! [IN]
227 
228  !--- start main routine
229 
230  if ( num_bulkjob > 1 ) then
231  write(local_cnf_fname,'(I4.4,2A)') id_bulkjob, "/", trim(conf_files(id_domain))
232  else
233  local_cnf_fname = trim(conf_files(id_domain))
234  endif
235 
236  if ( execute_preprocess ) then
237  call rm_prep( local_comm, & ! [IN]
238  prc_comm_null, & ! [IN]
239  prc_comm_null, & ! [IN]
240  local_cnf_fname ) ! [IN]
241  endif
242 
243  if ( execute_model ) then
244  call rm_driver( local_comm, & ! [IN]
245  intercomm_parent, & ! [IN]
246  intercomm_child, & ! [IN]
247  local_cnf_fname ) ! [IN]
248  endif
249 
250  ! stop MPI
251  call prc_mpifinish
252 
253  if( universal_master ) write(*,*) '*** End Launch System for SCALE-RM'
254 
255  stop
256 end program scalerm
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
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
scalerm
program scalerm
Program SCALE-RM (a launcher of main routine)
Definition: scale-rm.F90:12
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
Generated by   doxygen 1.8.17