SCALE-RM
scale_comm_cartesC_nest.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
12 module scale_comm_cartesc_nest
13  !-----------------------------------------------------------------------------
14  !
15  !++ used modules
16  !
17  use mpi
18  use scale_precision
19  use scale_io
20  use scale_prof
21  use scale_debug
22  use scale_atmos_grid_cartesc_index
23  use scale_index
24  use scale_tracer
25  use scale_file_h
26  !-----------------------------------------------------------------------------
27  implicit none
28  private
29  !-----------------------------------------------------------------------------
30  !
31  !++ Public procedure
32  !
33  public :: comm_cartesc_nest_setup
34  public :: comm_cartesc_nest_domain_regist_file
35  public :: comm_cartesc_nest_parent_info
36  public :: comm_cartesc_nest_domain_shape
37  public :: comm_cartesc_nest_nestdown_send
38  public :: comm_cartesc_nest_nestdown_recv
39  public :: comm_cartesc_nest_recvwait_issue_send
40  public :: comm_cartesc_nest_recvwait_issue_recv
41  public :: comm_cartesc_nest_recv_cancel_send
42  public :: comm_cartesc_nest_recv_cancel_recv
43  public :: comm_cartesc_nest_test_send
44  public :: comm_cartesc_nest_test_recv
45  public :: comm_cartesc_nest_finalize
46 
47  !-----------------------------------------------------------------------------
48  !
49  !++ Public parameters & variables
50  !
51  type, public :: domain_info
52  integer :: prc_num_x
53  integer :: prc_num_y
54  integer :: kmax
55  integer :: khalo
56  integer :: imax
57  integer :: ihalo
58  integer :: jmax
59  integer :: jhalo
60  integer :: okmax
61  integer :: lkmax
62  integer :: ukmax
63  logical :: periodic_x
64  logical :: periodic_y
65  real(rp), allocatable :: latlon_catalogue(:,:,:)
66  integer, allocatable :: tile_id(:)
67  integer :: tile_num_x
68  integer :: tile_num_y
69  character(len=FILE_HLONG) :: basename
70  end type domain_info
71 
72 
73  integer, public :: comm_cartesc_nest_filiation(10)
74  integer, public :: handling_num
75 
76  integer, public :: comm_cartesc_nest_interp_level = 5
77  integer, public :: comm_cartesc_nest_interp_weight_order = 2
78 
79  logical, public :: use_nesting = .false.
80  logical, public :: online_iam_parent = .false.
81  logical, public :: online_iam_daughter = .false.
82  integer, public :: online_domain_num = 1
83  logical, public :: online_use_velz = .false.
84  logical, public :: online_no_rotate = .false.
85  logical, public :: online_boundary_use_qhyd = .false.
86 
87  logical, public :: online_recv_diagqhyd = .false.
88  logical, public :: online_send_diagqhyd = .false.
89  integer, public :: online_recv_qa = 0
90  integer, public :: online_send_qa = 0
91 
92  real(dp), public :: online_parent_dtsec
93  integer, public :: online_parent_nstep
94 
95  integer, public :: online_daughter_nprocs = -1
96 
97  !-----------------------------------------------------------------------------
98  !
99  !++ Private procedure
100  !
101  private :: comm_cartesc_nest_ping
102  private :: comm_cartesc_nest_parentsize
103  private :: comm_cartesc_nest_catalogue
104  private :: comm_cartesc_nest_setup_nestdown
105  private :: comm_cartesc_nest_importgrid_nestdown
106  private :: comm_cartesc_nest_intercomm_nestdown
107  private :: comm_cartesc_nest_issuer_of_receive
108  private :: comm_cartesc_nest_issuer_of_wait
109 
110  interface comm_cartesc_nest_intercomm_nestdown
111  module procedure comm_cartesc_nest_intercomm_nestdown_3d
112  end interface comm_cartesc_nest_intercomm_nestdown
113 
114  interface comm_cartesc_nest_issuer_of_receive
115  module procedure comm_cartesc_nest_issuer_of_receive_3d
116  end interface comm_cartesc_nest_issuer_of_receive
117 
118  interface comm_cartesc_nest_issuer_of_wait
119  module procedure comm_cartesc_nest_issuer_of_wait_3d
120  end interface comm_cartesc_nest_issuer_of_wait
121 
122  !-----------------------------------------------------------------------------
123  !
124  !++ Private parameters & variables
125  !
126  integer, private, parameter :: max_dinfo = 3
127  integer, private :: num_dom = 0
128  type(domain_info), private, target :: dom_info(max_dinfo)
129  integer, private :: i_parent = -1
130 
131  real(rp), private :: latlon_local (4,2)
132 
133  integer, private :: comm_cartesc_nest_tile_all
134  integer, private :: comm_cartesc_nest_tile_allmax_p
135  integer, private :: comm_cartesc_nest_tile_allmax_d
136  integer, private, allocatable :: comm_cartesc_nest_tile_list_p(:,:)
137  integer, private, allocatable :: comm_cartesc_nest_tile_list_d(:,:)
138  integer, private, allocatable :: comm_cartesc_nest_tile_list_yp(:)
139  integer, private :: num_yp
140 
141  integer(8), private :: online_wait_limit
142  logical, private :: online_daughter_use_velz
143  logical, private :: online_daughter_no_rotate
144  logical, private :: online_aggressive_comm
145 
146  integer, private :: tileal_ka
147  integer, private :: tileal_ia
148  integer, private :: tileal_ja
149 
150  integer, parameter :: i_lon = 1
151  integer, parameter :: i_lat = 2
152 
153  integer, parameter :: i_min = 1
154  integer, parameter :: i_max = 2
155 
156  integer, parameter :: i_sclr = 1
157  integer, parameter :: i_zstg = 2
158  integer, parameter :: i_xstg = 3
159  integer, parameter :: i_ystg = 4
160 
161  integer, parameter :: itp_ng = 4
162  integer, private :: itp_nh = 4
163 
164  integer, parameter :: tag_lon = 1
165  integer, parameter :: tag_lat = 2
166  integer, parameter :: tag_lonuy = 3
167  integer, parameter :: tag_latuy = 4
168  integer, parameter :: tag_lonxv = 5
169  integer, parameter :: tag_latxv = 6
170  integer, parameter :: tag_cz = 7
171  integer, parameter :: tag_fz = 8
172 
173  integer, parameter :: tag_dens = 1
174  integer, parameter :: tag_momz = 2
175  integer, parameter :: tag_momx = 3
176  integer, parameter :: tag_momy = 4
177  integer, parameter :: tag_rhot = 5
178  integer, parameter :: tag_qx = 6
179 
180  integer, parameter :: order_tag_comm = 100000
181  integer, parameter :: order_tag_var = 1000
182  ! intercomm tag id: IC | VAR | YP
183  ! (total: 6columns) X X X X X X
184 
185  integer, private, parameter :: interp_search_divnum = 10
186 
187  integer, private :: intercomm_id(2)
188 
189  integer, private :: max_isu ! maximum number of receive/wait issue
190  integer, private :: max_rq = 1000 ! maximum number of req: tentative approach
191  integer, private :: rq_ctl_p ! for control request id (counting)
192  integer, private :: rq_ctl_d ! for control request id (counting)
193  integer, private :: rq_tot_p ! for control request id (total number)
194  integer, private :: rq_tot_d ! for control request id (total number)
195  integer, private, allocatable :: ireq_p(:) ! buffer of request-id for parent
196  integer, private, allocatable :: ireq_d(:) ! buffer of request-id for daughter
197  integer, private, allocatable :: call_order(:) ! calling order from parent
198 
199  real(rp), private, allocatable :: recvbuf_3d(:,:,:,:) ! buffer of receiver: 3D (with HALO)
200 
201  real(rp), private, allocatable :: buffer_ref_lon (:,:) ! buffer of communicator: LON
202  real(rp), private, allocatable :: buffer_ref_lonuy(:,:) ! buffer of communicator: LONUY
203  real(rp), private, allocatable :: buffer_ref_lonxv(:,:) ! buffer of communicator: LONXV
204  real(rp), private, allocatable :: buffer_ref_lat (:,:) ! buffer of communicator: LAT
205  real(rp), private, allocatable :: buffer_ref_latuy(:,:) ! buffer of communicator: LATUY
206  real(rp), private, allocatable :: buffer_ref_latxv(:,:) ! buffer of communicator: LATXV
207  real(rp), private, allocatable :: buffer_ref_cz (:,:,:) ! buffer of communicator: CZ
208  real(rp), private, allocatable :: buffer_ref_fz (:,:,:) ! buffer of communicator: FZ
209 
210 
211  real(rp), private, allocatable :: buffer_ref_3d (:,:,:) ! buffer of communicator: 3D data (with HALO)
212 
213  real(rp), private, allocatable :: org_dens(:,:,:) ! buffer of communicator: DENS
214  real(rp), private, allocatable :: org_momz(:,:,:) ! buffer of communicator: MOMZ
215  real(rp), private, allocatable :: org_momx(:,:,:) ! buffer of communicator: MOMX
216  real(rp), private, allocatable :: org_momy(:,:,:) ! buffer of communicator: MOMY
217  real(rp), private, allocatable :: org_u_ll(:,:,:) ! buffer of communicator: U_ll
218  real(rp), private, allocatable :: org_v_ll(:,:,:) ! buffer of communicator: V_ll
219  real(rp), private, allocatable :: org_rhot(:,:,:) ! buffer of communicator: RHOT
220  real(rp), private, allocatable :: org_qtrc(:,:,:,:) ! buffer of communicator: QTRC
221 
222  integer, private, allocatable :: igrd (:,:,:,:) ! interpolation target grids in x-axis
223  integer, private, allocatable :: jgrd (:,:,:,:) ! interpolation target grids in y-axis
224  real(rp), private, allocatable :: hfact(:,:,:,:) ! interpolation factor for horizontal direction
225  integer, private, allocatable :: kgrd (:,:,:,:,:,:) ! interpolation target grids in z-axis
226  real(rp), private, allocatable :: vfact(:, :,:,:,:) ! interpolation factor for vertical direction
227 
228  integer(8), private :: nwait_p, nwait_d, nrecv, nsend
229 
230  character(len=H_SHORT) :: mp_type
231 
232  !-----------------------------------------------------------------------------
233 contains
234  !-----------------------------------------------------------------------------
236  subroutine comm_cartesc_nest_setup ( &
237  QA_MP, &
238  MP_TYPE_in )
239  use scale_file, only: &
240  file_open, &
241  file_read, &
242  file_get_attribute, &
243  file_get_shape
244  use scale_const, only: &
245  d2r => const_d2r
246  use scale_time, only: &
247  time_nstep, &
248  time_dtsec
249  use scale_prc, only: &
250  prc_abort, &
251  prc_global_domainid, &
252  prc_ismaster, &
253  prc_intercomm_parent, &
254  prc_intercomm_child
255  use scale_interp, only: &
256  interp_setup, &
257  interp_factor3d
258  use scale_comm_cartesc, only: &
259  comm_bcast
260  use scale_atmos_grid_cartesc, only: &
261  atmos_grid_cartesc_cx, &
262  atmos_grid_cartesc_fx, &
263  atmos_grid_cartesc_cy, &
264  atmos_grid_cartesc_fy
265  use scale_atmos_grid_cartesc_real, only: &
266  atmos_grid_cartesc_real_lon, &
267  atmos_grid_cartesc_real_lat, &
268  atmos_grid_cartesc_real_lonuy, &
269  atmos_grid_cartesc_real_lonxv, &
270  atmos_grid_cartesc_real_lonuv, &
271  atmos_grid_cartesc_real_latuy, &
272  atmos_grid_cartesc_real_latxv, &
273  atmos_grid_cartesc_real_latuv, &
274  atmos_grid_cartesc_real_cz, &
275  atmos_grid_cartesc_real_fz
276  use scale_atmos_hydrometeor, only: &
277  atmos_hydrometeor_dry
278  use scale_mapprojection, only: &
279  mapprojection_lonlat2xy
280  implicit none
281 
282  integer, intent(in) :: qa_mp
283  character(len=*), intent(in) :: mp_type_in
284 
285  character(len=H_SHORT) :: comm_cartesc_nest_interp_type = 'LINEAR' ! "LINEAR" or "DIST-WEIGHT"
286  ! LINEAR : bi-linear interpolation
287  ! DIST-WEIGHT: distance-weighted mean of the nearest N-neighbors
288 
289  real(rp), allocatable :: x_ref(:,:)
290  real(rp), allocatable :: y_ref(:,:)
291 
292  integer :: online_specified_maxrq = 0
293  integer :: n, i, j
294  integer :: fid, ierr
295  integer :: parent_id
296 
297  logical :: flag_parent
298  logical :: flag_child
299 
300  integer :: nprocs
301  logical :: parent_periodic_x
302  logical :: parent_periodic_y
303 
304  logical :: error
305 
306  namelist / param_comm_cartesc_nest / &
307  online_domain_num, &
308  online_iam_parent, &
309  online_iam_daughter, &
310  online_use_velz, &
311  online_no_rotate, &
312  online_boundary_use_qhyd, &
313  online_aggressive_comm, &
314  online_wait_limit, &
315  online_specified_maxrq, &
316  comm_cartesc_nest_interp_type, &
317  comm_cartesc_nest_interp_level, &
318  comm_cartesc_nest_interp_weight_order
319 
320  !---------------------------------------------------------------------------
321 
322  log_newline
323  log_info("COMM_CARTESC_NEST_setup",*) 'Setup'
324 
325  flag_child = prc_intercomm_parent /= mpi_comm_null ! exist parent, so work as a child
326  flag_parent = prc_intercomm_child /= mpi_comm_null ! exist child, so work as a parent
327 
328  nwait_p = 0
329  nwait_d = 0
330  nrecv = 0
331  nsend = 0
332 
333  handling_num = 0
334  comm_cartesc_nest_filiation(:) = 0
335  online_wait_limit = 999999999
336  online_aggressive_comm = .true.
337 
338  !--- read namelist
339  rewind(io_fid_conf)
340  read(io_fid_conf,nml=param_comm_cartesc_nest,iostat=ierr)
341  if( ierr < 0 ) then !--- missing
342  log_info("COMM_CARTESC_NEST_setup",*) 'Not found namelist. Default used.'
343  elseif( ierr > 0 ) then !--- fatal error
344  log_error("COMM_CARTESC_NEST_setup",*) 'Not appropriate names in namelist PARAM_COMM_CARTESC_NEST. Check!'
345  call prc_abort
346  endif
347  log_nml(param_comm_cartesc_nest)
348 
349  prc_global_domainid = online_domain_num
350 
351 
352  if ( online_iam_daughter .or. online_iam_parent ) then
353  use_nesting = .true.
354  endif
355 
356  call interp_setup( comm_cartesc_nest_interp_weight_order ) ! [IN]
357 
358  select case ( comm_cartesc_nest_interp_type )
359  case ( 'LINEAR' )
360  itp_nh = 4
361  case ( 'DIST-WEIGHT' )
362  itp_nh = comm_cartesc_nest_interp_level
363  case default
364  log_error("COMM_CARTESC_NEST_setup",*) 'Unsupported type of COMM_CARTESC_NEST_INTERP_TYPE : ', trim(comm_cartesc_nest_interp_type)
365  log_error_cont(*) ' It must be "LINEAR" or "DIST-WEIGHT"'
366  call prc_abort
367  end select
368 
369 
370  latlon_local(i_min,i_lon) = minval(atmos_grid_cartesc_real_lonuv(:,:)) / d2r
371  latlon_local(i_max,i_lon) = maxval(atmos_grid_cartesc_real_lonuv(:,:)) / d2r
372  latlon_local(i_min,i_lat) = minval(atmos_grid_cartesc_real_latuv(:,:)) / d2r
373  latlon_local(i_max,i_lat) = maxval(atmos_grid_cartesc_real_latuv(:,:)) / d2r
374 
375  if ( .not. use_nesting ) return
376 
377 
378  debug_domain_num = online_domain_num
379  if( online_specified_maxrq > max_rq ) max_rq = online_specified_maxrq
380 
381  allocate( ireq_p(max_rq) )
382  allocate( ireq_d(max_rq) )
383  allocate( call_order(max_rq) )
384  ireq_p(:) = mpi_request_null
385  ireq_d(:) = mpi_request_null
386 
387 
388  ! ONLINE_(RECV|SEND)_QA can be modified according to the configuration in the other side
389  ! See COMM_CARTESC_NEST_parentsize
390 
391  if( online_boundary_use_qhyd ) then
392  mp_type = mp_type_in
393  online_recv_qa = qa_mp
394  elseif ( atmos_hydrometeor_dry ) then
395  mp_type = "DRY"
396  online_recv_qa = 0
397  else
398  mp_type = "QV"
399  online_recv_qa = 1
400  endif
401 
402  if ( atmos_hydrometeor_dry ) then
403  mp_type = "DRY"
404  online_send_qa = 0
405  else if ( mp_type_in == "NONE" ) then
406  mp_type = "QV"
407  online_send_qa = 1
408  else
409  mp_type = mp_type_in
410  online_send_qa = qa_mp
411  end if
412 
413  log_info("COMM_CARTESC_NEST_setup",*) "flag_parent", flag_parent, "flag_child", flag_child
414  log_info("COMM_CARTESC_NEST_setup",*) "ONLINE_IAM_PARENT", online_iam_parent, "ONLINE_IAM_DAUGHTER", online_iam_daughter
415 
416  if( flag_parent ) then ! must do first before daughter processes
417  !-------------------------------------------------
418  if ( .NOT. online_iam_parent ) then
419  log_error("COMM_CARTESC_NEST_setup",*) '[NEST_setup] Parent Flag from launcher is not consistent with namelist!'
420  log_error_cont(*) 'PARENT - domain : ', online_domain_num
421  call prc_abort
422  endif
423 
424  handling_num = 1 !HANDLING_NUM + 1
425  intercomm_id(handling_num) = online_domain_num
426  comm_cartesc_nest_filiation(intercomm_id(handling_num)) = 1
427 
428  log_info("COMM_CARTESC_NEST_setup",'(1x,A,I2,A)') 'Online Nesting - PARENT [INTERCOMM_ID:', &
429  intercomm_id(handling_num), ' ]'
430  log_info("COMM_CARTESC_NEST_setup",*) 'Online Nesting - INTERCOMM :', prc_intercomm_child
431 
432  call comm_cartesc_nest_ping( handling_num )
433  call comm_cartesc_nest_parentsize( handling_num )
434  call comm_cartesc_nest_catalogue( handling_num )
435  call mpi_barrier(prc_intercomm_child, ierr)
436 
437  log_info("COMM_CARTESC_NEST_setup",'(1x,A)' ) 'Informations of Daughter Domain'
438  log_info_cont('(1x,A,I6)' ) '--- DAUGHTER_nprocs :', online_daughter_nprocs
439  log_info_cont('(1x,A,I6) ') 'Limit Num. NCOMM req. :', max_rq
440 
441  allocate( org_dens(ka,ia,ja) )
442  allocate( org_momz(ka,ia,ja) )
443  allocate( org_momx(ka,ia,ja) )
444  allocate( org_momy(ka,ia,ja) )
445  allocate( org_u_ll(ka,ia,ja) )
446  allocate( org_v_ll(ka,ia,ja) )
447  allocate( org_rhot(ka,ia,ja) )
448  allocate( org_qtrc(ka,ia,ja,max(online_recv_qa,1)) )
449 
450  call comm_cartesc_nest_setup_nestdown( handling_num )
451 
452  !---------------------------------- end of parent routines
453  endif
454 
455 
456  if( flag_child ) then
457  !-------------------------------------------------
458  if ( .NOT. online_iam_daughter ) then
459  log_error("COMM_CARTESC_NEST_setup",*) '[NEST_setup] Child Flag from launcher is not consistent with namelist!'
460  log_error_cont(*) 'DAUGHTER - domain : ', online_domain_num
461  call prc_abort
462  endif
463 
464  handling_num = 2 !HANDLING_NUM + 1
465  intercomm_id(handling_num) = online_domain_num - 1
466  comm_cartesc_nest_filiation(intercomm_id(handling_num)) = -1
467 
468  log_info("COMM_CARTESC_NEST_setup",'(1x,A,I2,A)') 'Online Nesting - DAUGHTER [INTERCOMM_ID:', &
469  intercomm_id(handling_num), ' ]'
470  log_info("COMM_CARTESC_NEST_setup",*) 'Online Nesting - INTERCOMM :', prc_intercomm_parent
471 
472  num_dom = num_dom + 1
473  i_parent = num_dom
474  if ( i_parent > max_dinfo ) then
475  log_error("COMM_CARTESC_NEST_setup",*) 'number of domain exeeds the limit'
476  call prc_abort
477  end if
478 
479  call comm_cartesc_nest_ping( handling_num )
480 
481  call comm_cartesc_nest_parentsize( handling_num )
482 
483  nprocs = dom_info(i_parent)%prc_num_x * dom_info(i_parent)%prc_num_y
484  allocate( dom_info(i_parent)%latlon_catalogue(nprocs,2,2) )
485  call comm_cartesc_nest_catalogue( handling_num )
486  call mpi_barrier(prc_intercomm_parent, ierr)
487 
488  call comm_cartesc_nest_domain_relate( i_parent )
489 
490  tileal_ka = dom_info(i_parent)%KMAX + dom_info(i_parent)%KHALO * 2
491  tileal_ia = dom_info(i_parent)%IMAX * dom_info(i_parent)%tile_num_x
492  tileal_ja = dom_info(i_parent)%JMAX * dom_info(i_parent)%tile_num_y
493 
494  log_info("COMM_CARTESC_NEST_setup",'(1x,A)' ) 'Informations of Parent Domain'
495  log_info_cont('(1x,A,I6)' ) '--- PARENT_PRC_nprocs :', nprocs
496  log_info_cont('(1x,A,I6)' ) '--- PARENT_PRC_NUM_X :', dom_info(i_parent)%prc_num_x
497  log_info_cont('(1x,A,I6)' ) '--- PARENT_PRC_NUM_Y :', dom_info(i_parent)%prc_num_y
498  log_info_cont('(1x,A,I6)' ) '--- PARENT_KMAX :', dom_info(i_parent)%KMAX
499  log_info_cont('(1x,A,I6)' ) '--- PARENT_IMAX :', dom_info(i_parent)%IMAX
500  log_info_cont('(1x,A,I6)' ) '--- PARENT_JMAX :', dom_info(i_parent)%JMAX
501  log_info_cont('(1x,A,F9.3)') '--- PARENT_DTSEC :', online_parent_dtsec
502  log_info_cont('(1x,A,I6)' ) '--- PARENT_NSTEP :', online_parent_nstep
503  log_info_cont('(1x,A)' ) 'Informations of Daughter Domain [me]'
504  log_info_cont('(1x,A,F9.3)') '--- DAUGHTER_DTSEC :', time_dtsec
505  log_info_cont('(1x,A,I6)' ) '--- DAUGHTER_NSTEP :', time_nstep
506  log_info_cont('(1x,A)' ) 'Informations of Target Tiles'
507  log_info_cont('(1x,A,I6)' ) '--- TILEALL_KA :', tileal_ka
508  log_info_cont('(1x,A,I6)' ) '--- TILEALL_IA :', tileal_ia
509  log_info_cont('(1x,A,I6)' ) '--- TILEALL_JA :', tileal_ja
510  log_info_cont('(1x,A,I6) ') 'Limit Num. NCOMM req. :', max_rq
511 
512  allocate( buffer_ref_lon(tileal_ia,tileal_ja) )
513  allocate( buffer_ref_lonuy(tileal_ia,tileal_ja) )
514  allocate( buffer_ref_lonxv(tileal_ia,tileal_ja) )
515  allocate( buffer_ref_lat(tileal_ia,tileal_ja) )
516  allocate( buffer_ref_latuy(tileal_ia,tileal_ja) )
517  allocate( buffer_ref_latxv(tileal_ia,tileal_ja) )
518 
519  allocate( buffer_ref_cz(tileal_ka,tileal_ia,tileal_ja) )
520  allocate( buffer_ref_fz(tileal_ka,tileal_ia,tileal_ja) )
521 
522  allocate( buffer_ref_3d(tileal_ka,tileal_ia,tileal_ja) )
523 
524  allocate( igrd(ia,ja,itp_nh,itp_ng) )
525  allocate( jgrd(ia,ja,itp_nh,itp_ng) )
526  allocate( hfact(ia,ja,itp_nh,itp_ng) )
527  allocate( kgrd(ka,2,ia,ja,itp_nh,itp_ng) )
528  allocate( vfact(ka, ia,ja,itp_nh,itp_ng) )
529 
530  call comm_cartesc_nest_setup_nestdown( handling_num )
531 
532 
533  select case ( comm_cartesc_nest_interp_type )
534  case ( 'LINEAR' )
535 
536  allocate( x_ref(tileal_ia,tileal_ja) )
537  allocate( y_ref(tileal_ia,tileal_ja) )
538 
539  ! for scalar points
540  call mapprojection_lonlat2xy( tileal_ia, 1, tileal_ia, &
541  tileal_ja, 1, tileal_ja, &
542  buffer_ref_lon(:,:), & ! [IN]
543  buffer_ref_lat(:,:), & ! [IN]
544  x_ref(:,:), y_ref(:,:) ) ! [OUT]
545  call interp_factor3d( tileal_ka, khalo+1, tileal_ka-khalo, &
546  tileal_ia, tileal_ja, &
547  ka, ks, ke, ia, ja, &
548  x_ref(:,:), y_ref(:,:), & ! [IN]
549  buffer_ref_cz(:,:,:), & ! [IN]
550  atmos_grid_cartesc_cx(:), & ! [IN]
551  atmos_grid_cartesc_cy(:), & ! [IN]
552  atmos_grid_cartesc_real_cz(:,:,:), & ! [IN]
553  igrd( :,:,:,i_sclr), & ! [OUT]
554  jgrd( :,:,:,i_sclr), & ! [OUT]
555  hfact( :,:,:,i_sclr), & ! [OUT]
556  kgrd(:,:,:,:,:,i_sclr), & ! [OUT]
557  vfact(:, :,:,:,i_sclr) ) ! [OUT]
558 
559  ! for z staggered points
560  call interp_factor3d( tileal_ka+1, khalo+1, tileal_ka+1-khalo, &
561  tileal_ia, tileal_ja, &
562  ka, ks, ke, ia, ja, &
563  x_ref(:,:), y_ref(:,:), & ! [IN]
564  buffer_ref_fz(:,:,:), & ! [IN]
565  atmos_grid_cartesc_cx(:), & ! [IN]
566  atmos_grid_cartesc_cy(:), & ! [IN]
567  atmos_grid_cartesc_real_fz(1:ka,:,:), & ! [IN]
568  igrd( :,:,:,i_zstg), & ! [OUT]
569  jgrd( :,:,:,i_zstg), & ! [OUT]
570  hfact( :,:,:,i_zstg), & ! [OUT]
571  kgrd(:,:,:,:,:,i_zstg), & ! [OUT]
572  vfact(:, :,:,:,i_zstg) ) ! [OUT]
573 
574  ! for x staggered points
575  call mapprojection_lonlat2xy( tileal_ia, 1, tileal_ia, &
576  tileal_ja, 1, tileal_ja, &
577  buffer_ref_lonuy(:,:), & ! [IN]
578  buffer_ref_latuy(:,:), & ! [IN]
579  x_ref(:,:), y_ref(:,:) ) ! [OUT]
580  call interp_factor3d( tileal_ka, khalo+1, tileal_ka-khalo, &
581  tileal_ia, tileal_ja, &
582  ka, ks, ke, ia, ja, &
583  x_ref(:,:), y_ref(:,:), & ! [IN]
584  buffer_ref_cz(:,:,:), & ! [IN]
585  atmos_grid_cartesc_fx(1:ia), & ! [IN]
586  atmos_grid_cartesc_cy(:), & ! [IN]
587  atmos_grid_cartesc_real_cz(:,:,:), & ! [IN]
588  igrd( :,:,:,i_xstg), & ! [OUT]
589  jgrd( :,:,:,i_xstg), & ! [OUT]
590  hfact( :,:,:,i_xstg), & ! [OUT]
591  kgrd(:,:,:,:,:,i_xstg), & ! [OUT]
592  vfact(:, :,:,:,i_xstg) ) ! [OUT]
593 
594  ! for y staggered points
595  call mapprojection_lonlat2xy( tileal_ia, 1, tileal_ia, &
596  tileal_ja, 1, tileal_ja, &
597  buffer_ref_lonxv(:,:), & ! [IN]
598  buffer_ref_latxv(:,:), & ! [IN]
599  x_ref(:,:), y_ref(:,:) ) ! [OUT]
600  call interp_factor3d( tileal_ka, khalo+1, tileal_ka-khalo, &
601  tileal_ia, tileal_ja, &
602  ka, ks, ke, ia, ja, &
603  x_ref(:,:), y_ref(:,:), & ! [IN]
604  buffer_ref_cz(:,:,:), & ! [IN]
605  atmos_grid_cartesc_cx(:), & ! [IN]
606  atmos_grid_cartesc_fy(1:ja), & ! [IN]
607  atmos_grid_cartesc_real_cz(:,:,:), & ! [IN]
608  igrd( :,:,:,i_ystg), & ! [OUT]
609  jgrd( :,:,:,i_ystg), & ! [OUT]
610  hfact( :,:,:,i_ystg), & ! [OUT]
611  kgrd(:,:,:,:,:,i_ystg), & ! [OUT]
612  vfact(:, :,:,:,i_ystg) ) ! [OUT]
613 
614  deallocate( x_ref, y_ref )
615 
616  case ( 'DIST-WEIGHT' )
617 
618  ! for scalar points
619  call interp_factor3d( itp_nh, &
620  tileal_ka, khalo+1, tileal_ka-khalo, &
621  tileal_ia, tileal_ja, &
622  ka, ks, ke, ia, js, &
623  buffer_ref_lon(:,:), & ! [IN]
624  buffer_ref_lat(:,:), & ! [IN]
625  buffer_ref_cz(:,:,:), & ! [IN]
626  atmos_grid_cartesc_real_lon(:,:), & ! [IN]
627  atmos_grid_cartesc_real_lat(:,:), & ! [IN]
628  atmos_grid_cartesc_real_cz(:,:,:), & ! [IN]
629  igrd( :,:,:,i_sclr), & ! [OUT]
630  jgrd( :,:,:,i_sclr), & ! [OUT]
631  hfact( :,:,:,i_sclr), & ! [OUT]
632  kgrd(:,:,:,:,:,i_sclr), & ! [OUT]
633  vfact(:, :,:,:,i_sclr) ) ! [OUT]
634 
635  ! for z staggered points
636  call interp_factor3d( itp_nh, &
637  tileal_ka, khalo, tileal_ka-khalo, &
638  tileal_ia, tileal_ja, &
639  ka, ks, ke, ia, ja, &
640  buffer_ref_lon(:,:), & ! [IN]
641  buffer_ref_lat(:,:), & ! [IN]
642  buffer_ref_fz(:,:,:), & ! [IN]
643  atmos_grid_cartesc_real_lon(:,:), & ! [IN]
644  atmos_grid_cartesc_real_lat(:,:), & ! [IN]
645  atmos_grid_cartesc_real_fz(1:ka,:,:), & ! [IN]
646  igrd( :,:,:,i_zstg), & ! [OUT]
647  jgrd( :,:,:,i_zstg), & ! [OUT]
648  hfact( :,:,:,i_zstg), & ! [OUT]
649  kgrd(:,:,:,:,:,i_zstg), & ! [OUT]
650  vfact(:, :,:,:,i_zstg) ) ! [OUT]
651 
652  ! for x staggered points
653  call interp_factor3d( itp_nh, &
654  tileal_ka, khalo+1, tileal_ka-khalo, &
655  tileal_ia, tileal_ja, &
656  ka, ks, ke, ia, ja, &
657  buffer_ref_lonuy(:,:), & ! [IN]
658  buffer_ref_latuy(:,:), & ! [IN]
659  buffer_ref_cz(:,:,:), & ! [IN]
660  atmos_grid_cartesc_real_lonuy(1:ia,1:ja), & ! [IN]
661  atmos_grid_cartesc_real_latuy(1:ia,1:ja), & ! [IN]
662  atmos_grid_cartesc_real_cz(:,:,:), & ! [IN]
663  igrd( :,:,:,i_xstg), & ! [OUT]
664  jgrd( :,:,:,i_xstg), & ! [OUT]
665  hfact( :,:,:,i_xstg), & ! [OUT]
666  kgrd(:,:,:,:,:,i_xstg), & ! [OUT]
667  vfact(:, :,:,:,i_xstg) ) ! [OUT]
668 
669  ! for y staggered points
670  call interp_factor3d( itp_nh, &
671  tileal_ka, khalo+1, tileal_ka-khalo, &
672  tileal_ia, tileal_ja, &
673  ka, ks, ke, ia, ja, &
674  buffer_ref_lonxv(:,:), & ! [IN]
675  buffer_ref_latxv(:,:), & ! [IN]
676  buffer_ref_cz(:,:,:), & ! [IN]
677  atmos_grid_cartesc_real_lonxv(1:ia,1:ja), & ! [IN]
678  atmos_grid_cartesc_real_latxv(1:ia,1:ja), & ! [IN]
679  atmos_grid_cartesc_real_cz(:,:,:), & ! [IN]
680  igrd( :,:,:,i_ystg), & ! [OUT]
681  jgrd( :,:,:,i_ystg), & ! [OUT]
682  hfact( :,:,:,i_ystg), & ! [OUT]
683  kgrd(:,:,:,:,:,i_ystg), & ! [OUT]
684  vfact(:, :,:,:,i_ystg) ) ! [OUT]
685 
686  end select
687 
688  !---------------------------------- end of child routines
689  end if
690 
691  !LOG_INFO("COMM_CARTESC_NEST_setup",'(1x,A,I2)') 'Number of Related Domains :', HANDLING_NUM
692  !if ( HANDLING_NUM > 2 ) then
693  ! f( IO_L ) LOG_ERROR("COMM_CARTESC_NEST_setup",*) 'Too much handing domains (up to 2)'
694  ! call PRC_abort
695  !endif
696 
697  return
698  end subroutine comm_cartesc_nest_setup
699 
700  !-----------------------------------------------------------------------------
702  subroutine comm_cartesc_nest_domain_regist_file( &
703  dom_id, &
704  PARENT_BASENAME, &
705  PARENT_PRC_NUM_X, &
706  PARENT_PRC_NUM_Y, &
707  LATLON_CATALOGUE_FNAME )
708  use scale_prc, only: &
709  prc_ismaster, &
710  prc_abort
711  use scale_file, only: &
712  file_open, &
713  file_get_attribute, &
714  file_get_shape, &
715  file_read
716  use scale_comm_cartesc, only: &
717  comm_bcast
718  integer, intent(out) :: dom_id
719 
720  character(len=*), intent(in) :: parent_basename
721  integer, intent(in), optional :: parent_prc_num_x
722  integer, intent(in), optional :: parent_prc_num_y
723  character(len=*), intent(in), optional :: latlon_catalogue_fname
724 
725  type(domain_info), pointer :: dinfo
726 
727  integer :: nprocs
728  integer :: pnum_x(1), pnum_y(1)
729  integer :: imaxg(1), jmaxg(1)
730  integer :: dims(1), dims2(1)
731  integer :: halos(2)
732  integer :: parent_x, parent_xh
733  integer :: parent_y, parent_yh
734 
735  real(rp), allocatable :: work(:,:), work_uv(:,:), minmax(:,:,:)
736 
737  character(len=H_LONG) :: fname
738  integer :: fid
739  integer :: parent_id
740  logical :: existed, error
741  integer :: ierr
742 
743  integer :: i, j, n
744 
745  do n = 1, num_dom
746  if ( dom_info(n)%basename == parent_basename ) then
747  dom_id = n
748  return
749  end if
750  end do
751 
752  num_dom = num_dom + 1
753  dom_id = num_dom
754  if ( dom_id > max_dinfo ) then
755  log_error("COMM_CARTESC_NEST_domain_regist_file",*) 'number of domains exceed the limit'
756  call prc_abort
757  end if
758  dinfo => dom_info(dom_id)
759  dinfo%basename = parent_basename
760 
761  if ( prc_ismaster ) then
762  call file_open( parent_basename, & ! (in)
763  fid, & ! (out)
764  aggregate = .false., & ! (in)
765  allnodes = .false. ) ! (in)
766 
767  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_imaxg", &
768  imaxg(:), existed=existed )
769  if ( existed ) then
770  call file_get_attribute( fid, "global", "scale_cartesC_prc_num_x", &
771  pnum_x(:) )
772  dinfo%prc_num_x = pnum_x(1)
773  dinfo%IMAX = imaxg(1) / pnum_x(1)
774 
775  call file_get_attribute( fid, "x", "halo_global", & ! (in)
776  halos(:) ) ! (out)
777  dinfo%IHALO = halos(1)
778  call file_get_attribute( fid, "global", "scale_cartesC_prc_periodic_x", &
779  dinfo%periodic_x )
780 
781  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_jmaxg", &
782  jmaxg(:) )
783  call file_get_attribute( fid, "global", "scale_cartesC_prc_num_y", &
784  pnum_y(:) )
785  dinfo%prc_num_y = pnum_y(1)
786  dinfo%JMAX = jmaxg(1) / pnum_y(1)
787  call file_get_attribute( fid, "y", "halo_global", & ! (in)
788  halos(:) ) ! (out)
789  dinfo%JHALO = halos(1)
790  call file_get_attribute( fid, "global", "scale_cartesC_prc_periodic_y", &
791  dinfo%periodic_y )
792 
793  else
794  ! for old file (for backward compatibility)
795 
796  if ( present(parent_prc_num_x) .and. present(parent_prc_num_y) ) then
797  dinfo%prc_num_x = parent_prc_num_x
798  dinfo%prc_num_y = parent_prc_num_y
799  else
800  log_error("COMM_CARTESC_NEST_domain_regist_file",*) 'PARENT_PRC_NUM_(X|Y) is needed for files generated by the older version'
801  call prc_abort
802  end if
803 
804  call file_get_shape( fid, "CX", dims(:) )
805  call file_get_shape( fid, "x", dims2(:) )
806  dinfo%IHALO = dims2(1) + ihalo * 2 - dims(1) ! assume IHALO is the same
807  dinfo%IMAX = dims(1) - dinfo%IHALO*2
808 
809  call file_get_shape( fid, "CY", dims(:) )
810  call file_get_shape( fid, "y", dims2(:) )
811  dinfo%JHALO = dims2(1) + jhalo * 2 - dims(1) ! assume JHALO is the same
812  dinfo%JMAX = dims(1) - dinfo%JHALO*2
813 
814  dinfo%periodic_x = .false.
815  dinfo%periodic_y = .false.
816 
817  endif
818 
819  call file_get_attribute( fid, "global", "scale_atmos_grid_cartesC_index_kmax", &
820  dims(:), existed=existed )
821  if ( existed ) then
822  dinfo%KMAX = dims(1)
823  else
824  call file_get_shape( fid, "z", dims(:), error=error )
825  if ( error ) then
826  dinfo%KMAX = 0
827  else
828  dinfo%KMAX = dims(1)
829  endif
830  end if
831  dinfo%KHALO = 0
832 
833  call file_get_attribute( fid, "global", "scale_ocean_grid_cartesC_index_kmax", &
834  dims(:), existed=existed )
835  if ( existed ) then
836  dinfo%OKMAX = dims(1)
837  else
838  call file_get_shape( fid, "oz", dims(:), error=error )
839  if ( error ) then
840  dinfo%OKMAX = 0
841  else
842  dinfo%OKMAX = dims(1)
843  endif
844  end if
845 
846  call file_get_attribute( fid, "global", "scale_land_grid_cartesC_index_kmax", &
847  dims(:), existed=existed )
848  if ( existed ) then
849  dinfo%LKMAX = dims(1)
850  else
851  call file_get_shape( fid, "lz", dims(:), error=error )
852  if ( error ) then
853  dinfo%LKMAX = 0
854  else
855  dinfo%LKMAX = dims(1)
856  endif
857  end if
858 
859  call file_get_attribute( fid, "global", "scale_urban_grid_cartesC_index_kmax", &
860  dims(:), existed=existed )
861  if ( existed ) then
862  dinfo%UKMAX = dims(1)
863  else
864  call file_get_shape( fid, "uz", dims(:), error=error )
865  if ( error ) then
866  dinfo%UKMAX = 0
867  else
868  dinfo%UKMAX = dims(1)
869  endif
870  end if
871 
872  end if ! master node
873 
874 
875  call comm_bcast( dinfo%prc_num_x )
876  call comm_bcast( dinfo%prc_num_y )
877  call comm_bcast( dinfo%KMAX )
878  call comm_bcast( dinfo%OKMAX )
879  call comm_bcast( dinfo%LKMAX )
880  call comm_bcast( dinfo%UKMAX )
881  call comm_bcast( dinfo%IMAX )
882  call comm_bcast( dinfo%JMAX )
883  call comm_bcast( dinfo%IHALO )
884  call comm_bcast( dinfo%JHALO )
885  call comm_bcast( dinfo%periodic_x )
886  call comm_bcast( dinfo%periodic_y )
887 
888  !--- latlon catalogue
889  nprocs = dinfo%prc_num_x * dinfo%prc_num_y
890  allocate( dinfo%latlon_catalogue(nprocs,2,2) )
891 
892  if ( prc_ismaster ) then
893 
894  existed = present(latlon_catalogue_fname)
895  if ( existed ) then
896  existed = latlon_catalogue_fname /= ""
897  end if
898  if ( existed ) then
899  ! read from catalogue file
900 
901  fid = io_get_available_fid()
902  call io_get_fname(fname, latlon_catalogue_fname)
903  open( fid, &
904  file = fname, &
905  form = 'formatted', &
906  status = 'old', &
907  iostat = ierr )
908 
909  if ( ierr /= 0 ) then
910  log_error("COMM_CARTESC_NEST_domain_regist_file",*) 'cannot open latlon-catalogue file!: ', trim(fname)
911  call prc_abort
912  endif
913 
914  do i = 1, nprocs
915  read(fid,'(i8,4f32.24)',iostat=ierr) parent_id, &
916  dinfo%latlon_catalogue(i,i_min,i_lon), dinfo%latlon_catalogue(i,i_max,i_lon), & ! LON: MIN, MAX
917  dinfo%latlon_catalogue(i,i_min,i_lat), dinfo%latlon_catalogue(i,i_max,i_lat) ! LAT: MIN, MAX
918  if ( ierr /= 0 .or. i /= parent_id ) then
919  log_error("COMM_CARTESC_NEST_domain_regist_file",*) 'catalogue file is invalid, ', trim(fname)
920  call prc_abort
921  end if
922  if ( ierr /= 0 ) exit
923  enddo
924  close(fid)
925 
926  else
927  ! read from netcdf file
928 
929  allocate( minmax(nprocs,2,2) )
930 
931  n = 1
932  do j = 1, dinfo%prc_num_y
933  do i = 1, dinfo%prc_num_x
934  call file_open( parent_basename, & ! (in)
935  fid, & ! (out)
936  aggregate = .false., & ! (in)
937  allnodes = .false., & ! (in)
938  rankid = n-1 ) ! (in)
939 
940  call file_get_shape( fid, "xh", dims(:) )
941  parent_xh = dims(1)
942  call file_get_shape( fid, "yh", dims(:) )
943  parent_yh = dims(1)
944  allocate( work_uv( parent_xh, parent_yh ) )
945 
946  if ( dinfo%periodic_x .or. dinfo%periodic_y ) then
947  call file_get_shape( fid, "x", dims(:) )
948  parent_x = dims(1)
949  call file_get_shape( fid, "y", dims(:) )
950  parent_y = dims(1)
951  end if
952 
953  call file_read( fid, "lon_uv", work_uv(:,:) )
954  dinfo%latlon_catalogue(n,i_min,i_lon) = minval( work_uv(:,:) )
955  dinfo%latlon_catalogue(n,i_max,i_lon) = maxval( work_uv(:,:) )
956 
957  if ( i > 1 ) then
958  dinfo%latlon_catalogue(n,i_min,i_lon) = min( dinfo%latlon_catalogue(n,i_min,i_lon), minmax(n-1,i_min,i_lon) )
959  dinfo%latlon_catalogue(n,i_max,i_lon) = max( dinfo%latlon_catalogue(n,i_max,i_lon), minmax(n-1,i_max,i_lon) )
960  else
961  if ( dinfo%periodic_x ) then
962  allocate( work( parent_x, parent_yh ) )
963  call file_read( fid, "lon_xv", work(:,:) )
964  ! This assumes an equally spaced grid
965  work(1,:) = work(1,:) * 2.0_rp - work_uv(1,:)
966  dinfo%latlon_catalogue(n,i_min,i_lon) = min( dinfo%latlon_catalogue(n,i_min,i_lon), minval( work ) )
967  dinfo%latlon_catalogue(n,i_max,i_lon) = max( dinfo%latlon_catalogue(n,i_max,i_lon), maxval( work ) )
968  deallocate( work )
969  end if
970  end if
971  minmax(n,i_min,i_lon) = minval( work_uv(parent_xh,:) )
972  minmax(n,i_max,i_lon) = maxval( work_uv(parent_xh,:) )
973 
974  call file_read( fid, "lat_uv", work_uv(:,:) )
975  dinfo%latlon_catalogue(n,i_min,i_lat) = minval( work_uv(:,:) )
976  dinfo%latlon_catalogue(n,i_max,i_lat) = maxval( work_uv(:,:) )
977 
978  if ( j > 1 ) then
979  dinfo%latlon_catalogue(n,i_min,i_lat) = min( dinfo%latlon_catalogue(n,i_min,i_lat), minmax(n-dinfo%prc_num_x,i_min,i_lat) )
980  dinfo%latlon_catalogue(n,i_max,i_lat) = max( dinfo%latlon_catalogue(n,i_max,i_lat), minmax(n-dinfo%prc_num_x,i_max,i_lat) )
981  else
982  if ( dinfo%periodic_y ) then
983  allocate( work( parent_xh, parent_y ) )
984  call file_read( fid, "lat_uy", work(:,:) )
985  ! This assumes an equally spaced grid
986  work(:,1) = work(:,1) * 2.0_rp - work_uv(:,1)
987  dinfo%latlon_catalogue(n,i_min,i_lat) = min( dinfo%latlon_catalogue(n,i_min,i_lat), minval( work(:,1) ) )
988  dinfo%latlon_catalogue(n,i_max,i_lat) = max( dinfo%latlon_catalogue(n,i_max,i_lat), maxval( work(:,1) ) )
989  deallocate( work )
990  end if
991  end if
992  minmax(n,i_min,i_lat) = minval( work_uv(:,parent_yh) )
993  minmax(n,i_max,i_lat) = maxval( work_uv(:,parent_yh) )
994 
995  deallocate( work_uv )
996 
997  n = n + 1
998  enddo
999  enddo
1000 
1001  deallocate( minmax )
1002 
1003  endif
1004 
1005  end if ! master node
1006 
1007  call comm_bcast( nprocs, 2, 2, dinfo%latlon_catalogue(:,:,:) )
1008 
1009  call comm_cartesc_nest_domain_relate(dom_id)
1010 
1011 
1012  end subroutine comm_cartesc_nest_domain_regist_file
1013 
1014  !-----------------------------------------------------------------------------
1016  subroutine comm_cartesc_nest_domain_relate( &
1017  dom_id )
1018  use scale_prc, only: &
1019  prc_myrank, &
1020  prc_abort
1021  implicit none
1022 
1023  integer, intent(in) :: dom_id
1024 
1025  type(domain_info), pointer :: dinfo
1026 
1027  integer :: nprocs
1028  integer :: x_min, x_max
1029  integer :: y_min, y_max
1030  logical :: hit(2,2)
1031  real(RP) :: dx, dy
1032  integer :: p, i, j
1033  !---------------------------------------------------------------------------
1034 
1035  if ( dom_id < 1 .or. dom_id > num_dom ) then
1036  log_error("COMM_CARTESC_NEST_domain_relate",*) "domain id is invalid: ", dom_id
1037  call prc_abort
1038  end if
1039 
1040  dinfo => dom_info(dom_id)
1041  nprocs = dinfo%prc_num_x * dinfo%prc_num_y
1042 
1043  x_min = dinfo%prc_num_x
1044  x_max = -1
1045  y_min = dinfo%prc_num_y
1046  y_max = -1
1047  hit(:,:) = .false.
1048 
1049  do p = 1, nprocs
1050  dx = ( dinfo%latlon_catalogue(p,i_max,i_lon) - dinfo%latlon_catalogue(p,i_min,i_lon) ) / dinfo%IMAX
1051  dy = ( dinfo%latlon_catalogue(p,i_max,i_lat) - dinfo%latlon_catalogue(p,i_min,i_lat) ) / dinfo%JMAX
1052  if ( ( ( latlon_local(i_min,i_lon) >= dinfo%latlon_catalogue(p,i_min,i_lon) - dx &
1053  .AND. latlon_local(i_min,i_lon) <= dinfo%latlon_catalogue(p,i_max,i_lon) + dx ) .OR. &
1054  ( latlon_local(i_max,i_lon) >= dinfo%latlon_catalogue(p,i_min,i_lon) - dx &
1055  .AND. latlon_local(i_max,i_lon) <= dinfo%latlon_catalogue(p,i_max,i_lon) + dx ) .OR. &
1056  ( dinfo%latlon_catalogue(p,i_min,i_lon) >= latlon_local(i_min,i_lon) - dx &
1057  .AND. dinfo%latlon_catalogue(p,i_min,i_lon) <= latlon_local(i_max,i_lon) + dx ) .OR. &
1058  ( dinfo%latlon_catalogue(p,i_max,i_lon) >= latlon_local(i_min,i_lon) - dx &
1059  .AND. dinfo%latlon_catalogue(p,i_max,i_lon) <= latlon_local(i_max,i_lon) + dx ) ) .AND. &
1060  ( ( latlon_local(i_min,i_lat) >= dinfo%latlon_catalogue(p,i_min,i_lat) - dy &
1061  .AND. latlon_local(i_min,i_lat) <= dinfo%latlon_catalogue(p,i_max,i_lat) + dy ) .OR. &
1062  ( latlon_local(i_max,i_lat) >= dinfo%latlon_catalogue(p,i_min,i_lat) - dy &
1063  .AND. latlon_local(i_max,i_lat) <= dinfo%latlon_catalogue(p,i_max,i_lat) + dy ) .OR. &
1064  ( dinfo%latlon_catalogue(p,i_min,i_lat) >= latlon_local(i_min,i_lat) - dy &
1065  .AND. dinfo%latlon_catalogue(p,i_min,i_lat) <= latlon_local(i_max,i_lat) + dy ) .OR. &
1066  ( dinfo%latlon_catalogue(p,i_max,i_lat) >= latlon_local(i_min,i_lat) - dy &
1067  .AND. dinfo%latlon_catalogue(p,i_max,i_lat) <= latlon_local(i_max,i_lat) + dy ) ) ) then
1068  if ( dinfo%latlon_catalogue(p,i_min,i_lon) <= latlon_local(i_min,i_lon) ) hit(i_min,i_lon) = .true.
1069  if ( dinfo%latlon_catalogue(p,i_max,i_lon) >= latlon_local(i_max,i_lon) ) hit(i_max,i_lon) = .true.
1070  if ( dinfo%latlon_catalogue(p,i_min,i_lat) <= latlon_local(i_min,i_lat) ) hit(i_min,i_lat) = .true.
1071  if ( dinfo%latlon_catalogue(p,i_max,i_lat) >= latlon_local(i_max,i_lat) ) hit(i_max,i_lat) = .true.
1072  i = mod(p-1, dinfo%prc_num_x)
1073  j = (p-1) / dinfo%prc_num_x
1074  if ( i < x_min ) x_min = i
1075  if ( i > x_max ) x_max = i
1076  if ( j < y_min ) y_min = j
1077  if ( j > y_max ) y_max = j
1078  end if
1079  end do
1080 
1081  if ( .not. ( hit(i_min,i_lon) .and. hit(i_max,i_lon) .and. hit(i_min,i_lat) .and. hit(i_max,i_lat) ) ) then
1082  log_error("COMM_CARTESC_NEST_domain_relate",*) 'region of daughter domain is larger than that of parent'
1083  log_error_cont(*) ' at rank:', prc_myrank, ' of domain:', online_domain_num
1084  log_error_cont(*) 'LON MIN: ',hit(i_min,i_lon), ', LON MAX: ',hit(i_max,i_lon), ', LAT MIN: ',hit(i_min,i_lat), ', LAT MAX: ',hit(i_max,i_lat)
1085  log_error_cont('(A,F12.6,1x,F12.6)') 'daughter local (me) MIN-MAX: LON=', &
1086  latlon_local(i_min,i_lon), latlon_local(i_max,i_lon)
1087  do p = 1, nprocs
1088  log_error_cont('(A,I5,A,F12.6,1x,F12.6)') ' parent (', p,') MIN-MAX: LON=', &
1089  dinfo%latlon_catalogue(p,i_min,i_lon) ,dinfo%latlon_catalogue(p,i_max,i_lon)
1090  enddo
1091  log_error_cont('(A,F12.6,1x,F12.6)') 'daughter local (me): MIN-MAX LAT=', &
1092  latlon_local(i_min,i_lat), latlon_local(i_max,i_lat)
1093  do p = 1, nprocs
1094  log_error_cont('(A,I5,A,F12.6,1x,F12.6)') ' parent (', p,') MIN-MAX: LAT=', &
1095  dinfo%latlon_catalogue(p,i_min,i_lat) ,dinfo%latlon_catalogue(p,i_max,i_lat)
1096  enddo
1097  call prc_abort
1098  end if
1099 
1100 
1101 
1102  dinfo%tile_num_x = x_max - x_min + 1
1103  dinfo%tile_num_y = y_max - y_min + 1
1104 
1105  allocate( dinfo%tile_id(dinfo%tile_num_x * dinfo%tile_num_y) )
1106 
1107  log_info("COMM_CARTESC_NEST_domain_relate",'(1x,A)') 'NEST: target process tile in parent domain'
1108  p = 1
1109  do j = 1, dinfo%tile_num_y
1110  do i = 1, dinfo%tile_num_x
1111  dinfo%tile_id(p) = x_min + i - 1 + (y_min + j - 1) * dinfo%prc_num_x
1112  log_info_cont('(1x,A,I4,A,I6)') '(', p, ') target mpi-process:', dinfo%tile_id(p)
1113  p = p + 1
1114  enddo
1115  enddo
1116 
1117  return
1118  end subroutine comm_cartesc_nest_domain_relate
1119 
1120  !-----------------------------------------------------------------------------
1122  subroutine comm_cartesc_nest_parent_info( &
1123  dom_id, &
1124  KMAX, &
1125  LKMAX, &
1126  IMAXG, &
1127  JMAXG, &
1128  num_tile, &
1129  tile_id)
1130  use scale_prc, only: &
1131  prc_abort
1132  integer, intent(in) :: dom_id
1133 
1134  integer, intent(out), optional :: kmax
1135  integer, intent(out), optional :: lkmax
1136  integer, intent(out), optional :: imaxg
1137  integer, intent(out), optional :: jmaxg
1138  integer, intent(out), optional :: num_tile
1139  integer, intent(out), optional :: tile_id(:)
1140 
1141  integer :: i
1142 
1143  !---------------------------------------------------------------------------
1144 
1145  if ( dom_id < 1 .or. dom_id > num_dom ) then
1146  log_error("COMM_CARTESC_NEST_domina_shape",*) 'domain id is invalid: ', dom_id
1147  call prc_abort
1148  end if
1149 
1150  if ( present(kmax) ) &
1151  kmax = dom_info(dom_id)%KMAX
1152 
1153  if ( present(lkmax) ) &
1154  lkmax = dom_info(dom_id)%LKMAX
1155 
1156  if ( present(imaxg) ) &
1157  imaxg = dom_info(dom_id)%IMAX * dom_info(dom_id)%tile_num_x
1158 
1159  if ( present(jmaxg) ) &
1160  jmaxg = dom_info(dom_id)%JMAX * dom_info(dom_id)%tile_num_y
1161 
1162  if ( present(num_tile) ) &
1163  num_tile = dom_info(dom_id)%tile_num_x * dom_info(dom_id)%tile_num_y
1164 
1165  if ( present(tile_id) ) then
1166  do i = 1, min( size(tile_id), size(dom_info(dom_id)%tile_id) )
1167  tile_id(i) = dom_info(dom_id)%tile_id(i)
1168  end do
1169  end if
1170 
1171  return
1172  end subroutine comm_cartesc_nest_parent_info
1173 
1174  !-----------------------------------------------------------------------------
1176  ! including definition array size with BND or not in Parent domain
1177  subroutine comm_cartesc_nest_domain_shape ( &
1178  tilei, &
1179  tilej, &
1180  cxs, cxe, &
1181  cys, cye, &
1182  pxs, pxe, &
1183  pys, pye, &
1184  dom_id, &
1185  iloc, &
1186  xstg, ystg )
1187  use scale_prc, only: &
1188  prc_abort
1189  implicit none
1190 
1191  integer, intent(out) :: tilei, tilej
1192  integer, intent(out) :: cxs, cxe, cys, cye
1193  integer, intent(out) :: pxs, pxe, pys, pye
1194 
1195  integer, intent(in) :: dom_id
1196  integer, intent(in) :: iloc ! rank number; start from 1
1197 
1198  logical, intent(in), optional :: xstg
1199  logical, intent(in), optional :: ystg
1200 
1201  type(domain_info), pointer :: dinfo
1202 
1203  integer :: hdl = 1 ! handler number
1204  integer :: rank
1205  integer :: xloc, yloc
1206  integer :: xlocg, ylocg ! location over whole domain
1207  logical :: xstg_, ystg_
1208  !---------------------------------------------------------------------------
1209 
1210  if ( dom_id < 1 .or. dom_id > num_dom ) then
1211  log_error("COMM_CARTESC_NEST_domina_shape",*) 'domain id is invalid: ', dom_id
1212  call prc_abort
1213  end if
1214 
1215  if ( present(xstg) ) then
1216  xstg_ = xstg
1217  else
1218  xstg_ = .false.
1219  end if
1220  if ( present(ystg) ) then
1221  ystg_ = ystg
1222  else
1223  ystg_ = .false.
1224  end if
1225 
1226  dinfo => dom_info(dom_id)
1227 
1228  rank = dinfo%tile_id(iloc)
1229  xloc = mod( iloc-1, dinfo%tile_num_x ) + 1
1230  yloc = int( real(iloc-1) / real(dinfo%tile_num_x) ) + 1
1231  xlocg = mod( rank, dinfo%prc_num_x ) + 1
1232  ylocg = int( real(rank) / real(dinfo%prc_num_x) ) + 1
1233  tilei = dinfo%IMAX
1234  tilej = dinfo%JMAX
1235 
1236  cxs = tilei * (xloc-1) + 1
1237  cxe = tilei * xloc
1238  cys = tilej * (yloc-1) + 1
1239  cye = tilej * yloc
1240  pxs = 1
1241  pxe = tilei
1242  pys = 1
1243  pye = tilej
1244 
1245  if ( .not. dinfo%periodic_x ) then
1246  if ( xlocg == 1 ) then ! BND_W
1247  tilei = tilei + dinfo%IHALO
1248  pxs = pxs + dinfo%IHALO
1249  pxe = pxe + dinfo%IHALO
1250  endif
1251  if ( xlocg == dinfo%prc_num_x ) then ! BND_E
1252  tilei = tilei + dinfo%IHALO
1253  endif
1254 
1255  if ( xstg_ ) then ! staggarded grid
1256  if ( xlocg == 1 ) then ! BND_W
1257  tilei = tilei + 1
1258  if ( dinfo%IHALO > 0 ) then
1259  pxs = pxs - 1
1260  else
1261  pxe = pxe + 1
1262  end if
1263  else
1264  cxs = cxs + 1
1265  end if
1266  cxe = cxe + 1
1267  end if
1268  end if
1269 
1270  if ( .not. dinfo%periodic_y ) then
1271  if ( ylocg == 1 ) then ! BND_S
1272  tilej = tilej + dinfo%JHALO
1273  pys = pys + dinfo%JHALO
1274  pye = pye + dinfo%JHALO
1275  endif
1276  if ( ylocg == dinfo%prc_num_y ) then ! BND_N
1277  tilej = tilej + dinfo%JHALO
1278  endif
1279 
1280  if ( ystg_ ) then ! staggarded grid
1281  if ( ylocg == 1 ) then ! BND_W
1282  tilej = tilej + 1
1283  if ( dinfo%JHALO > 0 ) then
1284  pys = pys - 1
1285  else
1286  pye = pye + 1
1287  end if
1288  else
1289  cys = cys + 1
1290  end if
1291  cye = cye + 1
1292  end if
1293  end if
1294 
1295  return
1296  end subroutine comm_cartesc_nest_domain_shape
1297 
1298  !-----------------------------------------------------------------------------
1300  subroutine comm_cartesc_nest_parentsize( &
1301  HANDLE )
1302  use scale_prc, only: &
1303  prc_abort, &
1304  prc_nprocs, &
1305  prc_myrank, &
1306  prc_ismaster, &
1307  prc_intercomm_parent, &
1308  prc_intercomm_child
1309  use scale_prc_cartesc, only: &
1310  prc_num_x, &
1311  prc_num_y
1312  use scale_time, only: &
1313  time_nstep, &
1314  time_dtsec
1315  use scale_comm_cartesc, only: &
1316  comm_bcast
1317  use scale_atmos_hydrometeor, only: &
1318  n_hyd
1319  implicit none
1320 
1321  integer, intent(in) :: handle
1322 
1323  real(rp) :: buffer
1324  integer, parameter :: ileng = 10
1325  integer :: datapack(ileng)
1326 
1327  integer :: qa_otherside
1328  character(len=H_SHORT) :: mp_type_otherside
1329 
1330  integer :: ireq1, ireq2, ireq3, ireq4, ireq5, ireq6
1331  integer :: ierr1, ierr2, ierr3, ierr4, ierr5, ierr6
1332  integer :: istatus(mpi_status_size)
1333  integer :: tag
1334  !---------------------------------------------------------------------------
1335 
1336  if( .NOT. use_nesting ) return
1337 
1338  tag = intercomm_id(handle) * 100
1339 
1340  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
1341 
1342  !##### parent ####
1343 
1344  datapack( 1) = prc_num_x
1345  datapack( 2) = prc_num_y
1346  datapack( 3) = kmax
1347  datapack( 4) = khalo
1348  datapack( 5) = imax
1349  datapack( 6) = ihalo
1350  datapack( 7) = jmax
1351  datapack( 8) = jhalo
1352  datapack( 9) = time_nstep
1353  datapack(10) = online_send_qa
1354  buffer = time_dtsec
1355 
1356  if ( prc_ismaster ) then
1357  ! from daughter to parent
1358  call mpi_irecv(online_daughter_nprocs, 1, mpi_integer, prc_myrank, tag+3, prc_intercomm_child, ireq4, ierr4)
1359  call mpi_irecv(qa_otherside, 1, mpi_integer, prc_myrank, tag+4, prc_intercomm_child, ireq5, ierr5)
1360  call mpi_irecv(mp_type_otherside, h_short, mpi_character, prc_myrank, tag+5, prc_intercomm_child, ireq6, ierr6)
1361 
1362  ! from parent to daughter
1363  call mpi_isend(datapack, ileng, mpi_integer, prc_myrank, tag, prc_intercomm_child, ireq1, ierr1)
1364  call mpi_isend(buffer, 1, mpi_double_precision, prc_myrank, tag+1, prc_intercomm_child, ireq2, ierr2)
1365  call mpi_isend(mp_type, h_short, mpi_character, prc_myrank, tag+2, prc_intercomm_child, ireq3, ierr3)
1366  call mpi_wait(ireq1, istatus, ierr1)
1367  call mpi_wait(ireq2, istatus, ierr2)
1368  call mpi_wait(ireq3, istatus, ierr3)
1369 
1370  call mpi_wait(ireq4, istatus, ierr4)
1371  call mpi_wait(ireq5, istatus, ierr5)
1372  call mpi_wait(ireq6, istatus, ierr6)
1373  end if
1374 
1375  call comm_bcast(online_daughter_nprocs)
1376  call comm_bcast(qa_otherside)
1377  call comm_bcast(mp_type_otherside)
1378 
1379  if ( mp_type == mp_type_otherside .and. online_send_qa == qa_otherside ) then
1380  online_send_diagqhyd = .false.
1381  else if ( mp_type_otherside == "DRY" .or. mp_type == "DRY" ) then
1382  online_send_qa = 0
1383  online_send_diagqhyd = .false.
1384  else if ( mp_type_otherside == "QV" .or. mp_type == "QV" ) then
1385  online_send_qa = 1
1386  online_send_diagqhyd = .false.
1387  else
1388  log_info("COMM_CARTESC_NEST_parentsize",*) 'Hydrometeor will be diagnosed on children side'
1389  log_info("COMM_CARTESC_NEST_parentsize",*) 'MP type (remote,local) = ', trim(mp_type_otherside), ", ", trim(mp_type)
1390  log_info("COMM_CARTESC_NEST_parentsize",*) 'Number of QA (remote,local) = ', qa_otherside, online_send_qa
1391  online_send_qa = n_hyd + 1 ! QV + hydrometeors
1392  online_send_diagqhyd = .true.
1393  endif
1394 
1395 
1396  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
1397 
1398  !##### child ####
1399 
1400  if ( prc_ismaster ) then
1401  ! from parent to daughter
1402  call mpi_irecv(datapack, ileng, mpi_integer, prc_myrank, tag, prc_intercomm_parent, ireq1, ierr1)
1403  call mpi_irecv(buffer, 1, mpi_double_precision, prc_myrank, tag+1, prc_intercomm_parent, ireq2, ierr2)
1404  call mpi_irecv(mp_type_otherside, h_short, mpi_character, prc_myrank, tag+2, prc_intercomm_parent, ireq3, ierr3)
1405 
1406  ! from daughter to parent
1407  call mpi_isend(prc_nprocs, 1, mpi_integer, prc_myrank, tag+3, prc_intercomm_parent, ireq4, ierr4)
1408  call mpi_isend(online_recv_qa, 1, mpi_integer, prc_myrank, tag+4, prc_intercomm_parent, ireq5, ierr5)
1409  call mpi_isend(mp_type, h_short, mpi_character, prc_myrank, tag+5, prc_intercomm_parent, ireq6, ierr6)
1410 
1411  call mpi_wait(ireq4, istatus, ierr4)
1412  call mpi_wait(ireq5, istatus, ierr5)
1413  call mpi_wait(ireq6, istatus, ierr6)
1414 
1415  call mpi_wait(ireq1, istatus, ierr1)
1416  call mpi_wait(ireq2, istatus, ierr2)
1417  call mpi_wait(ireq3, istatus, ierr3)
1418 
1419  endif
1420  call comm_bcast(ileng, datapack)
1421  call comm_bcast(buffer)
1422  call comm_bcast(mp_type_otherside)
1423 
1424  dom_info(i_parent)%prc_num_x = datapack( 1)
1425  dom_info(i_parent)%prc_num_y = datapack( 2)
1426  dom_info(i_parent)%KMAX = datapack( 3)
1427  dom_info(i_parent)%KHALO = datapack( 4)
1428  dom_info(i_parent)%IMAX = datapack( 5)
1429  dom_info(i_parent)%IHALO = datapack( 6)
1430  dom_info(i_parent)%JMAX = datapack( 7)
1431  dom_info(i_parent)%JHALO = datapack( 8)
1432  online_parent_nstep = datapack( 9)
1433  qa_otherside = datapack(10)
1434  online_parent_dtsec = buffer
1435 
1436  if ( mp_type == mp_type_otherside .and. online_recv_qa == qa_otherside ) then
1437  online_recv_diagqhyd = .false.
1438  else if ( mp_type == "DRY" ) then
1439  online_recv_qa = 0
1440  online_recv_diagqhyd = .false.
1441  else if ( mp_type == "QV" ) then
1442  online_recv_qa = 1
1443  online_recv_diagqhyd = .false.
1444  else
1445  log_info("COMM_CARTESC_NEST_parentsize",*) 'Hydrometeor will be diagnosed on this side'
1446  log_info("COMM_CARTESC_NEST_parentsize",*) 'MP type (remote,local) = ', trim(mp_type_otherside), ", ", trim(mp_type)
1447  log_info("COMM_CARTESC_NEST_parentsize",*) 'Number of QA (remote,local) = ', qa_otherside, online_recv_qa
1448  online_recv_qa = n_hyd + 1 ! QV + hydrometeors
1449  online_recv_diagqhyd = .true.
1450  endif
1451 
1452  else
1453  log_error("COMM_CARTESC_NEST_parentsize",*) '[COMM_CARTESC_NEST_parentsize] internal error'
1454  call prc_abort
1455  endif
1456 
1457  return
1458  end subroutine comm_cartesc_nest_parentsize
1459 
1460  !-----------------------------------------------------------------------------
1462  subroutine comm_cartesc_nest_catalogue( &
1463  HANDLE )
1464  use scale_prc, only: &
1465  prc_abort, &
1466  prc_nprocs, &
1467  prc_myrank, &
1468  prc_ismaster, &
1469  prc_intercomm_parent, &
1470  prc_intercomm_child
1471  use scale_comm_cartesc, only: &
1472  comm_datatype, &
1473  comm_bcast
1474  use scale_atmos_grid_cartesc_real, only: &
1475  atmos_grid_cartesc_real_domain_catalogue
1476  implicit none
1477 
1478  integer, intent(in) :: handle
1479 
1480  integer :: nprocs
1481  integer :: ireq, ierr, ileng
1482  integer :: istatus(mpi_status_size)
1483  integer :: tag
1484  !---------------------------------------------------------------------------
1485 
1486  if( .NOT. use_nesting ) return
1487 
1488  tag = intercomm_id(handle) * 100
1489 
1490  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
1491 
1492  !##### parent ####
1493 
1494  ileng = prc_nprocs * 2 * 2
1495 
1496  if ( prc_ismaster ) then
1497  call mpi_isend(atmos_grid_cartesc_real_domain_catalogue, ileng, comm_datatype, prc_myrank, tag, prc_intercomm_child, ireq, ierr)
1498  call mpi_wait(ireq, istatus, ierr)
1499  endif
1500 
1501  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
1502 
1503  !##### child ####
1504 
1505  nprocs = dom_info(i_parent)%prc_num_x * dom_info(i_parent)%prc_num_y
1506  ileng = nprocs * 2 * 2
1507 
1508  if ( prc_ismaster ) then
1509  call mpi_irecv(dom_info(i_parent)%latlon_catalogue, ileng, comm_datatype, prc_myrank, tag, prc_intercomm_parent, ireq, ierr)
1510  call mpi_wait(ireq, istatus, ierr)
1511  endif
1512  call comm_bcast( nprocs, 2, 2, dom_info(i_parent)%latlon_catalogue )
1513 
1514  else
1515  log_error("COMM_CARTESC_NEST_catalogue",*) 'internal error'
1516  call prc_abort
1517  endif
1518 
1519  return
1520  end subroutine comm_cartesc_nest_catalogue
1521 
1522  !-----------------------------------------------------------------------------
1524  subroutine comm_cartesc_nest_ping( &
1525  HANDLE )
1526  use scale_prc, only: &
1527  prc_abort, &
1528  prc_myrank, &
1529  prc_ismaster, &
1530  prc_intercomm_parent, &
1531  prc_intercomm_child
1532  use scale_comm_cartesc, only: &
1533  comm_bcast
1534  implicit none
1535 
1536  integer, intent(in) :: handle
1537 
1538  integer :: ping, pong
1539  integer :: ireq1, ireq2, ierr1, ierr2
1540  integer :: istatus(mpi_status_size)
1541  integer :: tag
1542  logical :: ping_error
1543  !---------------------------------------------------------------------------
1544 
1545  if( .NOT. use_nesting ) return
1546 
1547  tag = intercomm_id(handle) * 100
1548  ping_error = .false.
1549 
1550  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
1551 
1552  !##### parent ####
1553 
1554  ping = online_domain_num
1555  pong = 0
1556 
1557  if ( prc_ismaster ) then
1558  call mpi_irecv(pong, 1, mpi_integer, prc_myrank, tag+2, prc_intercomm_child, ireq2, ierr2)
1559  call mpi_isend(ping, 1, mpi_integer, prc_myrank, tag+1, prc_intercomm_child, ireq1, ierr1)
1560  call mpi_wait(ireq1, istatus, ierr1)
1561  call mpi_wait(ireq2, istatus, ierr2)
1562  endif
1563 
1564  call comm_bcast(pong)
1565 
1566  if ( pong /= intercomm_id(handle)+1 ) ping_error = .true.
1567 
1568  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
1569 
1570  !##### child ####
1571 
1572  ping = online_domain_num
1573  pong = 0
1574 
1575  if ( prc_ismaster ) then
1576  call mpi_irecv(pong, 1, mpi_integer, prc_myrank, tag+1, prc_intercomm_parent, ireq2, ierr2)
1577  call mpi_isend(ping, 1, mpi_integer, prc_myrank, tag+2, prc_intercomm_parent, ireq1, ierr1)
1578  call mpi_wait(ireq1, istatus, ierr1)
1579  call mpi_wait(ireq2, istatus, ierr2)
1580  endif
1581 
1582  call comm_bcast(pong)
1583 
1584  if ( pong /= intercomm_id(handle) ) ping_error = .true.
1585 
1586  else
1587  log_error("COMM_CARTESC_NEST_ping",*) 'internal error'
1588  call prc_abort
1589  endif
1590 
1591  if ( ping_error ) then
1592  log_error("COMM_CARTESC_NEST_ping",*) 'ping destination error'
1593  call prc_abort
1594  endif
1595 
1596  return
1597  end subroutine comm_cartesc_nest_ping
1598 
1599  !-----------------------------------------------------------------------------
1601  subroutine comm_cartesc_nest_setup_nestdown( &
1602  HANDLE )
1603  use scale_prc, only: &
1604  prc_abort, &
1605  prc_myrank, &
1606  prc_ismaster, &
1607  prc_intercomm_parent, &
1608  prc_intercomm_child
1609  use scale_prc, only: &
1610  prc_nprocs
1611  use scale_comm_cartesc, only: &
1612  comm_world, &
1613  comm_bcast
1614  implicit none
1615 
1616  integer, intent(in) :: handle
1617 
1618  integer, allocatable :: buffer_list (:)
1619  integer, allocatable :: buffer_alllist(:)
1620 
1621  integer :: parent_ka
1622  integer :: parent_ia
1623  integer :: parent_ja
1624 
1625  integer :: ireq, ierr, ileng
1626  integer :: istatus(mpi_status_size)
1627  integer :: tag, target_rank
1628 
1629  integer :: i, j, k
1630  !---------------------------------------------------------------------------
1631 
1632  if( .NOT. use_nesting ) return
1633 
1634  tag = intercomm_id(handle) * 100
1635 
1636  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
1637 
1638  !##### parent ####
1639 
1640  if ( prc_ismaster ) then
1641  call mpi_irecv(comm_cartesc_nest_tile_allmax_p, 1, mpi_integer, prc_myrank, tag+1, prc_intercomm_child, ireq, ierr)
1642  call mpi_wait(ireq, istatus, ierr)
1643  endif
1644  call comm_bcast(comm_cartesc_nest_tile_allmax_p)
1645 
1646  allocate( comm_cartesc_nest_tile_list_p(comm_cartesc_nest_tile_allmax_p,online_daughter_nprocs) )
1647  allocate( comm_cartesc_nest_tile_list_yp(comm_cartesc_nest_tile_allmax_p*online_daughter_nprocs) )
1648 
1649  ileng = comm_cartesc_nest_tile_allmax_p * online_daughter_nprocs
1650  if ( prc_ismaster ) then
1651  call mpi_irecv(comm_cartesc_nest_tile_list_p, ileng, mpi_integer, prc_myrank, tag+2, prc_intercomm_child, ireq, ierr)
1652  call mpi_wait(ireq, istatus, ierr)
1653  endif
1654  call comm_bcast(comm_cartesc_nest_tile_allmax_p, online_daughter_nprocs, comm_cartesc_nest_tile_list_p)
1655 
1656  comm_cartesc_nest_tile_list_yp(:) = -1
1657 
1658  k = 0
1659  do j = 1, online_daughter_nprocs
1660  do i = 1, comm_cartesc_nest_tile_allmax_p
1661  if ( comm_cartesc_nest_tile_list_p(i,j) == prc_myrank ) then
1662  k = k + 1
1663  comm_cartesc_nest_tile_list_yp(k) = j - 1 !rank number is started from 1
1664  endif
1665  enddo
1666  enddo
1667  num_yp = k
1668 
1669  log_info("COMM_CARTESC_NEST_setup_nestdown",'(A,I5,A,I5)') "[P] Num YP =",num_yp," Num TILE(MAX) =",comm_cartesc_nest_tile_allmax_p
1670 
1671  if ( prc_ismaster ) then
1672  call mpi_irecv(online_daughter_use_velz, 1, mpi_logical, prc_myrank, tag+3, prc_intercomm_child, ireq, ierr)
1673  call mpi_wait(ireq, istatus, ierr)
1674  endif
1675  call comm_bcast(online_daughter_use_velz)
1676 
1677  log_info("COMM_CARTESC_NEST_setup_nestdown",'(1x,A,L2)') 'NEST: ONLINE_DAUGHTER_USE_VELZ =', online_daughter_use_velz
1678 
1679  if ( prc_ismaster ) then
1680  call mpi_irecv(online_daughter_no_rotate, 1, mpi_logical, prc_myrank, tag+4, prc_intercomm_child, ireq, ierr)
1681  call mpi_wait(ireq, istatus, ierr)
1682  endif
1683  call comm_bcast(online_daughter_no_rotate)
1684 
1685  if( online_no_rotate .neqv. online_daughter_no_rotate ) then
1686  log_error("COMM_CARTESC_NEST_setup_nestdown",*) 'Flag of NO_ROTATE is not consistent with the child domain'
1687  log_error_cont(*) 'ONLINE_NO_ROTATE = ', online_no_rotate
1688  log_error_cont(*) 'ONLINE_DAUGHTER_NO_ROTATE =', online_daughter_no_rotate
1689  call prc_abort
1690  endif
1691  log_info("COMM_CARTESC_NEST_setup_nestdown",'(1x,A,L2)') 'NEST: ONLINE_DAUGHTER_NO_ROTATE =', online_daughter_no_rotate
1692 
1693  call comm_cartesc_nest_importgrid_nestdown( handle )
1694 
1695  do i = 1, num_yp
1696  target_rank = comm_cartesc_nest_tile_list_yp(i)
1697  call mpi_isend(i, 1, mpi_integer, target_rank, tag+5, prc_intercomm_child, ireq, ierr)
1698  call mpi_wait(ireq, istatus, ierr)
1699  enddo
1700 
1701  call mpi_barrier(prc_intercomm_child, ierr)
1702 
1703  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
1704 
1705  !##### child ####
1706 
1707  comm_cartesc_nest_tile_all = size( dom_info(i_parent)%TILE_ID(:) ) ! should be equal to "NEST_TILE_NUM_X*NEST_TILE_NUM_Y"
1708  call mpi_allreduce( comm_cartesc_nest_tile_all, &
1709  comm_cartesc_nest_tile_allmax_d, &
1710  1, &
1711  mpi_integer, &
1712  mpi_max, &
1713  comm_world, &
1714  ierr )
1715  log_info("COMM_CARTESC_NEST_setup_nestdown",'(A,I5,A,I5)') "[D] Num YP =",comm_cartesc_nest_tile_all," Num TILE(MAX) =",comm_cartesc_nest_tile_allmax_d
1716 
1717  if ( prc_ismaster ) then
1718  call mpi_isend(comm_cartesc_nest_tile_allmax_d, 1, mpi_integer, prc_myrank, tag+1, prc_intercomm_parent, ireq, ierr)
1719  call mpi_wait(ireq, istatus, ierr)
1720  endif
1721 
1722  parent_ka = dom_info(i_parent)%KMAX + dom_info(i_parent)%KHALO * 2
1723  parent_ia = dom_info(i_parent)%IMAX + dom_info(i_parent)%IHALO * 2
1724  parent_ja = dom_info(i_parent)%JMAX + dom_info(i_parent)%JHALO * 2
1725 
1726  max_isu = 4 + online_recv_qa
1727  if ( online_use_velz ) max_isu = max_isu + 1
1728  max_isu = comm_cartesc_nest_tile_all * max_isu
1729  allocate( recvbuf_3d( parent_ka, parent_ia, parent_ja, max_isu ) )
1730 
1731  allocate( buffer_list(comm_cartesc_nest_tile_allmax_d) )
1732  allocate( buffer_alllist(comm_cartesc_nest_tile_allmax_d*prc_nprocs) )
1733  allocate( comm_cartesc_nest_tile_list_d(comm_cartesc_nest_tile_allmax_d,prc_nprocs) )
1734 
1735  do i = 1, comm_cartesc_nest_tile_allmax_d
1736  if ( i <= comm_cartesc_nest_tile_all ) then
1737  buffer_list(i) = dom_info(i_parent)%TILE_ID(i)
1738  else
1739  buffer_list(i) = -1
1740  endif
1741  enddo
1742 
1743  ileng = comm_cartesc_nest_tile_allmax_d
1744  call mpi_allgather( buffer_list(:), &
1745  ileng, &
1746  mpi_integer, &
1747  buffer_alllist(:), &
1748  ileng, &
1749  mpi_integer, &
1750  comm_world, &
1751  ierr )
1752  k = 1
1753  do j = 1, prc_nprocs
1754  do i = 1, comm_cartesc_nest_tile_allmax_d
1755  comm_cartesc_nest_tile_list_d(i,j) = buffer_alllist(k)
1756  k = k + 1
1757  enddo
1758  enddo
1759 
1760  deallocate( buffer_list )
1761  deallocate( buffer_alllist )
1762 
1763  ileng = comm_cartesc_nest_tile_allmax_d * prc_nprocs
1764  if ( prc_ismaster ) then
1765  call mpi_isend(comm_cartesc_nest_tile_list_d, ileng, mpi_integer, prc_myrank, tag+2, prc_intercomm_parent, ireq, ierr)
1766  call mpi_wait(ireq, istatus, ierr)
1767  endif
1768 
1769  if ( prc_ismaster ) then
1770  call mpi_isend(online_use_velz, 1, mpi_logical, prc_myrank, tag+3, prc_intercomm_parent, ireq, ierr)
1771  call mpi_wait(ireq, istatus, ierr)
1772  endif
1773 
1774  if ( prc_ismaster ) then
1775  call mpi_isend(online_no_rotate, 1, mpi_logical, prc_myrank, tag+4, prc_intercomm_parent, ireq, ierr)
1776  call mpi_wait(ireq, istatus, ierr)
1777  endif
1778  call comm_bcast(online_daughter_no_rotate)
1779 
1780  call comm_cartesc_nest_importgrid_nestdown( handle )
1781 
1782  do i = 1, comm_cartesc_nest_tile_all
1783  target_rank = comm_cartesc_nest_tile_list_d(i,prc_myrank+1)
1784  call mpi_irecv( call_order(i), 1, mpi_integer, target_rank, tag+5, prc_intercomm_parent, ireq, ierr )
1785  call mpi_wait(ireq, istatus, ierr)
1786  enddo
1787 
1788  call mpi_barrier(prc_intercomm_parent, ierr)
1789  else
1790  log_error("COMM_CARTESC_NEST_setup_nestdown",*) 'internal error'
1791  call prc_abort
1792  endif
1793 
1794  if( num_yp * 16 > max_rq .OR. comm_cartesc_nest_tile_all * 16 > max_rq ) then ! 16 = dyn:5 + qtrc:11
1795  log_error("COMM_CARTESC_NEST_setup_nestdown",*) 'internal error (overflow number of ireq)'
1796  log_error_cont(*) 'NUM_YP x 16 = ', num_yp * 16
1797  log_error_cont(*) 'COMM_CARTESC_NEST_TILE_ALL x 16 = ', comm_cartesc_nest_tile_all * 16
1798  log_error_cont(*) 'max_rq = ', max_rq
1799  call prc_abort
1800  endif
1801 
1802  return
1803  end subroutine comm_cartesc_nest_setup_nestdown
1804 
1805  !-----------------------------------------------------------------------------
1807  subroutine comm_cartesc_nest_importgrid_nestdown( &
1808  HANDLE )
1809  use scale_prc, only: &
1810  prc_myrank, &
1811  prc_abort, &
1812  prc_intercomm_parent, &
1813  prc_intercomm_child
1814  use scale_atmos_grid_cartesc_real, only: &
1815  atmos_grid_cartesc_real_lon, &
1816  atmos_grid_cartesc_real_lat, &
1817  atmos_grid_cartesc_real_lonuy, &
1818  atmos_grid_cartesc_real_lonxv, &
1819  atmos_grid_cartesc_real_latuy, &
1820  atmos_grid_cartesc_real_latxv, &
1821  atmos_grid_cartesc_real_cz, &
1822  atmos_grid_cartesc_real_fz
1823  use scale_comm_cartesc, only: &
1824  comm_datatype
1825  implicit none
1826 
1827  integer, intent(in) :: handle
1828 
1829  integer :: parent_ka
1830  integer :: parent_ia, parent_is, parent_ie, parent_imax
1831  integer :: parent_ja, parent_js, parent_je, parent_jmax
1832 
1833  integer :: ierr, ileng
1834  integer :: istatus(mpi_status_size)
1835  integer :: tag, tagbase, target_rank
1836  integer :: rq_str, rq_end, rq_tot
1837 
1838  integer :: xloc, yloc
1839  integer :: xs, xe
1840  integer :: ys, ye
1841 
1842  real(rp) :: max_ref, max_loc
1843 
1844  real(rp), allocatable :: sendbuf_2d(:,:,:)
1845  real(rp), allocatable :: sendbuf_3d(:,:,:,:)
1846  real(rp), allocatable :: recvbuf_2d(:,:,:)
1847 
1848  integer :: i, k, rq
1849  !---------------------------------------------------------------------------
1850 
1851  if( .NOT. use_nesting ) return
1852 
1853  tagbase = intercomm_id(handle) * 100
1854  rq = 0
1855 
1856  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
1857 
1858  !##### parent [send issue] #####
1859 
1860  allocate( sendbuf_2d( ia, ja, 4 ) )
1861  allocate( sendbuf_3d( ka, ia, ja, 1 ) )
1862 
1863  do i = 1, num_yp
1864  ! send data to multiple daughter processes
1865  target_rank = comm_cartesc_nest_tile_list_yp(i)
1866 
1867  rq_str = rq + 1
1868 
1869  rq = rq + 1
1870  ileng = ia * ja
1871  tag = tagbase + tag_lon
1872  call mpi_isend(atmos_grid_cartesc_real_lon, ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1873 
1874  rq = rq + 1
1875  ileng = ia * ja
1876  tag = tagbase + tag_lat
1877  call mpi_isend(atmos_grid_cartesc_real_lat, ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1878 
1879  sendbuf_2d(:,:,1) = atmos_grid_cartesc_real_lonuy(1:ia,1:ja)
1880  rq = rq + 1
1881  ileng = ia * ja
1882  tag = tagbase + tag_lonuy
1883  call mpi_isend(sendbuf_2d(:,:,1), ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1884 
1885  sendbuf_2d(:,:,2) = atmos_grid_cartesc_real_latuy(1:ia,1:ja)
1886  rq = rq + 1
1887  ileng = ia * ja
1888  tag = tagbase + tag_latuy
1889  call mpi_isend(sendbuf_2d(:,:,2), ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1890 
1891  sendbuf_2d(:,:,3) = atmos_grid_cartesc_real_lonxv(1:ia,1:ja)
1892  rq = rq + 1
1893  ileng = ia * ja
1894  tag = tagbase + tag_lonxv
1895  call mpi_isend(sendbuf_2d(:,:,3), ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1896 
1897  sendbuf_2d(:,:,4) = atmos_grid_cartesc_real_latxv(1:ia,1:ja)
1898  rq = rq + 1
1899  ileng = ia * ja
1900  tag = tagbase + tag_latxv
1901  call mpi_isend(sendbuf_2d(:,:,4), ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1902 
1903  rq = rq + 1
1904  ileng = ka * ia * ja
1905  tag = tagbase + tag_cz
1906  call mpi_isend(atmos_grid_cartesc_real_cz, ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1907 
1908  sendbuf_3d(:,:,:,1) = atmos_grid_cartesc_real_fz(1:,:,:)
1909  rq = rq + 1
1910  ileng = ka * ia * ja
1911  tag = tagbase + tag_fz
1912  call mpi_isend(sendbuf_3d(:,:,:,1), ileng, comm_datatype, target_rank, tag, prc_intercomm_child, ireq_p(rq), ierr)
1913 
1914  rq_end = rq
1915  rq_tot = rq_end - rq_str + 1
1916 
1917  call comm_cartesc_nest_waitall( rq_tot, ireq_p(rq_str:rq_end) )
1918  enddo
1919 
1920  deallocate( sendbuf_2d )
1921  deallocate( sendbuf_3d )
1922 
1923  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
1924 
1925  !##### child [recv & wait issue] #####
1926 
1927  parent_ka = dom_info(i_parent)%KMAX + dom_info(i_parent)%KHALO * 2
1928 
1929  parent_imax = dom_info(i_parent)%IMAX
1930  parent_ia = parent_imax + dom_info(i_parent)%IHALO * 2
1931  parent_is = dom_info(i_parent)%IHALO + 1
1932  parent_ie = parent_imax + dom_info(i_parent)%IHALO
1933 
1934  parent_jmax = dom_info(i_parent)%JMAX
1935  parent_ja = parent_jmax + dom_info(i_parent)%JHALO * 2
1936  parent_js = dom_info(i_parent)%JHALO + 1
1937  parent_je = parent_jmax + dom_info(i_parent)%JHALO
1938 
1939  allocate( recvbuf_2d( parent_ia, parent_ja, 6 ) )
1940 
1941  do i = 1, comm_cartesc_nest_tile_all
1942  ! receive data from multiple parent tiles
1943  target_rank = comm_cartesc_nest_tile_list_d(i,prc_myrank+1)
1944 
1945  xloc = mod( i-1, dom_info(i_parent)%tile_num_x ) + 1
1946  yloc = int( real(i-1) / real(dom_info(i_parent)%tile_num_x) ) + 1
1947 
1948  xs = parent_imax * (xloc-1) + 1
1949  xe = parent_imax * xloc
1950  ys = parent_jmax * (yloc-1) + 1
1951  ye = parent_jmax * yloc
1952 
1953  rq_str = rq + 1
1954 
1955  rq = rq + 1
1956  ileng = parent_ia * parent_ja
1957  tag = tagbase + tag_lon
1958  call mpi_irecv(recvbuf_2d(:,:,tag_lon), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1959 
1960  rq = rq + 1
1961  ileng = parent_ia * parent_ja
1962  tag = tagbase + tag_lat
1963  call mpi_irecv(recvbuf_2d(:,:,tag_lat), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1964 
1965  rq = rq + 1
1966  ileng = parent_ia * parent_ja
1967  tag = tagbase + tag_lonuy
1968  call mpi_irecv(recvbuf_2d(:,:,tag_lonuy), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1969 
1970  rq = rq + 1
1971  ileng = parent_ia * parent_ja
1972  tag = tagbase + tag_latuy
1973  call mpi_irecv(recvbuf_2d(:,:,tag_latuy), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1974 
1975  rq = rq + 1
1976  ileng = parent_ia * parent_ja
1977  tag = tagbase + tag_lonxv
1978  call mpi_irecv(recvbuf_2d(:,:,tag_lonxv), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1979 
1980  rq = rq + 1
1981  ileng = parent_ia * parent_ja
1982  tag = tagbase + tag_latxv
1983  call mpi_irecv(recvbuf_2d(:,:,tag_latxv), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1984 
1985  rq = rq + 1
1986  ileng = parent_ka * parent_ia * parent_ja
1987  tag = tagbase + tag_cz
1988  call mpi_irecv(recvbuf_3d(:,:,:,tag_cz), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1989 
1990  rq = rq + 1
1991  ileng = parent_ka * parent_ia * parent_ja
1992  tag = tagbase + tag_fz
1993  call mpi_irecv(recvbuf_3d(:,:,:,tag_fz), ileng, comm_datatype, target_rank, tag, prc_intercomm_parent, ireq_d(rq), ierr)
1994 
1995  rq_end = rq
1996  rq_tot = rq_end - rq_str + 1
1997 
1998  call comm_cartesc_nest_waitall( rq_tot, ireq_d(rq_str:rq_end) )
1999 
2000  buffer_ref_lon(xs:xe,ys:ye) = recvbuf_2d(parent_is:parent_ie,parent_js:parent_je,tag_lon )
2001  buffer_ref_lat(xs:xe,ys:ye) = recvbuf_2d(parent_is:parent_ie,parent_js:parent_je,tag_lat )
2002  buffer_ref_lonuy(xs:xe,ys:ye) = recvbuf_2d(parent_is:parent_ie,parent_js:parent_je,tag_lonuy)
2003  buffer_ref_latuy(xs:xe,ys:ye) = recvbuf_2d(parent_is:parent_ie,parent_js:parent_je,tag_latuy)
2004  buffer_ref_lonxv(xs:xe,ys:ye) = recvbuf_2d(parent_is:parent_ie,parent_js:parent_je,tag_lonxv)
2005  buffer_ref_latxv(xs:xe,ys:ye) = recvbuf_2d(parent_is:parent_ie,parent_js:parent_je,tag_latxv)
2006 
2007  do k = 1, parent_ka
2008  buffer_ref_cz(k,xs:xe,ys:ye) = recvbuf_3d(k,parent_is:parent_ie,parent_js:parent_je,tag_cz)
2009  buffer_ref_fz(k,xs:xe,ys:ye) = recvbuf_3d(k,parent_is:parent_ie,parent_js:parent_je,tag_fz)
2010  enddo
2011  enddo
2012 
2013  ! check domain compatibility
2014  max_ref = maxval( buffer_ref_fz(:,:,:) )
2015  max_loc = maxval( atmos_grid_cartesc_real_fz(ks-1:ke,:,:) ) ! HALO + 1
2016  if ( max_ref < max_loc ) then
2017  log_error("COMM_CARTESC_NEST_importgrid_nestdown",*) 'REQUESTED DOMAIN IS TOO MUCH BROAD'
2018  log_error_cont(*) '-- VERTICAL direction over the limit'
2019  log_error_cont(*) '-- reference max: ', max_ref
2020  log_error_cont(*) '-- local max: ', max_loc
2021  call prc_abort
2022  endif
2023 
2024  deallocate( recvbuf_2d )
2025 
2026  else
2027  log_error("COMM_CARTESC_NEST_importgrid_nestdown",*) 'internal error'
2028  call prc_abort
2029  endif
2030 
2031  return
2032  end subroutine comm_cartesc_nest_importgrid_nestdown
2033 
2034  !-----------------------------------------------------------------------------
2036  subroutine comm_cartesc_nest_nestdown_send( &
2037  DENS_send, &
2038  MOMZ_send, &
2039  MOMX_send, &
2040  MOMY_send, &
2041  RHOT_send, &
2042  QTRC_send )
2043  use scale_prc, only: &
2044  prc_abort, &
2045  prc_intercomm_parent, &
2046  prc_intercomm_child
2047  use scale_comm_cartesc, only: &
2048  comm_vars8, &
2049  comm_wait
2050  use scale_atmos_grid_cartesc_metric, only: &
2051  rotc => atmos_grid_cartesc_metric_rotc
2052  implicit none
2053 
2054  real(rp), intent(in) :: dens_send(ka,ia,ja)
2055  real(rp), intent(in) :: momz_send(ka,ia,ja)
2056  real(rp), intent(in) :: momx_send(ka,ia,ja)
2057  real(rp), intent(in) :: momy_send(ka,ia,ja)
2058  real(rp), intent(in) :: rhot_send(ka,ia,ja)
2059  real(rp), intent(in) :: qtrc_send(ka,ia,ja,online_send_qa)
2060 
2061  integer, parameter :: handle = 1
2062 
2063  real(rp) :: work1_send(ka,ia,ja)
2064  real(rp) :: work2_send(ka,ia,ja)
2065  real(rp) :: u_on_map, v_on_map
2066 
2067  real(rp) :: dummy(1,1,1)
2068  integer :: tagbase, tagcomm
2069  integer :: isu_tag
2070 
2071  integer :: ierr
2072  integer :: i, j, k, iq
2073  !---------------------------------------------------------------------------
2074 
2075  if( .NOT. use_nesting ) return
2076 
2077  tagcomm = intercomm_id(handle) * order_tag_comm
2078 
2079  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
2080 
2081  !##### parent [send issue] #####
2082 
2083  call prof_rapstart('NEST_total_P', 2)
2084  call prof_rapstart('NEST_pack_P', 2)
2085 
2086  nsend = nsend + 1
2087  log_info("COMM_CARTESC_NEST_nestdown",'(1X,A,I5,A)') "CONeP[P] send( ", nsend, " )"
2088 
2089  ! to keep values at that time by finish of sending process
2090 !OCL XFILL
2091  org_dens(:,:,:) = dens_send(:,:,:)
2092 !OCL XFILL
2093  org_momz(:,:,:) = momz_send(:,:,:)
2094 !OCL XFILL
2095  org_momx(:,:,:) = momx_send(:,:,:)
2096 !OCL XFILL
2097  org_momy(:,:,:) = momy_send(:,:,:)
2098 !OCL XFILL
2099  org_rhot(:,:,:) = rhot_send(:,:,:)
2100  do iq = 1, online_send_qa
2101 !OCL XFILL
2102  org_qtrc(:,:,:,iq) = qtrc_send(:,:,:,iq)
2103  enddo
2104 
2105  !*** request control
2106  !--- do not change the calling order below;
2107  !--- it should be consistent with the order in "COMM_CARTESC_NEST_recvwait_issue"
2108  rq_ctl_p = 0
2109 
2110  if ( .NOT. online_daughter_no_rotate ) then
2111  ! from staggered point to scalar point
2112  do j = 1, ja
2113  do i = 2, ia
2114  do k = 1, ka
2115  work1_send(k,i,j) = ( org_momx(k,i-1,j) + org_momx(k,i,j) ) * 0.5_rp
2116  enddo
2117  enddo
2118  enddo
2119 
2120  do j = 1, ja
2121  do k = 1, ka
2122  work1_send(k,1,j) = org_momx(k,1,j)
2123  enddo
2124  enddo
2125 
2126  call comm_vars8( work1_send(:,:,:), 1 )
2127 
2128  do j = 2, ja
2129  do i = 1, ia
2130  do k = 1, ka
2131  work2_send(k,i,j) = ( org_momy(k,i,j-1) + org_momy(k,i,j) ) * 0.5_rp
2132  enddo
2133  enddo
2134  enddo
2135 
2136  do i = 1, ia
2137  do k = 1, ka
2138  work2_send(k,i,1) = org_momy(k,i,1)
2139  enddo
2140  enddo
2141 
2142  call comm_vars8( work2_send(:,:,:), 2 )
2143 
2144  call comm_wait ( work1_send(:,:,:), 1, .false. )
2145  call comm_wait ( work2_send(:,:,:), 2, .false. )
2146 
2147  ! rotation from map-projected field to latlon field
2148  do j = 1, ja
2149  do i = 1, ia
2150  do k = 1, ka
2151  u_on_map = work1_send(k,i,j) / org_dens(k,i,j)
2152  v_on_map = work2_send(k,i,j) / org_dens(k,i,j)
2153 
2154  org_u_ll(k,i,j) = u_on_map * rotc(i,j,1) - v_on_map * rotc(i,j,2)
2155  org_v_ll(k,i,j) = u_on_map * rotc(i,j,2) + v_on_map * rotc(i,j,1)
2156  enddo
2157  enddo
2158  enddo
2159  endif
2160 
2161  tagbase = tagcomm + tag_dens*order_tag_var
2162  call comm_cartesc_nest_intercomm_nestdown( org_dens(:,:,:), & ! [IN]
2163  dummy(:,:,:), & ! [OUT]
2164  tagbase, i_sclr, handle, & ! [IN]
2165  isu_tag, & ! [INOUT]
2166  flag_dens = .true. ) ! [IN]
2167 
2168  tagbase = tagcomm + tag_momz*order_tag_var
2169  if ( online_daughter_use_velz ) then
2170  call comm_cartesc_nest_intercomm_nestdown( org_momz(:,:,:), & ! [IN]
2171  dummy(:,:,:), & ! [OUT]
2172  tagbase, i_zstg, handle, & ! [IN]
2173  isu_tag ) ! [INOUT]
2174  endif
2175 
2176  tagbase = tagcomm + tag_momx*order_tag_var
2177  if ( online_daughter_no_rotate ) then
2178  call comm_cartesc_nest_intercomm_nestdown( org_momx(:,:,:), & ! [IN]
2179  dummy(:,:,:), & ! [OUT]
2180  tagbase, i_xstg, handle, & ! [IN]
2181  isu_tag ) ! [INOUT]
2182  else
2183  call comm_cartesc_nest_intercomm_nestdown( org_u_ll(:,:,:), & ! [IN]
2184  dummy(:,:,:), & ! [OUT]
2185  tagbase, i_sclr, handle, & ! [IN]
2186  isu_tag ) ! [INOUT]
2187  endif
2188 
2189  tagbase = tagcomm + tag_momy*order_tag_var
2190  if ( online_daughter_no_rotate ) then
2191  call comm_cartesc_nest_intercomm_nestdown( org_momy(:,:,:), & ! [IN]
2192  dummy(:,:,:), & ! [OUT]
2193  tagbase, i_ystg, handle, & ! [IN]
2194  isu_tag ) ! [INOUT]
2195  else
2196  call comm_cartesc_nest_intercomm_nestdown( org_v_ll(:,:,:), & ! [IN]
2197  dummy(:,:,:), & ! [OUT]
2198  tagbase, i_sclr, handle, & ! [IN]
2199  isu_tag ) ! [INOUT]
2200  endif
2201 
2202  tagbase = tagcomm + tag_rhot*order_tag_var
2203  call comm_cartesc_nest_intercomm_nestdown( org_rhot(:,:,:), & ! [IN]
2204  dummy(:,:,:), & ! [OUT]
2205  tagbase, i_sclr, handle, & ! [IN]
2206  isu_tag ) ! [INOUT]
2207 
2208  do iq = 1, online_send_qa
2209  tagbase = tagcomm + (tag_qx*10+iq)*order_tag_var
2210  call comm_cartesc_nest_intercomm_nestdown( org_qtrc(:,:,:,iq), & ! [IN]
2211  dummy(:,:,:), & ! [OUT]
2212  tagbase, i_sclr, handle, & ! [IN]
2213  isu_tag ) ! [INOUT]
2214  enddo
2215 
2216  rq_tot_p = rq_ctl_p
2217 
2218  call prof_rapend ('NEST_pack_P', 2)
2219  call prof_rapend ('NEST_total_P', 2)
2220 
2221  else
2222  log_error("COMM_CARTESC_NEST_nestdown_send",*) 'internal error'
2223  call prc_abort
2224  endif
2225 
2226  return
2227  end subroutine comm_cartesc_nest_nestdown_send
2228  !-----------------------------------------------------------------------------
2230  subroutine comm_cartesc_nest_nestdown_recv( &
2231  DENS_recv, &
2232  VELZ_recv, &
2233  VELX_recv, &
2234  VELY_recv, &
2235  POTT_recv, &
2236  QTRC_recv )
2237  use scale_prc, only: &
2238  prc_abort, &
2239  prc_intercomm_parent, &
2240  prc_intercomm_child
2241  use scale_comm_cartesc, only: &
2242  comm_vars8, &
2243  comm_wait
2244  use scale_atmos_grid_cartesc_metric, only: &
2245  rotc => atmos_grid_cartesc_metric_rotc
2246  implicit none
2247 
2248  real(rp), intent(out) :: dens_recv(ka,ia,ja)
2249  real(rp), intent(out) :: velz_recv(ka,ia,ja)
2250  real(rp), intent(out) :: velx_recv(ka,ia,ja)
2251  real(rp), intent(out) :: vely_recv(ka,ia,ja)
2252  real(rp), intent(out) :: pott_recv(ka,ia,ja)
2253  real(rp), intent(out) :: qtrc_recv(ka,ia,ja,online_recv_qa)
2254 
2255  integer, parameter :: handle = 2
2256 
2257  real(rp) :: work1_recv(ka,ia,ja)
2258  real(rp) :: work2_recv(ka,ia,ja)
2259  real(rp) :: u_ll_recv (ka,ia,ja)
2260  real(rp) :: v_ll_recv (ka,ia,ja)
2261  real(rp) :: u_on_map, v_on_map
2262 
2263  real(rp) :: dummy(1,1,1)
2264  integer :: tagbase, tagcomm
2265  integer :: isu_tag
2266 
2267  integer :: ierr
2268  integer :: i, j, k, iq
2269  !---------------------------------------------------------------------------
2270 
2271  if( .NOT. use_nesting ) return
2272 
2273  tagcomm = intercomm_id(handle) * order_tag_comm
2274 
2275  if( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
2276 
2277  !##### child [wait issue] #####
2278 
2279  call prof_rapstart('NEST_total_C', 2)
2280  call prof_rapstart('NEST_wait_C', 2)
2281 
2282  nwait_d = nwait_d + 1
2283  !LOG_INFO("COMM_CARTESC_NEST_nestdown",'(1X,A,I5,A)') "NestIDC [C]: que wait ( ", nwait_d, " )"
2284 
2285  !*** reset issue tag and request control
2286  !--- do not change the calling order below;
2287  !--- it should be consistent with the order in "COMM_CARTESC_NEST_recvwait_issue"
2288  isu_tag = 0
2289 
2290  call comm_cartesc_nest_waitall( rq_tot_d, ireq_d )
2291 
2292  if ( online_aggressive_comm ) then
2293  ! nothing to do
2294  else
2295  call mpi_barrier(prc_intercomm_parent, ierr)
2296  endif
2297 
2298  call prof_rapend ('NEST_wait_C', 2)
2299  call prof_rapstart('NEST_unpack_C', 2)
2300 
2301  tagbase = tagcomm + tag_dens*order_tag_var
2302  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2303  work1_recv(:,:,:), & ! [OUT]
2304  tagbase, i_sclr, handle, & ! [IN]
2305  isu_tag, & ! [INOUT]
2306  flag_dens = .true. ) ! [IN]
2307 !OCL XFILL
2308  do j = 1, ja
2309  do i = 1, ia
2310  do k = ks, ke
2311  dens_recv(k,i,j) = work1_recv(k,i,j)
2312  enddo
2313  enddo
2314  enddo
2315 
2316  call comm_vars8( dens_recv, 1 )
2317 
2318  tagbase = tagcomm + tag_momz*order_tag_var
2319  if ( online_use_velz ) then
2320  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2321  work2_recv(:,:,:), & ! [OUT]
2322  tagbase, i_zstg, handle, & ! [IN]
2323  isu_tag ) ! [INOUT]
2324 !OCL XFILL
2325  do j = 1, ja
2326  do i = 1, ia
2327  do k = ks, ke-1
2328  velz_recv(k,i,j) = work2_recv(k,i,j) / ( work1_recv(k,i,j) + work1_recv(k+1,i,j) ) * 2.0_rp
2329  enddo
2330  enddo
2331  enddo
2332 
2333  do j = 1, ja
2334  do i = 1, ia
2335  velz_recv(ks-1,i,j) = 0.0_rp
2336  velz_recv(ke ,i,j) = 0.0_rp
2337  enddo
2338  enddo
2339  endif
2340 
2341  call comm_wait ( dens_recv, 1, .false. )
2342 
2343  tagbase = tagcomm + tag_momx*order_tag_var
2344  if ( online_no_rotate ) then
2345  ! U_ll_recv receives MOMX
2346  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2347  work1_recv(:,:,:), & ! [OUT]
2348  tagbase, i_xstg, handle, & ! [IN]
2349  isu_tag ) ! [INOUT]
2350  else
2351  ! U_ll_recv receives MOMX/DENS
2352  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2353  u_ll_recv(:,:,:), & ! [OUT]
2354  tagbase, i_sclr, handle, & ! [IN]
2355  isu_tag ) ! [INOUT]
2356  endif
2357 
2358  tagbase = tagcomm + tag_momy*order_tag_var
2359  if ( online_no_rotate ) then
2360  ! V_ll_recv receives MOMY
2361  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2362  work2_recv(:,:,:), & ! [OUT]
2363  tagbase, i_ystg, handle, & ! [IN]
2364  isu_tag ) ! [INOUT]
2365  else
2366  ! V_ll_recv receives MOMY/DENS
2367  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2368  v_ll_recv(:,:,:), & ! [OUT]
2369  tagbase, i_sclr, handle, & ! [IN]
2370  isu_tag ) ! [INOUT]
2371  endif
2372 
2373  if ( online_no_rotate ) then
2374 
2375 !OCL XFILL
2376  do j = 1, ja
2377  do i = 1, ia-1
2378  do k = ks, ke
2379  velx_recv(k,i,j) = work1_recv(k,i,j) / ( dens_recv(k,i+1,j) + dens_recv(k,i,j) ) * 2.0_rp
2380  enddo
2381  enddo
2382  enddo
2383 
2384 !OCL XFILL
2385  do j = 1, ja
2386  do k = ks, ke
2387  velx_recv(k,ia,j) = work1_recv(k,ia,j) / dens_recv(k,ia,j)
2388  enddo
2389  enddo
2390 
2391  call comm_vars8( velx_recv, 2 )
2392 
2393 !OCL XFILL
2394  do j = 1, ja-1
2395  do i = 1, ia
2396  do k = ks, ke
2397  vely_recv(k,i,j) = work2_recv(k,i,j) / ( dens_recv(k,i,j+1) + dens_recv(k,i,j) ) * 2.0_rp
2398  enddo
2399  enddo
2400  enddo
2401 
2402 !OCL XFILL
2403  do i = 1, ia
2404  do k = ks, ke
2405  vely_recv(k,i,ja) = work2_recv(k,i,ja) / dens_recv(k,i,ja)
2406  enddo
2407  enddo
2408 
2409  call comm_vars8( vely_recv, 3 )
2410 
2411  call comm_wait ( velx_recv, 2, .false. )
2412  call comm_wait ( vely_recv, 3, .false. )
2413 
2414  else ! rotate
2415 
2416  ! rotation from latlon field to map-projected field
2417 !OCL XFILL
2418  do j = 1, ja
2419  do i = 1, ia
2420  do k = ks, ke
2421  work1_recv(k,i,j) = u_ll_recv(k,i,j) * rotc(i,j,1) + v_ll_recv(k,i,j) * rotc(i,j,2)
2422  work2_recv(k,i,j) = -u_ll_recv(k,i,j) * rotc(i,j,2) + v_ll_recv(k,i,j) * rotc(i,j,1)
2423  enddo
2424  enddo
2425  enddo
2426 
2427  ! from scalar point to staggered point
2428 !OCL XFILL
2429  do j = 1, ja
2430  do i = 1, ia-1
2431  do k = ks, ke
2432  velx_recv(k,i,j) = ( work1_recv(k,i+1,j) + work1_recv(k,i,j) ) * 0.5_rp
2433  enddo
2434  enddo
2435  enddo
2436 
2437 !OCL XFILL
2438  do j = 1, ja
2439  do k = ks, ke
2440  velx_recv(k,ia,j) = work1_recv(k,ia,j)
2441  enddo
2442  enddo
2443 
2444  call comm_vars8( velx_recv, 2 )
2445 
2446 !OCL XFILL
2447  do j = 1, ja-1
2448  do i = 1, ia
2449  do k = ks, ke
2450  vely_recv(k,i,j) = ( work2_recv(k,i,j+1) + work2_recv(k,i,j) ) * 0.5_rp
2451  enddo
2452  enddo
2453  enddo
2454 
2455 !OCL XFILL
2456  do i = 1, ia
2457  do k = ks, ke
2458  vely_recv(k,i,ja) = work2_recv(k,i,ja)
2459  enddo
2460  enddo
2461 
2462  call comm_vars8( vely_recv, 3 )
2463 
2464  call comm_wait ( velx_recv, 2, .false. )
2465  call comm_wait ( vely_recv, 3, .false. )
2466 
2467  endif
2468 
2469  tagbase = tagcomm + tag_rhot*order_tag_var
2470  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2471  work1_recv(:,:,:), & ! [OUT]
2472  tagbase, i_sclr, handle, & ! [IN]
2473  isu_tag ) ! [INOUT]
2474 !OCL XFILL
2475  do j = 1, ja
2476  do i = 1, ia
2477  do k = ks, ke
2478  pott_recv(k,i,j) = work1_recv(k,i,j) / dens_recv(k,i,j)
2479  enddo
2480  enddo
2481  enddo
2482 
2483  do iq = 1, online_recv_qa
2484  tagbase = tagcomm + (tag_qx*10+iq)*order_tag_var
2485  call comm_cartesc_nest_intercomm_nestdown( dummy(:,:,:), & ! [IN]
2486  work1_recv(:,:,:), & ! [OUT]
2487  tagbase, i_sclr, handle, & ! [IN]
2488  isu_tag ) ! [INOUT]
2489 !OCL XFILL
2490  do j = 1, ja
2491  do i = 1, ia
2492  do k = ks, ke
2493  qtrc_recv(k,i,j,iq) = work1_recv(k,i,j)
2494  enddo
2495  enddo
2496  enddo
2497  enddo
2498 
2499  call prof_rapend ('NEST_unpack_C', 2)
2500  call prof_rapend ('NEST_total_C', 2)
2501 
2502  else
2503  log_error("COMM_CARTESC_NEST_nestdown_recv",*) 'internal error'
2504  call prc_abort
2505  endif
2506 
2507  return
2508  end subroutine comm_cartesc_nest_nestdown_recv
2509 
2510  !-----------------------------------------------------------------------------
2512  subroutine comm_cartesc_nest_recvwait_issue_send
2513  use scale_prc, only: &
2514  prc_abort, &
2515  prc_intercomm_child
2516  implicit none
2517 
2518  integer, parameter :: handle = 1
2519 
2520  integer :: isu_tag
2521  integer :: tagbase, tagcomm
2522  integer :: ierr
2523  integer :: iq
2524  !---------------------------------------------------------------------------
2525 
2526  if( .NOT. use_nesting ) return
2527 
2528  tagcomm = intercomm_id(handle) * order_tag_comm
2529 
2530  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
2531 
2532  !##### parent [wait issue] #####
2533 
2534  call prof_rapstart('NEST_total_P', 2)
2535  call prof_rapstart('NEST_wait_P', 2)
2536 
2537  nwait_p = nwait_p + 1
2538  !LOG_INFO("COMM_CARTESC_NEST_recvwait_issue",'(1X,A,I5,A)') "NestIDC [P]: que wait ( ", nwait_p, " )"
2539 
2540  call comm_cartesc_nest_issuer_of_wait( handle )
2541 
2542  if ( online_aggressive_comm ) then
2543  ! nothing to do
2544  else
2545  call mpi_barrier(prc_intercomm_child, ierr)
2546  endif
2547 
2548  call prof_rapend ('NEST_wait_P', 2)
2549  call prof_rapend ('NEST_total_P', 2)
2550 
2551  else
2552  log_error("COMM_CARTESC_NEST_recvwait_issue_send",*) 'internal error'
2553  call prc_abort
2554  endif
2555 
2556  return
2557  end subroutine comm_cartesc_nest_recvwait_issue_send
2558 
2559  !-----------------------------------------------------------------------------
2561  subroutine comm_cartesc_nest_recvwait_issue_recv
2562  use scale_prc, only: &
2563  prc_abort, &
2564  prc_intercomm_child
2565  implicit none
2566 
2567  integer, parameter :: handle = 2
2568 
2569  integer :: isu_tag
2570  integer :: tagbase, tagcomm
2571  integer :: ierr
2572  integer :: iq
2573  !---------------------------------------------------------------------------
2574 
2575  if( .NOT. use_nesting ) return
2576 
2577  tagcomm = intercomm_id(handle) * order_tag_comm
2578 
2579  if( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
2580 
2581  !##### child [receive issue] #####
2582 
2583  call prof_rapstart('NEST_total_C', 2)
2584 
2585  nrecv = nrecv + 1
2586  log_info("COMM_CARTESC_NEST_recvwait_issue_recv",'(1X,A,I5,A)') "NestIDC [C]: que recv ( ", nrecv, " )"
2587 
2588  !*** reset issue tag and request control
2589  !--- do not change the calling order below;
2590  !--- it should be consistent with the order in "COMM_CARTESC_NEST_nestdown"
2591  isu_tag = 0
2592  rq_ctl_d = 0
2593 
2594  tagbase = tagcomm + tag_dens*order_tag_var
2595  call comm_cartesc_nest_issuer_of_receive( tagbase, i_sclr, handle, isu_tag )
2596 
2597  tagbase = tagcomm + tag_momz*order_tag_var
2598  if ( online_use_velz ) then
2599  call comm_cartesc_nest_issuer_of_receive( tagbase, i_zstg, handle, isu_tag )
2600  endif
2601 
2602  tagbase = tagcomm + tag_momx*order_tag_var
2603  if ( online_no_rotate ) then
2604  call comm_cartesc_nest_issuer_of_receive( tagbase, i_xstg, handle, isu_tag )
2605  else
2606  call comm_cartesc_nest_issuer_of_receive( tagbase, i_sclr, handle, isu_tag )
2607  endif
2608 
2609  tagbase = tagcomm + tag_momy*order_tag_var
2610  if ( online_no_rotate ) then
2611  call comm_cartesc_nest_issuer_of_receive( tagbase, i_ystg, handle, isu_tag )
2612  else
2613  call comm_cartesc_nest_issuer_of_receive( tagbase, i_sclr, handle, isu_tag )
2614  endif
2615 
2616  tagbase = tagcomm + tag_rhot*order_tag_var
2617  call comm_cartesc_nest_issuer_of_receive( tagbase, i_sclr, handle, isu_tag )
2618 
2619  do iq = 1, online_recv_qa
2620  tagbase = tagcomm + (tag_qx*10+iq)*order_tag_var
2621  call comm_cartesc_nest_issuer_of_receive( tagbase, i_sclr, handle, isu_tag )
2622  enddo
2623 
2624  rq_tot_d = rq_ctl_d
2625 
2626  call prof_rapend('NEST_total_C', 2)
2627 
2628  else
2629  log_error("COMM_CARTESC_NEST_recvwait_issue_recv",*) 'internal error'
2630  call prc_abort
2631  endif
2632 
2633  return
2634  end subroutine comm_cartesc_nest_recvwait_issue_recv
2635 
2636  !-----------------------------------------------------------------------------
2638  subroutine comm_cartesc_nest_recv_cancel_send
2639  use scale_prc, only: &
2640  prc_abort
2641  implicit none
2642 
2643  integer, parameter :: handle = 1
2644 
2645  !logical :: flag
2646  !integer :: istatus(MPI_STATUS_SIZE)
2647 
2648  integer :: rq
2649  integer :: ierr
2650  !---------------------------------------------------------------------------
2651 
2652  if( .NOT. use_nesting ) return
2653 
2654  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
2655 
2656  !##### parent #####
2657  ! Nothing to do
2658 
2659  else
2660  log_error("COMM_CARTESC_NEST_recv_cancel_send",*) 'internal error'
2661  call prc_abort
2662  endif
2663 
2664  return
2665  end subroutine comm_cartesc_nest_recv_cancel_send
2666 
2667  !-----------------------------------------------------------------------------
2669  subroutine comm_cartesc_nest_recv_cancel_recv
2670  use scale_prc, only: &
2671  prc_abort
2672  implicit none
2673 
2674  integer, parameter :: handle = 2
2675 
2676  !logical :: flag
2677  !integer :: istatus(MPI_STATUS_SIZE)
2678 
2679  integer :: rq
2680  integer :: ierr
2681  !---------------------------------------------------------------------------
2682 
2683  if( .NOT. use_nesting ) return
2684 
2685  if( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
2686 
2687  !##### child #####
2688 
2689  log_info("COMM_CARTESC_NEST_recv_cancel_recv",'(1X,A,I5,A)') "NestIDC [C]: CANCEL recv ( ", nrecv, " )"
2690 
2691  do rq = 1, rq_tot_d
2692  if ( ireq_d(rq) /= mpi_request_null ) then
2693 
2694  call mpi_cancel(ireq_d(rq), ierr)
2695 
2696 ! call MPI_TEST_CANCELLED(istatus, flag, ierr)
2697 ! if ( .NOT. flag ) then
2698 ! LOG_ERROR("COMM_CARTESC_NEST_recv_cancel_recv",*) 'receive actions do not cancelled, req = ', rq
2699 ! endif
2700  endif
2701  enddo
2702 
2703  else
2704  log_error("COMM_CARTESC_NEST_recv_cancel_recv",*) 'internal error'
2705  call prc_abort
2706  endif
2707 
2708  return
2709  end subroutine comm_cartesc_nest_recv_cancel_recv
2710 
2711  !-----------------------------------------------------------------------------
2713  subroutine comm_cartesc_nest_intercomm_nestdown_3d( &
2714  pvar, &
2715  dvar, &
2716  tagbase, &
2717  id_stag, &
2718  HANDLE, &
2719  isu_tag, &
2720  flag_dens )
2721  use scale_prc, only: &
2722  prc_abort, &
2723  prc_intercomm_parent, &
2724  prc_intercomm_child
2725  use scale_comm_cartesc, only: &
2726  comm_datatype
2727  use scale_interp, only: &
2728  interp_interp3d
2729  use scale_atmos_grid_cartesc_real, &
2730  real_cz => atmos_grid_cartesc_real_cz, &
2731  real_fz => atmos_grid_cartesc_real_fz
2732  implicit none
2733 
2734  real(RP), intent(in) :: pvar(:,:,:)
2735  real(RP), intent(out) :: dvar(:,:,:)
2736  integer, intent(in) :: tagbase
2737  integer, intent(in) :: id_stag
2738  integer, intent(in) :: HANDLE
2739  integer, intent(inout) :: isu_tag
2740 
2741  logical , intent(in), optional :: flag_dens
2742 
2743  integer :: tile_num_x
2744 
2745  integer :: ileng, tag, target_rank
2746 
2747  integer :: parent_KA
2748 
2749  integer :: xloc, yloc
2750  integer :: gxs, gxe, gys, gye ! for large domain
2751  integer :: pxs, pxe, pys, pye ! for parent domain
2752  integer :: zs, ze
2753 
2754  integer :: ig, rq, yp
2755  logical :: no_zstag
2756  logical :: spline
2757  logical :: logarithmic
2758 
2759  integer :: ierr
2760  integer :: i, j
2761  !---------------------------------------------------------------------------
2762 
2763  if( .NOT. use_nesting ) return
2764 
2765  logarithmic = .false.
2766  spline = .false.
2767  if ( present(flag_dens) ) then
2768  if( flag_dens ) then
2769  logarithmic = .true.
2770  spline = .true.
2771  end if
2772  endif
2773 
2774  if ( id_stag == i_sclr ) then
2775  no_zstag = .true.
2776  ig = i_sclr
2777  elseif( id_stag == i_zstg ) then
2778  no_zstag = .false.
2779  ig = i_zstg
2780  elseif( id_stag == i_xstg ) then
2781  no_zstag = .true.
2782  ig = i_xstg
2783  elseif( id_stag == i_ystg ) then
2784  no_zstag = .true.
2785  ig = i_ystg
2786  endif
2787 
2788  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
2789  !##### parent #####
2790 
2791  ileng = ka * ia * ja
2792 
2793  rq = rq_ctl_p
2794 
2795  do yp = 1, num_yp
2796  rq = rq + 1
2797 
2798  ! send data to multiple daughter processes
2799  target_rank = comm_cartesc_nest_tile_list_yp(yp)
2800  tag = tagbase + yp
2801 
2802  call mpi_isend( pvar, &
2803  ileng, &
2804  comm_datatype, &
2805  target_rank, &
2806  tag, &
2807  prc_intercomm_child, &
2808  ireq_p(rq), &
2809  ierr )
2810 
2811  dvar(:,:,:) = -1.0_rp ! input as a dummy value
2812  enddo
2813 
2814  rq_ctl_p = rq
2815 
2816  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
2817 
2818  !##### child #####
2819 
2820  parent_ka = dom_info(i_parent)%KMAX + dom_info(i_parent)%KHALO * 2
2821  ileng = parent_ka &
2822  * ( dom_info(i_parent)%IMAX + dom_info(i_parent)%IHALO * 2 ) &
2823  * ( dom_info(i_parent)%JMAX + dom_info(i_parent)%JHALO * 2 )
2824 
2825  tile_num_x = dom_info(i_parent)%tile_num_x
2826 
2827  zs = 1
2828  ze = parent_ka
2829 
2830  pxs = dom_info(i_parent)%IHALO + 1
2831  pxe = dom_info(i_parent)%IMAX + dom_info(i_parent)%IHALO
2832  pys = dom_info(i_parent)%JHALO + 1
2833  pye = dom_info(i_parent)%JMAX + dom_info(i_parent)%JHALO
2834 
2835  rq = rq_ctl_d
2836 
2837  do yp = 1, comm_cartesc_nest_tile_all
2838  rq = rq + 1
2839 
2840  xloc = mod( yp-1, dom_info(i_parent)%TILE_NUM_X ) + 1
2841  yloc = int( real(yp-1) / real(dom_info(i_parent)%TILE_NUM_X) ) + 1
2842 
2843  gxs = dom_info(i_parent)%IMAX * (xloc-1) + 1
2844  gxe = dom_info(i_parent)%IMAX * xloc
2845  gys = dom_info(i_parent)%JMAX * (yloc-1) + 1
2846  gye = dom_info(i_parent)%JMAX * yloc
2847 
2848  isu_tag = isu_tag + 1
2849 
2850  if ( isu_tag > max_isu ) then
2851  log_error("COMM_CARTESC_NEST_intercomm_nestdown_3D",*) 'Exceeded maximum issue'
2852  log_error_cont(*) 'isu_tag = ', isu_tag
2853  call prc_abort
2854  endif
2855 
2856 !OCL XFILL
2857  buffer_ref_3d(zs:ze,gxs:gxe,gys:gye) = recvbuf_3d(zs:ze,pxs:pxe,pys:pye,isu_tag)
2858 
2859  enddo
2860 
2861  rq_ctl_d = rq
2862 
2863  if ( no_zstag ) then
2864  call interp_interp3d( itp_nh, &
2865  tileal_ka, khalo+1, tileal_ka-khalo, &
2866  tileal_ia, tileal_ja, &
2867  ka, ks, ke, ia, ja, &
2868  igrd( :,:,:,ig), & ! [IN]
2869  jgrd( :,:,:,ig), & ! [IN]
2870  hfact( :,:,:,ig), & ! [IN]
2871  kgrd(:,:,:,:,:,ig), & ! [IN]
2872  vfact(:, :,:,:,ig), & ! [IN]
2873  buffer_ref_cz(:,:,:), & ! [IN]
2874  real_cz(:,:,:), & ! [IN]
2875  buffer_ref_3d(:,:,:), & ! [IN]
2876  dvar(:,:,:), & ! [OUT]
2877  spline = spline, & ! [IN, optional]
2878  logwgt = logarithmic ) ! [IN, optional]
2879 
2880  else
2881  call interp_interp3d( itp_nh, &
2882  tileal_ka, khalo, tileal_ka-khalo, &
2883  tileal_ia, tileal_ja, &
2884  ka, ks, ke, ia, ja, &
2885  igrd( :,:,:,ig), & ! [IN]
2886  jgrd( :,:,:,ig), & ! [IN]
2887  hfact( :,:,:,ig), & ! [IN]
2888  kgrd(:,:,:,:,:,ig), & ! [IN]
2889  vfact(:, :,:,:,ig), & ! [IN]
2890  buffer_ref_fz(:,:,:), & ! [IN]
2891  real_fz(1:,:,:), & ! [IN]
2892  buffer_ref_3d(:,:,:), & ! [IN]
2893  dvar(:,:,:), & ! [OUT]
2894  spline = spline, & ! [IN, optional]
2895  logwgt = logarithmic ) ! [IN, optional]
2896  endif
2897 
2898  do j = 1, ja
2899  do i = 1, ia
2900  dvar( 1:ks-1,i,j) = 0.0_rp
2901  dvar(ke+1:ka ,i,j) = 0.0_rp
2902  enddo
2903  enddo
2904 
2905  else
2906  log_error("COMM_CARTESC_NEST_intercomm_nestdown_3D",*) 'internal error'
2907  call prc_abort
2908  endif
2909 
2910  return
2911  end subroutine comm_cartesc_nest_intercomm_nestdown_3d
2912 
2913  !-----------------------------------------------------------------------------
2915  subroutine comm_cartesc_nest_issuer_of_receive_3d( &
2916  tagbase, &
2917  id_stag, &
2918  HANDLE, &
2919  isu_tag )
2920  use scale_prc, only: &
2921  prc_myrank, &
2922  prc_abort, &
2923  prc_intercomm_parent
2924  use scale_comm_cartesc, only: &
2925  comm_datatype
2926  implicit none
2927 
2928  integer, intent(in) :: tagbase
2929  integer, intent(in) :: id_stag
2930  integer, intent(in) :: HANDLE
2931  integer, intent(inout) :: isu_tag
2932 
2933  integer :: ierr, ileng
2934  integer :: tag, target_rank
2935 
2936  integer :: rq, yp
2937  !---------------------------------------------------------------------------
2938 
2939  if( .NOT. use_nesting ) return
2940 
2941  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
2942 
2943  !##### parent #####
2944  ! nothing to do
2945 
2946  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
2947 
2948  !##### child #####
2949 
2950  ileng = ( dom_info(i_parent)%KMAX + dom_info(i_parent)%KHALO * 2 ) &
2951  * ( dom_info(i_parent)%IMAX + dom_info(i_parent)%IHALO * 2 ) &
2952  * ( dom_info(i_parent)%JMAX + dom_info(i_parent)%JHALO * 2 )
2953 
2954  rq = rq_ctl_d
2955 
2956  do yp = 1, comm_cartesc_nest_tile_all
2957  rq = rq + 1
2958 
2959  target_rank = comm_cartesc_nest_tile_list_d(yp,prc_myrank+1)
2960  tag = tagbase + call_order(yp)
2961 
2962  isu_tag = isu_tag + 1
2963 
2964  if ( isu_tag > max_isu ) then
2965  log_error("COMM_CARTESC_NEST_issuer_of_receive_3D",*) 'Exceeded maximum issue'
2966  log_error_cont(*) 'isu_tag = ', isu_tag
2967  call prc_abort
2968  endif
2969 
2970  recvbuf_3d(:,:,:,isu_tag) = 0.0_rp
2971 
2972  call mpi_irecv( recvbuf_3d(:,:,:,isu_tag), &
2973  ileng, &
2974  comm_datatype, &
2975  target_rank, &
2976  tag, &
2977  prc_intercomm_parent, &
2978  ireq_d(rq), &
2979  ierr )
2980 
2981  enddo
2982 
2983  rq_ctl_d = rq
2984 
2985  else
2986  log_error("COMM_CARTESC_NEST_issuer_of_receive_3D",*) 'internal error'
2987  call prc_abort
2988  endif
2989 
2990  return
2991  end subroutine comm_cartesc_nest_issuer_of_receive_3d
2992 
2993  !-----------------------------------------------------------------------------
2995  subroutine comm_cartesc_nest_issuer_of_wait_3d( &
2996  HANDLE )
2997  use scale_prc, only: &
2998  prc_abort
2999  implicit none
3000 
3001  integer, intent(in) :: HANDLE
3002  !---------------------------------------------------------------------------
3003 
3004  if( .NOT. use_nesting ) return
3005 
3006  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
3007 
3008  !##### parent #####
3009  call comm_cartesc_nest_waitall( rq_tot_p, ireq_p(:) )
3010 
3011  elseif( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
3012 
3013  !##### child #####
3014  ! nothing to do
3015 
3016  else
3017  log_error("COMM_CARTESC_NEST_issuer_of_wait_3D",*) 'internal error'
3018  call prc_abort
3019  endif
3020 
3021  return
3022  end subroutine comm_cartesc_nest_issuer_of_wait_3d
3023 
3024  !-----------------------------------------------------------------------------
3026  subroutine comm_cartesc_nest_waitall( &
3027  req_count, &
3028  ireq )
3029  use scale_prc, only: &
3030  prc_abort
3031  implicit none
3032 
3033  integer, intent(in) :: req_count
3034  integer, intent(inout) :: ireq(max_rq)
3035 
3036  integer :: i
3037  integer :: ierr
3038  integer :: istatus(MPI_STATUS_SIZE,req_count)
3039  integer :: req_count2
3040  integer :: ireq2(max_rq)
3041 
3042 ! logical :: flag = .false.
3043 ! integer(8) :: num = 0
3044  !---------------------------------------------------------------------------
3045 
3046  if( .NOT. use_nesting ) return
3047 
3048  req_count2 = 0
3049  do i = 1, req_count
3050  if ( ireq(i) /= mpi_request_null ) then
3051  req_count2 = req_count2 + 1
3052  ireq2(req_count2) = ireq(i)
3053  endif
3054  enddo
3055 
3056  if( req_count2 /= 0 ) call mpi_waitall( req_count2, ireq2(1:req_count2), istatus, ierr )
3057 
3058 ! do while ( .NOT. flag )
3059 ! num = num + 1
3060 ! call MPI_TESTALL( req_count, ireq, flag, istatus, ierr )
3061 !
3062 ! if ( num > ONLINE_WAIT_LIMIT ) then
3063 ! LOG_ERROR("COMM_CARTESC_NEST_waitall",'(1x,A)') 'over the limit of waiting time [NESTCOM]'
3064 ! LOG_ERROR_CONT('(1x,A)') 'over the limit of waiting time [NESTCOM]'
3065 ! call PRC_abort
3066 ! endif
3067 ! enddo
3068 
3069  return
3070  end subroutine comm_cartesc_nest_waitall
3071 
3072  !-----------------------------------------------------------------------------
3074  subroutine comm_cartesc_nest_test_send
3075  use scale_prc, only: &
3076  prc_abort
3077  implicit none
3078 
3079  integer, parameter :: handle = 1
3080 
3081  integer :: istatus(mpi_status_size)
3082  integer :: ierr
3083  logical :: flag
3084  !---------------------------------------------------------------------------
3085 
3086  if( .NOT. use_nesting ) return
3087 
3088  if ( comm_cartesc_nest_filiation( intercomm_id(handle) ) > 0 ) then
3089 
3090  !##### parent #####
3091 
3092  call prof_rapstart('NEST_test_P', 2)
3093  if ( rq_ctl_p > 0 ) call mpi_test(ireq_p(1), flag, istatus, ierr)
3094  call prof_rapend('NEST_test_P', 2)
3095 
3096  else
3097  log_error("COMM_CARTESC_NEST_test_send",*) 'error'
3098  call prc_abort
3099  endif
3100 
3101  return
3102  end subroutine comm_cartesc_nest_test_send
3103 
3104  !-----------------------------------------------------------------------------
3106  subroutine comm_cartesc_nest_test_recv
3107  use scale_prc, only: &
3108  prc_abort
3109  implicit none
3110 
3111  integer, parameter :: handle = 2
3112 
3113  integer :: istatus(mpi_status_size)
3114  integer :: ierr
3115  logical :: flag
3116  !---------------------------------------------------------------------------
3117 
3118  if( .NOT. use_nesting ) return
3119 
3120  if( comm_cartesc_nest_filiation( intercomm_id(handle) ) < 0 ) then
3121 
3122  !##### child #####
3123 
3124  call prof_rapstart('NEST_test_C', 2)
3125  if ( rq_ctl_d > 0 ) call mpi_test(ireq_d(1), flag, istatus, ierr)
3126  call prof_rapend('NEST_test_C', 2)
3127 
3128  else
3129  log_error("COMM_CARTESC_NEST_test_recv",*) 'error'
3130  call prc_abort
3131  endif
3132 
3133  return
3134  end subroutine comm_cartesc_nest_test_recv
3135 
3136  !-----------------------------------------------------------------------------
3138  subroutine comm_cartesc_nest_finalize
3139  implicit none
3140 
3141  integer :: i
3142 
3143  do i = 1, num_dom
3144  if ( allocated( dom_info(i)%latlon_catalogue ) ) deallocate( dom_info(i)%latlon_catalogue )
3145  if ( allocated( dom_info(i)%tile_id ) ) deallocate( dom_info(i)%tile_id )
3146  num_dom = 0
3147  end do
3148 
3149  if ( allocated( comm_cartesc_nest_tile_list_p ) ) deallocate( comm_cartesc_nest_tile_list_p )
3150  if ( allocated( comm_cartesc_nest_tile_list_d ) ) deallocate( comm_cartesc_nest_tile_list_d )
3151  if ( allocated( comm_cartesc_nest_tile_list_yp ) ) deallocate( comm_cartesc_nest_tile_list_yp )
3152 
3153  if ( allocated( ireq_p ) ) deallocate( ireq_p )
3154  if ( allocated( ireq_d ) ) deallocate( ireq_d )
3155 
3156  if ( allocated( call_order ) ) deallocate( call_order )
3157  if ( allocated( recvbuf_3d ) ) deallocate( recvbuf_3d )
3158 
3159  if ( allocated( buffer_ref_lon ) ) deallocate( buffer_ref_lon )
3160  if ( allocated( buffer_ref_lonuy ) ) deallocate( buffer_ref_lonuy )
3161  if ( allocated( buffer_ref_lonxv ) ) deallocate( buffer_ref_lonxv )
3162  if ( allocated( buffer_ref_lat ) ) deallocate( buffer_ref_lat )
3163  if ( allocated( buffer_ref_latuy ) ) deallocate( buffer_ref_latuy )
3164  if ( allocated( buffer_ref_latxv ) ) deallocate( buffer_ref_latxv )
3165  if ( allocated( buffer_ref_cz ) ) deallocate( buffer_ref_cz )
3166  if ( allocated( buffer_ref_fz ) ) deallocate( buffer_ref_fz )
3167  if ( allocated( buffer_ref_3d ) ) deallocate( buffer_ref_3d )
3168 
3169  if ( allocated( org_dens ) ) deallocate( org_dens )
3170  if ( allocated( org_momz ) ) deallocate( org_momz )
3171  if ( allocated( org_momx ) ) deallocate( org_momx )
3172  if ( allocated( org_momy ) ) deallocate( org_momy )
3173  if ( allocated( org_u_ll ) ) deallocate( org_u_ll )
3174  if ( allocated( org_v_ll ) ) deallocate( org_v_ll )
3175  if ( allocated( org_rhot ) ) deallocate( org_rhot )
3176  if ( allocated( org_qtrc ) ) deallocate( org_qtrc )
3177 
3178  if ( allocated( igrd ) ) deallocate( igrd )
3179  if ( allocated( jgrd ) ) deallocate( jgrd )
3180  if ( allocated( hfact ) ) deallocate( hfact )
3181  if ( allocated( kgrd ) ) deallocate( kgrd )
3182  if ( allocated( vfact ) ) deallocate( vfact )
3183 
3184  return
3185  end subroutine comm_cartesc_nest_finalize
3186 
3187 end module scale_comm_cartesc_nest
scale_comm_cartesc_nest::comm_cartesc_nest_interp_level
integer, public comm_cartesc_nest_interp_level
horizontal interpolation level
Definition: scale_comm_cartesC_nest.F90:76
scale_comm_cartesc_nest::comm_cartesc_nest_domain_shape
subroutine, public comm_cartesc_nest_domain_shape(tilei, tilej, cxs, cxe, cys, cye, pxs, pxe, pys, pye, dom_id, iloc, xstg, ystg)
Return shape of ParentDomain at the specified rank (for offline)
Definition: scale_comm_cartesC_nest.F90:1187
scale_comm_cartesc::comm_datatype
integer, public comm_datatype
datatype of variable
Definition: scale_comm_cartesC.F90:105
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
scale_comm_cartesc_nest::comm_cartesc_nest_filiation
integer, dimension(10), public comm_cartesc_nest_filiation
index of parent-daughter relation (p>0, d<0)
Definition: scale_comm_cartesC_nest.F90:73
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_comm_cartesc_nest::handling_num
integer, public handling_num
handing number of nesting relation
Definition: scale_comm_cartesC_nest.F90:74
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_cz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
Definition: scale_atmos_grid_cartesC_real.F90:39
scale_index
module Index
Definition: scale_index.F90:11
scale_atmos_grid_cartesc_index::ihalo
integer, public ihalo
Definition: scale_atmos_grid_cartesC_index.F90:44
scale_file::file_open
subroutine, public file_open(basename, fid, mode, single, allnodes, aggregate, rankid, postfix)
Definition: scale_file.F90:536
scale_comm_cartesc_nest::comm_cartesc_nest_test_recv
subroutine, public comm_cartesc_nest_test_recv
[check communication status] Inter-communication (daughter side)
Definition: scale_comm_cartesC_nest.F90:3107
scale_comm_cartesc_nest::online_no_rotate
logical, public online_no_rotate
Definition: scale_comm_cartesC_nest.F90:84
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lonxv
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lonxv
longitude at staggered point (xv) [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:51
scale_comm_cartesc_nest
module Communication CartesianC nesting
Definition: scale_comm_cartesC_nest.F90:12
scale_interp
module INTERPOLATION
Definition: scale_interp.F90:12
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level, disable_barrier)
Start raptime.
Definition: scale_prof.F90:174
scale_atmos_grid_cartesc_metric
module Atmosphere Grid CartesianC metirc
Definition: scale_atmos_grid_cartesC_metric.F90:12
scale_comm_cartesc_nest::online_recv_diagqhyd
logical, public online_recv_diagqhyd
Definition: scale_comm_cartesC_nest.F90:87
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_atmos_grid_cartesc::atmos_grid_cartesc_fx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fx
face coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:58
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:91
scale_comm_cartesc_nest::online_send_qa
integer, public online_send_qa
number of tracer sent to the daughter domain
Definition: scale_comm_cartesC_nest.F90:90
scale_comm_cartesc_nest::online_parent_nstep
integer, public online_parent_nstep
parent nsteps
Definition: scale_comm_cartesC_nest.F90:93
scale_atmos_grid_cartesc_index::khalo
integer, parameter, public khalo
Definition: scale_atmos_grid_cartesC_index.F90:43
scale_io::io_get_available_fid
integer function, public io_get_available_fid()
search & get available file ID
Definition: scale_io.F90:373
scale_atmos_hydrometeor::atmos_hydrometeor_dry
logical, public atmos_hydrometeor_dry
Definition: scale_atmos_hydrometeor.F90:114
scale_atmos_grid_cartesc_index::imaxg
integer, public imaxg
Definition: scale_atmos_grid_cartesC_index.F90:72
scale_atmos_grid_cartesc_real
module Atmosphere GRID CartesC Real(real space)
Definition: scale_atmos_grid_cartesC_real.F90:11
scale_comm_cartesc_nest::comm_cartesc_nest_parent_info
subroutine, public comm_cartesc_nest_parent_info(dom_id, KMAX, LKMAX, IMAXG, JMAXG, num_tile, tile_id)
Return infomation of parent domain (for offline)
Definition: scale_comm_cartesC_nest.F90:1130
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lon
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lon
longitude [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:49
scale_file
module file
Definition: scale_file.F90:15
scale_atmos_grid_cartesc_index::imax
integer, public imax
Definition: scale_atmos_grid_cartesC_index.F90:37
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_domain_catalogue
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_domain_catalogue
domain latlon catalogue [rad]
Definition: scale_atmos_grid_cartesC_real.F90:93
scale_comm_cartesc_nest::domain_info
Definition: scale_comm_cartesC_nest.F90:51
scale_atmos_grid_cartesc_index::jmaxg
integer, public jmaxg
Definition: scale_atmos_grid_cartesC_index.F90:73
scale_comm_cartesc_nest::comm_cartesc_nest_nestdown_recv
subroutine, public comm_cartesc_nest_nestdown_recv(DENS_recv, VELZ_recv, VELX_recv, VELY_recv, POTT_recv, QTRC_recv)
Boundary data transfer from parent to daughter: nestdown (daughter side)
Definition: scale_comm_cartesC_nest.F90:2237
scale_comm_cartesc_nest::comm_cartesc_nest_nestdown_send
subroutine, public comm_cartesc_nest_nestdown_send(DENS_send, MOMZ_send, MOMX_send, MOMY_send, RHOT_send, QTRC_send)
Boundary data transfer from parent to daughter: nestdown (parent side)
Definition: scale_comm_cartesC_nest.F90:2043
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_comm_cartesc_nest::comm_cartesc_nest_setup
subroutine, public comm_cartesc_nest_setup(QA_MP, MP_TYPE_in)
Setup.
Definition: scale_comm_cartesC_nest.F90:239
scale_comm_cartesc_nest::online_iam_parent
logical, public online_iam_parent
a flag to say "I am a parent"
Definition: scale_comm_cartesC_nest.F90:80
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_mapprojection
module Map projection
Definition: scale_mapprojection.F90:12
scale_io::io_get_fname
subroutine, public io_get_fname(outstr, instr, rank, ext, len)
generate process specific filename
Definition: scale_io.F90:421
scale_io
module STDIO
Definition: scale_io.F90:10
scale_comm_cartesc_nest::online_send_diagqhyd
logical, public online_send_diagqhyd
Definition: scale_comm_cartesC_nest.F90:88
scale_comm_cartesc_nest::comm_cartesc_nest_domain_relate
subroutine comm_cartesc_nest_domain_relate(dom_id)
Solve relationship between ParentDomain & Daughter Domain.
Definition: scale_comm_cartesC_nest.F90:1018
scale_comm_cartesc_nest::online_boundary_use_qhyd
logical, public online_boundary_use_qhyd
Definition: scale_comm_cartesC_nest.F90:85
scale_comm_cartesc_nest::comm_cartesc_nest_finalize
subroutine, public comm_cartesc_nest_finalize
finalize
Definition: scale_comm_cartesC_nest.F90:3139
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:45
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_comm_cartesc_nest::comm_cartesc_nest_recv_cancel_send
subroutine, public comm_cartesc_nest_recv_cancel_send
Sub-command for data transfer from parent to daughter: nestdown (parent side)
Definition: scale_comm_cartesC_nest.F90:2639
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_comm_cartesc_nest::comm_cartesc_nest_domain_regist_file
subroutine, public comm_cartesc_nest_domain_regist_file(dom_id, PARENT_BASENAME, PARENT_PRC_NUM_X, PARENT_PRC_NUM_Y, LATLON_CATALOGUE_FNAME)
offline setup
Definition: scale_comm_cartesC_nest.F90:708
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_latuv
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_latuv
latitude at staggered point (uv) [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:56
scale_atmos_grid_cartesc_index::kmax
integer, public kmax
Definition: scale_atmos_grid_cartesC_index.F90:36
scale_comm_cartesc_nest::comm_cartesc_nest_recvwait_issue_send
subroutine, public comm_cartesc_nest_recvwait_issue_send
Sub-command for data transfer from parent to daughter: nestdown (parent side)
Definition: scale_comm_cartesC_nest.F90:2513
scale_atmos_grid_cartesc::atmos_grid_cartesc_fy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fy
face coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:59
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_latuy
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_latuy
latitude at staggered point (uy) [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:54
scale_prc_cartesc
module process / cartesC
Definition: scale_prc_cartesC.F90:11
scale_comm_cartesc_nest::comm_cartesc_nest_recvwait_issue_recv
subroutine, public comm_cartesc_nest_recvwait_issue_recv
Sub-command for data transfer from parent to daughter: nestdown (daughter side)
Definition: scale_comm_cartesC_nest.F90:2562
scale_io::h_short
integer, parameter, public h_short
Character length (short=16)
Definition: scale_io.F90:45
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_comm_cartesc_nest::online_iam_daughter
logical, public online_iam_daughter
a flag to say "I am a daughter"
Definition: scale_comm_cartesC_nest.F90:81
scale_atmos_grid_cartesc_index::jhalo
integer, public jhalo
Definition: scale_atmos_grid_cartesC_index.F90:45
scale_comm_cartesc_nest::online_recv_qa
integer, public online_recv_qa
number of tracer received from the parent domain
Definition: scale_comm_cartesC_nest.F90:89
scale_precision::dp
integer, parameter, public dp
Definition: scale_precision.F90:32
scale_file_h
module file_h
Definition: scale_file_h.F90:11
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_time
module TIME
Definition: scale_time.F90:11
scale_interp::interp_interp3d
subroutine, public interp_interp3d(npoints, KA_ref, KS_ref, KE_ref, IA_ref, JA_ref, KA, KS, KE, IA, JA, idx_i, idx_j, hfact, idx_k, vfact, hgt_ref, hgt, val_ref, val, spline, logwgt, threshold_undef, wsum, val2)
Definition: scale_interp.F90:1469
scale_comm_cartesc_nest::online_domain_num
integer, public online_domain_num
Definition: scale_comm_cartesC_nest.F90:82
scale_prc::prc_global_domainid
integer, public prc_global_domainid
my domain ID in global communicator
Definition: scale_prc.F90:85
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
scale_comm_cartesc::comm_world
integer, public comm_world
communication world ID
Definition: scale_comm_cartesC.F90:106
scale_comm_cartesc_nest::online_daughter_nprocs
integer, public online_daughter_nprocs
Definition: scale_comm_cartesC_nest.F90:95
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_latxv
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_latxv
latitude at staggered point (xv) [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:55
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
scale_prc::prc_intercomm_child
integer, public prc_intercomm_child
communicator between this rank and child domain
Definition: scale_prc.F90:97
scale_prc::prc_nprocs
integer, public prc_nprocs
myrank in local communicator
Definition: scale_prc.F90:90
scale_comm_cartesc_nest::comm_cartesc_nest_test_send
subroutine, public comm_cartesc_nest_test_send
[check communication status] Inter-communication (parent side)
Definition: scale_comm_cartesC_nest.F90:3075
scale_debug
module DEBUG
Definition: scale_debug.F90:11
scale_prc::prc_intercomm_parent
integer, public prc_intercomm_parent
communicator between this rank and parent domain
Definition: scale_prc.F90:96
scale_comm_cartesc_nest::online_use_velz
logical, public online_use_velz
Definition: scale_comm_cartesC_nest.F90:83
scale_time::time_dtsec
real(dp), public time_dtsec
time interval of model [sec]
Definition: scale_time.F90:33
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lonuv
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lonuv
longitude at staggered point (uv) [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:52
scale_comm_cartesc_nest::use_nesting
logical, public use_nesting
Definition: scale_comm_cartesC_nest.F90:79
scale_atmos_grid_cartesc_index::jmax
integer, public jmax
Definition: scale_atmos_grid_cartesC_index.F90:38
scale_atmos_grid_cartesc_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:55
scale_prc_cartesc::prc_num_y
integer, public prc_num_y
y length of 2D processor topology
Definition: scale_prc_cartesC.F90:43
scale_atmos_grid_cartesc::atmos_grid_cartesc_cy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:57
scale_comm_cartesc_nest::comm_cartesc_nest_waitall
subroutine comm_cartesc_nest_waitall(req_count, ireq)
[substance of comm_wait] Inter-communication
Definition: scale_comm_cartesC_nest.F90:3029
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level, disable_barrier)
Save raptime.
Definition: scale_prof.F90:246
scale_interp::interp_setup
subroutine, public interp_setup(weight_order, search_limit)
Setup.
Definition: scale_interp.F90:90
scale_comm_cartesc_nest::comm_cartesc_nest_issuer_of_receive_3d
subroutine comm_cartesc_nest_issuer_of_receive_3d(tagbase, id_stag, HANDLE, isu_tag)
[substance of issuer] Inter-communication from parent to daughter: nestdown
Definition: scale_comm_cartesC_nest.F90:2920
scale_const::const_d2r
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:33
scale_comm_cartesc_nest::comm_cartesc_nest_issuer_of_wait_3d
subroutine comm_cartesc_nest_issuer_of_wait_3d(HANDLE)
[substance of issuer] Inter-communication from parent to daughter: nestdown
Definition: scale_comm_cartesC_nest.F90:2997
scale_prc_cartesc::prc_num_x
integer, public prc_num_x
x length of 2D processor topology
Definition: scale_prc_cartesC.F90:42
scale_comm_cartesc_nest::comm_cartesc_nest_intercomm_nestdown_3d
subroutine comm_cartesc_nest_intercomm_nestdown_3d(pvar, dvar, tagbase, id_stag, HANDLE, isu_tag, flag_dens)
Inter-communication from parent to daughter: nestdown.
Definition: scale_comm_cartesC_nest.F90:2721
scale_time::time_nstep
integer, public time_nstep
total steps [number]
Definition: scale_time.F90:74
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lat
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lat
latitude [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:53
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_fz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
Definition: scale_atmos_grid_cartesC_real.F90:43
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_comm_cartesc_nest::online_parent_dtsec
real(dp), public online_parent_dtsec
parent DT [sec]
Definition: scale_comm_cartesC_nest.F90:92
scale_debug::debug_domain_num
integer, public debug_domain_num
Definition: scale_debug.F90:41
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_atmos_hydrometeor::n_hyd
integer, parameter, public n_hyd
Definition: scale_atmos_hydrometeor.F90:95
scale_comm_cartesc_nest::comm_cartesc_nest_recv_cancel_recv
subroutine, public comm_cartesc_nest_recv_cancel_recv
Sub-command for data transfer from parent to daughter: nestdown (daughter side)
Definition: scale_comm_cartesC_nest.F90:2670
scale_atmos_grid_cartesc::atmos_grid_cartesc_cx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cx
center coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:56
scale_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:92
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lonuy
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lonuy
longitude at staggered point (uy) [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:50
scale_comm_cartesc_nest::comm_cartesc_nest_interp_weight_order
integer, public comm_cartesc_nest_interp_weight_order
horizontal interpolation weight order
Definition: scale_comm_cartesC_nest.F90:77
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_rotc
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_metric_rotc
rotation coefficient
Definition: scale_atmos_grid_cartesC_metric.F90:36
Generated by   doxygen 1.8.17