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_abort, &
23  prc_domain_nlim, &
24  prc_mpistart, &
25  prc_mpifinish, &
26  prc_mpisplit, &
27  prc_universal_setup, &
28  prc_global_setup, &
29  prc_global_root, &
30  prc_errhandler_setup
31  use scale_fpm, only: &
32  fpm_init
33  use mod_rm_prep, only: &
34  rm_prep
35  use mod_rm_driver, only: &
36  rm_driver
37  !-----------------------------------------------------------------------------
38  implicit none
39  !-----------------------------------------------------------------------------
40  !
41  !++ included parameters
42  !
43  !-----------------------------------------------------------------------------
44  !
45  !++ parameters & variables
46  !
47  !=============================================================================
48 
49  logical :: EXECUTE_PREPROCESS = .false. ! execute preprocess tools?
50  logical :: EXECUTE_MODEL = .true. ! execute main model?
51  integer :: NUM_BULKJOB = 1 ! number of bulk jobs
52  integer :: NUM_DOMAIN = 1 ! number of domains
53  integer :: NUM_FAIL_TOLERANCE = 1 ! tolerance number of failure processes
54  integer :: FREQ_FAIL_CHECK = 5 ! FPM polling frequency per DT (0: no polling)
55  integer :: PRC_DOMAINS(prc_domain_nlim) = 0 ! number of total process in each domain
56  character(len=H_LONG) :: CONF_FILES (prc_domain_nlim) = "" ! name of configulation files
57  logical :: ABORT_ALL_JOBS = .false. ! abort all jobs or not?
58  logical :: LOG_SPLIT = .false. ! log-output for mpi splitting?
59  logical :: COLOR_REORDER = .true. ! coloring reorder for mpi splitting?
60  logical :: FAILURE_PRC_MANAGE = .false. ! use failure process management?
61 
62  namelist / param_launcher / &
63 ! EXECUTE_PREPROCESS, &
64 ! EXECUTE_MODEL, &
65  num_bulkjob, &
66  num_domain, &
67  num_fail_tolerance, &
68  freq_fail_check, &
69  prc_domains, &
70  conf_files, &
71  abort_all_jobs, &
72  log_split, &
73  color_reorder, &
74  failure_prc_manage
75 
76  integer :: universal_comm ! universal communicator
77  integer :: universal_nprocs ! number of procs in universal communicator
78  logical :: universal_master ! master process in universal communicator?
79  character(len=H_LONG) :: universal_cnf_fname ! config file for launcher
80 
81  integer :: global_comm ! communicator for each member
82  integer :: global_nprocs ! number of procs in global communicator
83  integer :: PRC_BULKJOB(prc_domain_nlim) = 0 ! = global_nprocs
84  character(len=H_LONG) :: dummy1 (prc_domain_nlim) = ""
85  integer :: intercomm_parent_null ! NULL inter communicator with parent
86  integer :: intercomm_child_null ! NULL inter communicator with child
87  character(len=H_LONG) :: bulk_prefix ! dirname of each member
88 
89  logical :: use_fpm = .false. ! switch for fpm module
90 
91  integer :: local_comm ! assigned local communicator
92  integer :: intercomm_parent ! inter communicator with parent
93  integer :: intercomm_child ! inter communicator with child
94  character(len=H_LONG) :: local_cnf_fname ! config file for local domain
95 
96  integer :: fid, ierr
97  !-----------------------------------------------------------
98 
99  ! start MPI
100  call prc_mpistart( universal_comm ) ! [OUT]
101 
102  call prc_universal_setup( universal_comm, & ! [IN]
103  universal_nprocs, & ! [OUT]
104  universal_master ) ! [OUT]
105 
106  if( universal_master ) write(*,*) '*** Start Launch System for SCALE-RM'
107 
108  !--- read launcher config
109 
110  universal_cnf_fname = io_arg_getfname( universal_master )
111 
112  fid = io_cnf_open( universal_cnf_fname, & ! [IN]
113  universal_master ) ! [IN]
114 
115  ! set default
116  conf_files(1) = universal_cnf_fname
117 
118  ! read namelist
119  rewind(fid)
120  read(fid,nml=param_launcher,iostat=ierr)
121  if ( ierr < 0 ) then !--- missing
122  ! keep default setting (no members, no nesting)
123  elseif( ierr > 0 ) then !--- fatal error
124  if( universal_master ) write(*,*) 'xxx Not appropriate names in namelist PARAM_LAUNCHER. Check!'
125  call prc_abort
126  endif
127 
128  close(fid)
129 
130  if ( execute_preprocess &
131  .OR. execute_model ) then
132  if( universal_master ) write(*,*) "*** Execute preprocess? : ", execute_preprocess
133  if( universal_master ) write(*,*) "*** Execute model? : ", execute_model
134  else
135  if( universal_master ) write(*,*) 'xxx No execution. please check PARAM_LAUNCHER. STOP'
136  call prc_abort
137  endif
138 
139  !--- split for bulk jobs
140 
141  if ( mod(universal_nprocs,num_bulkjob) /= 0 ) then !--- fatal error
142  if( universal_master ) write(*,*) 'xxx Total Num of Processes must be divisible by NUM_BULKJOB. Check!'
143  if( universal_master ) write(*,*) 'xxx Total Num of Processes = ', universal_nprocs
144  if( universal_master ) write(*,*) 'xxx NUM_BULKJOB = ', num_bulkjob
145  call prc_abort
146  endif
147 
148  global_nprocs = universal_nprocs / num_bulkjob
149  prc_bulkjob(1:num_bulkjob) = global_nprocs
150  if ( num_bulkjob > 1 ) then
151  if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL BULK JOB NUMBER = ", num_bulkjob
152  if( universal_master ) write(*,'(1x,A,I5)') "*** PROCESS NUM of EACH JOB = ", global_nprocs
153 
154  if ( failure_prc_manage ) then
155  if( universal_master ) write(*,'(1x,A)') "*** Available: Failure Process Management"
156  use_fpm = .true. !--- available only in bulk job
157  if ( num_fail_tolerance <= 0 ) then !--- fatal error
158  if( universal_master ) write(*,*) 'xxx Num of Failure Processes must be positive number. Check!'
159  if( universal_master ) write(*,*) 'xxx NUM_FAIL_TOLERANCE = ', num_fail_tolerance
160  call prc_abort
161  endif
162 
163  if ( num_fail_tolerance > num_bulkjob ) then !--- fatal error
164  write(*,*) 'xxx NUM_FAIL_TOLERANCE is bigger than NUM_BLUKJOB number'
165  write(*,*) ' set to be: NUM_FAIL_TOLERANCE <= NUM_BLUKJOB'
166  call prc_abort
167  endif
168 
169  if ( num_domain > 1 ) then !--- avoid error in the current implementation
170  if ( freq_fail_check >= 1 .or. num_fail_tolerance /= num_bulkjob ) then
171  write(*,*) 'xxx Full function of FPM is not available with online nesting.'
172  write(*,*) ' You can use this only to avoid job stop until all members finish.'
173  write(*,*) ' for this purpose, set: FREQ_FAIL_CHECK = 0'
174  write(*,*) ' NUM_FAIL_TOLERANCE == NUM_BULKJOB'
175  call prc_abort
176  endif
177  endif
178  endif
179  endif
180 
181  ! communicator split for bulk/ensemble
182  call prc_mpisplit( universal_comm, & ! [IN]
183  num_bulkjob, & ! [IN]
184  prc_bulkjob(:), & ! [IN]
185  dummy1(:), & ! [IN] dummy
186  log_split, & ! [IN]
187  .true., & ! [IN] flag bulk_split
188  .false., & ! [IN] no reordering
189  global_comm, & ! [OUT]
190  intercomm_parent_null, & ! [OUT] null
191  intercomm_child_null, & ! [OUT] null
192  bulk_prefix ) ! [OUT] dir name instead of file name
193 
194  call prc_global_setup( abort_all_jobs, & ! [IN]
195  global_comm ) ! [IN]
196 
197  !--- split for nesting
198 
199  if ( num_domain > 1 ) then
200  if( universal_master ) write(*,'(1x,A,I5)') "*** TOTAL DOMAIN NUMBER = ", num_domain
201  if( universal_master ) write(*,'(1x,A,L5)') "*** Flag of ABORT ALL JOBS = ", abort_all_jobs
202  endif
203 
204  ! communicator split for nesting domains
205  call prc_mpisplit( global_comm, & ! [IN]
206  num_domain, & ! [IN]
207  prc_domains(:), & ! [IN]
208  conf_files(:), & ! [IN]
209  log_split, & ! [IN]
210  .false., & ! [IN] flag bulk_split
211  color_reorder, & ! [IN]
212  local_comm, & ! [OUT]
213  intercomm_parent, & ! [OUT]
214  intercomm_child, & ! [OUT]
215  local_cnf_fname ) ! [OUT]
216 
217  !--- initialize FPM module & error handler
218  call fpm_init( num_fail_tolerance, & ! [IN]
219  freq_fail_check, & ! [IN]
220  universal_comm, & ! [IN]
221  global_comm, & ! [IN]
222  local_comm, & ! [IN]
223  num_bulkjob, & ! [IN]
224  prc_global_root, & ! [IN]
225  use_fpm ) ! [IN]
226 
227  call prc_errhandler_setup( use_fpm, universal_master )
228 
229  !--- start main routine
230 
231  if ( num_bulkjob > 1 ) then
232  local_cnf_fname = trim(bulk_prefix)//"/"//trim(local_cnf_fname)
233  endif
234 
235  if ( execute_preprocess ) then
236  call rm_prep( local_comm, & ! [IN]
237  intercomm_parent_null, & ! [IN]
238  intercomm_child_null, & ! [IN]
239  local_cnf_fname ) ! [IN]
240  endif
241 
242  if ( execute_model ) then
243  call rm_driver( local_comm, & ! [IN]
244  intercomm_parent, & ! [IN]
245  intercomm_child, & ! [IN]
246  local_cnf_fname ) ! [IN]
247  endif
248 
249  ! stop MPI
250  call prc_mpifinish
251 
252  if( universal_master ) write(*,*) '*** End Launch System for SCALE-RM'
253 
254  stop
255 end program scalerm
scale_prc::prc_domain_nlim
integer, parameter, public prc_domain_nlim
max depth of domains
Definition: scale_prc.F90:66
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_mpistart
subroutine, public prc_mpistart(comm)
Start MPI.
Definition: scale_prc.F90:121
scale_prc::prc_mpisplit
subroutine, public prc_mpisplit(ORG_COMM, NUM_DOMAIN, PRC_DOMAINS, CONF_FILES, LOG_SPLIT, bulk_split, color_reorder, INTRA_COMM, inter_parent, inter_child, fname_local)
MPI Communicator Split.
Definition: scale_prc.F90:416
scale_io::io_cnf_open
integer function, public io_cnf_open(fname, is_master)
open config file
Definition: scale_io.F90:392
scale_prc::prc_global_setup
subroutine, public prc_global_setup(abortall, comm)
setup MPI in global communicator
Definition: scale_prc.F90:184
mod_rm_driver
module SCALE-RM (a main routine of regional model)
Definition: mod_rm_driver.F90:13
scale_prc::prc_universal_setup
subroutine, public prc_universal_setup(comm, nprocs, ismaster)
setup MPI in universal communicator
Definition: scale_prc.F90:146
scale_prc
module PROCESS
Definition: scale_prc.F90:11
mod_rm_driver::rm_driver
subroutine, public rm_driver(comm_world, intercomm_parent, intercomm_child, cnf_fname)
Setup.
Definition: mod_rm_driver.F90:58
scalerm
program scalerm
Program SCALE-RM (a launcher of main routine)
Definition: scale-rm.F90:12
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
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:360
scale_fpm
module FPM
Definition: scale_fpm.F90:10
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_prc::prc_errhandler_setup
subroutine, public prc_errhandler_setup(use_fpm, master)
Setup MPI error handler.
Definition: scale_prc.F90:301
scale_prc::prc_mpifinish
subroutine, public prc_mpifinish
Stop MPI peacefully.
Definition: scale_prc.F90:354
scale_precision
module PRECISION
Definition: scale_precision.F90:14
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_io
module STDIO
Definition: scale_io.F90:10
scale_prc::prc_global_root
integer, dimension(prc_domain_nlim+1), public prc_global_root
root processes in global members
Definition: scale_prc.F90:84
Generated by   doxygen 1.8.13