SCALE-RM
scale_comm_cartesC.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module scale_comm_cartesc
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use mpi
17  use iso_c_binding
18  use scale_precision
19  use scale_io
20  use scale_prof
21  use scale_tracer
22 #ifdef _OPENACC
23  use openacc
24 #endif
25 
26  use scale_prc, only: &
27  prc_abort
28  use scale_prc_cartesc, only: &
29  prc_next, &
30  prc_w, &
31  prc_n, &
32  prc_e, &
33  prc_s, &
34  prc_nw, &
35  prc_ne, &
36  prc_sw, &
37  prc_se, &
38  prc_has_w, &
39  prc_has_n, &
40  prc_has_e, &
41  prc_has_s
42  !-----------------------------------------------------------------------------
43  implicit none
44  private
45  !-----------------------------------------------------------------------------
46  !
47  !++ Public procedure
48  !
49  public :: comm_setup
50  public :: comm_regist
51  public :: comm_finalize
52  public :: comm_vars_init
53  public :: comm_vars8_init
54  public :: comm_vars
55  public :: comm_vars8
56  public :: comm_wait
57  public :: comm_gather
58  public :: comm_bcast
59 
60  interface comm_vars
61  module procedure comm_vars_2d
62  module procedure comm_vars_3d
63  end interface comm_vars
64 
65  interface comm_vars8
66  module procedure comm_vars8_2d
67  module procedure comm_vars8_3d
68  end interface comm_vars8
69 
70  interface comm_wait
71  module procedure comm_wait_2d
72  module procedure comm_wait_3d
73  end interface comm_wait
74 
75  interface comm_gather
76  module procedure comm_gather_2d
77  module procedure comm_gather_3d
78  end interface comm_gather
79 
80  interface comm_bcast
81  module procedure comm_bcast_scr_sp
82  module procedure comm_bcast_scr_dp
83  module procedure comm_bcast_1d_sp
84  module procedure comm_bcast_1d_dp
85  module procedure comm_bcast_2d_sp
86  module procedure comm_bcast_2d_dp
87  module procedure comm_bcast_3d_sp
88  module procedure comm_bcast_3d_dp
89  module procedure comm_bcast_4d_sp
90  module procedure comm_bcast_4d_dp
91  module procedure comm_bcast_int_scr
92  module procedure comm_bcast_int_1d
93  module procedure comm_bcast_int_2d
94  module procedure comm_bcast_logical_scr
95  module procedure comm_bcast_logical_1d
96  module procedure comm_bcast_character
97  end interface comm_bcast
98 
99  !-----------------------------------------------------------------------------
100  !
101  !++ Public parameters & variables
102  !
103  integer, public :: comm_datatype
104  integer, public :: comm_world
105 
106  !-----------------------------------------------------------------------------
107  !
108  !++ Private procedure
109  !
110  !-----------------------------------------------------------------------------
111  !
112  !++ Private parameters & variables
113  !
114  integer, private :: comm_vsize_max
115  integer, private :: comm_vsize_max_pc
116 
117  logical, private :: comm_isallperiodic
118 
119  logical, private :: comm_use_mpi_pc = .true.
120 #ifdef ___FUJITSU
121  logical, private :: comm_use_mpi_onesided = .true.
122 #else
123  logical, private :: comm_use_mpi_onesided = .false.
124 #endif
125 
126 #ifdef _OPENACC
127  type ptr_t
128  real(rp), pointer :: ptr(:,:,:)
129  end type ptr_t
130 #endif
131  type ginfo_t
132  integer :: ka
133  integer :: ia, is, ie, ihalo
134  integer :: ja, js, je, jhalo
135  integer :: nreq_max
136  integer :: size2d_ns4
137  integer :: size2d_ns8
138  integer :: size2d_we
139  integer :: size2d_4c
140  integer :: vars_num = 0
141  real(rp), pointer :: recvpack_we2p(:,:,:)
142  real(rp), pointer :: sendpack_p2we(:,:,:)
143  type(c_ptr), allocatable :: recvbuf_we(:)
144  type(c_ptr), allocatable :: recvbuf_ns(:)
145  integer, allocatable :: req_cnt (:)
146  integer, allocatable :: req_list(:,:)
147  integer, allocatable :: preq_cnt (:)
148  integer, allocatable :: preq_list(:,:)
149  integer, allocatable :: packid(:)
150  integer, allocatable :: win_packwe(:)
151  integer, allocatable :: win_packns(:)
152 #ifdef DEBUG
153  logical, allocatable :: use_packbuf(:)
154 #endif
155 #ifdef _OPENACC
156  logical, allocatable :: device_alloc(:)
157  type(ptr_t), allocatable :: device_ptr(:)
158 #endif
159  end type ginfo_t
160 
161  integer, private, parameter :: comm_gid_max = 20
162  integer, private :: comm_gid
163  type(ginfo_t), private, save :: ginfo(comm_gid_max)
164 
165  integer, private :: group_packwe
166  integer, private :: group_packns
167  logical, private :: group_packwe_created = .false.
168  logical, private :: group_packns_created = .false.
169 
170  logical, private :: initialized = .false.
171 
172  !-----------------------------------------------------------------------------
173 contains
174 
175  !-----------------------------------------------------------------------------
177  subroutine comm_setup
178  use scale_prc, only: &
179  prc_local_comm_world
180  use scale_prc_cartesc, only: &
181  prc_twod
182  implicit none
183 
184  namelist / param_comm_cartesc / &
185  comm_vsize_max, &
186  comm_vsize_max_pc, &
187  comm_use_mpi_pc, &
188  comm_use_mpi_onesided
189 
190  integer :: group, ranks(8)
191  integer :: n, m
192 
193  integer :: ierr
194  !---------------------------------------------------------------------------
195 
196  if ( initialized ) return
197 
198  log_newline
199  log_info("COMM_setup",*) 'Setup'
200 
201  comm_vsize_max = max( 10 + qa*2, 25 )
202  comm_vsize_max_pc = 50 + qa*2
203 
204 #ifdef _OPENACC
205  comm_use_mpi_onesided = .false.
206 #endif
207 
208  !--- read namelist
209  rewind(io_fid_conf)
210  read(io_fid_conf,nml=param_comm_cartesc,iostat=ierr)
211  if( ierr < 0 ) then !--- missing
212  log_info("COMM_setup",*) 'Not found namelist. Default used.'
213  elseif( ierr > 0 ) then !--- fatal error
214  log_error("COMM_setup",*) 'Not appropriate names in namelist PARAM_COMM_CARTESC. Check!'
215  call prc_abort
216  endif
217  log_nml(param_comm_cartesc)
218 
219  if ( prc_has_n .AND. prc_has_s .AND. prc_has_w .AND. prc_has_e ) then
220  comm_isallperiodic = .true.
221  else
222  comm_isallperiodic = .false.
223  endif
224 
225  if ( rp == kind(0.d0) ) then
226  comm_datatype = mpi_double_precision
227  elseif( rp == kind(0.0) ) then
228  comm_datatype = mpi_real
229  else
230  log_error("COMM_setup",*) 'precision is not supportd'
231  call prc_abort
232  endif
233 
234  comm_world = prc_local_comm_world
235  comm_gid = 0
236 
237 #ifdef _OPENACC
238  if ( comm_use_mpi_onesided ) then
239  log_warn("COMM_setup",*) "Open MPI does not support one-sided APIs with CUDA-aware UCX"
240  end if
241 #endif
242 
243  if ( comm_use_mpi_onesided ) then
244 
245  comm_use_mpi_pc = .false.
246 
247  call mpi_comm_group( comm_world, group, ierr )
248 
249  n = 0
250  if ( prc_has_s ) then
251  n = 1
252  ranks(n) = prc_next(prc_s)
253  end if
254  if ( prc_has_n ) then
255  do m = 1, n
256  if ( ranks(m) == prc_next(prc_n) ) exit
257  end do
258  if ( m == n + 1 ) then
259  n = n + 1
260  ranks(n) = prc_next(prc_n)
261  end if
262  end if
263  if ( prc_has_n .and. prc_has_w ) then
264  do m = 1, n
265  if ( ranks(m) == prc_next(prc_nw) ) exit
266  end do
267  if ( m == n + 1 ) then
268  n = n + 1
269  ranks(n) = prc_next(prc_nw)
270  end if
271  else if ( prc_has_n ) then
272  do m = 1, n
273  if ( ranks(m) == prc_next(prc_n) ) exit
274  end do
275  if ( m == n + 1 ) then
276  n = n + 1
277  ranks(n) = prc_next(prc_n)
278  end if
279  else if ( prc_has_w ) then
280  do m = 1, n
281  if ( ranks(m) == prc_next(prc_w) ) exit
282  end do
283  if ( m == n + 1 ) then
284  n = n + 1
285  ranks(n) = prc_next(prc_w)
286  end if
287  end if
288  if ( prc_has_n .and. prc_has_e ) then
289  do m = 1, n
290  if ( ranks(m) == prc_next(prc_ne) ) exit
291  end do
292  if ( m == n + 1 ) then
293  n = n + 1
294  ranks(n) = prc_next(prc_ne)
295  end if
296  else if ( prc_has_n ) then
297  do m = 1, n
298  if ( ranks(m) == prc_next(prc_n) ) exit
299  end do
300  if ( m == n + 1 ) then
301  n = n + 1
302  ranks(n) = prc_next(prc_n)
303  end if
304  else if ( prc_has_e ) then
305  do m = 1, n
306  if ( ranks(m) == prc_next(prc_e) ) exit
307  end do
308  if ( m == n + 1 ) then
309  n = n + 1
310  ranks(n) = prc_next(prc_e)
311  end if
312  end if
313  if ( prc_has_s .and. prc_has_w ) then
314  do m = 1, n
315  if ( ranks(m) == prc_next(prc_sw) ) exit
316  end do
317  if ( m == n + 1 ) then
318  n = n + 1
319  ranks(n) = prc_next(prc_sw)
320  end if
321  else if ( prc_has_s ) then
322  do m = 1, n
323  if ( ranks(m) == prc_next(prc_s) ) exit
324  end do
325  if ( m == n + 1 ) then
326  n = n + 1
327  ranks(n) = prc_next(prc_s)
328  end if
329  else if ( prc_has_w ) then
330  do m = 1, n
331  if ( ranks(m) == prc_next(prc_w) ) exit
332  end do
333  if ( m == n + 1 ) then
334  n = n + 1
335  ranks(n) = prc_next(prc_w)
336  end if
337  end if
338  if ( prc_has_s .and. prc_has_e ) then
339  do m = 1, n
340  if ( ranks(m) == prc_next(prc_se) ) exit
341  end do
342  if ( m == n + 1 ) then
343  n = n + 1
344  ranks(n) = prc_next(prc_se)
345  end if
346  else if ( prc_has_s ) then
347  do m = 1, n
348  if ( ranks(m) == prc_next(prc_s) ) exit
349  end do
350  if ( m == n + 1 ) then
351  n = n + 1
352  ranks(n) = prc_next(prc_s)
353  end if
354  else if ( prc_has_e ) then
355  do m = 1, n
356  if ( ranks(m) == prc_next(prc_e) ) exit
357  end do
358  if ( m == n + 1 ) then
359  n = n + 1
360  ranks(n) = prc_next(prc_e)
361  end if
362  end if
363  if ( n > 0 ) then
364  call mpi_group_incl( group, n, ranks, group_packns, ierr )
365  group_packns_created = .true.
366  else
367  group_packns_created = .false.
368  end if
369 
370  n = 0
371  if ( .not. prc_twod ) then
372  if ( prc_has_w ) then
373  n = 1
374  ranks(n) = prc_next(prc_w)
375  end if
376  if ( prc_has_e ) then
377  if ( n == 0 .or. ranks(1) .ne. prc_next(prc_e) ) then
378  n = n + 1
379  ranks(n) = prc_next(prc_e)
380  end if
381  end if
382  end if
383  if ( n > 0 ) then
384  call mpi_group_incl( group, n, ranks, group_packwe, ierr )
385  group_packwe_created = .true.
386  else
387  group_packwe_created = .false.
388  end if
389 
390  call mpi_group_free( group, ierr )
391  end if
392 
393  log_newline
394  log_info("COMM_setup",*) 'Communication information'
395  log_info_cont(*) 'Maximum number of vars for one communication: ', comm_vsize_max
396  log_info_cont(*) 'All side is periodic? : ', comm_isallperiodic
397 
398 
399  initialized = .true.
400 
401  return
402  end subroutine comm_setup
403 
404  !-----------------------------------------------------------------------------
406  subroutine comm_regist( &
407  KA, IA, JA, IHALO, JHALO, &
408  gid )
409  implicit none
410 
411  integer, intent(in) :: ka, ia, ja, ihalo, jhalo
412  integer, intent(out) :: gid
413 
414  integer :: imax, jmax
415  integer :: nreq_ns, nreq_we, nreq_4c
416 
417  integer :: win_info
418  integer(kind=MPI_ADDRESS_KIND) :: size
419 
420  integer :: ierr
421  integer :: n
422 
423  if ( .not. initialized ) then
424  log_error("COMM_regist",*) 'COMM_setup must be called before calling COMM_regist'
425  call prc_abort
426  end if
427 
428  comm_gid = comm_gid + 1
429  if ( comm_gid > comm_gid_max ) then
430  log_error("COMM_regist",*) 'number of registed grid size exceeds the limit'
431  call prc_abort
432  end if
433  gid = comm_gid
434 
435  if ( ia < ihalo * 3 ) then
436  log_error("COMM_regist",*) 'IA must be >= IHALO * 3'
437  call prc_abort
438  end if
439  if ( ja < jhalo * 3 ) then
440  log_error("COMM_regist",*) 'JA must be >= JHALO * 3'
441  call prc_abort
442  end if
443 
444  imax = ia - ihalo * 2
445  jmax = ja - jhalo * 2
446 
447  ginfo(gid)%KA = ka
448  ginfo(gid)%IA = ia
449  ginfo(gid)%IS = ihalo + 1
450  ginfo(gid)%IE = ia - ihalo
451  ginfo(gid)%IHALO = ihalo
452  ginfo(gid)%JA = ja
453  ginfo(gid)%JS = jhalo + 1
454  ginfo(gid)%JE = ja - jhalo
455  ginfo(gid)%JHALO = jhalo
456 
457  nreq_ns = 2 * jhalo !--- send x JHALO, recv x JHALO
458  nreq_we = 2 !--- send x 1 , recv x 1
459  nreq_4c = 2 * jhalo !--- send x JHALO, recv x JHALO
460 
461  if ( comm_use_mpi_pc ) then
462  ginfo(gid)%nreq_MAX = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c + 1
463  else
464  ginfo(gid)%nreq_MAX = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c
465  end if
466 
467  ginfo(gid)%size2D_NS4 = ia * jhalo
468  ginfo(gid)%size2D_NS8 = imax
469  ginfo(gid)%size2D_WE = jmax * ihalo
470  ginfo(gid)%size2D_4C = ihalo
471 
472  allocate( ginfo(gid)%sendpack_P2WE(ginfo(gid)%size2D_WE * ka, 2, comm_vsize_max) )
473  !$acc enter data create(ginfo(gid)%sendpack_P2WE)
474 
475 #ifdef DEBUG
476  allocate( ginfo(gid)%use_packbuf(comm_vsize_max) )
477  ginfo(gid)%use_packbuf(:) = .false.
478 #endif
479 
480 #ifdef _OPENACC
481  allocate( ginfo(gid)%device_alloc(comm_vsize_max+comm_vsize_max_pc) )
482  allocate( ginfo(gid)%device_ptr(comm_vsize_max+1:comm_vsize_max_pc) )
483  ginfo(gid)%device_alloc(:) = .false.
484 #endif
485 
486  if ( comm_use_mpi_onesided ) then
487 
488  allocate( ginfo(gid)%recvbuf_WE(comm_vsize_max) )
489  allocate( ginfo(gid)%recvbuf_NS(comm_vsize_max) )
490 
491  allocate( ginfo(gid)%win_packWE(comm_vsize_max) )
492  allocate( ginfo(gid)%win_packNS(comm_vsize_max) )
493 
494  call mpi_info_create(win_info, ierr)
495  call mpi_info_set(win_info, "no_locks", "true", ierr)
496  call mpi_info_set(win_info, "same_size", "true", ierr)
497  call mpi_info_set(win_info, "same_disp_unit", "true", ierr)
498 
499  do n = 1, comm_vsize_max
500  size = ginfo(gid)%size2D_WE * ka * 2 * rp
501 #ifdef _OPENACC
502  block
503  real(rp), pointer :: pack(:)
504  call mpi_alloc_mem(size, mpi_info_null, ginfo(gid)%recvbuf_WE(n), ierr)
505  call c_f_pointer(ginfo(gid)%recvbuf_WE(n), pack, (/ size/rp /))
506  !$acc enter data create(pack)
507  !$acc host_data use_device(pack)
508  call mpi_win_create(pack, size, ginfo(gid)%size2D_WE*ka*rp, &
509  win_info, comm_world, &
510  ginfo(gid)%win_packWE(n), ierr)
511  !$acc end host_data
512  end block
513 #else
514  call mpi_win_allocate(size, ginfo(gid)%size2D_WE*ka*rp, &
515  win_info, comm_world, &
516  ginfo(gid)%recvbuf_WE(n), ginfo(gid)%win_packWE(n), ierr)
517 #endif
518  size = ginfo(gid)%size2D_NS4 * ka * 2 * rp
519 #ifdef _OPENACC
520  block
521  real(rp), pointer :: pack(:)
522  call mpi_alloc_mem(size, mpi_info_null, ginfo(gid)%recvbuf_NS(n), ierr)
523  call c_f_pointer(ginfo(gid)%recvbuf_NS(n), pack, (/ size/rp /))
524  !$acc enter data create(pack)
525  !$acc host_data use_device(pack)
526  call mpi_win_create(pack, size, rp, &
527  win_info, comm_world, &
528  ginfo(gid)%win_packNS(n), ierr)
529  !$acc end host_data
530  end block
531 #else
532  call mpi_win_allocate(size, rp, &
533  win_info, comm_world, &
534  ginfo(gid)%recvbuf_NS(n), ginfo(gid)%win_packNS(n), ierr)
535 #endif
536  end do
537 
538  call mpi_info_free(win_info, ierr)
539 
540  do n = 1, comm_vsize_max
541  call mpi_win_post( group_packwe, mpi_mode_nostore, ginfo(gid)%win_packWE(n), ierr )
542  call mpi_win_post( group_packns, mpi_mode_nostore, ginfo(gid)%win_packNS(n), ierr )
543  end do
544 
545  ginfo(gid)%vars_num = 0
546  allocate( ginfo(gid)%packid(comm_vsize_max_pc) )
547 
548  else
549 
550  allocate( ginfo(gid)%recvpack_WE2P(ginfo(gid)%size2D_WE * ka, 2, comm_vsize_max) )
551  !$acc enter data create(ginfo(gid)%recvpack_WE2P)
552 
553  allocate( ginfo(gid)%req_cnt ( comm_vsize_max) )
554  allocate( ginfo(gid)%req_list(ginfo(gid)%nreq_MAX, comm_vsize_max) )
555  ginfo(gid)%req_cnt (:) = -1
556  ginfo(gid)%req_list(:,:) = mpi_request_null
557 
558  if ( comm_use_mpi_pc ) then
559  ginfo(gid)%vars_num = 0
560  allocate( ginfo(gid)%packid(comm_vsize_max_pc) )
561  allocate( ginfo(gid)%preq_cnt ( comm_vsize_max_pc) )
562  allocate( ginfo(gid)%preq_list(ginfo(gid)%nreq_MAX+1,comm_vsize_max_pc) )
563  ginfo(gid)%preq_cnt (:) = -1
564  ginfo(gid)%preq_list(:,:) = mpi_request_null
565  end if
566 
567  end if
568 
569 
570  log_newline
571  log_info("COMM_regist",*) 'Register grid: id=', gid
572  log_info_cont(*) 'Data size of var (3D,including halo) [byte] : ', rp*ka*ia*ja
573  log_info_cont(*) 'Data size of halo [byte] : ', rp*ka*(2*ia*jhalo+2*jmax*ihalo)
574  log_info_cont(*) 'Ratio of halo against the whole 3D grid : ', real(2*ia*jhalo+2*jmax*ihalo) / real(ia*ja)
575 
576  return
577  end subroutine comm_regist
578 
579  !-----------------------------------------------------------------------------
581  subroutine comm_finalize
582  use mpi
583  implicit none
584 
585  integer :: gid
586  integer :: i, j, ierr
587  !---------------------------------------------------------------------------
588 
589  do gid = 1, comm_gid
590 
591  if ( comm_use_mpi_onesided ) then
592 
593  do i = 1, comm_vsize_max
594  call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(i), ierr )
595  call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(i), ierr )
596  end do
597 
598  do i = 1, comm_vsize_max
599  call mpi_win_complete( ginfo(gid)%win_packWE(i), ierr )
600  call mpi_win_complete( ginfo(gid)%win_packNS(i), ierr )
601  end do
602 
603  do i = 1, comm_vsize_max
604  call mpi_win_wait( ginfo(gid)%win_packWE(i), ierr )
605  call mpi_win_wait( ginfo(gid)%win_packNS(i), ierr )
606  end do
607 
608  do i = 1, comm_vsize_max
609  call mpi_win_free(ginfo(gid)%win_packWE(i), ierr)
610  call mpi_win_free(ginfo(gid)%win_packNS(i), ierr)
611 #ifdef _OPENACC
612  block
613  real(rp), pointer :: pack(:)
614  integer :: ka
615  ka = ginfo(gid)%KA
616  call c_f_pointer( ginfo(gid)%recvbuf_WE(i), pack, (/ginfo(gid)%size2D_WE*ka*2/) )
617  !$acc exit data delete(pack)
618  call c_f_pointer( ginfo(gid)%recvbuf_NS(i), pack, (/ginfo(gid)%size2D_NS4*ka*2/) )
619  !$acc exit data delete(pack)
620  end block
621  call mpi_free_mem(ginfo(gid)%recvbuf_WE(i), ierr)
622  call mpi_free_mem(ginfo(gid)%recvbuf_NS(i), ierr)
623 #endif
624  end do
625 
626  deallocate( ginfo(gid)%packid )
627  ginfo(gid)%vars_num = 0
628 
629  deallocate( ginfo(gid)%win_packWE )
630  deallocate( ginfo(gid)%win_packNS )
631 
632  deallocate( ginfo(gid)%recvbuf_WE )
633  deallocate( ginfo(gid)%recvbuf_NS )
634 
635  else
636 
637  if ( comm_use_mpi_pc ) then
638 
639  do j = 1, comm_vsize_max_pc
640  do i = 1, ginfo(gid)%nreq_MAX+1
641  if (ginfo(gid)%preq_list(i,j) .NE. mpi_request_null) &
642  call mpi_request_free(ginfo(gid)%preq_list(i,j), ierr)
643  enddo
644 #ifdef _OPENACC
645  if ( ginfo(gid)%device_alloc(j+comm_vsize_max) ) then
646  !$acc exit data delete(ginfo(gid)%device_ptr(j+COMM_vsize_max)%ptr)
647  end if
648 #endif
649  enddo
650  deallocate( ginfo(gid)%preq_cnt )
651  deallocate( ginfo(gid)%preq_list )
652  deallocate( ginfo(gid)%packid )
653  ginfo(gid)%vars_num = 0
654 
655  end if
656 
657  deallocate( ginfo(gid)%req_cnt )
658  deallocate( ginfo(gid)%req_list )
659 
660  !$acc exit data delete(ginfo(gid)%recvpack_WE2P)
661  deallocate( ginfo(gid)%recvpack_WE2P )
662 
663  end if
664 
665  !$acc exit data delete(ginfo(gid)%sendpack_P2WE)
666  deallocate( ginfo(gid)%sendpack_P2WE )
667 #ifdef DEBUG
668  deallocate( ginfo(gid)%use_packbuf )
669 #endif
670 
671  end do
672 
673  if ( comm_use_mpi_onesided ) then
674  if ( group_packwe_created ) then
675  call mpi_group_free(group_packwe, ierr)
676  group_packwe_created = .false.
677  end if
678  if ( group_packns_created ) then
679  call mpi_group_free(group_packns, ierr)
680  group_packns_created = .false.
681  end if
682  end if
683 
684 
685  comm_gid = 0
686 
687  initialized = .false.
688 
689  return
690  end subroutine comm_finalize
691 
692  !-----------------------------------------------------------------------------
694  subroutine comm_vars_init( &
695  varname, &
696  var, &
697  vid, &
698  gid )
699  implicit none
700 
701  character(len=*), intent(in) :: varname
702  real(rp), target, intent(inout) :: var(:,:,:)
703  integer, intent(inout) :: vid
704 
705  integer, intent(in), optional :: gid
706 
707  integer :: gid_
708  integer :: vars_id
709  !---------------------------------------------------------------------------
710 
711  if ( .not. comm_use_mpi_pc ) return
712 #ifdef _OPENACC
713  if ( .not. acc_is_present(var) ) return
714 #endif
715 
716  call prof_rapstart('COMM_init_pers', 2)
717 
718  gid_ = 1
719  if ( present(gid) ) gid_ = gid
720  if ( gid_ > comm_gid_max ) then
721  log_error("COMM_vars_init",*) 'gid is invalid', gid_, comm_gid_max
722  call prc_abort
723  end if
724 
725  if ( vid > comm_vsize_max ) then
726  log_error("COMM_vars_init",*) 'vid exceeds max', vid, comm_vsize_max, gid
727  call prc_abort
728  end if
729 
730  ginfo(gid_)%vars_num = ginfo(gid_)%vars_num + 1
731  if ( ginfo(gid_)%vars_num > comm_vsize_max_pc ) then
732  log_error("COMM_vars_init",*) 'number of variable for MPI PC exceeds max', ginfo(gid_)%vars_num, comm_vsize_max_pc
733  call prc_abort
734  end if
735 
736  vars_id = ginfo(gid_)%vars_num
737  ginfo(gid_)%packid(vars_id) = vid
738 
739 #ifdef _OPENACC
740  if ( .not. acc_is_present(var) ) then
741  ginfo(gid_)%device_alloc(vars_id+comm_vsize_max) = .true.
742  ginfo(gid_)%device_ptr(vars_id*comm_vsize_max)%ptr => var
743  !$acc enter data copyin(var)
744  end if
745 #endif
746 
747  call vars_init_mpi_pc(var, gid_, vars_id, vid)
748 
749  vid = vars_id + comm_vsize_max
750 
751  log_info("COMM_vars_init",'(1x,A,I3.3,A,I3.3,2A)') 'Initialize variable (grid ID = ', gid_, '): ID = ', vid, &
752  ', name = ', trim(varname)
753 
754  call prof_rapend ('COMM_init_pers', 2)
755 
756  return
757  end subroutine comm_vars_init
758 
759  !-----------------------------------------------------------------------------
761  subroutine comm_vars8_init( &
762  varname, &
763  var, &
764  vid, &
765  gid )
766  implicit none
767 
768  character(len=*), intent(in) :: varname
769 
770  real(rp), target, intent(inout) :: var(:,:,:)
771  integer, intent(inout) :: vid
772 
773  integer, intent(in), optional :: gid
774 
775  integer :: gid_
776  integer :: vars_id
777  !---------------------------------------------------------------------------
778 
779  if ( .not. comm_use_mpi_pc ) return
780 #ifdef _OPENACC
781  if ( .not. acc_is_present(var) ) return
782 #endif
783 
784  call prof_rapstart('COMM_init_pers', 2)
785 
786  gid_ = 1
787  if ( present(gid) ) gid_ = gid
788  if ( gid_ > comm_gid_max ) then
789  log_error("COMM_vars8_init",*) 'gid is invalid', gid_, comm_gid_max
790  call prc_abort
791  end if
792 
793  if ( vid > comm_vsize_max ) then
794  log_error("COMM_vars8_init",*) 'vid exceeds max', vid, comm_vsize_max
795  call prc_abort
796  end if
797 
798  ginfo(gid_)%vars_num = ginfo(gid_)%vars_num + 1
799  if ( ginfo(gid_)%vars_num > comm_vsize_max_pc ) then
800  log_error("COMM_vars8_init",*) 'number of variable for MPI PC exceeds max', ginfo(gid_)%vars_num, comm_vsize_max_pc
801  call prc_abort
802  end if
803 
804  vars_id = ginfo(gid_)%vars_num
805  ginfo(gid_)%packid(vars_id) = vid
806 
807 #ifdef _OPENACC
808  if ( .not. acc_is_present(var) ) then
809  ginfo(gid_)%device_alloc(vars_id+comm_vsize_max) = .true.
810  ginfo(gid_)%device_ptr(vars_id+comm_vsize_max)%ptr => var
811  !$acc enter data copyin(var)
812  end if
813 #endif
814 
815  call vars8_init_mpi_pc(var, gid_, vars_id, vid)
816 
817  vid = vars_id + comm_vsize_max
818 
819  log_info("COMM_vars8_init",'(1x,A,I3.3,A,I3.3,2A)') 'Initialize variable (grid ID = ', gid_, '): ID = ', vid, &
820  ', name = ', trim(varname)
821 
822  call prof_rapend ('COMM_init_pers', 2)
823 
824  return
825  end subroutine comm_vars8_init
826 
827  !-----------------------------------------------------------------------------
828  subroutine comm_vars_3d(var, vid, gid)
829  implicit none
830 
831  real(rp), intent(inout) :: var(:,:,:)
832 
833  integer, intent(in) :: vid
834 
835  integer, intent(in), optional :: gid
836 
837  integer :: gid_
838  !---------------------------------------------------------------------------
839 
840  gid_ = 1
841  if ( present(gid) ) gid_ = gid
842  if ( gid_ > comm_gid_max ) then
843  log_error("COMM_vars_3D",*) 'gid is invalid', gid_, comm_gid_max
844  call prc_abort
845  end if
846 
847  if ( vid > comm_vsize_max ) then
848  call prof_rapstart('COMM_vars_pers', 2)
849  call vars_3d_mpi_pc(var, gid_, vid-comm_vsize_max)
850  call prof_rapend ('COMM_vars_pers', 2)
851  else
852  call prof_rapstart('COMM_vars', 2)
853  if ( comm_use_mpi_onesided ) then
854  call vars_3d_mpi_onesided(var, gid_, vid)
855  else
856  call vars_3d_mpi(var, gid_, vid)
857  end if
858  call prof_rapend ('COMM_vars', 2)
859  end if
860 
861  return
862  end subroutine comm_vars_3d
863 
864  !-----------------------------------------------------------------------------
865  subroutine comm_vars8_3d(var, vid, gid)
866  implicit none
867 
868  real(rp), intent(inout) :: var(:,:,:)
869 
870  integer, intent(in) :: vid
871 
872  integer, intent(in), optional :: gid
873 
874  integer :: gid_
875  !---------------------------------------------------------------------------
876 
877  gid_ = 1
878  if ( present(gid) ) gid_ = gid
879  if ( gid_ > comm_gid_max ) then
880  log_error("COMM_vars8_3D",*) 'gid is invalid', gid_, comm_gid_max
881  call prc_abort
882  end if
883 
884  if ( vid > comm_vsize_max ) then
885  call prof_rapstart('COMM_vars_pers', 2)
886  call vars_3d_mpi_pc(var, gid_, vid-comm_vsize_max)
887  call prof_rapend ('COMM_vars_pers', 2)
888  else
889  call prof_rapstart('COMM_vars', 2)
890  if ( comm_use_mpi_onesided ) then
891  call vars8_3d_mpi_onesided(var, gid_, vid)
892  else
893  call vars8_3d_mpi(var, gid_, vid)
894  end if
895  call prof_rapend ('COMM_vars', 2)
896  end if
897 
898  return
899  end subroutine comm_vars8_3d
900 
901  !-----------------------------------------------------------------------------
902  subroutine comm_wait_3d(var, vid, FILL_BND, gid)
903  implicit none
904 
905  real(rp), intent(inout) :: var(:,:,:)
906 
907  integer, intent(in) :: vid
908 
909  logical, intent(in), optional :: fill_bnd
910  integer, intent(in), optional :: gid
911 
912  logical :: fill_bnd_
913  integer :: gid_
914  !---------------------------------------------------------------------------
915 
916  fill_bnd_ = .true.
917  if ( present(fill_bnd) ) fill_bnd_ = fill_bnd
918 
919  gid_ = 1
920  if ( present(gid) ) gid_ = gid
921  if ( gid_ > comm_gid_max ) then
922  log_error("COMM_wait_3D",*) 'gid is invalid', gid_, comm_gid_max
923  call prc_abort
924  end if
925 
926  if ( vid > comm_vsize_max ) then
927  call prof_rapstart('COMM_wait_pers', 2)
928  call wait_3d_mpi_pc(var, gid_, vid-comm_vsize_max)
929  call prof_rapend ('COMM_wait_pers', 2)
930  else
931  call prof_rapstart('COMM_wait', 2)
932  if ( comm_use_mpi_onesided ) then
933  call wait_3d_mpi_onesided(var, gid_, vid)
934  else
935  call wait_3d_mpi(var, gid_, vid)
936  end if
937  call prof_rapend ('COMM_wait', 2)
938  end if
939 
940  ! copy inner data to boundary
941  if ( .NOT. comm_isallperiodic ) then
942  if ( fill_bnd_ ) then
943  call copy_boundary_3d(var, gid_)
944  end if
945  end if
946 
947  return
948  end subroutine comm_wait_3d
949 
950  !-----------------------------------------------------------------------------
951  subroutine comm_vars_2d(var, vid, gid)
952  implicit none
953 
954  real(rp), intent(inout) :: var(:,:)
955 
956  integer, intent(in) :: vid
957 
958  integer, intent(in), optional :: gid
959 
960  integer :: gid_
961  !---------------------------------------------------------------------------
962 
963  gid_ = 1
964  if ( present(gid) ) gid_ = gid
965  if ( gid_ > comm_gid_max ) then
966  log_error("COMM_vars_2D",*) 'gid is invalid', gid_, comm_gid_max
967  call prc_abort
968  end if
969 
970  call prof_rapstart('COMM_vars', 2)
971  if ( comm_use_mpi_onesided ) then
972  call vars_2d_mpi_onesided(var, gid_, vid)
973  else
974  call vars_2d_mpi(var, gid_, vid)
975  end if
976  call prof_rapend ('COMM_vars', 2)
977 
978  return
979  end subroutine comm_vars_2d
980 
981  !-----------------------------------------------------------------------------
982  subroutine comm_vars8_2d(var, vid, gid)
983  implicit none
984 
985  real(rp), intent(inout) :: var(:,:)
986 
987  integer, intent(in) :: vid
988 
989  integer, intent(in), optional :: gid
990 
991  integer :: gid_
992  !---------------------------------------------------------------------------
993 
994  gid_ = 1
995  if ( present(gid) ) gid_ = gid
996  if ( gid_ > comm_gid_max ) then
997  log_error("COMM_vars8_2D",*) 'gid is invalid', gid_, comm_gid_max
998  call prc_abort
999  end if
1000 
1001  call prof_rapstart('COMM_vars', 2)
1002  if ( comm_use_mpi_onesided ) then
1003  call vars8_2d_mpi_onesided(var, gid_, vid)
1004  else
1005  call vars8_2d_mpi(var, gid_, vid)
1006  end if
1007  call prof_rapend ('COMM_vars', 2)
1008 
1009  return
1010  end subroutine comm_vars8_2d
1011 
1012  !-----------------------------------------------------------------------------
1013  subroutine comm_wait_2d(var, vid, FILL_BND, gid)
1014  implicit none
1015 
1016  real(rp), intent(inout) :: var(:,:)
1017 
1018  integer, intent(in) :: vid
1019 
1020  logical, intent(in), optional :: fill_bnd
1021  integer, intent(in), optional :: gid
1022 
1023  logical :: fill_bnd_
1024  integer :: gid_
1025  !---------------------------------------------------------------------------
1026 
1027  fill_bnd_ = .true.
1028  if ( present(fill_bnd) ) fill_bnd_ = fill_bnd
1029 
1030  gid_ = 1
1031  if ( present(gid) ) gid_ = gid
1032  if ( gid_ > comm_gid_max ) then
1033  log_error("COMM_wait_2D",*) 'gid is invalid', gid_, comm_gid_max
1034  call prc_abort
1035  end if
1036 
1037  call prof_rapstart('COMM_wait', 2)
1038  if ( comm_use_mpi_onesided ) then
1039  call wait_2d_mpi_onesided(var, gid_, vid)
1040  else
1041  call wait_2d_mpi(var, gid_, vid)
1042  end if
1043  call prof_rapend ('COMM_wait', 2)
1044 
1045  if( .NOT. comm_isallperiodic ) then
1046  if ( fill_bnd_ ) then
1047  call copy_boundary_2d(var, gid_)
1048  end if
1049  end if
1050 
1051  return
1052  end subroutine comm_wait_2d
1053 
1054  !-----------------------------------------------------------------------------
1056  subroutine comm_horizontal_mean_2d( &
1057  IA, IS, IE, JA, JS, JE, &
1058  var, &
1059  varmean )
1060  use scale_const, only: &
1061  const_undef
1062  implicit none
1063 
1064  integer, intent(in) :: ia, is, ie
1065  integer, intent(in) :: ja, js, je
1066  real(rp), intent(in) :: var(ia,ja)
1067 
1068  real(rp), intent(out) :: varmean
1069 
1070  real(dp) :: stat(2)
1071  real(dp) :: stat1, stat2
1072  real(dp) :: allstat(2)
1073  real(dp) :: zerosw
1074 
1075  integer :: ierr
1076  integer :: i, j
1077  !---------------------------------------------------------------------------
1078 
1079  stat1 = 0.0_dp
1080  stat2 = 0.0_dp
1081  !$omp parallel do reduction(+:stat1,stat2)
1082  !$acc kernels if(acc_is_present(var))
1083  !$acc loop reduction(+:stat1,stat2)
1084  do j = js, je
1085  !$acc loop reduction(+:stat1,stat2)
1086  do i = is, ie
1087  if ( abs(var(i,j)) < abs(const_undef) ) then
1088  stat1 = stat1 + var(i,j)
1089  stat2 = stat2 + 1.0_dp
1090  endif
1091  enddo
1092  enddo
1093  !$acc end kernels
1094 
1095  stat(:) = (/stat1, stat2/)
1096 
1097  ! All reduce
1098  ! [NOTE] always communicate globally
1099  call prof_rapstart('COMM_Allreduce', 2)
1100  call mpi_allreduce( stat, &
1101  allstat, &
1102  2, &
1103  mpi_double_precision, &
1104  mpi_sum, &
1105  comm_world, &
1106  ierr )
1107  call prof_rapend ('COMM_Allreduce', 2)
1108 
1109  zerosw = 0.5_dp - sign(0.5_dp, allstat(1) - 1.e-12_dp )
1110  varmean = allstat(1) / ( allstat(2) + zerosw ) * ( 1.0_dp - zerosw )
1111  !LOG_INFO("COMM_horizontal_mean_2D",*) varmean, allstat(1), allstat(2)
1112 
1113  return
1114  end subroutine comm_horizontal_mean_2d
1115 
1116  !-----------------------------------------------------------------------------
1118  subroutine comm_horizontal_mean_3d( &
1119  KA, IA, IS, IE, JA, JS, JE, &
1120  var, &
1121  varmean )
1122  use scale_const, only: &
1123  const_undef
1124  implicit none
1125 
1126  integer, intent(in) :: KA
1127  integer, intent(in) :: IA, IS, IE
1128  integer, intent(in) :: JA, JS, JE
1129  real(RP), intent(in) :: var(KA,IA,JA)
1130 
1131  real(RP), intent(out) :: varmean(KA)
1132 
1133  real(DP) :: stat (KA,2)
1134  real(DP) :: allstat(KA,2)
1135  real(DP) :: zerosw
1136 
1137  integer :: ierr
1138  integer :: k, i, j
1139 #ifdef _OPENACC
1140  logical :: flag_device
1141 #endif
1142  !---------------------------------------------------------------------------
1143 
1144 #ifdef _OPENACC
1145  flag_device = acc_is_present(var)
1146 #endif
1147 
1148  !$acc data create(stat, allstat) if(flag_device)
1149 
1150  !$acc kernels if(flag_device)
1151  stat(:,:) = 0.0_dp
1152  !$acc end kernels
1153  !$acc kernels if(flag_device)
1154  !$acc loop independent
1155  do j = js, je
1156  !$acc loop independent
1157  do i = is, ie
1158  do k = 1, ka
1159  if ( abs(var(k,i,j)) < abs(const_undef) ) then
1160  !$acc atomic update
1161  stat(k,1) = stat(k,1) + var(k,i,j)
1162  !$acc end atomic
1163  !$acc atomic update
1164  stat(k,2) = stat(k,2) + 1.0_dp
1165  !$acc end atomic
1166  endif
1167  enddo
1168  enddo
1169  enddo
1170  !$acc end kernels
1171 
1172 
1173  ! All reduce
1174  ! [NOTE] always communicate globally
1175  call prof_rapstart('COMM_Allreduce', 2)
1176  !$acc host_data use_device(stat, allstat) if(flag_device)
1177  call mpi_allreduce( stat, &
1178  allstat, &
1179  ka * 2, &
1180  mpi_double_precision, &
1181  mpi_sum, &
1182  comm_world, &
1183  ierr )
1184  !$acc end host_data
1185  call prof_rapend ('COMM_Allreduce', 2)
1186 
1187  !$acc kernels if(flag_device)
1188  do k = 1, ka
1189  zerosw = 0.5_dp - sign(0.5_dp, allstat(k,2) - 1.e-12_dp )
1190  varmean(k) = allstat(k,1) / ( allstat(k,2) + zerosw ) * ( 1.0_dp - zerosw )
1191  !LOG_INFO("COMM_horizontal_mean_3D",*) k, varmean(k), allstatval(k), allstatcnt(k)
1192  enddo
1193  !$acc end kernels
1194 
1195  !$acc end data
1196 
1197  return
1198  end subroutine comm_horizontal_mean_3d
1199 
1200  !-----------------------------------------------------------------------------
1202  subroutine comm_gather_2d( &
1203  IA, JA, &
1204  send, &
1205  recv )
1206  use scale_prc, only: &
1207  prc_masterrank
1208  implicit none
1209 
1210  integer, intent(in) :: IA, JA
1211  real(RP), intent(in) :: send(IA,JA)
1212 
1213  real(RP), intent(out) :: recv(:,:,:)
1214 
1215  integer :: sendcounts, recvcounts
1216  integer :: ierr
1217  !---------------------------------------------------------------------------
1218 
1219  sendcounts = ia * ja
1220  recvcounts = ia * ja
1221 
1222  !$acc host_data use_device(send, recv) if(acc_is_present(send))
1223  call mpi_gather( send(:,:), &
1224  sendcounts, &
1225  comm_datatype, &
1226  recv(:,:,:), &
1227  recvcounts, &
1228  comm_datatype, &
1229  prc_masterrank, &
1230  comm_world, &
1231  ierr )
1232  !$acc end host_data
1233 
1234  return
1235  end subroutine comm_gather_2d
1236 
1237  !-----------------------------------------------------------------------------
1239  subroutine comm_gather_3d( &
1240  KA, IA, JA, &
1241  send, &
1242  recv )
1243  use scale_prc, only: &
1244  prc_masterrank
1245  implicit none
1246 
1247  integer, intent(in) :: KA, IA, JA
1248  real(RP), intent(in) :: send(KA,IA,JA)
1249 
1250  real(RP), intent(out) :: recv(:,:,:,:)
1251 
1252  integer :: sendcounts, recvcounts
1253  integer :: ierr
1254  !---------------------------------------------------------------------------
1255 
1256  sendcounts = ka * ia * ja
1257  recvcounts = ka * ia * ja
1258 
1259  !$acc host_data use_device(send, recv) if(acc_is_present(send))
1260  call mpi_gather( send(:,:,:), &
1261  sendcounts, &
1262  comm_datatype, &
1263  recv(:,:,:,:), &
1264  recvcounts, &
1265  comm_datatype, &
1266  prc_masterrank, &
1267  comm_world, &
1268  ierr )
1269  !$acc end host_data
1270 
1271  return
1272  end subroutine comm_gather_3d
1273 
1274  !-----------------------------------------------------------------------------
1276  subroutine comm_bcast_scr_sp( var )
1277  use scale_prc, only: &
1278  prc_masterrank
1279  implicit none
1280 
1281  real(SP), intent(inout) :: var
1282 
1283  integer :: counts
1284  integer :: ierr
1285  !---------------------------------------------------------------------------
1286 
1287  call prof_rapstart('COMM_Bcast', 2)
1288 
1289  counts = 1
1290 
1291  call mpi_bcast( var, &
1292  counts, &
1293  mpi_real, &
1294  prc_masterrank, &
1295  comm_world, &
1296  ierr )
1297 
1298  call prof_rapend('COMM_Bcast', 2)
1299 
1300  return
1301  end subroutine comm_bcast_scr_sp
1302  subroutine comm_bcast_scr_dp( var )
1303  use scale_prc, only: &
1304  prc_masterrank
1305  implicit none
1306 
1307  real(DP), intent(inout) :: var
1308 
1309  integer :: counts
1310  integer :: ierr
1311  !---------------------------------------------------------------------------
1312 
1313  call prof_rapstart('COMM_Bcast', 2)
1314 
1315  counts = 1
1316 
1317  call mpi_bcast( var, &
1318  counts, &
1319  mpi_double_precision, &
1320  prc_masterrank, &
1321  comm_world, &
1322  ierr )
1323 
1324  call prof_rapend('COMM_Bcast', 2)
1325 
1326  return
1327  end subroutine comm_bcast_scr_dp
1328 
1329  !-----------------------------------------------------------------------------
1331  subroutine comm_bcast_1d_sp( IA, var )
1332  use scale_prc, only: &
1333  prc_masterrank
1334  implicit none
1335 
1336  integer, intent(in) :: IA
1337 
1338  real(SP), intent(inout) :: var(IA)
1339 
1340  integer :: counts
1341  integer :: ierr
1342  !---------------------------------------------------------------------------
1343 
1344  call prof_rapstart('COMM_Bcast', 2)
1345 
1346  counts = ia
1347 
1348  !$acc host_data use_device(var) if(acc_is_present(var))
1349  call mpi_bcast( var(:), &
1350  counts, &
1351  mpi_real, &
1352  prc_masterrank, &
1353  comm_world, &
1354  ierr )
1355  !$acc end host_data
1356 
1357  call prof_rapend('COMM_Bcast', 2)
1358 
1359  return
1360  end subroutine comm_bcast_1d_sp
1361  subroutine comm_bcast_1d_dp( IA, var )
1362  use scale_prc, only: &
1363  prc_masterrank
1364  implicit none
1365 
1366  integer, intent(in) :: IA
1367 
1368  real(DP), intent(inout) :: var(IA)
1369 
1370  integer :: counts
1371  integer :: ierr
1372  !---------------------------------------------------------------------------
1373 
1374  call prof_rapstart('COMM_Bcast', 2)
1375 
1376  counts = ia
1377 
1378  !$acc host_data use_device(var) if(acc_is_present(var))
1379  call mpi_bcast( var(:), &
1380  counts, &
1381  mpi_double_precision, &
1382  prc_masterrank, &
1383  comm_world, &
1384  ierr )
1385  !$acc end host_data
1386 
1387  call prof_rapend('COMM_Bcast', 2)
1388 
1389  return
1390  end subroutine comm_bcast_1d_dp
1391 
1392  !-----------------------------------------------------------------------------
1394  subroutine comm_bcast_2d_sp( IA, JA, var )
1395  use scale_prc, only: &
1396  prc_masterrank
1397  implicit none
1398 
1399  integer, intent(in) :: IA, JA
1400 
1401  real(SP), intent(inout) :: var(IA,JA)
1402 
1403  integer :: counts
1404  integer :: ierr
1405  !---------------------------------------------------------------------------
1406 
1407  call prof_rapstart('COMM_Bcast', 2)
1408 
1409  counts = ia * ja
1410 
1411  !$acc host_data use_device(var) if(acc_is_present(var))
1412  call mpi_bcast( var(:,:), &
1413  counts, &
1414  mpi_real, &
1415  prc_masterrank, &
1416  comm_world, &
1417  ierr )
1418  !$acc end host_data
1419 
1420  call prof_rapend('COMM_Bcast', 2)
1421 
1422  return
1423  end subroutine comm_bcast_2d_sp
1424  subroutine comm_bcast_2d_dp( IA, JA, var )
1425  use scale_prc, only: &
1426  prc_masterrank
1427  implicit none
1428 
1429  integer, intent(in) :: IA, JA
1430 
1431  real(DP), intent(inout) :: var(IA,JA)
1432 
1433  integer :: counts
1434  integer :: ierr
1435  !---------------------------------------------------------------------------
1436 
1437  call prof_rapstart('COMM_Bcast', 2)
1438 
1439  counts = ia * ja
1440 
1441  !$acc host_data use_device(var) if(acc_is_present(var))
1442  call mpi_bcast( var(:,:), &
1443  counts, &
1444  mpi_double_precision, &
1445  prc_masterrank, &
1446  comm_world, &
1447  ierr )
1448  !$acc end host_data
1449 
1450  call prof_rapend('COMM_Bcast', 2)
1451 
1452  return
1453  end subroutine comm_bcast_2d_dp
1454 
1455  !-----------------------------------------------------------------------------
1457  subroutine comm_bcast_3d_sp( KA, IA, JA, var )
1458  use scale_prc, only: &
1459  prc_masterrank
1460  implicit none
1461 
1462  integer, intent(in) :: KA, IA, JA
1463 
1464  real(SP), intent(inout) :: var(KA,IA,JA)
1465 
1466  integer :: counts
1467  integer :: ierr
1468  !---------------------------------------------------------------------------
1469 
1470  call prof_rapstart('COMM_Bcast', 2)
1471 
1472  counts = ka * ia * ja
1473 
1474  !$acc host_data use_device(var) if(acc_is_present(var))
1475  call mpi_bcast( var(:,:,:), &
1476  counts, &
1477  mpi_real, &
1478  prc_masterrank, &
1479  comm_world, &
1480  ierr )
1481  !$acc end host_data
1482 
1483  call prof_rapend('COMM_Bcast', 2)
1484 
1485  return
1486  end subroutine comm_bcast_3d_sp
1487  subroutine comm_bcast_3d_dp( KA, IA, JA, var )
1488  use scale_prc, only: &
1489  prc_masterrank
1490  implicit none
1491 
1492  integer, intent(in) :: KA, IA, JA
1493 
1494  real(DP), intent(inout) :: var(KA,IA,JA)
1495 
1496  integer :: counts
1497  integer :: ierr
1498  !---------------------------------------------------------------------------
1499 
1500  call prof_rapstart('COMM_Bcast', 2)
1501 
1502  counts = ka * ia * ja
1503 
1504  !$acc host_data use_device(var) if(acc_is_present(var))
1505  call mpi_bcast( var(:,:,:), &
1506  counts, &
1507  mpi_double_precision, &
1508  prc_masterrank, &
1509  comm_world, &
1510  ierr )
1511  !$acc end host_data
1512 
1513  call prof_rapend('COMM_Bcast', 2)
1514 
1515  return
1516  end subroutine comm_bcast_3d_dp
1517 
1518  !-----------------------------------------------------------------------------
1520  subroutine comm_bcast_4d_sp( KA, IA, JA, NT, var )
1521  use scale_prc, only: &
1522  prc_masterrank
1523  implicit none
1524 
1525  integer, intent(in) :: KA, IA, JA, NT
1526 
1527  real(SP), intent(inout) :: var(KA,IA,JA,NT)
1528 
1529  integer :: counts
1530  integer :: ierr
1531  !---------------------------------------------------------------------------
1532 
1533  call prof_rapstart('COMM_Bcast', 2)
1534 
1535  counts = ka * ia * ja * nt
1536  if ( ka>0 .AND. ia>0 .AND. ja>0 .AND. nt>0 .AND. &
1537  counts < 0 ) then
1538  log_error("COMM_bcast_4D",*) 'counts overflow'
1539  call prc_abort
1540  end if
1541 
1542  !$acc host_data use_device(var) if(acc_is_present(var))
1543  call mpi_bcast( var(:,:,:,:), &
1544  counts, &
1545  mpi_real, &
1546  prc_masterrank, &
1547  comm_world, &
1548  ierr )
1549  !$acc end host_data
1550 
1551  call prof_rapend('COMM_Bcast', 2)
1552 
1553  return
1554  end subroutine comm_bcast_4d_sp
1555  subroutine comm_bcast_4d_dp( KA, IA, JA, NT, var )
1556  use scale_prc, only: &
1557  prc_masterrank
1558  implicit none
1559 
1560  integer, intent(in) :: KA, IA, JA, NT
1561 
1562  real(DP), intent(inout) :: var(KA,IA,JA,NT)
1563 
1564  integer :: counts
1565  integer :: ierr
1566  !---------------------------------------------------------------------------
1567 
1568  call prof_rapstart('COMM_Bcast', 2)
1569 
1570  counts = ka * ia * ja * nt
1571  if ( ka>0 .AND. ia>0 .AND. ja>0 .AND. nt>0 .AND. &
1572  counts < 0 ) then
1573  log_error("COMM_bcast_4D",*) 'counts overflow'
1574  call prc_abort
1575  end if
1576 
1577  !$acc host_data use_device(var) if(acc_is_present(var))
1578  call mpi_bcast( var(:,:,:,:), &
1579  counts, &
1580  mpi_double_precision, &
1581  prc_masterrank, &
1582  comm_world, &
1583  ierr )
1584  !$acc end host_data
1585 
1586  call prof_rapend('COMM_Bcast', 2)
1587 
1588  return
1589  end subroutine comm_bcast_4d_dp
1590 
1591  !-----------------------------------------------------------------------------
1593  subroutine comm_bcast_int_scr( var )
1594  use scale_prc, only: &
1595  prc_masterrank
1596  implicit none
1597 
1598  integer, intent(inout) :: var
1599 
1600  integer :: counts
1601  integer :: ierr
1602  !---------------------------------------------------------------------------
1603 
1604  call prof_rapstart('COMM_Bcast', 2)
1605 
1606  counts = 1
1607 
1608  call mpi_bcast( var, &
1609  counts, &
1610  mpi_integer, &
1611  prc_masterrank, &
1612  comm_world, &
1613  ierr )
1614 
1615  call prof_rapend('COMM_Bcast', 2)
1616 
1617  return
1618  end subroutine comm_bcast_int_scr
1619 
1620  !-----------------------------------------------------------------------------
1622  subroutine comm_bcast_int_1d( IA, var )
1623  use scale_prc, only: &
1624  prc_masterrank
1625  implicit none
1626 
1627  integer, intent(in) :: IA
1628  integer, intent(inout) :: var(IA)
1629 
1630  integer :: counts
1631  integer :: ierr
1632  !---------------------------------------------------------------------------
1633 
1634  call prof_rapstart('COMM_Bcast', 2)
1635 
1636  counts = ia
1637 
1638  call mpi_bcast( var(:), &
1639  counts, &
1640  mpi_integer, &
1641  prc_masterrank, &
1642  comm_world, &
1643  ierr )
1644 
1645  call prof_rapend('COMM_Bcast', 2)
1646 
1647  return
1648  end subroutine comm_bcast_int_1d
1649 
1650  !-----------------------------------------------------------------------------
1652  subroutine comm_bcast_int_2d( IA, JA, var )
1653  use scale_prc, only: &
1654  prc_masterrank
1655  implicit none
1656 
1657  integer, intent(in) :: IA, JA
1658 
1659  integer, intent(inout) :: var(IA,JA)
1660 
1661  integer :: counts
1662  integer :: ierr
1663  !---------------------------------------------------------------------------
1664 
1665  call prof_rapstart('COMM_Bcast', 2)
1666 
1667  counts = ia * ja
1668 
1669  !$acc host_data use_device(var) if(acc_is_present(var))
1670  call mpi_bcast( var(:,:), &
1671  counts, &
1672  mpi_integer, &
1673  prc_masterrank, &
1674  comm_world, &
1675  ierr )
1676  !$acc end host_data
1677 
1678  call prof_rapend('COMM_Bcast', 2)
1679 
1680  return
1681  end subroutine comm_bcast_int_2d
1682 
1683  !-----------------------------------------------------------------------------
1685  subroutine comm_bcast_logical_scr( var )
1686  use scale_prc, only: &
1687  prc_masterrank
1688  implicit none
1689 
1690  logical, intent(inout) :: var
1691 
1692  integer :: counts
1693  integer :: ierr
1694  !---------------------------------------------------------------------------
1695 
1696  call prof_rapstart('COMM_Bcast', 2)
1697 
1698  counts = 1
1699 
1700  call mpi_bcast( var, &
1701  counts, &
1702  mpi_logical, &
1703  prc_masterrank, &
1704  comm_world, &
1705  ierr )
1706 
1707  call prof_rapend('COMM_Bcast', 2)
1708 
1709  return
1710  end subroutine comm_bcast_logical_scr
1711 
1712  !-----------------------------------------------------------------------------
1714  subroutine comm_bcast_logical_1d( IA, var )
1715  use scale_prc, only: &
1716  prc_masterrank
1717  implicit none
1718 
1719  integer, intent(in) :: IA
1720  logical, intent(inout) :: var(IA)
1721 
1722  integer :: counts
1723  integer :: ierr
1724  !---------------------------------------------------------------------------
1725 
1726  call prof_rapstart('COMM_Bcast', 2)
1727 
1728  counts = ia
1729 
1730  !$acc host_data use_device(var) if(acc_is_present(var))
1731  call mpi_bcast( var(:), &
1732  counts, &
1733  mpi_logical, &
1734  prc_masterrank, &
1735  comm_world, &
1736  ierr )
1737  !$acc end host_data
1738 
1739  call prof_rapend('COMM_Bcast', 2)
1740 
1741  return
1742  end subroutine comm_bcast_logical_1d
1743 
1744  !-----------------------------------------------------------------------------
1746  subroutine comm_bcast_character( var )
1747  use scale_prc, only: &
1748  prc_masterrank
1749  implicit none
1750 
1751  character(len=*), intent(inout) :: var
1752 
1753  integer :: counts
1754  integer :: ierr
1755  !---------------------------------------------------------------------------
1756 
1757  call prof_rapstart('COMM_Bcast', 2)
1758 
1759  counts = len(var)
1760 
1761  call mpi_bcast( var, &
1762  counts, &
1763  mpi_character, &
1764  prc_masterrank, &
1765  comm_world, &
1766  ierr )
1767 
1768  call prof_rapend('COMM_Bcast', 2)
1769 
1770  return
1771  end subroutine comm_bcast_character
1772 
1773 !-------------------------------------------------------------------------------
1774 ! private routines
1775 !-------------------------------------------------------------------------------
1776  subroutine vars_init_mpi_pc(var, gid, vid, seqid)
1777  use scale_prc_cartesc, only: &
1778  prc_twod
1779  implicit none
1780 
1781  real(RP), intent(inout) :: var(:,:,:)
1782  integer, intent(in) :: gid
1783  integer, intent(in) :: vid
1784  integer, intent(in) :: seqid
1785 
1786  integer :: ireq, tag, ierr
1787  logical :: flag
1788 
1789  integer :: KA
1790  integer :: JA, JS, JE, JHALO
1791 
1792  integer :: nreq
1793  integer :: i
1794 
1795 #ifdef _OPENACC
1796  real(RP), pointer :: ptr(:,:)
1797 #endif
1798 
1799  tag = ( (gid - 1) * comm_vsize_max + vid ) * 100
1800  ireq = 1
1801 
1802  ka = ginfo(gid)%KA
1803  ja = ginfo(gid)%JA
1804  js = ginfo(gid)%JS
1805  je = ginfo(gid)%JE
1806  jhalo = ginfo(gid)%JHALO
1807 
1808  !$acc host_data use_device(var)
1809 
1810  ! register whole array to inner table of MPI and/or lower library
1811  ! otherwise a lot of sub small segments would be registered
1812  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
1813  mpi_proc_null, tag+ginfo(gid)%nreq_max+1, comm_world, &
1814  ginfo(gid)%preq_list(ginfo(gid)%nreq_max+1,vid), ierr )
1815 
1816  !--- From 4-Direction HALO communicate
1817  ! From S
1818  if ( prc_has_s ) then
1819  call mpi_recv_init( var(:,:,1:js-1), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
1820  prc_next(prc_s), tag+1, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1821  ireq = ireq + 1
1822  end if
1823  ! From N
1824  if ( prc_has_n ) then
1825  call mpi_recv_init( var(:,:,je+1:ja), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
1826  prc_next(prc_n), tag+2, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1827  ireq = ireq + 1
1828  end if
1829  if ( .not. prc_twod ) then
1830 #ifdef _OPENACC
1831  ptr => ginfo(gid)%recvpack_WE2P(:,:,seqid)
1832  !$acc host_data use_device(ptr)
1833 #endif
1834 
1835  ! From E
1836  if ( prc_has_e ) then
1837 #ifdef _OPENACC
1838  call mpi_recv_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1839 #else
1840  call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1841 #endif
1842  prc_next(prc_e), tag+3, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1843  ireq = ireq + 1
1844  end if
1845  ! From W
1846  if ( prc_has_w ) then
1847 #ifdef _OPENACC
1848  call mpi_recv_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1849 #else
1850  call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1851 #endif
1852  prc_next(prc_w), tag+4, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1853  ireq = ireq + 1
1854  end if
1855  !$acc end host_data
1856  end if
1857 
1858  !--- To 4-Direction HALO communicate
1859  if ( .not. prc_twod ) then
1860 #ifdef _OPENACC
1861  ptr => ginfo(gid)%sendpack_P2WE(:,:,seqid)
1862  !$acc host_data use_device(ptr)
1863 #endif
1864  ! To W HALO
1865  if ( prc_has_w ) then
1866 #ifdef _OPENACC
1867  call mpi_send_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1868 #else
1869  call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1870 #endif
1871  prc_next(prc_w), tag+3, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1872  ireq = ireq + 1
1873  end if
1874  ! To E HALO
1875  if ( prc_has_e ) then
1876 #ifdef _OPENACC
1877  call mpi_send_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1878 #else
1879  call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
1880 #endif
1881  prc_next(prc_e), tag+4, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1882  ireq = ireq + 1
1883  end if
1884  !$acc end host_data
1885  end if
1886  ! To N HALO
1887  if ( prc_has_n ) then
1888  call mpi_send_init( var(:,:,je-jhalo+1:je), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
1889  prc_next(prc_n), tag+1, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1890  ireq = ireq + 1
1891  end if
1892  ! To S HALO
1893  if ( prc_has_s ) then
1894  call mpi_send_init( var(:,:,js:js+jhalo-1), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
1895  prc_next(prc_s), tag+2, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1896  ireq = ireq + 1
1897  end if
1898 
1899  ginfo(gid)%preq_cnt(vid) = ireq - 1
1900 
1901  ! to finish initial processes of MPI
1902  nreq = ginfo(gid)%preq_cnt(vid)
1903  do i = 1, 32
1904  call mpi_testall( nreq, ginfo(gid)%preq_list(1:nreq,vid), &
1905  flag, mpi_statuses_ignore, ierr )
1906  enddo
1907 
1908  !$acc end host_data
1909 
1910  return
1911  end subroutine vars_init_mpi_pc
1912 
1913  subroutine vars8_init_mpi_pc(var, gid, vid, seqid)
1914  use scale_prc_cartesc, only: &
1915  prc_twod
1916  implicit none
1917 
1918  real(RP), intent(inout) :: var(:,:,:)
1919  integer, intent(in) :: gid
1920  integer, intent(in) :: vid
1921  integer, intent(in) :: seqid
1922 
1923  integer :: ireq, tag, tagc
1924  integer :: ierr
1925  logical :: flag
1926 
1927  integer :: KA
1928  integer :: IS, IE, IHALO
1929  integer :: JA, JS, JE, JHALO
1930 
1931  integer :: nreq
1932  integer :: i, j
1933 
1934 #ifdef _OPENACC
1935  real(RP), pointer :: ptr(:,:)
1936 #endif
1937 
1938  ka = ginfo(gid)%KA
1939  is = ginfo(gid)%IS
1940  ie = ginfo(gid)%IE
1941  ihalo = ginfo(gid)%IHALO
1942  ja = ginfo(gid)%JA
1943  js = ginfo(gid)%JS
1944  je = ginfo(gid)%JE
1945  jhalo = ginfo(gid)%JHALO
1946 
1947  tag = ( (gid - 1) * comm_vsize_max + vid ) * 100
1948  ireq = 1
1949 
1950  !$acc host_data use_device(var)
1951 
1952  ! register whole array to inner table of MPI and/or lower library
1953  ! otherwise a lot of sub small segments would be registered
1954  call mpi_send_init( var(:,:,:), size(var), comm_datatype, &
1955  mpi_proc_null, tag+ginfo(gid)%nreq_max+1, comm_world, &
1956  ginfo(gid)%preq_list(ginfo(gid)%nreq_max+1,vid), ierr )
1957 
1958 
1959  if ( comm_isallperiodic ) then ! periodic condition
1960 
1961  !--- From 8-Direction HALO communicate
1962  if ( .not. prc_twod ) then
1963  ! From SE
1964  tagc = 0
1965  do j = 1, js-1
1966  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
1967  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1968  ireq = ireq + 1
1969  tagc = tagc + 1
1970  enddo
1971  ! From SW
1972  tagc = 10
1973  do j = 1, js-1
1974  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
1975  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1976  ireq = ireq + 1
1977  tagc = tagc + 1
1978  enddo
1979  ! From NE
1980  tagc = 20
1981  do j = je+1, ja
1982  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
1983  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1984  ireq = ireq + 1
1985  tagc = tagc + 1
1986  enddo
1987  ! From NW
1988  tagc = 30
1989  do j = je+1, je+jhalo
1990  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
1991  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
1992  ireq = ireq + 1
1993  tagc = tagc + 1
1994  enddo
1995  ! From E
1996  tagc = 60
1997 #ifdef _OPENACC
1998  ptr => ginfo(gid)%recvpack_WE2P(:,:,seqid)
1999  !$acc host_data use_device(ptr)
2000  call mpi_recv_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2001 #else
2002  call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2003 #endif
2004  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2005  ireq = ireq + 1
2006  ! From W
2007  tagc = 70
2008 #ifdef _OPENACC
2009  call mpi_recv_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2010 #else
2011  call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2012 #endif
2013  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2014  !$acc end host_data
2015  ireq = ireq + 1
2016  end if
2017  ! From S
2018  tagc = 40
2019  do j = 1, js-1
2020  call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2021  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2022  ireq = ireq + 1
2023  tagc = tagc + 1
2024  enddo
2025  ! From N
2026  tagc = 50
2027  do j = je+1, ja
2028  call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2029  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2030  ireq = ireq + 1
2031  tagc = tagc + 1
2032  enddo
2033 
2034  !--- To 8-Direction HALO communicate
2035  ! To N HALO
2036  tagc = 40
2037  do j = je-jhalo+1, je
2038  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2039  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2040  ireq = ireq + 1
2041  tagc = tagc + 1
2042  enddo
2043  ! To S HALO
2044  tagc = 50
2045  do j = js, js+jhalo-1
2046  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2047  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2048  ireq = ireq + 1
2049  tagc = tagc + 1
2050  enddo
2051  if ( .not. prc_twod ) then
2052  ! To W HALO
2053  tagc = 60
2054 #ifdef _OPENACC
2055  ptr => ginfo(gid)%sendpack_P2WE(:,:,seqid)
2056  !$acc host_data use_device(ptr)
2057  call mpi_send_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2058 #else
2059  call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2060 #endif
2061  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2062  ireq = ireq + 1
2063  ! To E HALO
2064  tagc = 70
2065 #ifdef _OPENACC
2066  call mpi_send_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2067 #else
2068  call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2069 #endif
2070  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2071  !$acc end host_data
2072  ireq = ireq + 1
2073  ! To NW HALO
2074  tagc = 0
2075  do j = je-jhalo+1, je
2076  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2077  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2078  ireq = ireq + 1
2079  tagc = tagc + 1
2080  enddo
2081  ! To NE HALO
2082  tagc = 10
2083  do j = je-jhalo+1, je
2084  call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2085  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2086  ireq = ireq + 1
2087  tagc = tagc + 1
2088  enddo
2089  ! To SW HALO
2090  tagc = 20
2091  do j = js, js+jhalo-1
2092  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2093  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2094  ireq = ireq + 1
2095  tagc = tagc + 1
2096  enddo
2097  ! To SE HALO
2098  tagc = 30
2099  do j = js, js+jhalo-1
2100  call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2101  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2102  ireq = ireq + 1
2103  tagc = tagc + 1
2104  enddo
2105  end if
2106 
2107  else ! non-periodic condition
2108 
2109  !--- From 8-Direction HALO communicate
2110  if ( .not. prc_twod ) then
2111  ! From SE
2112  if ( prc_has_s .AND. prc_has_e ) then
2113  tagc = 0
2114  do j = 1, js-1
2115  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2116  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2117  ireq = ireq + 1
2118  tagc = tagc + 1
2119  enddo
2120  else if ( prc_has_s ) then
2121  tagc = 0
2122  do j = 1, js-1
2123  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2124  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2125  ireq = ireq + 1
2126  tagc = tagc + 1
2127  enddo
2128  else if ( prc_has_e ) then
2129  tagc = 0
2130  do j = 1, js-1
2131  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2132  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2133  ireq = ireq + 1
2134  tagc = tagc + 1
2135  enddo
2136  endif
2137  ! From SW
2138  if ( prc_has_s .AND. prc_has_w ) then
2139  tagc = 10
2140  do j = 1, js-1
2141  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2142  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2143  ireq = ireq + 1
2144  tagc = tagc + 1
2145  enddo
2146  else if ( prc_has_s ) then
2147  tagc = 10
2148  do j = 1, js-1
2149  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2150  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2151  ireq = ireq + 1
2152  tagc = tagc + 1
2153  enddo
2154  else if ( prc_has_w ) then
2155  tagc = 10
2156  do j = 1, js-1
2157  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2158  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2159  ireq = ireq + 1
2160  tagc = tagc + 1
2161  enddo
2162  endif
2163  ! From NE
2164  if ( prc_has_n .AND. prc_has_e ) then
2165  tagc = 20
2166  do j = je+1, ja
2167  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2168  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2169  ireq = ireq + 1
2170  tagc = tagc + 1
2171  enddo
2172  else if ( prc_has_n ) then
2173  tagc = 20
2174  do j = je+1, ja
2175  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2176  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2177  ireq = ireq + 1
2178  tagc = tagc + 1
2179  enddo
2180  else if ( prc_has_e ) then
2181  tagc = 20
2182  do j = je+1, ja
2183  call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2184  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2185  ireq = ireq + 1
2186  tagc = tagc + 1
2187  enddo
2188  endif
2189  ! From NW
2190  if ( prc_has_n .AND. prc_has_w ) then
2191  tagc = 30
2192  do j = je+1, ja
2193  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2194  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2195  ireq = ireq + 1
2196  tagc = tagc + 1
2197  enddo
2198  else if ( prc_has_n ) then
2199  tagc = 30
2200  do j = je+1, ja
2201  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2202  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2203  ireq = ireq + 1
2204  tagc = tagc + 1
2205  enddo
2206  else if ( prc_has_w ) then
2207  tagc = 30
2208  do j = je+1, ja
2209  call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2210  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2211  ireq = ireq + 1
2212  tagc = tagc + 1
2213  enddo
2214  endif
2215 #ifdef _OPENACC
2216  ptr => ginfo(gid)%recvpack_WE2P(:,:,seqid)
2217  !$acc host_data use_device(ptr)
2218 #endif
2219  ! From E
2220  if ( prc_has_e ) then
2221  tagc = 60
2222 #ifdef _OPENACC
2223  call mpi_recv_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2224 #else
2225  call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2226 #endif
2227  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2228  ireq = ireq + 1
2229  endif
2230  ! From W
2231  if ( prc_has_w ) then
2232  tagc = 70
2233 #ifdef _OPENACC
2234  call mpi_recv_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2235 #else
2236  call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2237 #endif
2238  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2239  ireq = ireq + 1
2240  endif
2241  !$acc end host_data
2242  end if
2243  ! From S
2244  if ( prc_has_s ) then
2245  tagc = 40
2246  do j = 1, js-1
2247  call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2248  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2249  ireq = ireq + 1
2250  tagc = tagc + 1
2251  enddo
2252  endif
2253  ! From N
2254  if ( prc_has_n ) then
2255  tagc = 50
2256  do j = je+1, ja
2257  call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2258  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2259  ireq = ireq + 1
2260  tagc = tagc + 1
2261  enddo
2262  endif
2263 
2264  !--- To 8-Direction HALO communicate
2265  ! To N HALO
2266  if ( prc_has_n ) then
2267  tagc = 40
2268  do j = je-jhalo+1, je
2269  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2270  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2271  ireq = ireq + 1
2272  tagc = tagc + 1
2273  enddo
2274  endif
2275  ! To S HALO
2276  if ( prc_has_s ) then
2277  tagc = 50
2278  do j = js, js+jhalo-1
2279  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2280  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2281  ireq = ireq + 1
2282  tagc = tagc + 1
2283  enddo
2284  endif
2285  if ( .not. prc_twod ) then
2286 #ifdef _OPENACC
2287  ptr => ginfo(gid)%sendpack_P2WE(:,:,seqid)
2288  !$acc host_data use_device(ptr)
2289 #endif
2290  ! To W HALO
2291  if ( prc_has_w ) then
2292  tagc = 60
2293 #ifdef _OPENACC
2294  call mpi_send_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2295 #else
2296  call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2297 #endif
2298  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2299  ireq = ireq + 1
2300  endif
2301  ! To E HALO
2302  if ( prc_has_e ) then
2303  tagc = 70
2304 #ifdef _OPENACC
2305  call mpi_send_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2306 #else
2307  call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2308 #endif
2309  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2310  ireq = ireq + 1
2311  endif
2312  !$acc end host_data
2313  ! To NW HALO
2314  if ( prc_has_n .AND. prc_has_w ) then
2315  tagc = 0
2316  do j = je-jhalo+1, je
2317  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2318  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2319  ireq = ireq + 1
2320  tagc = tagc + 1
2321  enddo
2322  else if ( prc_has_n ) then
2323  tagc = 10
2324  do j = je-jhalo+1, je
2325  call mpi_send_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2326  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2327  ireq = ireq + 1
2328  tagc = tagc + 1
2329  enddo
2330  else if ( prc_has_w ) then
2331  tagc = 20
2332  do j = je+1, ja
2333  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2334  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2335  ireq = ireq + 1
2336  tagc = tagc + 1
2337  enddo
2338  endif
2339  ! To NE HALO
2340  if ( prc_has_n .AND. prc_has_e ) then
2341  tagc = 10
2342  do j = je-jhalo+1, je
2343  call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2344  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2345  ireq = ireq + 1
2346  tagc = tagc + 1
2347  enddo
2348  else if ( prc_has_n ) then
2349  tagc = 0
2350  do j = je-jhalo+1, je
2351  call mpi_send_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2352  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2353  ireq = ireq + 1
2354  tagc = tagc + 1
2355  enddo
2356  else if ( prc_has_e ) then
2357  tagc = 30
2358  do j = je+1, ja
2359  call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2360  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2361  ireq = ireq + 1
2362  tagc = tagc + 1
2363  enddo
2364  endif
2365  ! To SW HALO
2366  if ( prc_has_s .AND. prc_has_w ) then
2367  tagc = 20
2368  do j = js, js+jhalo-1
2369  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2370  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2371  ireq = ireq + 1
2372  tagc = tagc + 1
2373  enddo
2374  else if ( prc_has_s ) then
2375  tagc = 30
2376  do j = js, js+jhalo-1
2377  call mpi_send_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2378  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2379  ireq = ireq + 1
2380  tagc = tagc + 1
2381  enddo
2382  else if ( prc_has_w ) then
2383  tagc = 0
2384  do j = 1, js-1
2385  call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2386  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2387  ireq = ireq + 1
2388  tagc = tagc + 1
2389  enddo
2390  endif
2391  ! To SE HALO
2392  if ( prc_has_s .AND. prc_has_e ) then
2393  tagc = 30
2394  do j = js, js+jhalo-1
2395  call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2396  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2397  ireq = ireq + 1
2398  tagc = tagc + 1
2399  enddo
2400  else if ( prc_has_s ) then
2401  tagc = 20
2402  do j = js, js+jhalo-1
2403  call mpi_send_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2404  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2405  ireq = ireq + 1
2406  tagc = tagc + 1
2407  enddo
2408  else if ( prc_has_e ) then
2409  tagc = 10
2410  do j = 1, js-1
2411  call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2412  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
2413  ireq = ireq + 1
2414  tagc = tagc + 1
2415  enddo
2416  endif
2417  end if
2418 
2419  endif
2420 
2421  ginfo(gid)%preq_cnt(vid) = ireq - 1
2422 
2423  ! to finish initial processes of MPI
2424  nreq = ginfo(gid)%preq_cnt(vid)
2425  do i = 1, 32
2426  call mpi_testall( nreq, ginfo(gid)%preq_list(1:nreq,vid), &
2427  flag, mpi_statuses_ignore, ierr )
2428  enddo
2429 
2430  !$acc end host_data
2431 
2432  return
2433  end subroutine vars8_init_mpi_pc
2434 
2435  subroutine vars_3d_mpi(var, gid, vid)
2436  use scale_prc, only: &
2437  prc_abort
2438  use scale_prc_cartesc, only: &
2439  prc_twod
2440  implicit none
2441 
2442  real(RP), intent(inout) :: var(:,:,:)
2443  integer, intent(in) :: gid
2444  integer, intent(in) :: vid
2445 
2446 
2447  integer :: ireq, tag
2448 
2449  integer :: KA
2450  integer :: IA, IS, IE
2451  integer :: JA, JS, JE
2452  integer :: IHALO, JHALO
2453 
2454  integer :: ierr
2455 #ifdef _OPENACC
2456  real(RP), pointer :: ptr(:,:)
2457  logical :: flag_device
2458 #endif
2459  !---------------------------------------------------------------------------
2460 
2461  tag = ( (gid - 1) * comm_vsize_max + vid ) * 100
2462  ireq = 1
2463 
2464  ka = ginfo(gid)%KA
2465  ia = ginfo(gid)%IA
2466  is = ginfo(gid)%IS
2467  ie = ginfo(gid)%IE
2468  ja = ginfo(gid)%JA
2469  js = ginfo(gid)%JS
2470  je = ginfo(gid)%JE
2471  ihalo = ginfo(gid)%IHALO
2472  jhalo = ginfo(gid)%JHALO
2473 
2474 #ifdef DEBUG
2475  if ( ginfo(gid)%use_packbuf(vid) ) then
2476  log_error("vars_3D_mpi",*) 'packing buffer is already used', vid
2477  call prc_abort
2478  end if
2479  ginfo(gid)%use_packbuf(vid) = .true.
2480 #endif
2481 
2482 #ifdef _OPENACC
2483  flag_device = acc_is_present(var)
2484 #endif
2485 
2486  !$acc host_data use_device(var) if(flag_device)
2487 
2488  !--- From 4-Direction HALO communicate
2489  ! From S
2490  if ( prc_has_s ) then
2491  call mpi_irecv( var(:,:,1:js-1), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2492  prc_next(prc_s), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2493  ireq = ireq + 1
2494  endif
2495  ! From N
2496  if ( prc_has_n ) then
2497  call mpi_irecv( var(:,:,je+1:ja), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2498  prc_next(prc_n), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2499  ireq = ireq + 1
2500  endif
2501  if ( .not. prc_twod ) then
2502 #ifdef _OPENACC
2503  ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
2504  !$acc host_data use_device(ptr) if(flag_device)
2505 #endif
2506  ! From E
2507  if ( prc_has_e ) then
2508 #ifdef _OPENACC
2509  call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2510 #else
2511  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2512 #endif
2513  prc_next(prc_e), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2514  ireq = ireq + 1
2515  endif
2516  ! From W
2517  if ( prc_has_w ) then
2518 #ifdef _OPENACC
2519  call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2520 #else
2521  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2522 #endif
2523  prc_next(prc_w), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2524  ireq = ireq + 1
2525  endif
2526  !$acc end host_data
2527  end if
2528 
2529  !$acc end host_data
2530 
2531  !--- To 4-Direction HALO communicate
2532  if ( .not. prc_twod ) then
2533  call packwe_3d( ka, ia, is, ie, ja, js, je, &
2534  ihalo, &
2535  var, gid, vid)
2536  end if
2537 
2538  !$acc host_data use_device(var) if(flag_device)
2539 
2540  ! To N HALO
2541  if ( prc_has_n ) then
2542  call mpi_isend( var(:,:,je-jhalo+1:je), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2543  prc_next(prc_n), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2544  ireq = ireq + 1
2545  endif
2546  ! To S HALO
2547  if ( prc_has_s ) then
2548  call mpi_isend( var(:,:,js:js+jhalo-1), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2549  prc_next(prc_s), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2550  ireq = ireq + 1
2551  endif
2552 
2553  !$acc end host_data
2554 
2555  if ( .not. prc_twod ) then
2556 #ifdef _OPENACC
2557  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
2558  !$acc wait
2559  !$acc host_data use_device(ptr) if(flag_device)
2560 #endif
2561  ! To W HALO
2562  if ( prc_has_w ) then
2563 #ifdef _OPENACC
2564  call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2565 #else
2566  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2567 #endif
2568  prc_next(prc_w), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2569  ireq = ireq + 1
2570  endif
2571  ! To E HALO
2572  if ( prc_has_e ) then
2573 #ifdef _OPENACC
2574  call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2575 #else
2576  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2577 #endif
2578  prc_next(prc_e), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2579  ireq = ireq + 1
2580  endif
2581 
2582  !$acc end host_data
2583  end if
2584 
2585  ginfo(gid)%req_cnt(vid) = ireq - 1
2586 
2587  return
2588  end subroutine vars_3d_mpi
2589 
2590  subroutine vars_3d_mpi_onesided(var, gid, vid)
2591  use scale_prc, only: &
2592  prc_abort
2593  use scale_prc_cartesc, only: &
2594  prc_twod
2595  implicit none
2596 
2597  real(RP), intent(inout) :: var(:,:,:)
2598  integer, intent(in) :: gid
2599  integer, intent(in) :: vid
2600 
2601  integer :: KA
2602  integer :: IA, IS, IE
2603  integer :: JA, JS, JE
2604  integer :: IHALO, JHALO
2605 
2606  integer(kind=MPI_ADDRESS_KIND) :: disp
2607 
2608  integer :: ierr
2609 #ifdef _OPENACC
2610  real(RP), pointer :: ptr(:,:)
2611 #endif
2612  !---------------------------------------------------------------------------
2613 
2614  ka = ginfo(gid)%KA
2615  ia = ginfo(gid)%IA
2616  is = ginfo(gid)%IS
2617  ie = ginfo(gid)%IE
2618  ja = ginfo(gid)%JA
2619  js = ginfo(gid)%JS
2620  je = ginfo(gid)%JE
2621  ihalo = ginfo(gid)%IHALO
2622  jhalo = ginfo(gid)%JHALO
2623 
2624  !$acc data copyin(var)
2625 
2626  call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
2627  call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
2628 
2629  !--- To 4-Direction HALO communicate
2630  if ( .not. prc_twod ) then
2631  call packwe_3d( ka, ia, is, ie, ja, js, je, &
2632  ihalo, &
2633  var, gid, vid)
2634  end if
2635 
2636  !$acc host_data use_device(var)
2637 
2638  ! To N HALO
2639  if ( prc_has_n ) then
2640  disp = 0
2641  call mpi_put( var(:,:,je-jhalo+1:je), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2642  prc_next(prc_n), disp, ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2643  ginfo(gid)%win_packNS(vid), ierr )
2644  endif
2645  ! To S HALO
2646  if ( prc_has_s ) then
2647  disp = ka * ia * jhalo
2648  call mpi_put( var(:,:,js:js+jhalo-1), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2649  prc_next(prc_s), disp, ginfo(gid)%size2D_NS4*ka, comm_datatype, &
2650  ginfo(gid)%win_packNS(vid), ierr )
2651  endif
2652 
2653  !$acc end host_data
2654 
2655  if ( .not. prc_twod ) then
2656 #ifdef _OPENACC
2657  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
2658  !$acc wait
2659  !$acc host_data use_device(ptr)
2660 #endif
2661 
2662  ! To W HALO
2663  if ( prc_has_w ) then
2664  disp = 1
2665 #ifdef _OPENACC
2666  call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2667 #else
2668  call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2669 #endif
2670  prc_next(prc_w), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
2671  ginfo(gid)%win_packWE(vid), ierr )
2672  endif
2673  ! To E HALO
2674  if ( prc_has_e ) then
2675  disp = 0
2676 #ifdef _OPENACC
2677  call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2678 #else
2679  call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2680 #endif
2681  prc_next(prc_e), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
2682  ginfo(gid)%win_packWE(vid), ierr )
2683  endif
2684 
2685  !$acc end host_data
2686  end if
2687 
2688  call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
2689  call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
2690 
2691  !$acc end data
2692 
2693  return
2694  end subroutine vars_3d_mpi_onesided
2695 
2696  subroutine vars8_3d_mpi(var, gid, vid)
2697  use scale_prc, only: &
2698  prc_abort
2699  use scale_prc_cartesc, only: &
2700  prc_twod
2701  implicit none
2702 
2703  real(RP), intent(inout) :: var(:,:,:)
2704  integer, intent(in) :: gid
2705  integer, intent(in) :: vid
2706 
2707  integer :: ireq, tag, tagc
2708 
2709  integer :: KA
2710  integer :: IA, IS, IE
2711  integer :: JA, JS, JE
2712  integer :: IHALO, JHALO
2713 
2714  integer :: ierr
2715  integer :: j
2716 #ifdef _OPENACC
2717  real(RP), pointer :: ptr(:,:)
2718  logical :: flag_device
2719 #endif
2720  !---------------------------------------------------------------------------
2721 
2722  tag = ( (gid - 1) * comm_vsize_max + vid ) * 100
2723  tag = vid * 100
2724  ireq = 1
2725 
2726  ka = ginfo(gid)%KA
2727  ia = ginfo(gid)%IA
2728  is = ginfo(gid)%IS
2729  ie = ginfo(gid)%IE
2730  ja = ginfo(gid)%JA
2731  js = ginfo(gid)%JS
2732  je = ginfo(gid)%JE
2733  ihalo = ginfo(gid)%IHALO
2734  jhalo = ginfo(gid)%JHALO
2735 
2736 #ifdef DEBUG
2737  if ( ginfo(gid)%use_packbuf(vid) ) then
2738  log_error("vars8_3D_mpi",*) 'packing buffer is already used', vid
2739  call prc_abort
2740  end if
2741  ginfo(gid)%use_packbuf(vid) = .true.
2742 #endif
2743 
2744 #ifdef _OPENACC
2745  flag_device = acc_is_present(var)
2746 #endif
2747 
2748  if ( comm_isallperiodic ) then ! periodic condition
2749 
2750  !$acc host_data use_device(var) if(flag_device)
2751 
2752  !--- From 8-Direction HALO communicate
2753  if ( .not. prc_twod ) then
2754  ! From SE
2755  tagc = 0
2756  do j = 1, js-1
2757  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2758  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2759  ireq = ireq + 1
2760  tagc = tagc + 1
2761  enddo
2762  ! From SW
2763  tagc = 10
2764  do j = 1, js-1
2765  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2766  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2767  ireq = ireq + 1
2768  tagc = tagc + 1
2769  enddo
2770  ! From NE
2771  tagc = 20
2772  do j = je+1, ja
2773  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2774  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2775  ireq = ireq + 1
2776  tagc = tagc + 1
2777  enddo
2778  ! From NW
2779  tagc = 30
2780  do j = je+1, ja
2781  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2782  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2783  ireq = ireq + 1
2784  tagc = tagc + 1
2785  enddo
2786 #ifdef _OPENACC
2787  ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
2788  !$acc host_data use_device(ptr) if(flag_device)
2789 #endif
2790  ! From E
2791  tagc = 60
2792 #ifdef _OPENACC
2793  call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2794 #else
2795  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2796 #endif
2797  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2798  ireq = ireq + 1
2799  ! From W
2800  tagc = 70
2801 #ifdef _OPENACC
2802  call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2803 #else
2804  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2805 #endif
2806  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2807  ireq = ireq + 1
2808  !$acc end host_data
2809  end if
2810  ! From S
2811  tagc = 40
2812  do j = 1, js-1
2813  call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2814  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2815  ireq = ireq + 1
2816  tagc = tagc + 1
2817  enddo
2818  ! From N
2819  tagc = 50
2820  do j = je+1, ja
2821  call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2822  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2823  ireq = ireq + 1
2824  tagc = tagc + 1
2825  enddo
2826 
2827  !--- To 8-Direction HALO communicate
2828  ! To N HALO
2829  tagc = 40
2830  do j = je-jhalo+1, je
2831  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2832  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2833  ireq = ireq + 1
2834  tagc = tagc + 1
2835  enddo
2836  ! To S HALO
2837  tagc = 50
2838  do j = js, js+jhalo-1
2839  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
2840  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2841  ireq = ireq + 1
2842  tagc = tagc + 1
2843  enddo
2844 
2845  !$acc end host_data
2846 
2847  if ( .not. prc_twod ) then
2848 
2849  call packwe_3d( ka, ia, is, ie, ja, js, je, &
2850  ihalo, &
2851  var, gid, vid)
2852 
2853  !$acc host_data use_device(var) if(flag_device)
2854 
2855  ! To NW HALO
2856  tagc = 0
2857  do j = je-jhalo+1, je
2858  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2859  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2860  ireq = ireq + 1
2861  tagc = tagc + 1
2862  enddo
2863  ! To NE HALO
2864  tagc = 10
2865  do j = je-jhalo+1, je
2866  call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2867  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2868  ireq = ireq + 1
2869  tagc = tagc + 1
2870  enddo
2871  ! To SW HALO
2872  tagc = 20
2873  do j = js, js+jhalo-1
2874  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2875  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2876  ireq = ireq + 1
2877  tagc = tagc + 1
2878  enddo
2879  ! To SE HALO
2880  tagc = 30
2881  do j = js, js+jhalo-1
2882  call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2883  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2884  ireq = ireq + 1
2885  tagc = tagc + 1
2886  enddo
2887 
2888  !$acc end host_data
2889 
2890 #ifdef _OPENACC
2891  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
2892  !$acc wait
2893  !$acc host_data use_device(ptr) if(flag_device)
2894 #endif
2895  ! To W HALO
2896  tagc = 60
2897 #ifdef _OPENACC
2898  call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2899 #else
2900  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2901 #endif
2902  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2903  ireq = ireq + 1
2904  ! To E HALO
2905  tagc = 70
2906 #ifdef _OPENACC
2907  call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2908 #else
2909  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
2910 #endif
2911  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2912  !$acc end host_data
2913  ireq = ireq + 1
2914 
2915  end if
2916 
2917  else ! non-periodic condition
2918 
2919  !$acc host_data use_device(var) if(flag_device)
2920 
2921  !--- From 8-Direction HALO communicate
2922  if ( .not. prc_twod ) then
2923  ! From SE
2924  if ( prc_has_s .AND. prc_has_e ) then
2925  tagc = 0
2926  do j = 1, js-1
2927  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2928  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2929  ireq = ireq + 1
2930  tagc = tagc + 1
2931  enddo
2932  else if ( prc_has_s ) then
2933  tagc = 0
2934  do j = 1, js-1
2935  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2936  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2937  ireq = ireq + 1
2938  tagc = tagc + 1
2939  enddo
2940  else if ( prc_has_e ) then
2941  tagc = 0
2942  do j = 1, js-1
2943  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2944  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2945  ireq = ireq + 1
2946  tagc = tagc + 1
2947  enddo
2948  endif
2949  ! From SW
2950  if ( prc_has_s .AND. prc_has_w ) then
2951  tagc = 10
2952  do j = 1, js-1
2953  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2954  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2955  ireq = ireq + 1
2956  tagc = tagc + 1
2957  enddo
2958  else if ( prc_has_s ) then
2959  tagc = 10
2960  do j = 1, js-1
2961  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2962  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2963  ireq = ireq + 1
2964  tagc = tagc + 1
2965  enddo
2966  else if ( prc_has_w ) then
2967  tagc = 10
2968  do j = 1, js-1
2969  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2970  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2971  ireq = ireq + 1
2972  tagc = tagc + 1
2973  enddo
2974  endif
2975  ! From NE
2976  if ( prc_has_n .AND. prc_has_e ) then
2977  tagc = 20
2978  do j = je+1, ja
2979  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2980  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2981  ireq = ireq + 1
2982  tagc = tagc + 1
2983  enddo
2984  else if ( prc_has_n ) then
2985  tagc = 20
2986  do j = je+1, ja
2987  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2988  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2989  ireq = ireq + 1
2990  tagc = tagc + 1
2991  enddo
2992  else if ( prc_has_e ) then
2993  tagc = 20
2994  do j = je+1, ja
2995  call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
2996  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
2997  ireq = ireq + 1
2998  tagc = tagc + 1
2999  enddo
3000  endif
3001  ! From NW
3002  if ( prc_has_n .AND. prc_has_w ) then
3003  tagc = 30
3004  do j = je+1, ja
3005  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3006  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3007  ireq = ireq + 1
3008  tagc = tagc + 1
3009  enddo
3010  else if ( prc_has_n ) then
3011  tagc = 30
3012  do j = je+1, ja
3013  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3014  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3015  ireq = ireq + 1
3016  tagc = tagc + 1
3017  enddo
3018  else if ( prc_has_w ) then
3019  tagc = 30
3020  do j = je+1, ja
3021  call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3022  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3023  ireq = ireq + 1
3024  tagc = tagc + 1
3025  enddo
3026  endif
3027 #ifdef _OPENACC
3028  ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
3029  !$acc host_data use_device(ptr) if(flag_device)
3030 #endif
3031  ! From E
3032  if ( prc_has_e ) then
3033  tagc = 60
3034 #ifdef _OPENACC
3035  call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3036 #else
3037  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3038 #endif
3039  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3040  ireq = ireq + 1
3041  endif
3042  ! From W
3043  if ( prc_has_w ) then
3044  tagc = 70
3045 #ifdef _OPENACC
3046  call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3047 #else
3048  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3049 #endif
3050  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3051  ireq = ireq + 1
3052  endif
3053  !$acc end host_data
3054  end if
3055  ! From S
3056  if ( prc_has_s ) then
3057  tagc = 40
3058  do j = 1, js-1
3059  call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3060  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3061  ireq = ireq + 1
3062  tagc = tagc + 1
3063  enddo
3064  endif
3065  ! From N
3066  if ( prc_has_n ) then
3067  tagc = 50
3068  do j = je+1, ja
3069  call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3070  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3071  ireq = ireq + 1
3072  tagc = tagc + 1
3073  enddo
3074  endif
3075 
3076  !--- To 8-Direction HALO communicate
3077  ! To N HALO
3078  if ( prc_has_n ) then
3079  tagc = 40
3080  do j = je-jhalo+1, je
3081  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3082  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3083  ireq = ireq + 1
3084  tagc = tagc + 1
3085  enddo
3086  endif
3087  ! To S HALO
3088  if ( prc_has_s ) then
3089  tagc = 50
3090  do j = js, js+jhalo-1
3091  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3092  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3093  ireq = ireq + 1
3094  tagc = tagc + 1
3095  enddo
3096  endif
3097 
3098  !$acc end host_data
3099 
3100  if ( .not. prc_twod ) then
3101 
3102  call packwe_3d( ka, ia, is, ie, ja, js, je, &
3103  ihalo, &
3104  var, gid, vid)
3105 
3106  !$acc host_data use_device(var) if(flag_device)
3107 
3108  ! To NW HALO
3109  if ( prc_has_n .AND. prc_has_w ) then
3110  tagc = 0
3111  do j = je-jhalo+1, je
3112  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3113  prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3114  ireq = ireq + 1
3115  tagc = tagc + 1
3116  enddo
3117  else if ( prc_has_n ) then
3118  tagc = 10
3119  do j = je-jhalo+1, je
3120  call mpi_isend( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3121  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3122  ireq = ireq + 1
3123  tagc = tagc + 1
3124  enddo
3125  else if ( prc_has_w ) then
3126  tagc = 20
3127  do j = je+1, ja
3128  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3129  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3130  ireq = ireq + 1
3131  tagc = tagc + 1
3132  enddo
3133  endif
3134  ! To NE HALO
3135  if ( prc_has_n .AND. prc_has_e ) then
3136  tagc = 10
3137  do j = je-jhalo+1, je
3138  call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3139  prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3140  ireq = ireq + 1
3141  tagc = tagc + 1
3142  enddo
3143  else if ( prc_has_n ) then
3144  tagc = 0
3145  do j = je-jhalo+1, je
3146  call mpi_isend( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3147  prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3148  ireq = ireq + 1
3149  tagc = tagc + 1
3150  enddo
3151  else if ( prc_has_e ) then
3152  tagc = 30
3153  do j = je+1, ja
3154  call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3155  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3156  ireq = ireq + 1
3157  tagc = tagc + 1
3158  enddo
3159  endif
3160  ! To SW HALO
3161  if ( prc_has_s .AND. prc_has_w ) then
3162  tagc = 20
3163  do j = js, js+jhalo-1
3164  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3165  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3166  ireq = ireq + 1
3167  tagc = tagc + 1
3168  enddo
3169  else if ( prc_has_s ) then
3170  tagc = 30
3171  do j = js, js+jhalo-1
3172  call mpi_isend( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3173  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3174  ireq = ireq + 1
3175  tagc = tagc + 1
3176  enddo
3177  else if ( prc_has_w ) then
3178  tagc = 0
3179  do j = 1, js-1
3180  call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3181  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3182  ireq = ireq + 1
3183  tagc = tagc + 1
3184  enddo
3185  endif
3186  ! To SE HALO
3187  if ( prc_has_s .AND. prc_has_e ) then
3188  tagc = 30
3189  do j = js, js+jhalo-1
3190  call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3191  prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3192  ireq = ireq + 1
3193  tagc = tagc + 1
3194  enddo
3195  else if ( prc_has_s ) then
3196  tagc = 20
3197  do j = js, js+jhalo-1
3198  call mpi_isend( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3199  prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3200  ireq = ireq + 1
3201  tagc = tagc + 1
3202  enddo
3203  else if ( prc_has_e ) then
3204  tagc = 10
3205  do j = 1, js-1
3206  call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3207  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3208  ireq = ireq + 1
3209  tagc = tagc + 1
3210  enddo
3211  endif
3212 
3213  !$acc end host_data
3214 
3215 #ifdef _OPENACC
3216  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
3217  !$acc wait
3218  !$acc host_data use_device(ptr) if(flag_device)
3219 #endif
3220 
3221  ! To W HALO
3222  if ( prc_has_w ) then
3223  tagc = 60
3224 #ifdef _OPENACC
3225  call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3226 #else
3227  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3228 #endif
3229  prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3230  ireq = ireq + 1
3231  endif
3232  ! To E HALO
3233  if ( prc_has_e ) then
3234  tagc = 70
3235 #ifdef _OPENACC
3236  call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3237 #else
3238  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3239 #endif
3240  prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3241  ireq = ireq + 1
3242  endif
3243  !$acc end host_data
3244 
3245  end if
3246 
3247  endif
3248 
3249  ginfo(gid)%req_cnt(vid) = ireq - 1
3250 
3251  return
3252  end subroutine vars8_3d_mpi
3253 
3254  subroutine vars8_3d_mpi_onesided(var, gid, vid)
3255  use scale_prc, only: &
3256  prc_abort
3257  use scale_prc_cartesc, only: &
3258  prc_twod
3259  implicit none
3260 
3261  real(RP), intent(inout) :: var(:,:,:)
3262  integer, intent(in) :: gid
3263  integer, intent(in) :: vid
3264 
3265  integer :: KA
3266  integer :: IA, IS, IE
3267  integer :: JA, JS, JE
3268  integer :: IHALO, JHALO
3269 
3270  integer(kind=MPI_ADDRESS_KIND) :: disp
3271 
3272  integer :: ierr
3273  integer :: j
3274 #ifdef _OPENACC
3275  real(RP), pointer :: ptr(:,:)
3276 #endif
3277  !---------------------------------------------------------------------------
3278 
3279  ka = ginfo(gid)%KA
3280  ia = ginfo(gid)%IA
3281  is = ginfo(gid)%IS
3282  ie = ginfo(gid)%IE
3283  ja = ginfo(gid)%JA
3284  js = ginfo(gid)%JS
3285  je = ginfo(gid)%JE
3286  ihalo = ginfo(gid)%IHALO
3287  jhalo = ginfo(gid)%JHALO
3288 
3289  !$acc data copyin(var)
3290  call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
3291  call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
3292 
3293  if ( comm_isallperiodic ) then ! periodic condition
3294 
3295  !$acc host_data use_device(var)
3296 
3297  !--- To 8-Direction HALO communicate
3298  ! To N HALO
3299  do j = je-jhalo+1, je
3300  disp = ka * ( ihalo + ia * ( j - je+jhalo-1 ) )
3301  call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3302  prc_next(prc_n), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3303  ginfo(gid)%win_packNS(vid), ierr )
3304  enddo
3305  ! To S HALO
3306  do j = js, js+jhalo-1
3307  disp = ka * ( ihalo + ia * ( j - js + jhalo ) )
3308  call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3309  prc_next(prc_s), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3310  ginfo(gid)%win_packNS(vid), ierr )
3311  enddo
3312 
3313  !$acc end host_data
3314 
3315  if ( .not. prc_twod ) then
3316 
3317  call packwe_3d( ka, ia, is, ie, ja, js, je, &
3318  ihalo, &
3319  var, gid, vid)
3320 
3321  !$acc host_data use_device(var)
3322  ! To NW HALO
3323  do j = je-jhalo+1, je
3324  disp = ka * ( ie + ia * ( j - je+jhalo-1 ) )
3325  call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3326  prc_next(prc_nw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3327  ginfo(gid)%win_packNS(vid), ierr )
3328  enddo
3329  ! To NE HALO
3330  do j = je-jhalo+1, je
3331  disp = ka * ( ia * ( j - je+jhalo-1 ) )
3332  call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3333  prc_next(prc_ne), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3334  ginfo(gid)%win_packNS(vid), ierr )
3335  enddo
3336  ! To SW HALO
3337  do j = js, js+jhalo-1
3338  disp = ka * ( ie + ia * ( j - js + jhalo ) )
3339  call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3340  prc_next(prc_sw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3341  ginfo(gid)%win_packNS(vid), ierr )
3342  enddo
3343  ! To SE HALO
3344  do j = js, js+jhalo-1
3345  disp = ka * ( ia * ( j - js + jhalo ) )
3346  call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3347  prc_next(prc_se), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3348  ginfo(gid)%win_packNS(vid), ierr )
3349  enddo
3350 
3351  !$acc end host_data
3352 
3353 #ifdef _OPENACC
3354  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
3355  !$acc wait
3356  !$acc host_data use_device(ptr)
3357 #endif
3358  ! To W HALO
3359  disp = 1
3360 #ifdef _OPENACC
3361  call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3362 #else
3363  call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3364 #endif
3365  prc_next(prc_w), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
3366  ginfo(gid)%win_packWE(vid), ierr )
3367  ! To E HALO
3368  disp = 0
3369 #ifdef _OPENACC
3370  call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3371 #else
3372  call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3373 #endif
3374  prc_next(prc_e), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
3375  ginfo(gid)%win_packWE(vid), ierr )
3376  !$acc end host_data
3377 
3378  end if
3379 
3380  else ! non-periodic condition
3381 
3382  !$acc host_data use_device(var)
3383 
3384  !--- To 8-Direction HALO communicate
3385  ! To N HALO
3386  if ( prc_has_n ) then
3387  do j = je-jhalo+1, je
3388  disp = ka * ( ihalo + ia * ( j - je+jhalo-1 ) )
3389  call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3390  prc_next(prc_n), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3391  ginfo(gid)%win_packNS(vid), ierr )
3392  enddo
3393  endif
3394  ! To S HALO
3395  if ( prc_has_s ) then
3396  do j = js, js+jhalo-1
3397  disp = ka * ( ihalo + ia * ( j - js + jhalo ) )
3398  call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3399  prc_next(prc_s), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
3400  ginfo(gid)%win_packNS(vid), ierr )
3401  enddo
3402  endif
3403 
3404  !$acc end host_data
3405 
3406  if ( .not. prc_twod ) then
3407 
3408  call packwe_3d( ka, ia, is, ie, ja, js, je, &
3409  ihalo, &
3410  var, gid, vid)
3411 
3412  !$acc host_data use_device(var)
3413 
3414  ! To NW HALO
3415  if ( prc_has_n .AND. prc_has_w ) then
3416  do j = je-jhalo+1, je
3417  disp = ka * ( ie + ia * ( j - je+jhalo-1 ) )
3418  call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3419  prc_next(prc_nw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3420  ginfo(gid)%win_packNS(vid), ierr )
3421  enddo
3422  else if ( prc_has_n ) then
3423  do j = je-jhalo+1, je
3424  disp = ka * ( ia * ( j - je+jhalo-1 ) )
3425  call mpi_put( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3426  prc_next(prc_n), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3427  ginfo(gid)%win_packNS(vid), ierr )
3428  enddo
3429  else if ( prc_has_w ) then
3430  do j = je+1, ja
3431  disp = ka * ( ie + ia * ( j - je-1 + jhalo ) )
3432  call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3433  prc_next(prc_w), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3434  ginfo(gid)%win_packNS(vid), ierr )
3435  enddo
3436  endif
3437  ! To NE HALO
3438  if ( prc_has_n .AND. prc_has_e ) then
3439  do j = je-jhalo+1, je
3440  disp = ka * ( ia * ( j - je+jhalo-1 ) )
3441  call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3442  prc_next(prc_ne), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3443  ginfo(gid)%win_packNS(vid), ierr )
3444  enddo
3445  else if ( prc_has_n ) then
3446  do j = je-jhalo+1, je
3447  disp = ka * ( ie + ia * ( j - je+jhalo-1 ) )
3448  call mpi_put( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3449  prc_next(prc_n), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3450  ginfo(gid)%win_packNS(vid), ierr )
3451  enddo
3452  else if ( prc_has_e ) then
3453  do j = je+1, ja
3454  disp = ka * ia * ( j - je-1 + jhalo )
3455  call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3456  prc_next(prc_e), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3457  ginfo(gid)%win_packNS(vid), ierr )
3458  enddo
3459  endif
3460  ! To SW HALO
3461  if ( prc_has_s .AND. prc_has_w ) then
3462  do j = js, js+jhalo-1
3463  disp = ka * ( ie + ia * ( j - js + jhalo ) )
3464  call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3465  prc_next(prc_sw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3466  ginfo(gid)%win_packNS(vid), ierr )
3467  enddo
3468  else if ( prc_has_s ) then
3469  do j = js, js+jhalo-1
3470  disp = ka * ( ia * ( j - js + jhalo ) )
3471  call mpi_put( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3472  prc_next(prc_s), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3473  ginfo(gid)%win_packNS(vid), ierr )
3474  enddo
3475  else if ( prc_has_w ) then
3476  do j = 1, js-1
3477  disp = ka * ( ie + ia * (j-1) )
3478  call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3479  prc_next(prc_w), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3480  ginfo(gid)%win_packNS(vid), ierr )
3481  enddo
3482  endif
3483  ! To SE HALO
3484  if ( prc_has_s .AND. prc_has_e ) then
3485  do j = js, js+jhalo-1
3486  disp = ka * ( ia * ( j - js + jhalo ) )
3487  call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3488  prc_next(prc_se), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3489  ginfo(gid)%win_packNS(vid), ierr )
3490  enddo
3491  else if ( prc_has_s ) then
3492  do j = js, js+jhalo-1
3493  disp = ka * ( ie + ia * ( j - js + jhalo ) )
3494  call mpi_put( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3495  prc_next(prc_s), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3496  ginfo(gid)%win_packNS(vid), ierr )
3497  enddo
3498  else if ( prc_has_e ) then
3499  do j = 1, js-1
3500  disp = ka * ( ia * ( j - 1 ) )
3501  call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
3502  prc_next(prc_e), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
3503  ginfo(gid)%win_packNS(vid), ierr )
3504  enddo
3505  endif
3506 
3507  !$acc end host_data
3508 
3509 #ifdef _OPENACC
3510  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
3511  !$acc wait
3512  !$acc host_data use_device(ptr)
3513 #endif
3514 
3515  ! To W HALO
3516  if ( prc_has_w ) then
3517  disp = 1
3518 #ifdef _OPENACC
3519  call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3520 #else
3521  call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3522 #endif
3523  prc_next(prc_w), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
3524  ginfo(gid)%win_packWE(vid), ierr )
3525  endif
3526  ! To E HALO
3527  if ( prc_has_e ) then
3528  disp = 0
3529 #ifdef _OPENACC
3530  call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3531 #else
3532  call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
3533 #endif
3534  prc_next(prc_e), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
3535  ginfo(gid)%win_packWE(vid), ierr )
3536  endif
3537  !$acc end host_data
3538 
3539  end if
3540 
3541  endif
3542 
3543  call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
3544  call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
3545 
3546  !$acc end data
3547 
3548  return
3549  end subroutine vars8_3d_mpi_onesided
3550 
3551  subroutine vars_2d_mpi(var, gid, vid)
3552  use scale_prc, only: &
3553  prc_abort
3554  use scale_prc_cartesc, only: &
3555  prc_twod
3556  implicit none
3557 
3558  real(RP), intent(inout) :: var(:,:)
3559  integer, intent(in) :: gid
3560  integer, intent(in) :: vid
3561 
3562  integer :: IA, IS, IE
3563  integer :: JA, JS, JE
3564  integer :: IHALO, JHALO
3565 
3566  integer :: ireq, tag
3567  integer :: ierr
3568 #ifdef _OPENACC
3569  real(RP), pointer :: ptr(:,:)
3570  logical :: flag_device
3571 #endif
3572  !---------------------------------------------------------------------------
3573 
3574  ia = ginfo(gid)%IA
3575  is = ginfo(gid)%IS
3576  ie = ginfo(gid)%IE
3577  ja = ginfo(gid)%JA
3578  js = ginfo(gid)%JS
3579  je = ginfo(gid)%JE
3580  ihalo = ginfo(gid)%IHALO
3581  jhalo = ginfo(gid)%JHALO
3582 
3583  tag = ( (gid - 1) * comm_vsize_max + vid ) * 100
3584  ireq = 1
3585 
3586 #ifdef DEBUG
3587  if ( ginfo(gid)%use_packbuf(vid) ) then
3588  log_error("vars_2D_mpi",*) 'packing buffer is already used', vid
3589  call prc_abort
3590  end if
3591  ginfo(gid)%use_packbuf(vid) = .true.
3592 #endif
3593 
3594 #ifdef _OPENACC
3595  flag_device = acc_is_present(var)
3596 #endif
3597 
3598  !$acc host_data use_device(var) if(flag_device)
3599 
3600  !--- From 4-Direction HALO communicate
3601  ! From S
3602  if ( prc_has_s ) then
3603  call mpi_irecv( var(:,1:js-1), ginfo(gid)%size2D_NS4, comm_datatype, &
3604  prc_next(prc_s), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3605  ireq = ireq + 1
3606  endif
3607  ! From N
3608  if ( prc_has_n ) then
3609  call mpi_irecv( var(:,je+1:ja), ginfo(gid)%size2D_NS4, comm_datatype, &
3610  prc_next(prc_n), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3611  ireq = ireq + 1
3612  endif
3613 
3614  if ( .not. prc_twod ) then
3615 #ifdef _OPENACC
3616  ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
3617  !$acc host_data use_device(ptr) if(flag_device)
3618 #endif
3619  ! From E
3620  if ( prc_has_e ) then
3621 #ifdef _OPENACC
3622  call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
3623 #else
3624  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
3625 #endif
3626  prc_next(prc_e), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3627  ireq = ireq + 1
3628  endif
3629  ! From W
3630  if ( prc_has_w ) then
3631 #ifdef _OPENACC
3632  call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
3633 #else
3634  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
3635 #endif
3636  prc_next(prc_w), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3637  ireq = ireq + 1
3638  endif
3639  !$acc end host_data
3640  end if
3641 
3642  !$acc end host_data
3643 
3644  !--- To 4-Direction HALO communicate
3645  if ( .not. prc_twod ) then
3646 
3647  call packwe_2d( ia, is, ie, ja, js, je, &
3648  ihalo, &
3649  var, gid, vid)
3650 
3651 #ifdef _OPENACC
3652  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
3653  !$acc host_data use_device(ptr) if(flag_device)
3654 #endif
3655 
3656  ! To W HALO communicate
3657  if ( prc_has_w ) then
3658 #ifdef _OPENACC
3659  call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
3660 #else
3661  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
3662 #endif
3663  prc_next(prc_w), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3664  ireq = ireq + 1
3665  endif
3666  ! To E HALO communicate
3667  if ( prc_has_e ) then
3668 #ifdef _OPENACC
3669  call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
3670 #else
3671  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
3672 #endif
3673  prc_next(prc_e), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3674  ireq = ireq + 1
3675  endif
3676 
3677  !$acc end host_data
3678 
3679  end if
3680 
3681  !$acc host_data use_device(var) if(flag_device)
3682 
3683  ! To N HALO communicate
3684  if ( prc_has_n ) then
3685  call mpi_isend( var(:,je-jhalo+1:je), ginfo(gid)%size2D_NS4, comm_datatype, &
3686  prc_next(prc_n), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3687  ireq = ireq + 1
3688  endif
3689  ! To S HALO communicate
3690  if ( prc_has_s ) then
3691  call mpi_isend( var(:,js:js+jhalo-1), ginfo(gid)%size2D_NS4, comm_datatype, &
3692  prc_next(prc_s), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3693  ireq = ireq + 1
3694  endif
3695 
3696  !$acc end host_data
3697 
3698  ginfo(gid)%req_cnt(vid) = ireq - 1
3699 
3700  return
3701  end subroutine vars_2d_mpi
3702 
3703  subroutine vars_2d_mpi_onesided(var, gid, vid)
3704  use scale_prc, only: &
3705  prc_abort
3706  use scale_prc_cartesc, only: &
3707  prc_twod
3708  implicit none
3709 
3710  real(RP), intent(inout) :: var(:,:)
3711  integer, intent(in) :: gid
3712  integer, intent(in) :: vid
3713 
3714  integer :: IA, IS, IE
3715  integer :: JA, JS, JE
3716  integer :: IHALO, JHALO
3717 
3718  integer(kind=MPI_ADDRESS_KIND) :: disp
3719 
3720  integer :: ierr
3721 #ifdef _OPENACC
3722  real(RP), pointer :: ptr(:,:)
3723 #endif
3724  !---------------------------------------------------------------------------
3725 
3726  ia = ginfo(gid)%IA
3727  is = ginfo(gid)%IS
3728  ie = ginfo(gid)%IE
3729  ja = ginfo(gid)%JA
3730  js = ginfo(gid)%JS
3731  je = ginfo(gid)%JE
3732  ihalo = ginfo(gid)%IHALO
3733  jhalo = ginfo(gid)%JHALO
3734 
3735  !$acc data copyin(var)
3736 
3737  call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
3738  call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
3739 
3740  !--- To 4-Direction HALO communicate
3741 
3742  if ( .not. prc_twod ) then
3743 
3744  call packwe_2d( ia, is, ie, ja, js, je, &
3745  ihalo, &
3746  var, gid, vid)
3747 
3748 #ifdef _OPENACC
3749  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
3750  !$acc host_data use_device(ptr)
3751 #endif
3752 
3753  ! To W HALO communicate
3754  if ( prc_has_w ) then
3755  disp = 1
3756 #ifdef _OPENACC
3757  call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
3758 #else
3759  call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
3760 #endif
3761  prc_next(prc_w), disp, ginfo(gid)%size2D_WE, comm_datatype, &
3762  ginfo(gid)%win_packWE(vid), ierr )
3763  endif
3764  ! To E HALO communicate
3765  if ( prc_has_e ) then
3766  disp = 0
3767 #ifdef _OPENACC
3768  call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
3769 #else
3770  call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
3771 #endif
3772  prc_next(prc_e), disp, ginfo(gid)%size2D_WE, comm_datatype, &
3773  ginfo(gid)%win_packWE(vid), ierr )
3774  endif
3775 
3776  !$acc end host_data
3777 
3778  end if
3779 
3780  !$acc host_data use_device(var)
3781 
3782  ! To N HALO communicate
3783  if ( prc_has_n ) then
3784  disp = 0
3785  call mpi_put( var(:,je-jhalo+1:je), ginfo(gid)%size2D_NS4, comm_datatype, &
3786  prc_next(prc_n), disp, ginfo(gid)%size2D_NS4, comm_datatype, &
3787  ginfo(gid)%win_packNS(vid), ierr )
3788  endif
3789  ! To S HALO communicate
3790  if ( prc_has_s ) then
3791  disp = ia * jhalo
3792  call mpi_put( var(:,js:js+jhalo-1), ginfo(gid)%size2D_NS4, comm_datatype, &
3793  prc_next(prc_s), disp, ginfo(gid)%size2D_NS4, comm_datatype, &
3794  ginfo(gid)%win_packNS(vid), ierr )
3795  endif
3796 
3797  !$acc end host_data
3798 
3799  call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
3800  call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
3801 
3802  !$acc end data
3803 
3804  return
3805  end subroutine vars_2d_mpi_onesided
3806 
3807  subroutine vars8_2d_mpi(var, gid, vid)
3808  use scale_prc, only: &
3809  prc_abort
3810  use scale_prc_cartesc, only: &
3811  prc_twod
3812  implicit none
3813 
3814  real(RP), intent(inout) :: var(:,:)
3815  integer, intent(in) :: gid
3816  integer, intent(in) :: vid
3817 
3818  integer :: IA, IS, IE
3819  integer :: JA, JS, JE
3820  integer :: IHALO, JHALO
3821 
3822  integer :: ireq, tag, tagc
3823 
3824  integer :: ierr
3825  integer :: j
3826 #ifdef _OPENACC
3827  real(RP), pointer :: ptr(:,:)
3828  logical :: flag_device
3829 #endif
3830  !---------------------------------------------------------------------------
3831 
3832  ia = ginfo(gid)%IA
3833  is = ginfo(gid)%IS
3834  ie = ginfo(gid)%IE
3835  ja = ginfo(gid)%JA
3836  js = ginfo(gid)%JS
3837  je = ginfo(gid)%JE
3838  ihalo = ginfo(gid)%IHALO
3839  jhalo = ginfo(gid)%JHALO
3840 
3841  tag = ( (gid - 1) * comm_vsize_max + vid ) * 100
3842  ireq = 1
3843 
3844 #ifdef DEBUG
3845  if ( ginfo(gid)%use_packbuf(vid) ) then
3846  log_error("vars8_2D_mpi",*) 'packing buffer is already used', vid
3847  call prc_abort
3848  end if
3849  ginfo(gid)%use_packbuf(vid) = .true.
3850 #endif
3851 
3852 #ifdef _OPENACC
3853  flag_device = acc_is_present(var)
3854 #endif
3855 
3856  if ( comm_isallperiodic ) then
3857  !--- periodic condition
3858  !--- From 8-Direction HALO communicate
3859  !$acc host_data use_device(var) if(flag_device)
3860 
3861  if ( .not. prc_twod ) then
3862  ! From SE
3863  tagc = 0
3864  do j = 1, js-1
3865  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
3866  comm_datatype, prc_next(prc_se), tag+tagc, &
3867  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3868  ireq = ireq + 1
3869  tagc = tagc + 1
3870  enddo
3871  ! From SW
3872  tagc = 10
3873  do j = 1, js-1
3874  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
3875  comm_datatype, prc_next(prc_sw), tag+tagc, &
3876  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3877  ireq = ireq + 1
3878  tagc = tagc + 1
3879  enddo
3880  ! From NE
3881  tagc = 20
3882  do j = je+1, ja
3883  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
3884  comm_datatype, prc_next(prc_ne), tag+tagc, &
3885  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3886  ireq = ireq + 1
3887  tagc = tagc + 1
3888  enddo
3889  ! From NW
3890  tagc = 30
3891  do j = je+1, ja
3892  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
3893  comm_datatype, prc_next(prc_nw), tag+tagc, &
3894  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3895  ireq = ireq + 1
3896  tagc = tagc + 1
3897  enddo
3898 #ifdef _OPENACC
3899  ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
3900  !$acc host_data use_device(ptr) if(flag_device)
3901 #endif
3902  ! From E
3903 #ifdef _OPENACC
3904  call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE, &
3905 #else
3906  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE, &
3907 #endif
3908  comm_datatype, prc_next(prc_e), tag+60, &
3909  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3910  ireq = ireq + 1
3911  ! From W
3912 #ifdef _OPENACC
3913  call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE, &
3914 #else
3915  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE, &
3916 #endif
3917  comm_datatype, prc_next(prc_w), tag+70, &
3918  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3919  ireq = ireq + 1
3920  !$acc end host_data
3921  end if
3922  ! From S
3923  tagc = 40
3924  do j = 1, js-1
3925  call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8, &
3926  comm_datatype, prc_next(prc_s), tag+tagc, &
3927  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3928  ireq = ireq + 1
3929  tagc = tagc + 1
3930  enddo
3931  ! From N
3932  tagc = 50
3933  do j = je+1, ja
3934  call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8, &
3935  comm_datatype, prc_next(prc_n), tag+tagc, &
3936  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3937  ireq = ireq + 1
3938  tagc = tagc + 1
3939  enddo
3940 
3941 
3942  !--- To 8-Direction HALO communicate
3943 
3944  ! To N HALO communicate
3945  tagc = 40
3946  do j = je-jhalo+1, je
3947  call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8, &
3948  comm_datatype, prc_next(prc_n), tag+tagc, &
3949  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3950  ireq = ireq + 1
3951  tagc = tagc + 1
3952  enddo
3953 
3954  ! To S HALO communicate
3955  tagc = 50
3956  do j = js, js+jhalo-1
3957  call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8, &
3958  comm_datatype, prc_next(prc_s), tag+tagc, &
3959  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3960  ireq = ireq + 1
3961  tagc = tagc + 1
3962  enddo
3963 
3964  !$acc end host_data
3965 
3966  if ( .not. prc_twod ) then
3967 
3968  call packwe_2d( ia, is, ie, ja, js, je, &
3969  ihalo, &
3970  var, gid, vid)
3971 
3972  !$acc host_data use_device(var) if(flag_device)
3973 #ifdef _OPENACC
3974  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
3975  !$acc host_data use_device(ptr) if(flag_device)
3976 #endif
3977 
3978  ! To W HALO communicate
3979 #ifdef _OPENACC
3980  call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE, &
3981 #else
3982  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, &
3983 #endif
3984  comm_datatype, prc_next(prc_w), tag+60, &
3985  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3986  ireq = ireq + 1
3987 
3988  ! To E HALO communicate
3989 #ifdef _OPENACC
3990  call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE, &
3991 #else
3992  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, &
3993 #endif
3994  comm_datatype, prc_next(prc_e), tag+70, &
3995  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
3996  ireq = ireq + 1
3997  !$acc end host_data
3998 
3999  ! To NW HALO communicate
4000  tagc = 0
4001  do j = je-jhalo+1, je
4002  call mpi_isend( var(is,j), ginfo(gid)%size2D_4C, &
4003  comm_datatype, prc_next(prc_nw), tag+tagc, &
4004  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4005  ireq = ireq + 1
4006  tagc = tagc + 1
4007  enddo
4008 
4009  ! To NE HALO communicate
4010  tagc = 10
4011  do j = je-jhalo+1, je
4012  call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, &
4013  comm_datatype, prc_next(prc_ne), tag+tagc, &
4014  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4015  ireq = ireq + 1
4016  tagc = tagc + 1
4017  enddo
4018 
4019  ! To SW HALO communicate
4020  tagc = 20
4021  do j = js, js+jhalo-1
4022  call mpi_isend( var(is,j), ginfo(gid)%size2D_4C, &
4023  comm_datatype, prc_next(prc_sw), tag+tagc, &
4024  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4025  ireq = ireq + 1
4026  tagc = tagc + 1
4027  enddo
4028 
4029  ! To SE HALO communicate
4030  tagc = 30
4031  do j = js, js+jhalo-1
4032  call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, &
4033  comm_datatype, prc_next(prc_se), tag+tagc, &
4034  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4035  ireq = ireq + 1
4036  tagc = tagc + 1
4037  enddo
4038 
4039  !$acc end host_data
4040 
4041  end if
4042 
4043  else
4044  !--- non-periodic condition
4045  !--- From 8-Direction HALO communicate
4046 
4047  !$acc host_data use_device(var) if(flag_device)
4048 
4049  if ( .not. prc_twod ) then
4050  ! From SE
4051  if ( prc_has_s .AND. prc_has_e ) then
4052  tagc = 0
4053  do j = 1, js-1
4054  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
4055  comm_datatype, prc_next(prc_se), tag+tagc, &
4056  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4057  ireq = ireq + 1
4058  tagc = tagc + 1
4059  enddo
4060  else if ( prc_has_s ) then
4061  tagc = 0
4062  do j = 1, js-1
4063  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
4064  comm_datatype, prc_next(prc_s), tag+tagc, &
4065  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4066  ireq = ireq + 1
4067  tagc = tagc + 1
4068  enddo
4069  else if ( prc_has_e ) then
4070  tagc = 0
4071  do j = 1, js-1
4072  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
4073  comm_datatype, prc_next(prc_e), tag+tagc, &
4074  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4075  ireq = ireq + 1
4076  tagc = tagc + 1
4077  enddo
4078  endif
4079 
4080  ! From SW
4081  if ( prc_has_s .AND. prc_has_w ) then
4082  tagc = 10
4083  do j = 1, js-1
4084  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
4085  comm_datatype, prc_next(prc_sw), tag+tagc, &
4086  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4087  ireq = ireq + 1
4088  tagc = tagc + 1
4089  enddo
4090  else if ( prc_has_s ) then
4091  tagc = 10
4092  do j = 1, js-1
4093  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
4094  comm_datatype, prc_next(prc_s), tag+tagc, &
4095  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4096  ireq = ireq + 1
4097  tagc = tagc + 1
4098  enddo
4099  else if ( prc_has_w ) then
4100  tagc = 10
4101  do j = 1, js-1
4102  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
4103  comm_datatype, prc_next(prc_w), tag+tagc, &
4104  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4105  ireq = ireq + 1
4106  tagc = tagc + 1
4107  enddo
4108  endif
4109 
4110  ! From NE
4111  if ( prc_has_n .AND. prc_has_e ) then
4112  tagc = 20
4113  do j = je+1, je+jhalo
4114  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
4115  comm_datatype, prc_next(prc_ne), tag+tagc, &
4116  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4117  ireq = ireq + 1
4118  tagc = tagc + 1
4119  enddo
4120  else if ( prc_has_n ) then
4121  tagc = 20
4122  do j = je+1, ja
4123  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
4124  comm_datatype, prc_next(prc_n), tag+tagc, &
4125  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4126  ireq = ireq + 1
4127  tagc = tagc + 1
4128  enddo
4129  else if ( prc_has_e ) then
4130  tagc = 20
4131  do j = je+1, ja
4132  call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C, &
4133  comm_datatype, prc_next(prc_e), tag+tagc, &
4134  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4135  ireq = ireq + 1
4136  tagc = tagc + 1
4137  enddo
4138  endif
4139 
4140  ! From NW
4141  if ( prc_has_n .AND. prc_has_w ) then
4142  tagc = 30
4143  do j = je+1, ja
4144  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
4145  comm_datatype, prc_next(prc_nw), tag+tagc, &
4146  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4147  ireq = ireq + 1
4148  tagc = tagc + 1
4149  enddo
4150  else if ( prc_has_n ) then
4151  tagc = 30
4152  do j = je+1, ja
4153  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
4154  comm_datatype, prc_next(prc_n), tag+tagc, &
4155  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4156  ireq = ireq + 1
4157  tagc = tagc + 1
4158  enddo
4159  else if ( prc_has_w ) then
4160  tagc = 30
4161  do j = je+1, ja
4162  call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C, &
4163  comm_datatype, prc_next(prc_w), tag+tagc, &
4164  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4165  ireq = ireq + 1
4166  tagc = tagc + 1
4167  enddo
4168  endif
4169 
4170 #ifdef _OPENACC
4171  ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
4172  !$acc host_data use_device(ptr) if(flag_device)
4173 #endif
4174  ! From E
4175  if ( prc_has_e ) then
4176 #ifdef _OPENACC
4177  call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE, &
4178 #else
4179  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE, &
4180 #endif
4181  comm_datatype, prc_next(prc_e), tag+60, &
4182  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4183  ireq = ireq + 1
4184  endif
4185 
4186  ! From W
4187  if ( prc_has_w ) then
4188 #ifdef _OPENACC
4189  call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE, &
4190 #else
4191  call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE, &
4192 #endif
4193  comm_datatype, prc_next(prc_w), tag+70, &
4194  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4195  ireq = ireq + 1
4196  endif
4197  !$acc end host_data
4198 
4199  end if
4200 
4201  ! From S
4202  if ( prc_has_s ) then
4203  tagc = 40
4204  do j = 1, js-1
4205  call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8, &
4206  comm_datatype, prc_next(prc_s), tag+tagc, &
4207  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4208  ireq = ireq + 1
4209  tagc = tagc + 1
4210  enddo
4211  endif
4212 
4213  ! From N
4214  if ( prc_has_n ) then
4215  tagc = 50
4216  do j = je+1, ja
4217  call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8, &
4218  comm_datatype, prc_next(prc_n), tag+tagc, &
4219  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4220  ireq = ireq + 1
4221  tagc = tagc + 1
4222  enddo
4223  endif
4224 
4225 
4226  !! RECEIVE
4227 
4228  ! To N HALO communicate
4229  if ( prc_has_n ) then
4230  tagc = 40
4231  do j = je-jhalo+1, je
4232  call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8, &
4233  comm_datatype, prc_next(prc_n), tag+tagc, &
4234  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4235  ireq = ireq + 1
4236  tagc = tagc + 1
4237  enddo
4238  endif
4239 
4240  ! To S HALO communicate
4241  if ( prc_has_s ) then
4242  tagc = 50
4243  do j = js, js+jhalo-1
4244  call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8, &
4245  comm_datatype, prc_next(prc_s), tag+tagc, &
4246  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4247  ireq = ireq + 1
4248  tagc = tagc + 1
4249  enddo
4250  endif
4251 
4252  !$acc end host_data
4253 
4254  if ( .not. prc_twod ) then
4255 
4256  call packwe_2d( ia, is, ie, ja, js, je, &
4257  ihalo, &
4258  var, gid, vid)
4259 
4260  !$acc host_data use_device(var) if(flag_device)
4261 #ifdef _OPENACC
4262  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
4263  !$acc host_data use_device(ptr) if(flag_device)
4264 #endif
4265 
4266  ! To W HALO communicate
4267  if ( prc_has_w ) then
4268 #ifdef _OPENACC
4269  call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE, &
4270 #else
4271  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, &
4272 #endif
4273  comm_datatype, prc_next(prc_w), tag+60, &
4274  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4275  ireq = ireq + 1
4276  endif
4277 
4278  ! To E HALO communicate
4279  if ( prc_has_e ) then
4280 #ifdef _OPENACC
4281  call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE, &
4282 #else
4283  call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, &
4284 #endif
4285  comm_datatype, prc_next(prc_e), tag+70, &
4286  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4287  ireq = ireq + 1
4288  endif
4289  !$acc end host_data
4290 
4291  ! To NW HALO communicate
4292  if ( prc_has_n .AND. prc_has_w ) then
4293  tagc = 0
4294  do j = je-jhalo+1, je
4295  call mpi_isend( var(is,j), ginfo(gid)%size2D_4C, &
4296  comm_datatype, prc_next(prc_nw), tag+tagc, &
4297  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4298  ireq = ireq + 1
4299  tagc = tagc + 1
4300  enddo
4301  else if ( prc_has_n ) then
4302  tagc = 10
4303  do j = je-jhalo+1, je
4304  call mpi_isend( var(1,j), ginfo(gid)%size2D_4C, &
4305  comm_datatype, prc_next(prc_n), tag+tagc, &
4306  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4307  ireq = ireq + 1
4308  tagc = tagc + 1
4309  enddo
4310  else if ( prc_has_w ) then
4311  tagc = 20
4312  do j = je+1, ja
4313  call mpi_isend( var(is,j), ginfo(gid)%size2D_4C, &
4314  comm_datatype, prc_next(prc_w), tag+tagc, &
4315  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4316  ireq = ireq + 1
4317  tagc = tagc + 1
4318  enddo
4319  endif
4320 
4321  ! To NE HALO communicate
4322  if ( prc_has_n .AND. prc_has_e ) then
4323  tagc = 10
4324  do j = je-jhalo+1, je
4325  call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, &
4326  comm_datatype, prc_next(prc_ne), tag+tagc, &
4327  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4328  ireq = ireq + 1
4329  tagc = tagc + 1
4330  enddo
4331  else if ( prc_has_n ) then
4332  tagc = 0
4333  do j = je-jhalo+1, je
4334  call mpi_isend( var(ie+1,j), ginfo(gid)%size2D_4C, &
4335  comm_datatype, prc_next(prc_n), tag+tagc, &
4336  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4337  ireq = ireq + 1
4338  tagc = tagc + 1
4339  enddo
4340  else if ( prc_has_e ) then
4341  tagc = 30
4342  do j = je+1, ja
4343  call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, &
4344  comm_datatype, prc_next(prc_e), tag+tagc, &
4345  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4346  ireq = ireq + 1
4347  tagc = tagc + 1
4348  enddo
4349  endif
4350 
4351  ! To SW HALO communicate
4352  if ( prc_has_s .AND. prc_has_w ) then
4353  tagc = 20
4354  do j = js, js+jhalo-1
4355  call mpi_isend( var(is,j), ginfo(gid)%size2D_4C, &
4356  comm_datatype, prc_next(prc_sw), tag+tagc, &
4357  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4358  ireq = ireq + 1
4359  tagc = tagc + 1
4360  enddo
4361  else if ( prc_has_s ) then
4362  tagc = 30
4363  do j = js, js+jhalo-1
4364  call mpi_isend( var(1,j), ginfo(gid)%size2D_4C, &
4365  comm_datatype, prc_next(prc_s), tag+tagc, &
4366  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4367  ireq = ireq + 1
4368  tagc = tagc + 1
4369  enddo
4370  else if ( prc_has_w ) then
4371  tagc = 0
4372  do j = 1, js-1
4373  call mpi_isend( var(is,j), ginfo(gid)%size2D_4C, &
4374  comm_datatype, prc_next(prc_w), tag+tagc, &
4375  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4376  ireq = ireq + 1
4377  tagc = tagc + 1
4378  enddo
4379  endif
4380 
4381  ! To SE HALO communicate
4382  if ( prc_has_s .AND. prc_has_e ) then
4383  tagc = 30
4384  do j = js, js+jhalo-1
4385  call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, &
4386  comm_datatype, prc_next(prc_se), tag+tagc, &
4387  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4388  ireq = ireq + 1
4389  tagc = tagc + 1
4390  enddo
4391  else if ( prc_has_s ) then
4392  tagc = 20
4393  do j = js, js+jhalo-1
4394  call mpi_isend( var(ie+1,j), ginfo(gid)%size2D_4C, &
4395  comm_datatype, prc_next(prc_s), tag+tagc, &
4396  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4397  ireq = ireq + 1
4398  tagc = tagc + 1
4399  enddo
4400  else if ( prc_has_e ) then
4401  tagc = 10
4402  do j = 1, js-1
4403  call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, &
4404  comm_datatype, prc_next(prc_e), tag+tagc, &
4405  comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
4406  ireq = ireq + 1
4407  tagc = tagc + 1
4408  enddo
4409  endif
4410 
4411  !$acc end host_data
4412 
4413  end if
4414 
4415  endif
4416 
4417  ginfo(gid)%req_cnt(vid) = ireq - 1
4418 
4419  return
4420  end subroutine vars8_2d_mpi
4421 
4422  subroutine vars8_2d_mpi_onesided(var, gid, vid)
4423  use scale_prc, only: &
4424  prc_abort
4425  use scale_prc_cartesc, only: &
4426  prc_twod
4427  implicit none
4428 
4429  real(RP), intent(inout) :: var(:,:)
4430  integer, intent(in) :: gid
4431  integer, intent(in) :: vid
4432 
4433  integer :: IA, IS, IE, IHALO
4434  integer :: JA, JS, JE, JHALO
4435 
4436  integer(kind=MPI_ADDRESS_KIND) :: disp
4437 
4438  integer :: ierr
4439  integer :: j
4440 #ifdef _OPENACC
4441  real(RP), pointer :: ptr(:,:)
4442 #endif
4443  !---------------------------------------------------------------------------
4444 
4445  ia = ginfo(gid)%IA
4446  is = ginfo(gid)%IS
4447  ie = ginfo(gid)%IE
4448  ihalo = ginfo(gid)%IHALO
4449  ja = ginfo(gid)%JA
4450  js = ginfo(gid)%JS
4451  je = ginfo(gid)%JE
4452  jhalo = ginfo(gid)%JHALO
4453 
4454  !$acc data copyin(var)
4455 
4456  call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
4457  call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
4458 
4459  if ( comm_isallperiodic ) then
4460  !--- periodic condition
4461 
4462  !--- To 8-Direction HALO communicate
4463 
4464  !$acc host_data use_device(var)
4465 
4466  ! To N HALO communicate
4467  do j = je-jhalo+1, je
4468  disp = ihalo + ia * ( j - je+jhalo-1 )
4469  call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
4470  prc_next(prc_n), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
4471  ginfo(gid)%win_packNS(vid), ierr )
4472  enddo
4473  ! To S HALO communicate
4474  do j = js, js+jhalo-1
4475  disp = ihalo + ia * ( j - js + jhalo )
4476  call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
4477  prc_next(prc_s), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
4478  ginfo(gid)%win_packNS(vid), ierr )
4479  enddo
4480 
4481  !$acc end host_data
4482 
4483  if ( .not. prc_twod ) then
4484 
4485  call packwe_2d( ia, is, ie, ja, js, je, &
4486  ihalo, &
4487  var, gid, vid)
4488 
4489  !$acc host_data use_device(var)
4490 #ifdef _OPENACC
4491  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
4492  !$acc host_data use_device(ptr)
4493 #endif
4494 
4495  ! To W HALO communicate
4496  disp = 1
4497 #ifdef _OPENACC
4498  call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
4499 #else
4500  call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
4501 #endif
4502  prc_next(prc_w), disp, ginfo(gid)%size2D_WE, comm_datatype, &
4503  ginfo(gid)%win_packWE(vid), ierr )
4504  ! To E HALO communicate
4505  disp = 0
4506 #ifdef _OPENACC
4507  call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
4508 #else
4509  call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
4510 #endif
4511  prc_next(prc_e), disp, ginfo(gid)%size2D_WE, comm_datatype, &
4512  ginfo(gid)%win_packWE(vid), ierr )
4513  !$acc end host_data
4514  ! To NW HALO communicate
4515  do j = je-jhalo+1, je
4516  disp = ie + ia * ( j - je+jhalo-1 )
4517  call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
4518  prc_next(prc_nw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4519  ginfo(gid)%win_packNS(vid), ierr )
4520  enddo
4521  ! To NE HALO communicate
4522  do j = je-jhalo+1, je
4523  disp = ia * ( j - je+jhalo-1 )
4524  call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4525  prc_next(prc_ne), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4526  ginfo(gid)%win_packNS(vid), ierr )
4527  enddo
4528  ! To SW HALO communicate
4529  do j = js, js+jhalo-1
4530  disp = ie + ia * ( j - js + jhalo )
4531  call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
4532  prc_next(prc_sw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4533  ginfo(gid)%win_packNS(vid), ierr )
4534  enddo
4535  ! To SE HALO communicate
4536  do j = js, js+jhalo-1
4537  disp = ia * ( j - js + jhalo )
4538  call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4539  prc_next(prc_se), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4540  ginfo(gid)%win_packNS(vid), ierr )
4541  enddo
4542 
4543  !$acc end host_data
4544 
4545  end if
4546  else
4547  !--- non-periodic condition
4548 
4549  !$acc host_data use_device(var)
4550 
4551  ! To N HALO communicate
4552  if ( prc_has_n ) then
4553  do j = je-jhalo+1, je
4554  disp = ihalo + ia * ( j - je+jhalo-1 )
4555  call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
4556  prc_next(prc_n), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
4557  ginfo(gid)%win_packNS(vid), ierr )
4558  enddo
4559  endif
4560  ! To S HALO communicate
4561  if ( prc_has_s ) then
4562  do j = js, js+jhalo-1
4563  disp = ihalo + ia * ( j - js + jhalo )
4564  call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
4565  prc_next(prc_s), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
4566  ginfo(gid)%win_packNS(vid), ierr )
4567  enddo
4568  endif
4569 
4570  !$acc end host_data
4571 
4572  if ( .not. prc_twod ) then
4573 
4574  call packwe_2d( ia, is, ie, ja, js, je, &
4575  ihalo, &
4576  var, gid, vid)
4577 
4578  !$acc host_data use_device(var)
4579 #ifdef _OPENACC
4580  ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
4581  !$acc host_data use_device(ptr)
4582 #endif
4583 
4584  ! To W HALO communicate
4585  if ( prc_has_w ) then
4586  disp = 1
4587 #ifdef _OPENACC
4588  call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
4589 #else
4590  call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
4591 #endif
4592  prc_next(prc_w), disp, ginfo(gid)%size2D_WE, comm_datatype, &
4593  ginfo(gid)%win_packWE(vid), ierr )
4594  endif
4595  ! To E HALO communicate
4596  if ( prc_has_e ) then
4597  disp = 0
4598 #ifdef _OPENACC
4599  call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
4600 #else
4601  call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
4602 #endif
4603  prc_next(prc_e), disp, ginfo(gid)%size2D_WE, comm_datatype, &
4604  ginfo(gid)%win_packWE(vid), ierr )
4605  endif
4606  !$acc end host_data
4607  ! To NW HALO communicate
4608  if ( prc_has_n .AND. prc_has_w ) then
4609  do j = je-jhalo+1, je
4610  disp = ie + ia * ( j - je+jhalo-1 )
4611  call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
4612  prc_next(prc_nw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4613  ginfo(gid)%win_packNS(vid), ierr )
4614  enddo
4615  else if ( prc_has_n ) then
4616  do j = je-jhalo+1, je
4617  disp = ia * ( j - je+jhalo-1 )
4618  call mpi_put( var(1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4619  prc_next(prc_n), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4620  ginfo(gid)%win_packNS(vid), ierr )
4621  enddo
4622  else if ( prc_has_w ) then
4623  do j = je+1, ja
4624  disp = ie + ia * ( j - je-1 + jhalo )
4625  call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
4626  prc_next(prc_w), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4627  ginfo(gid)%win_packNS(vid), ierr )
4628  enddo
4629  endif
4630  ! To NE HALO communicate
4631  if ( prc_has_n .AND. prc_has_e ) then
4632  do j = je-jhalo+1, je
4633  disp = ia * ( j - je+jhalo-1 )
4634  call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4635  prc_next(prc_ne), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4636  ginfo(gid)%win_packNS(vid), ierr )
4637  enddo
4638  else if ( prc_has_n ) then
4639  do j = je-jhalo+1, je
4640  disp = ie + ia * ( j - je+jhalo-1 )
4641  call mpi_put( var(ie+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4642  prc_next(prc_n), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4643  ginfo(gid)%win_packNS(vid), ierr )
4644  enddo
4645  else if ( prc_has_e ) then
4646  do j = je+1, ja
4647  disp = ia * ( j - je-1 + jhalo )
4648  call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4649  prc_next(prc_e), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4650  ginfo(gid)%win_packNS(vid), ierr )
4651  enddo
4652  endif
4653  ! To SW HALO communicate
4654  if ( prc_has_s .AND. prc_has_w ) then
4655  do j = js, js+jhalo-1
4656  disp = ie + ia * ( j - js + jhalo )
4657  call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
4658  prc_next(prc_sw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4659  ginfo(gid)%win_packNS(vid), ierr )
4660  enddo
4661  else if ( prc_has_s ) then
4662  do j = js, js+jhalo-1
4663  disp = ia * ( j - js + jhalo )
4664  call mpi_put( var(1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4665  prc_next(prc_s), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4666  ginfo(gid)%win_packNS(vid), ierr )
4667  enddo
4668  else if ( prc_has_w ) then
4669  do j = 1, js-1
4670  disp = ie + ia * ( j - 1 )
4671  call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
4672  prc_next(prc_w), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4673  ginfo(gid)%win_packNS(vid), ierr )
4674  enddo
4675  endif
4676  ! To SE HALO communicate
4677  if ( prc_has_s .AND. prc_has_e ) then
4678  do j = js, js+jhalo-1
4679  disp = ia * ( j - js + jhalo )
4680  call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4681  prc_next(prc_se), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4682  ginfo(gid)%win_packNS(vid), ierr )
4683  enddo
4684  else if ( prc_has_s ) then
4685  do j = js, js+jhalo-1
4686  disp = ie + ia * ( j - js + jhalo )
4687  call mpi_put( var(ie+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4688  prc_next(prc_s), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4689  ginfo(gid)%win_packNS(vid), ierr )
4690  enddo
4691  else if ( prc_has_e ) then
4692  do j = 1, js-1
4693  disp = ia * ( j - 1 )
4694  call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
4695  prc_next(prc_e), disp, ginfo(gid)%size2D_4C, comm_datatype, &
4696  ginfo(gid)%win_packNS(vid), ierr )
4697  enddo
4698  endif
4699 
4700  !$acc end host_data
4701  end if
4702 
4703  endif
4704 
4705  call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
4706  call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
4707 
4708  !$acc end data
4709 
4710  return
4711  end subroutine vars8_2d_mpi_onesided
4712 
4713  subroutine vars_3d_mpi_pc(var, gid, vid)
4714  use scale_prc, only: &
4715  prc_abort
4716  use scale_prc_cartesc, only: &
4717  prc_twod
4718  implicit none
4719  real(RP), intent(inout) :: var(:,:,:)
4720  integer, intent(in) :: gid
4721  integer, intent(in) :: vid
4722 
4723  integer :: KA
4724  integer :: IA, IS, IE
4725  integer :: JA, JS, JE
4726  integer :: IHALO
4727 
4728  integer :: ierr
4729  !---------------------------------------------------------------------------
4730 
4731 #ifdef DEBUG
4732  if ( ginfo(gid)%use_packbuf(ginfo(gid)%packid(vid)) ) then
4733  log_error("vars_3D_mpi_pc",*) 'packing buffer is already used', vid, ginfo(gid)%packid(vid)
4734  call prc_abort
4735  end if
4736  ginfo(gid)%use_packbuf(ginfo(gid)%packid(vid)) = .true.
4737 #endif
4738 
4739 #ifdef _OPENACC
4740  if ( ginfo(gid)%device_alloc(vid+comm_vsize_max) ) then
4741  !$acc update device(var)
4742  end if
4743 #endif
4744 
4745  if ( .not. prc_twod ) then
4746  ka = ginfo(gid)%KA
4747  ia = ginfo(gid)%IA
4748  is = ginfo(gid)%IS
4749  ie = ginfo(gid)%IE
4750  ja = ginfo(gid)%JA
4751  js = ginfo(gid)%JS
4752  je = ginfo(gid)%JE
4753  ihalo = ginfo(gid)%IHALO
4754  call packwe_3d( ka, ia, is, ie, ja, js, je, &
4755  ihalo, &
4756  var, gid, ginfo(gid)%packid(vid))
4757  !$acc wait
4758  end if
4759 
4760  call mpi_startall(ginfo(gid)%preq_cnt(vid), ginfo(gid)%preq_list(1:ginfo(gid)%preq_cnt(vid),vid), ierr)
4761 
4762  return
4763  end subroutine vars_3d_mpi_pc
4764 
4765  subroutine wait_3d_mpi(var, gid, vid)
4766  use scale_prc_cartesc, only: &
4767  prc_twod
4768  implicit none
4769  real(RP), intent(inout) :: var(:,:,:)
4770  integer, intent(in) :: gid
4771  integer, intent(in) :: vid
4772 
4773  integer :: KA
4774  integer :: IA, IS, IE
4775  integer :: JA, JS, JE
4776  integer :: IHALO
4777 
4778  integer :: ierr
4779  !---------------------------------------------------------------------------
4780 
4781  !--- wait packets
4782  call mpi_waitall( ginfo(gid)%req_cnt (vid), &
4783  ginfo(gid)%req_list(1:ginfo(gid)%req_cnt(vid),vid), &
4784  mpi_statuses_ignore, &
4785  ierr )
4786  if ( .not. prc_twod ) then
4787  ka = ginfo(gid)%KA
4788  ia = ginfo(gid)%IA
4789  is = ginfo(gid)%IS
4790  ie = ginfo(gid)%IE
4791  ja = ginfo(gid)%JA
4792  js = ginfo(gid)%JS
4793  je = ginfo(gid)%JE
4794  ihalo = ginfo(gid)%IHALO
4795  call unpackwe_3d( ka, ia, is, ie, ja, js, je, &
4796  ihalo, &
4797  var, ginfo(gid)%recvpack_WE2P(:,:,vid) )
4798  !$acc wait
4799  end if
4800 
4801 #ifdef DEBUG
4802  ginfo(gid)%use_packbuf(vid) = .false.
4803 #endif
4804 
4805  return
4806  end subroutine wait_3d_mpi
4807 
4808  subroutine wait_3d_mpi_onesided(var, gid, vid)
4809  use scale_prc_cartesc, only: &
4810  prc_twod
4811  implicit none
4812  real(RP), intent(inout) :: var(:,:,:)
4813  integer, intent(in) :: gid
4814  integer, intent(in) :: vid
4815 
4816  integer :: KA
4817  integer :: IA, IS, IE
4818  integer :: JA, JS, JE
4819  integer :: IHALO, JHALO
4820 
4821  real(RP), pointer :: pack(:)
4822 
4823  integer :: ierr
4824  !---------------------------------------------------------------------------
4825 
4826  ka = ginfo(gid)%KA
4827  ia = ginfo(gid)%IA
4828  is = ginfo(gid)%IS
4829  ie = ginfo(gid)%IE
4830  ja = ginfo(gid)%JA
4831  js = ginfo(gid)%JS
4832  je = ginfo(gid)%JE
4833  ihalo = ginfo(gid)%IHALO
4834  jhalo = ginfo(gid)%JHALO
4835 
4836  call mpi_win_wait( ginfo(gid)%win_packWE(vid), ierr )
4837  if ( .not. prc_twod ) then
4838  call c_f_pointer( ginfo(gid)%recvbuf_WE(vid), pack, (/ginfo(gid)%size2D_WE*ka*2/) )
4839  call unpackwe_3d( ka, ia, is, ie, ja, js, je, &
4840  ihalo, &
4841  var, pack )
4842  end if
4843 
4844  call mpi_win_wait( ginfo(gid)%win_packNS(vid), ierr )
4845  call c_f_pointer( ginfo(gid)%recvbuf_NS(vid), pack, (/ginfo(gid)%size2D_NS4*ka*2/) )
4846  call unpackns_3d( ka, ia, is, ie, ja, js, je, &
4847  jhalo, &
4848  var, pack )
4849 
4850  !$acc wait
4851 
4852  call mpi_win_post( group_packwe, mpi_mode_nostore, ginfo(gid)%win_packWE(vid), ierr )
4853  call mpi_win_post( group_packns, mpi_mode_nostore, ginfo(gid)%win_packNS(vid), ierr )
4854 
4855  return
4856  end subroutine wait_3d_mpi_onesided
4857 
4858  subroutine wait_2d_mpi(var, gid, vid)
4859  use scale_prc_cartesc, only: &
4860  prc_twod
4861  implicit none
4862  real(RP), intent(inout) :: var(:,:)
4863  integer, intent(in) :: gid
4864  integer, intent(in) :: vid
4865 
4866  integer :: KA
4867  integer :: IA, IS, IE
4868  integer :: JA, JS, JE
4869  integer :: IHALO
4870 
4871  integer :: ierr
4872  !---------------------------------------------------------------------------
4873 
4874  !--- wait packets
4875  call mpi_waitall( ginfo(gid)%req_cnt(vid), &
4876  ginfo(gid)%req_list(1:ginfo(gid)%req_cnt(vid),vid), &
4877  mpi_statuses_ignore, &
4878  ierr )
4879  if ( .not. prc_twod ) then
4880  ka = ginfo(gid)%KA
4881  ia = ginfo(gid)%IA
4882  is = ginfo(gid)%IS
4883  ie = ginfo(gid)%IE
4884  ja = ginfo(gid)%JA
4885  js = ginfo(gid)%JS
4886  je = ginfo(gid)%JE
4887  ihalo = ginfo(gid)%IHALO
4888  call unpackwe_2d( ka, ia, is, ie, ja, js, je, &
4889  ihalo, &
4890  var, ginfo(gid)%recvpack_WE2P(:,:,vid) )
4891  end if
4892 
4893 #ifdef DEBUG
4894  ginfo(gid)%use_packbuf(vid) = .false.
4895 #endif
4896 
4897  return
4898  end subroutine wait_2d_mpi
4899 
4900  subroutine wait_2d_mpi_onesided(var, gid, vid)
4901  use scale_prc_cartesc, only: &
4902  prc_twod
4903  implicit none
4904  real(RP), intent(inout) :: var(:,:)
4905  integer, intent(in) :: gid
4906  integer, intent(in) :: vid
4907 
4908  integer :: KA
4909  integer :: IA, IS, IE
4910  integer :: JA, JS, JE
4911  integer :: IHALO, JHALO
4912 
4913  real(RP), pointer :: pack(:)
4914 
4915  integer :: ierr
4916  !---------------------------------------------------------------------------
4917 
4918  ka = ginfo(gid)%KA
4919  ia = ginfo(gid)%IA
4920  is = ginfo(gid)%IS
4921  ie = ginfo(gid)%IE
4922  ja = ginfo(gid)%JA
4923  js = ginfo(gid)%JS
4924  je = ginfo(gid)%JE
4925  ihalo = ginfo(gid)%IHALO
4926  jhalo = ginfo(gid)%JHALO
4927 
4928  call mpi_win_wait( ginfo(gid)%win_packWE(vid), ierr )
4929  if ( .not. prc_twod ) then
4930  call c_f_pointer( ginfo(gid)%recvbuf_WE(vid), pack, (/ginfo(gid)%size2D_WE*ka*2/) )
4931  call unpackwe_2d( ka, ia, is, ie, ja, js, je, &
4932  ihalo, &
4933  var, pack )
4934  end if
4935 
4936  call mpi_win_wait( ginfo(gid)%win_packNS(vid), ierr )
4937  call c_f_pointer( ginfo(gid)%recvbuf_NS(vid), pack, (/ginfo(gid)%size2D_NS4*ka*2/) )
4938  call unpackns_2d( ia, is, ie, ja, js, je, &
4939  jhalo, &
4940  var, pack )
4941 
4942  call mpi_win_post( group_packwe, mpi_mode_nostore, ginfo(gid)%win_packWE(vid), ierr )
4943  call mpi_win_post( group_packns, mpi_mode_nostore, ginfo(gid)%win_packNS(vid), ierr )
4944 
4945  return
4946  end subroutine wait_2d_mpi_onesided
4947 
4948  subroutine wait_3d_mpi_pc(var, gid, vid)
4949  use scale_prc_cartesc, only: &
4950  prc_twod
4951  implicit none
4952  real(RP), intent(inout) :: var(:,:,:)
4953  integer, intent(in) :: gid
4954  integer, intent(in) :: vid
4955 
4956  integer :: KA
4957  integer :: IA, IS, IE
4958  integer :: JA, JS, JE
4959  integer :: IHALO
4960 
4961  integer :: pid
4962  integer :: ierr
4963 
4964  !--- wait packets
4965  call mpi_waitall( ginfo(gid)%preq_cnt (vid), &
4966  ginfo(gid)%preq_list(1:ginfo(gid)%preq_cnt(vid),vid), &
4967  mpi_statuses_ignore, &
4968  ierr )
4969  if ( .not. prc_twod ) then
4970  ka = ginfo(gid)%KA
4971  ia = ginfo(gid)%IA
4972  is = ginfo(gid)%IS
4973  ie = ginfo(gid)%IE
4974  ja = ginfo(gid)%JA
4975  js = ginfo(gid)%JS
4976  je = ginfo(gid)%JE
4977  ihalo = ginfo(gid)%IHALO
4978  pid = ginfo(gid)%packid(vid)
4979  call unpackwe_3d( ka, ia, is, ie, ja, js, je, &
4980  ihalo, &
4981  var, ginfo(gid)%recvpack_WE2P(:,:,pid) )
4982  !$acc wait
4983  end if
4984 
4985 #ifdef DEBUG
4986  ginfo(gid)%use_packbuf(ginfo(gid)%packid(vid)) = .false.
4987 #endif
4988 
4989 #ifdef _OPENACC
4990  if ( ginfo(gid)%device_alloc(vid+comm_vsize_max) ) then
4991  !$acc update host(var)
4992  end if
4993 #endif
4994 
4995  return
4996  end subroutine wait_3d_mpi_pc
4997 
4998  subroutine packwe_3d( KA, IA, IS, IE, JA, JS, JE, &
4999  IHALO, &
5000  var, gid, vid)
5001  implicit none
5002  integer, intent(in) :: KA
5003  integer, intent(in) :: IA, IS, IE
5004  integer, intent(in) :: JA, JS, JE
5005  integer, intent(in) :: IHALO
5006  real(RP), intent(in) :: var(KA,IA,JA)
5007  integer, intent(in) :: gid
5008  integer, intent(in) :: vid
5009 
5010  integer :: k, i, j, n
5011 
5012 #ifdef _OPENACC
5013  real(RP), pointer :: ptr(:,:,:)
5014  ptr => ginfo(gid)%sendpack_P2WE
5015 #endif
5016 
5017  !$acc data copyin(var) if(acc_is_present(var))
5018 
5019  call prof_rapstart('COMM_pack', 3)
5020 
5021  if ( prc_has_w ) then
5022  !--- packing packets to West
5023  !$omp parallel do private(i,j,k,n) OMP_SCHEDULE_ collapse(2)
5024  !$acc parallel if(acc_is_present(var)) async
5025  !$acc loop collapse(2) gang
5026  do j = js, je
5027  do i = is, is+ihalo-1
5028  !$acc loop independent vector
5029  do k = 1, ka
5030  n = (j-js) * ka * ihalo &
5031  + (i-is) * ka &
5032  + k
5033 #ifdef _OPENACC
5034  ptr(n,1,vid) = var(k,i,j)
5035 #else
5036  ginfo(gid)%sendpack_P2WE(n,1,vid) = var(k,i,j)
5037 #endif
5038  enddo
5039  enddo
5040  enddo
5041  !$acc end parallel
5042  end if
5043 
5044  if ( prc_has_e ) then
5045  !--- packing packets to East
5046  !$omp parallel do private(i,j,k,n) OMP_SCHEDULE_ collapse(2)
5047  !$acc parallel if(acc_is_present(var)) async
5048  !$acc loop collapse(2) gang
5049  do j = js, je
5050  do i = ie-ihalo+1, ie
5051  !$acc loop independent vector
5052  do k = 1, ka
5053  n = (j-js) * ka * ihalo &
5054  + (i-ie+ihalo-1) * ka &
5055  + k
5056 #ifdef _OPENACC
5057  ptr(n,2,vid) = var(k,i,j)
5058 #else
5059  ginfo(gid)%sendpack_P2WE(n,2,vid) = var(k,i,j)
5060 #endif
5061  enddo
5062  enddo
5063  enddo
5064  !$acc end parallel
5065  end if
5066 
5067  call prof_rapend('COMM_pack', 3)
5068 
5069  !$acc end data
5070 
5071  return
5072  end subroutine packwe_3d
5073 
5074  subroutine packwe_2d( IA, IS, IE, JA, JS, JE, &
5075  IHALO, &
5076  var, gid, vid)
5077  implicit none
5078  integer, intent(in) :: IA, IS, IE
5079  integer, intent(in) :: JA, JS, JE
5080  integer, intent(in) :: IHALO
5081  real(RP), intent(in) :: var(IA,JA)
5082  integer, intent(in) :: vid
5083  integer, intent(in) :: gid
5084 
5085  integer :: i, j, n
5086 
5087 #ifdef _OPENACC
5088  real(RP), pointer :: ptr(:,:,:)
5089  ptr => ginfo(gid)%sendpack_P2WE
5090 #endif
5091  !$acc data copyin(var) if(acc_is_present(var))
5092 
5093  call prof_rapstart('COMM_pack', 3)
5094 
5095  if ( prc_has_w ) then
5096  !--- To 4-Direction HALO communicate
5097  !--- packing packets to West
5098  !$omp parallel do private(i,j,n) OMP_SCHEDULE_
5099  !$acc kernels if(acc_is_present(var)) async
5100  !$acc loop independent
5101  do j = js, je
5102  !$acc loop independent
5103  do i = is, is+ihalo-1
5104  n = (j-js) * ihalo &
5105  + (i-is) + 1
5106 #ifdef _OPENACC
5107  ptr(n,1,vid) = var(i,j)
5108 #else
5109  ginfo(gid)%sendpack_P2WE(n,1,vid) = var(i,j)
5110 #endif
5111  enddo
5112  enddo
5113  !$acc end kernels
5114  end if
5115 
5116  if ( prc_has_e ) then
5117  !--- packing packets to East
5118  !$omp parallel do private(i,j,n) OMP_SCHEDULE_
5119  !$acc kernels if(acc_is_present(var)) async
5120  !$acc loop independent
5121  do j = js, je
5122  !$acc loop independent
5123  do i = ie-ihalo+1, ie
5124  n = (j-js) * ihalo &
5125  + (i-ie+ihalo-1) + 1
5126 #ifdef _OPENACC
5127  ptr(n,2,vid) = var(i,j)
5128 #else
5129  ginfo(gid)%sendpack_P2WE(n,2,vid) = var(i,j)
5130 #endif
5131  enddo
5132  enddo
5133  !$acc end kernels
5134  end if
5135 
5136  !$acc wait
5137 
5138  call prof_rapend('COMM_pack', 3)
5139 
5140  !$acc end data
5141 
5142  return
5143  end subroutine packwe_2d
5144 
5145  subroutine unpackwe_3d( KA, IA, IS, IE, JA, JS, JE, &
5146  IHALO, &
5147  var, buf )
5148  implicit none
5149  integer, intent(in) :: KA
5150  integer, intent(in) :: IA, IS, IE
5151  integer, intent(in) :: JA, JS, JE
5152  integer, intent(in) :: IHALO
5153  real(RP), intent(inout) :: var(KA,IA,JA)
5154  real(RP), intent(in) :: buf(KA,IHALO,JS:JE,2)
5155 
5156  integer :: i, j, k
5157  !---------------------------------------------------------------------------
5158 
5159  !$acc data copy(var) copyin(buf) if(acc_is_present(var))
5160 
5161  call prof_rapstart('COMM_unpack', 3)
5162 
5163  if ( prc_has_e ) then
5164  !--- unpacking packets from East
5165  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5166  !$acc parallel if(acc_is_present(var)) async
5167  !$acc loop collapse(2) gang
5168  do j = js, je
5169  do i = ie+1, ia
5170  !$acc loop vector
5171  do k = 1, ka
5172  var(k,i,j) = buf(k,i-ie,j,2)
5173  enddo
5174  enddo
5175  enddo
5176  !$acc end parallel
5177  end if
5178 
5179  if ( prc_has_w ) then
5180  !--- unpacking packets from West
5181  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5182  !$acc parallel if(acc_is_present(var)) async
5183  !$acc loop collapse(2) gang
5184  do j = js, je
5185  do i = 1, is-1
5186  !$acc loop vector
5187  do k = 1, ka
5188  var(k,i,j) = buf(k,i,j,1)
5189  enddo
5190  enddo
5191  enddo
5192  !$acc end parallel
5193  end if
5194 
5195  call prof_rapend('COMM_unpack', 3)
5196 
5197  !$acc end data
5198 
5199  return
5200  end subroutine unpackwe_3d
5201 
5202  subroutine unpackwe_2d( KA, IA, IS, IE, JA, JS, JE, &
5203  IHALO, &
5204  var, buf )
5205  implicit none
5206  integer, intent(in) :: KA
5207  integer, intent(in) :: IA, IS, IE
5208  integer, intent(in) :: JA, JS, JE
5209  integer, intent(in) :: IHALO
5210  real(RP), intent(inout) :: var(IA,JA)
5211  real(RP), intent(in) :: buf(IHALO,JS:JE,KA,2)
5212 
5213  integer :: i, j
5214  !---------------------------------------------------------------------------
5215 
5216  !$acc data copy(var) copyin(buf) if(acc_is_present(var))
5217 
5218  call prof_rapstart('COMM_unpack', 3)
5219 
5220  if( prc_has_e ) then
5221  !--- unpacking packets from East
5222  !$omp parallel do private(i,j) OMP_SCHEDULE_
5223  !$acc kernels if(acc_is_present(var)) async
5224  do j = js, je
5225  do i = ie+1, ie+ihalo
5226  var(i,j) = buf(i-ie,j,1,2)
5227  enddo
5228  enddo
5229  !$acc end kernels
5230  end if
5231 
5232  if( prc_has_w ) then
5233  !--- unpacking packets from West
5234  !$omp parallel do private(i,j) OMP_SCHEDULE_
5235  !$acc kernels if(acc_is_present(var)) async
5236  do j = js, je
5237  do i = is-ihalo, is-1
5238  var(i,j) = buf(i,j,1,1)
5239  enddo
5240  enddo
5241  !$acc end kernels
5242  end if
5243 
5244  !$acc wait
5245 
5246  call prof_rapend('COMM_unpack', 3)
5247 
5248  !$acc end data
5249 
5250  return
5251  end subroutine unpackwe_2d
5252 
5253  subroutine unpackns_3d( KA, IA, IS, IE, JA, JS, JE, &
5254  JHALO, &
5255  var, buf )
5256  implicit none
5257  integer, intent(in) :: KA
5258  integer, intent(in) :: IA, IS, IE
5259  integer, intent(in) :: JA, JS, JE
5260  integer, intent(in) :: JHALO
5261  real(RP), intent(inout) :: var(KA,IA,JA)
5262  real(RP), intent(in) :: buf(KA,IA,JHALO,2)
5263 
5264  integer :: i, j, k
5265  !---------------------------------------------------------------------------
5266 
5267  !$acc data copy(var) copyin(buf)
5268 
5269  call prof_rapstart('COMM_unpack', 3)
5270 
5271  if ( prc_has_s ) then
5272  !--- unpacking packets from S, SW, and SE
5273  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5274  !$acc kernels async
5275  do j = 1, js-1
5276  do i = 1, ia
5277  do k = 1, ka
5278  var(k,i,j) = buf(k,i,j,1)
5279  enddo
5280  enddo
5281  enddo
5282  !$acc end kernels
5283  else
5284  if ( prc_has_w ) then
5285  !--- unpacking packets from SW
5286  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5287  !$acc kernels async
5288  do j = 1, js-1
5289  do i = 1, is-1
5290  do k = 1, ka
5291  var(k,i,j) = buf(k,i,j,1)
5292  enddo
5293  enddo
5294  enddo
5295  !$acc end kernels
5296  end if
5297  if ( prc_has_e ) then
5298  !--- unpacking packets from SE
5299  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5300  !$acc kernels async
5301  do j = 1, js-1
5302  do i = ie+1, ia
5303  do k = 1, ka
5304  var(k,i,j) = buf(k,i,j,1)
5305  enddo
5306  enddo
5307  enddo
5308  !$acc end kernels
5309  end if
5310  end if
5311 
5312  if ( prc_has_n ) then
5313  !--- unpacking packets from N, NW, and NE
5314  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5315  !$acc kernels async
5316  do j = je+1, ja
5317  do i = 1, ia
5318  do k = 1, ka
5319  var(k,i,j) = buf(k,i,j-je,2)
5320  enddo
5321  enddo
5322  enddo
5323  !$acc end kernels
5324  else
5325  if ( prc_has_w ) then
5326  !--- unpacking packets from NW
5327  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5328  !$acc kernels async
5329  do j = je+1, ja
5330  do i = 1, is-1
5331  do k = 1, ka
5332  var(k,i,j) = buf(k,i,j-je,2)
5333  enddo
5334  enddo
5335  enddo
5336  !$acc end kernels
5337  end if
5338  if ( prc_has_e ) then
5339  !--- unpacking packets from NE
5340  !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
5341  !$acc kernels async
5342  do j = je+1, ja
5343  do i = ie+1, ia
5344  do k = 1, ka
5345  var(k,i,j) = buf(k,i,j-je,2)
5346  enddo
5347  enddo
5348  enddo
5349  !$acc end kernels
5350  end if
5351  end if
5352 
5353  !$acc wait
5354 
5355  call prof_rapend('COMM_unpack', 3)
5356 
5357  !$acc end data
5358 
5359  return
5360  end subroutine unpackns_3d
5361 
5362  subroutine unpackns_2d( IA, IS, IE, JA, JS, JE, &
5363  JHALO, &
5364  var, buf )
5365  implicit none
5366  integer, intent(in) :: IA, IS, IE
5367  integer, intent(in) :: JA, JS, JE
5368  integer, intent(in) :: JHALO
5369  real(RP), intent(inout) :: var(IA,JA)
5370  real(RP), intent(in) :: buf(IA,JHALO,2)
5371 
5372  integer :: i, j
5373  !---------------------------------------------------------------------------
5374 
5375  !$acc data copy(var) copyin(buf)
5376 
5377  call prof_rapstart('COMM_unpack', 3)
5378 
5379  if ( prc_has_s ) then
5380  !--- unpacking packets from S, SW, and SE
5381  !$omp parallel do private(i,j) OMP_SCHEDULE_
5382  !$acc kernels async
5383  do j = 1, js-1
5384  do i = 1, ia
5385  var(i,j) = buf(i,j,1)
5386  enddo
5387  enddo
5388  !$acc end kernels
5389  else
5390  if ( prc_has_w ) then
5391  !--- unpacking packets from SW
5392  !$omp parallel do private(i,j) OMP_SCHEDULE_
5393  !$acc kernels async
5394  do j = 1, js-1
5395  do i = 1, is-1
5396  var(i,j) = buf(i,j,1)
5397  enddo
5398  enddo
5399  !$acc end kernels
5400  end if
5401  if ( prc_has_e ) then
5402  !--- unpacking packets from SE
5403  !$omp parallel do private(i,j) OMP_SCHEDULE_
5404  !$acc kernels async
5405  do j = 1, js-1
5406  do i = ie+1, ia
5407  var(i,j) = buf(i,j,1)
5408  enddo
5409  enddo
5410  !$acc end kernels
5411  end if
5412  end if
5413 
5414  if ( prc_has_n ) then
5415  !--- unpacking packets from N, NW, and NE
5416  !$omp parallel do private(i,j) OMP_SCHEDULE_
5417  !$acc kernels async
5418  do j = je+1, ja
5419  do i = 1, ia
5420  var(i,j) = buf(i,j-je,2)
5421  enddo
5422  enddo
5423  !$acc end kernels
5424  else
5425  if ( prc_has_w ) then
5426  !--- unpacking packets from NW
5427  !$omp parallel do private(i,j) OMP_SCHEDULE_
5428  !$acc kernels async
5429  do j = je+1, ja
5430  do i = 1, is-1
5431  var(i,j) = buf(i,j-je,2)
5432  enddo
5433  enddo
5434  !$acc end kernels
5435  end if
5436  if ( prc_has_e ) then
5437  !--- unpacking packets from NE
5438  !$omp parallel do private(i,j) OMP_SCHEDULE_
5439  !$acc kernels async
5440  do j = je+1, ja
5441  do i = ie+1, ia
5442  var(i,j) = buf(i,j-je,2)
5443  enddo
5444  enddo
5445  !$acc end kernels
5446  end if
5447  end if
5448 
5449  !$acc wait
5450 
5451  call prof_rapend('COMM_unpack', 3)
5452 
5453  !$acc end data
5454 
5455  return
5456  end subroutine unpackns_2d
5457 
5458  subroutine copy_boundary_3d(var, gid)
5459  use scale_prc_cartesc, only: &
5460  prc_twod
5461  implicit none
5462 
5463  real(RP), intent(inout) :: var(:,:,:)
5464  integer, intent(in) :: gid
5465 
5466  integer :: KA
5467  integer :: IS, IE, IHALO
5468  integer :: JS, JE, JHALO
5469 
5470  integer :: k, i, j
5471  !---------------------------------------------------------------------------
5472 
5473  !$acc data copy(var)
5474 
5475  ka = ginfo(gid)%KA
5476  is = ginfo(gid)%IS
5477  ie = ginfo(gid)%IE
5478  ihalo = ginfo(gid)%IHALO
5479  js = ginfo(gid)%JS
5480  je = ginfo(gid)%JE
5481  jhalo = ginfo(gid)%JHALO
5482 
5483  !$omp parallel
5484 
5485  !--- copy inner data to HALO(North)
5486  if ( .NOT. prc_has_n ) then
5487  !$acc kernels async
5488  do j = je+1, je+jhalo
5489  !$omp do
5490  do i = is, ie
5491  do k = 1, ka
5492  var(k,i,j) = var(k,i,je)
5493  enddo
5494  enddo
5495  !$omp end do nowait
5496  enddo
5497  !$acc end kernels
5498  endif
5499 
5500  !--- copy inner data to HALO(South)
5501  if ( .NOT. prc_has_s ) then
5502  !$acc kernels async
5503  !$acc loop independent
5504  do j = js-jhalo, js-1
5505  !$omp do
5506  do i = is, ie
5507  do k = 1, ka
5508  var(k,i,j) = var(k,i,js)
5509  enddo
5510  enddo
5511  !$omp end do nowait
5512  enddo
5513  !$acc end kernels
5514  endif
5515 
5516  if ( .not. prc_twod ) then
5517 
5518  !--- copy inner data to HALO(East)
5519  if ( .NOT. prc_has_e ) then
5520  !$acc kernels async
5521  !$omp do
5522  do j = js, je
5523  do i = ie+1, ie+ihalo
5524  do k = 1, ka
5525  var(k,i,j) = var(k,ie,j)
5526  enddo
5527  enddo
5528  enddo
5529  !$omp end do nowait
5530  !$acc end kernels
5531  end if
5532 
5533  !--- copy inner data to HALO(West)
5534  if ( .NOT. prc_has_w ) then
5535  !$acc kernels async
5536  !$omp do
5537  do j = js, je
5538  !$acc loop independent
5539  do i = is-ihalo, is-1
5540  var(:,i,j) = var(:,is,j)
5541  enddo
5542  enddo
5543  !$omp end do nowait
5544  !$acc end kernels
5545  end if
5546 
5547  !--- copy inner data to HALO(NorthWest)
5548  if ( .NOT. prc_has_n .AND. &
5549  .NOT. prc_has_w ) then
5550  !$acc kernels async
5551  do j = je+1, je+jhalo
5552  !$acc loop independent
5553  do i = is-ihalo, is-1
5554  do k = 1, ka
5555  var(k,i,j) = var(k,is,je)
5556  enddo
5557  enddo
5558  enddo
5559  !$acc end kernels
5560  elseif( .NOT. prc_has_n ) then
5561  !$acc kernels async
5562  do j = je+1, je+jhalo
5563  do i = is-ihalo, is-1
5564  do k = 1, ka
5565  var(k,i,j) = var(k,i,je)
5566  enddo
5567  enddo
5568  enddo
5569  !$acc end kernels
5570  elseif( .NOT. prc_has_w ) then
5571  !$acc kernels async
5572  do j = je+1, je+jhalo
5573  !$acc loop independent
5574  do i = is-ihalo, is-1
5575  do k = 1, ka
5576  var(k,i,j) = var(k,is,j)
5577  enddo
5578  enddo
5579  enddo
5580  !$acc end kernels
5581  endif
5582 
5583  !--- copy inner data to HALO(SouthWest)
5584  if ( .NOT. prc_has_s .AND. &
5585  .NOT. prc_has_w ) then
5586  !$acc kernels async
5587  !$acc loop independent
5588  do j = js-jhalo, js-1
5589  !$acc loop independent
5590  do i = is-ihalo, is-1
5591  do k = 1, ka
5592  var(k,i,j) = var(k,is,js)
5593  enddo
5594  enddo
5595  enddo
5596  !$acc end kernels
5597  elseif( .NOT. prc_has_s ) then
5598  !$acc kernels async
5599  !$acc loop independent
5600  do j = js-jhalo, js-1
5601  do i = is-ihalo, is-1
5602  do k = 1, ka
5603  var(k,i,j) = var(k,i,js)
5604  enddo
5605  enddo
5606  enddo
5607  !$acc end kernels
5608  elseif( .NOT. prc_has_w ) then
5609  !$acc kernels async
5610  do j = js-jhalo, js-1
5611  !$acc loop independent
5612  do i = is-ihalo, is-1
5613  do k = 1, ka
5614  var(k,i,j) = var(k,is,j)
5615  enddo
5616  enddo
5617  enddo
5618  !$acc end kernels
5619  endif
5620 
5621  !--- copy inner data to HALO(NorthEast)
5622  if ( .NOT. prc_has_n .AND. &
5623  .NOT. prc_has_e ) then
5624  !$acc kernels async
5625  do j = je+1, je+jhalo
5626  do i = ie+1, ie+ihalo
5627  do k = 1, ka
5628  var(k,i,j) = var(k,ie,je)
5629  enddo
5630  enddo
5631  enddo
5632  !$acc end kernels
5633  elseif( .NOT. prc_has_n ) then
5634  !$acc kernels async
5635  do j = je+1, je+jhalo
5636  do i = ie+1, ie+ihalo
5637  do k = 1, ka
5638  var(k,i,j) = var(k,i,je)
5639  enddo
5640  enddo
5641  enddo
5642  !$acc end kernels
5643  elseif( .NOT. prc_has_e ) then
5644  !$acc kernels async
5645  do j = je+1, je+jhalo
5646  do i = ie+1, ie+ihalo
5647  do k = 1, ka
5648  var(k,i,j) = var(k,ie,j)
5649  enddo
5650  enddo
5651  enddo
5652  !$acc end kernels
5653  endif
5654 
5655  !--- copy inner data to HALO(SouthEast)
5656  if ( .NOT. prc_has_s .AND. &
5657  .NOT. prc_has_e ) then
5658  !$acc kernels async
5659  do j = js-jhalo, js-1
5660  do i = ie+1, ie+ihalo
5661  do k = 1, ka
5662  var(k,i,j) = var(k,ie,js)
5663  enddo
5664  enddo
5665  enddo
5666  !$acc end kernels
5667  elseif( .NOT. prc_has_s ) then
5668  !$acc kernels async
5669  !$acc loop independent
5670  do j = js-jhalo, js-1
5671  do i = ie+1, ie+ihalo
5672  do k = 1, ka
5673  var(k,i,j) = var(k,i,js)
5674  enddo
5675  enddo
5676  enddo
5677  !$acc end kernels
5678  elseif( .NOT. prc_has_e ) then
5679  !$acc kernels async
5680  do j = js-jhalo, js-1
5681  do i = ie+1, ie+ihalo
5682  do k = 1, ka
5683  var(k,i,j) = var(k,ie,j)
5684  enddo
5685  enddo
5686  enddo
5687  !$acc end kernels
5688  endif
5689 
5690  end if
5691 
5692  !$omp end parallel
5693 
5694  !$acc wait
5695 
5696  !$acc end data
5697 
5698  return
5699  end subroutine copy_boundary_3d
5700 
5701  subroutine copy_boundary_2d(var, gid)
5702  use scale_prc_cartesc, only: &
5703  prc_twod
5704  implicit none
5705 
5706  real(RP), intent(inout) :: var(:,:)
5707  integer, intent(in) :: gid
5708 
5709  integer :: IS, IE, IHALO
5710  integer :: JS, JE, JHALO
5711 
5712  integer :: i, j
5713  !---------------------------------------------------------------------------
5714 
5715  !$acc data copy(var)
5716 
5717  is = ginfo(gid)%IS
5718  ie = ginfo(gid)%IE
5719  ihalo = ginfo(gid)%IHALO
5720  js = ginfo(gid)%JS
5721  je = ginfo(gid)%JE
5722  jhalo = ginfo(gid)%JHALO
5723 
5724  !$omp parallel
5725 
5726  !--- copy inner data to HALO(North)
5727  if( .NOT. prc_has_n ) then
5728  !$acc kernels async
5729  do j = je+1, je+jhalo
5730  !$omp do
5731  do i = is, ie
5732  var(i,j) = var(i,je)
5733  enddo
5734  !$omp end do nowait
5735  enddo
5736  !$acc end kernels
5737  endif
5738 
5739  !--- copy inner data to HALO(South)
5740  if( .NOT. prc_has_s ) then
5741  !$acc kernels async
5742  !$acc loop independent
5743  do j = js-jhalo, js-1
5744  !$omp do
5745  do i = is, ie
5746  var(i,j) = var(i,js)
5747  enddo
5748  !$omp end do nowait
5749  enddo
5750  !$acc end kernels
5751  endif
5752 
5753  if ( .not. prc_twod ) then
5754 
5755  if( .NOT. prc_has_e ) then
5756  !$omp do
5757  !$acc kernels async
5758  do j = js, je
5759  do i = ie+1, ie+ihalo
5760  var(i,j) = var(ie,j)
5761  enddo
5762  enddo
5763  !$acc end kernels
5764  !$omp end do nowait
5765  endif
5766 
5767  if( .NOT. prc_has_w ) then
5768  !$omp do
5769  !$acc kernels async
5770  do j = js, je
5771  !$acc loop independent
5772  do i = is-ihalo, is-1
5773  var(i,j) = var(is,j)
5774  enddo
5775  enddo
5776  !$acc end kernels
5777  !$omp end do nowait
5778  endif
5779 
5780  !--- copy inner data to HALO(NorthWest)
5781  if( .NOT. prc_has_n .AND. .NOT. prc_has_w ) then
5782  !$acc kernels async
5783  do j = je+1, je+jhalo
5784  !$acc loop independent
5785  do i = is-ihalo, is-1
5786  var(i,j) = var(is,je)
5787  enddo
5788  enddo
5789  !$acc end kernels
5790  elseif( .NOT. prc_has_n ) then
5791  !$acc kernels async
5792  do j = je+1, je+jhalo
5793  do i = is-ihalo, is-1
5794  var(i,j) = var(i,je)
5795  enddo
5796  enddo
5797  !$acc end kernels
5798  elseif( .NOT. prc_has_w ) then
5799  !$acc kernels async
5800  do j = je+1, je+jhalo
5801  !$acc loop independent
5802  do i = is-ihalo, is-1
5803  var(i,j) = var(is,j)
5804  enddo
5805  enddo
5806  !$acc end kernels
5807  endif
5808 
5809  !--- copy inner data to HALO(SouthWest)
5810  if( .NOT. prc_has_s .AND. .NOT. prc_has_w ) then
5811  !$acc kernels async
5812  !$acc loop independent
5813  do j = js-jhalo, js-1
5814  !$acc loop independent
5815  do i = is-ihalo, is-1
5816  var(i,j) = var(is,js)
5817  enddo
5818  enddo
5819  !$acc end kernels
5820  elseif( .NOT. prc_has_s ) then
5821  !$acc kernels async
5822  !$acc loop independent
5823  do j = js-jhalo, js-1
5824  do i = is-ihalo, is-1
5825  var(i,j) = var(i,js)
5826  enddo
5827  enddo
5828  !$acc end kernels
5829  elseif( .NOT. prc_has_w ) then
5830  !$acc kernels async
5831  do j = js-jhalo, js-1
5832  !$acc loop independent
5833  do i = is-ihalo, is-1
5834  var(i,j) = var(is,j)
5835  enddo
5836  enddo
5837  !$acc end kernels
5838  endif
5839 
5840  !--- copy inner data to HALO(NorthEast)
5841  if( .NOT. prc_has_n .AND. .NOT. prc_has_e ) then
5842  !$acc kernels async
5843  do j = je+1, je+jhalo
5844  do i = ie+1, ie+ihalo
5845  var(i,j) = var(ie,je)
5846  enddo
5847  enddo
5848  !$acc end kernels
5849  elseif( .NOT. prc_has_n ) then
5850  !$acc kernels async
5851  do j = je+1, je+jhalo
5852  do i = ie+1, ie+ihalo
5853  var(i,j) = var(i,je)
5854  enddo
5855  enddo
5856  !$acc end kernels
5857  elseif( .NOT. prc_has_e ) then
5858  !$acc kernels async
5859  do j = je+1, je+jhalo
5860  do i = ie+1, ie+ihalo
5861  var(i,j) = var(ie,j)
5862  enddo
5863  enddo
5864  !$acc end kernels
5865  endif
5866 
5867  !--- copy inner data to HALO(SouthEast)
5868  if( .NOT. prc_has_s .AND. .NOT. prc_has_e ) then
5869  !$acc kernels async
5870  do j = js-jhalo, js-1
5871  do i = ie+1, ie+ihalo
5872  var(i,j) = var(ie,js)
5873  enddo
5874  enddo
5875  !$acc end kernels
5876  elseif( .NOT. prc_has_s ) then
5877  !$acc kernels async
5878  !$acc loop independent
5879  do j = js-jhalo, js-1
5880  do i = ie+1, ie+ihalo
5881  var(i,j) = var(i,js)
5882  enddo
5883  enddo
5884  !$acc end kernels
5885  elseif( .NOT. prc_has_e ) then
5886  !$acc kernels async
5887  do j = js-jhalo, js-1
5888  do i = ie+1, ie+ihalo
5889  var(i,j) = var(ie,j)
5890  enddo
5891  enddo
5892  !$acc end kernels
5893  endif
5894 
5895  end if
5896 
5897  !$omp end parallel
5898 
5899  !$acc wait
5900 
5901  !$acc end data
5902 
5903  return
5904  end subroutine copy_boundary_2d
5905 
5906 end module scale_comm_cartesc
scale_comm_cartesc::comm_setup
subroutine, public comm_setup
Setup.
Definition: scale_comm_cartesC.F90:178
scale_comm_cartesc::comm_vars_init
subroutine, public comm_vars_init(varname, var, vid, gid)
Register variables.
Definition: scale_comm_cartesC.F90:699
scale_comm_cartesc::comm_datatype
integer, public comm_datatype
datatype of variable
Definition: scale_comm_cartesC.F90:103
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:349
scale_prc_cartesc::prc_n
integer, parameter, public prc_n
[node direction] north
Definition: scale_prc_cartesC.F90:34
scale_comm_cartesc::wait_2d_mpi
subroutine wait_2d_mpi(var, gid, vid)
Definition: scale_comm_cartesC.F90:4859
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:35
scale_prc_cartesc::prc_sw
integer, parameter, public prc_sw
[node direction] southwest
Definition: scale_prc_cartesC.F90:39
scale_comm_cartesc::comm_bcast_1d_sp
subroutine comm_bcast_1d_sp(IA, var)
Broadcast data for whole process value in 1D field.
Definition: scale_comm_cartesC.F90:1332
scale_prc_cartesc::prc_next
integer, dimension(8), public prc_next
node ID of 8 neighbour process
Definition: scale_prc_cartesC.F90:46
scale_prc_cartesc::prc_has_s
logical, public prc_has_s
Definition: scale_prc_cartesC.F90:51
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_comm_cartesc::comm_gather_2d
subroutine comm_gather_2d(IA, JA, send, recv)
Get data from whole process value in 2D field.
Definition: scale_comm_cartesC.F90:1206
scale_comm_cartesc::comm_horizontal_mean_3d
subroutine comm_horizontal_mean_3d(KA, IA, IS, IE, JA, JS, JE, var, varmean)
calculate horizontal mean (global total with communication) 3D
Definition: scale_comm_cartesC.F90:1122
scale_prc::prc_local_comm_world
integer, public prc_local_comm_world
local communicator
Definition: scale_prc.F90:88
scale_comm_cartesc::vars_3d_mpi_onesided
subroutine vars_3d_mpi_onesided(var, gid, vid)
Definition: scale_comm_cartesC.F90:2591
scale_comm_cartesc::wait_3d_mpi_pc
subroutine wait_3d_mpi_pc(var, gid, vid)
Definition: scale_comm_cartesC.F90:4949
scale_comm_cartesc::vars8_3d_mpi_onesided
subroutine vars8_3d_mpi_onesided(var, gid, vid)
Definition: scale_comm_cartesC.F90:3255
scale_comm_cartesc::comm_bcast_scr_sp
subroutine comm_bcast_scr_sp(var)
Broadcast data for whole process value in scalar field.
Definition: scale_comm_cartesC.F90:1277
scale_prc_cartesc::prc_se
integer, parameter, public prc_se
[node direction] southeast
Definition: scale_prc_cartesC.F90:40
scale_prc_cartesc::prc_has_n
logical, public prc_has_n
Definition: scale_prc_cartesC.F90:49
scale_comm_cartesc::comm_bcast_scr_dp
subroutine comm_bcast_scr_dp(var)
Definition: scale_comm_cartesC.F90:1303
scale_prc_cartesc::prc_has_e
logical, public prc_has_e
Definition: scale_prc_cartesC.F90:50
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_comm_cartesc::comm_bcast_1d_dp
subroutine comm_bcast_1d_dp(IA, var)
Definition: scale_comm_cartesC.F90:1362
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_io
module STDIO
Definition: scale_io.F90:10
scale_prc::prc_masterrank
integer, parameter, public prc_masterrank
master process in each communicator
Definition: scale_prc.F90:66
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_comm_cartesc::copy_boundary_2d
subroutine copy_boundary_2d(var, gid)
Definition: scale_comm_cartesC.F90:5702
scale_comm_cartesc::comm_bcast_4d_dp
subroutine comm_bcast_4d_dp(KA, IA, JA, NT, var)
Definition: scale_comm_cartesC.F90:1556
scale_comm_cartesc::comm_regist
subroutine, public comm_regist(KA, IA, JA, IHALO, JHALO, gid)
Regist grid.
Definition: scale_comm_cartesC.F90:409
scale_comm_cartesc::comm_gather_3d
subroutine comm_gather_3d(KA, IA, JA, send, recv)
Get data from whole process value in 3D field.
Definition: scale_comm_cartesC.F90:1243
scale_prc_cartesc::prc_w
integer, parameter, public prc_w
[node direction] west
Definition: scale_prc_cartesC.F90:33
scale_comm_cartesc::vars_3d_mpi
subroutine vars_3d_mpi(var, gid, vid)
Definition: scale_comm_cartesC.F90:2436
scale_prc_cartesc
module process / cartesC
Definition: scale_prc_cartesC.F90:11
scale_comm_cartesc::comm_finalize
subroutine, public comm_finalize
Finalize.
Definition: scale_comm_cartesC.F90:582
scale_comm_cartesc::comm_bcast_character
subroutine comm_bcast_character(var)
Broadcast data for whole process value in character.
Definition: scale_comm_cartesC.F90:1747
scale_comm_cartesc::vars8_3d_mpi
subroutine vars8_3d_mpi(var, gid, vid)
Definition: scale_comm_cartesC.F90:2697
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_comm_cartesc::comm_bcast_int_2d
subroutine comm_bcast_int_2d(IA, JA, var)
Broadcast data for whole process value in 2D field (integer)
Definition: scale_comm_cartesC.F90:1653
scale_comm_cartesc::vars8_2d_mpi_onesided
subroutine vars8_2d_mpi_onesided(var, gid, vid)
Definition: scale_comm_cartesC.F90:4423
scale_comm_cartesc::comm_bcast_int_1d
subroutine comm_bcast_int_1d(IA, var)
Broadcast data for whole process value in 1D field (integer)
Definition: scale_comm_cartesC.F90:1623
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:104
scale_prc_cartesc::prc_s
integer, parameter, public prc_s
[node direction] south
Definition: scale_prc_cartesC.F90:36
scale_comm_cartesc::wait_3d_mpi_onesided
subroutine wait_3d_mpi_onesided(var, gid, vid)
Definition: scale_comm_cartesC.F90:4809
scale_comm_cartesc::comm_bcast_3d_sp
subroutine comm_bcast_3d_sp(KA, IA, JA, var)
Broadcast data for whole process value in 3D field.
Definition: scale_comm_cartesC.F90:1458
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
scale_comm_cartesc::comm_bcast_2d_dp
subroutine comm_bcast_2d_dp(IA, JA, var)
Definition: scale_comm_cartesC.F90:1425
scale_prc_cartesc::prc_nw
integer, parameter, public prc_nw
[node direction] northwest
Definition: scale_prc_cartesC.F90:37
scale_comm_cartesc::comm_bcast_2d_sp
subroutine comm_bcast_2d_sp(IA, JA, var)
Broadcast data for whole process value in 2D field.
Definition: scale_comm_cartesC.F90:1395
scale_comm_cartesc::comm_bcast_4d_sp
subroutine comm_bcast_4d_sp(KA, IA, JA, NT, var)
Broadcast data for whole process value in 4D field.
Definition: scale_comm_cartesC.F90:1521
scale_comm_cartesc::vars_2d_mpi
subroutine vars_2d_mpi(var, gid, vid)
Definition: scale_comm_cartesC.F90:3552
scale_prc_cartesc::prc_e
integer, parameter, public prc_e
[node direction] east
Definition: scale_prc_cartesC.F90:35
scale_comm_cartesc::vars_2d_mpi_onesided
subroutine vars_2d_mpi_onesided(var, gid, vid)
Definition: scale_comm_cartesC.F90:3704
scale_comm_cartesc::packwe_3d
subroutine packwe_3d(KA, IA, IS, IE, JA, JS, JE, IHALO, var, gid, vid)
Definition: scale_comm_cartesC.F90:5001
scale_comm_cartesc::wait_2d_mpi_onesided
subroutine wait_2d_mpi_onesided(var, gid, vid)
Definition: scale_comm_cartesC.F90:4901
scale_comm_cartesc::vars8_init_mpi_pc
subroutine vars8_init_mpi_pc(var, gid, vid, seqid)
Definition: scale_comm_cartesC.F90:1914
scale_comm_cartesc::vars_init_mpi_pc
subroutine vars_init_mpi_pc(var, gid, vid, seqid)
Definition: scale_comm_cartesC.F90:1777
scale_comm_cartesc::wait_3d_mpi
subroutine wait_3d_mpi(var, gid, vid)
Definition: scale_comm_cartesC.F90:4766
scale_comm_cartesc::comm_vars8_init
subroutine, public comm_vars8_init(varname, var, vid, gid)
Register variables.
Definition: scale_comm_cartesC.F90:766
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_prc_cartesc::prc_ne
integer, parameter, public prc_ne
[node direction] northeast
Definition: scale_prc_cartesC.F90:38
scale_comm_cartesc::comm_bcast_logical_scr
subroutine comm_bcast_logical_scr(var)
Broadcast data for whole process value in scalar (logical)
Definition: scale_comm_cartesC.F90:1686
scale_prc_cartesc::prc_has_w
logical, public prc_has_w
Definition: scale_prc_cartesC.F90:48
scale_comm_cartesc::comm_bcast_3d_dp
subroutine comm_bcast_3d_dp(KA, IA, JA, var)
Definition: scale_comm_cartesC.F90:1488
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_prc_cartesc::prc_twod
logical, public prc_twod
2D experiment
Definition: scale_prc_cartesC.F90:56
scale_comm_cartesc::comm_bcast_logical_1d
subroutine comm_bcast_logical_1d(IA, var)
Broadcast data for whole process value in 1D (logical)
Definition: scale_comm_cartesC.F90:1715
scale_comm_cartesc::vars_3d_mpi_pc
subroutine vars_3d_mpi_pc(var, gid, vid)
Definition: scale_comm_cartesC.F90:4714
scale_comm_cartesc::comm_bcast_int_scr
subroutine comm_bcast_int_scr(var)
Broadcast data for whole process value in scalar (integer)
Definition: scale_comm_cartesC.F90:1594
scale_comm_cartesc::vars8_2d_mpi
subroutine vars8_2d_mpi(var, gid, vid)
Definition: scale_comm_cartesC.F90:3808
Generated by   doxygen 1.8.17