scale_comm_cartesc Module Reference

module COMMUNICATION More...

Functions/Subroutines
subroutine, public	comm_setup
	Setup. More...
subroutine, public	comm_regist (KA, IA, JA, IHALO, JHALO, gid)
	Regist grid. More...
subroutine, public	comm_finalize
	Finalize. More...
subroutine, public	comm_vars_init (varname, var, vid, gid)
	Register variables. More...
subroutine, public	comm_vars8_init (varname, var, vid, gid)
	Register variables. More...
subroutine	comm_horizontal_mean_3d (KA, IA, IS, IE, JA, JS, JE, var, varmean)
	calculate horizontal mean (global total with communication) 3D More...
subroutine	comm_gather_2d (IA, JA, send, recv)
	Get data from whole process value in 2D field. More...
subroutine	comm_gather_3d (KA, IA, JA, send, recv)
	Get data from whole process value in 3D field. More...
subroutine	comm_bcast_scr_sp (var)
	Broadcast data for whole process value in scalar field. More...
subroutine	comm_bcast_scr_dp (var)
subroutine	comm_bcast_1d_sp (IA, var)
	Broadcast data for whole process value in 1D field. More...
subroutine	comm_bcast_1d_dp (IA, var)
subroutine	comm_bcast_2d_sp (IA, JA, var)
	Broadcast data for whole process value in 2D field. More...
subroutine	comm_bcast_2d_dp (IA, JA, var)
subroutine	comm_bcast_3d_sp (KA, IA, JA, var)
	Broadcast data for whole process value in 3D field. More...
subroutine	comm_bcast_3d_dp (KA, IA, JA, var)
subroutine	comm_bcast_4d_sp (KA, IA, JA, NT, var)
	Broadcast data for whole process value in 4D field. More...
subroutine	comm_bcast_4d_dp (KA, IA, JA, NT, var)
subroutine	comm_bcast_int_scr (var)
	Broadcast data for whole process value in scalar (integer) More...
subroutine	comm_bcast_int_1d (IA, var)
	Broadcast data for whole process value in 1D field (integer) More...
subroutine	comm_bcast_int_2d (IA, JA, var)
	Broadcast data for whole process value in 2D field (integer) More...
subroutine	comm_bcast_logical_scr (var)
	Broadcast data for whole process value in scalar (logical) More...
subroutine	comm_bcast_logical_1d (IA, var)
	Broadcast data for whole process value in 1D (logical) More...
subroutine	comm_bcast_character (var)
	Broadcast data for whole process value in character. More...
subroutine	vars_init_mpi_pc (var, gid, vid, seqid)
subroutine	vars8_init_mpi_pc (var, gid, vid, seqid)
subroutine	vars_3d_mpi (var, gid, vid)
subroutine	vars_3d_mpi_onesided (var, gid, vid)
subroutine	vars8_3d_mpi (var, gid, vid)
subroutine	vars8_3d_mpi_onesided (var, gid, vid)
subroutine	vars_2d_mpi (var, gid, vid)
subroutine	vars_2d_mpi_onesided (var, gid, vid)
subroutine	vars8_2d_mpi (var, gid, vid)
subroutine	vars8_2d_mpi_onesided (var, gid, vid)
subroutine	vars_3d_mpi_pc (var, gid, vid)
subroutine	wait_3d_mpi (var, gid, vid)
subroutine	wait_3d_mpi_onesided (var, gid, vid)
subroutine	wait_2d_mpi (var, gid, vid)
subroutine	wait_2d_mpi_onesided (var, gid, vid)
subroutine	wait_3d_mpi_pc (var, gid, vid)
subroutine	packwe_3d (KA, IA, IS, IE, JA, JS, JE, IHALO, var, gid, vid)
subroutine	copy_boundary_2d (var, gid)

Variables
integer, public	comm_datatype
	datatype of variable More...
integer, public	comm_world
	communication world ID More...

Detailed Description

module COMMUNICATION

Description

MPI Communication module for Cartesian C-grid

Author

Team SCALE

NAMELIST

• PARAM_COMM_CARTESC

  name	type	default value	comment
  COMM_VSIZE_MAX	integer		# limit of communication variables at once
  COMM_VSIZE_MAX_PC	integer		# limit of total communication variables for MPI PC
  COMM_USE_MPI_PC	logical	.true.	MPI persistent communication
  COMM_USE_MPI_ONESIDED	logical	.false.	MPI one-sided communication

  
  

History Output

No history output

Function/Subroutine Documentation

comm_setup()

subroutine, public scale_comm_cartesc::comm_setup

Setup.

Definition at line 178 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_local_comm_world
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    namelist / param_comm_cartesc / &
       comm_vsize_max, &
       comm_vsize_max_pc, &
       comm_use_mpi_pc, &
       comm_use_mpi_onesided
 
    integer :: group, ranks(8)
    integer :: n, m
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    if ( initialized ) return
 
    log_newline
    log_info("COMM_setup",*) 'Setup'
 
    comm_vsize_max = max( 10 + qa*2, 25 )
    comm_vsize_max_pc = 50 + qa*2
 
#ifdef _OPENACC
    comm_use_mpi_onesided = .false.
#endif
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_comm_cartesc,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("COMM_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("COMM_setup",*) 'Not appropriate names in namelist PARAM_COMM_CARTESC. Check!'
       call prc_abort
    endif
    log_nml(param_comm_cartesc)
 
    if ( prc_has_n .AND. prc_has_s .AND. prc_has_w .AND. prc_has_e ) then
       comm_isallperiodic = .true.
    else
       comm_isallperiodic = .false.
    endif
 
    if ( rp == kind(0.d0) ) then
       comm_datatype = mpi_double_precision
    elseif( rp == kind(0.0) ) then
       comm_datatype = mpi_real
    else
       log_error("COMM_setup",*) 'precision is not supportd'
       call prc_abort
    endif
 
    comm_world = prc_local_comm_world
    comm_gid = 0
 
#ifdef _OPENACC
    if ( comm_use_mpi_onesided ) then
       log_warn("COMM_setup",*) "Open MPI does not support one-sided APIs with CUDA-aware UCX"
    end if
#endif
 
    if ( comm_use_mpi_onesided ) then
 
       comm_use_mpi_pc = .false.
 
       call mpi_comm_group( comm_world, group, ierr )
 
       n = 0
       if ( prc_has_s ) then
          n = 1
          ranks(n) = prc_next(prc_s)
       end if
       if ( prc_has_n ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_n) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_n)
          end if
       end if
       if ( prc_has_n .and. prc_has_w ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_nw) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_nw)
          end if
       else if ( prc_has_n ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_n) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_n)
          end if
       else if ( prc_has_w ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_w) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_w)
          end if
       end if
       if ( prc_has_n .and. prc_has_e ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_ne) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_ne)
          end if
       else if ( prc_has_n ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_n) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_n)
          end if
       else if ( prc_has_e ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_e) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_e)
          end if
       end if
       if ( prc_has_s .and. prc_has_w ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_sw) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_sw)
          end if
       else if ( prc_has_s ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_s) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_s)
          end if
       else if ( prc_has_w ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_w) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_w)
          end if
       end if
       if ( prc_has_s .and. prc_has_e ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_se) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_se)
          end if
       else if ( prc_has_s ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_s) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_s)
          end if
       else if ( prc_has_e ) then
          do m = 1, n
             if ( ranks(m) == prc_next(prc_e) ) exit
          end do
          if ( m == n + 1 ) then
             n = n + 1
             ranks(n) = prc_next(prc_e)
          end if
       end if
       if ( n > 0 ) then
          call mpi_group_incl( group, n, ranks, group_packns, ierr )
          group_packns_created = .true.
       else
          group_packns_created = .false.
       end if
 
       n = 0
       if ( .not. prc_twod ) then
          if ( prc_has_w ) then
             n = 1
             ranks(n) = prc_next(prc_w)
          end if
          if ( prc_has_e ) then
             if ( n == 0 .or. ranks(1) .ne. prc_next(prc_e) ) then
                n = n + 1
                ranks(n) = prc_next(prc_e)
             end if
          end if
       end if
       if ( n > 0 ) then
          call mpi_group_incl( group, n, ranks, group_packwe, ierr )
          group_packwe_created = .true.
       else
          group_packwe_created = .false.
       end if
 
       call mpi_group_free( group, ierr )
    end if
 
    log_newline
    log_info("COMM_setup",*) 'Communication information'
    log_info_cont(*)         'Maximum number of vars for one communication: ', comm_vsize_max
    log_info_cont(*)         'All side is periodic?                       : ', comm_isallperiodic
 
 
    initialized = .true.
 
    return

References comm_datatype, comm_world, scale_io::io_fid_conf, scale_prc::prc_local_comm_world, scale_prc_cartesc::prc_twod, scale_tracer::qa, and scale_precision::rp.

Referenced by mod_rm_driver::rm_driver(), mod_rm_prep::rm_prep(), and scale_statistics::statistics_setup().

Here is the caller graph for this function:

comm_regist()

subroutine, public scale_comm_cartesc::comm_regist	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	JA,
		integer, intent(in)	IHALO,
		integer, intent(in)	JHALO,
		integer, intent(out)	gid
	)

Regist grid.

Definition at line 409 of file scale_comm_cartesC.F90.

    implicit none
 
    integer, intent(in)  :: KA, IA, JA, IHALO, JHALO
    integer, intent(out) :: gid
 
    integer :: IMAX, JMAX
    integer :: nreq_NS, nreq_WE, nreq_4C
 
    integer :: win_info
    integer(kind=MPI_ADDRESS_KIND) :: size
 
    integer :: ierr
    integer :: n
 
    if ( .not. initialized ) then
       log_error("COMM_regist",*) 'COMM_setup must be called before calling COMM_regist'
       call prc_abort
    end if
 
    comm_gid = comm_gid + 1
    if ( comm_gid > comm_gid_max ) then
       log_error("COMM_regist",*) 'number of registed grid size exceeds the limit'
       call prc_abort
    end if
    gid = comm_gid
 
    if ( ia < ihalo * 3 ) then
       log_error("COMM_regist",*) 'IA must be >= IHALO * 3'
       call prc_abort
    end if
    if ( ja < jhalo * 3 ) then
       log_error("COMM_regist",*) 'JA must be >= JHALO * 3'
       call prc_abort
    end if
 
    imax = ia - ihalo * 2
    jmax = ja - jhalo * 2
 
    ginfo(gid)%KA    = ka
    ginfo(gid)%IA    = ia
    ginfo(gid)%IS    = ihalo + 1
    ginfo(gid)%IE    = ia - ihalo
    ginfo(gid)%IHALO = ihalo
    ginfo(gid)%JA    = ja
    ginfo(gid)%JS    = jhalo + 1
    ginfo(gid)%JE    = ja - jhalo
    ginfo(gid)%JHALO = jhalo
 
    nreq_ns  = 2 * jhalo !--- send x JHALO, recv x JHALO
    nreq_we  = 2         !--- send x 1    , recv x 1
    nreq_4c  = 2 * jhalo !--- send x JHALO, recv x JHALO
 
    if ( comm_use_mpi_pc ) then
       ginfo(gid)%nreq_MAX = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c + 1
    else
       ginfo(gid)%nreq_MAX = 2 * nreq_ns + 2 * nreq_we + 4 * nreq_4c
    end if
 
    ginfo(gid)%size2D_NS4 = ia   * jhalo
    ginfo(gid)%size2D_NS8 = imax
    ginfo(gid)%size2D_WE  = jmax * ihalo
    ginfo(gid)%size2D_4C  =        ihalo
 
    allocate( ginfo(gid)%sendpack_P2WE(ginfo(gid)%size2D_WE * ka, 2, comm_vsize_max) )
    !$acc enter data create(ginfo(gid)%sendpack_P2WE)
 
#ifdef DEBUG
    allocate( ginfo(gid)%use_packbuf(comm_vsize_max) )
    ginfo(gid)%use_packbuf(:) = .false.
#endif
 
#ifdef _OPENACC
    allocate( ginfo(gid)%device_alloc(comm_vsize_max+comm_vsize_max_pc) )
    allocate( ginfo(gid)%device_ptr(comm_vsize_max+1:comm_vsize_max_pc) )
    ginfo(gid)%device_alloc(:) = .false.
#endif
 
    if ( comm_use_mpi_onesided ) then
 
       allocate( ginfo(gid)%recvbuf_WE(comm_vsize_max) )
       allocate( ginfo(gid)%recvbuf_NS(comm_vsize_max) )
 
       allocate( ginfo(gid)%win_packWE(comm_vsize_max) )
       allocate( ginfo(gid)%win_packNS(comm_vsize_max) )
 
       call mpi_info_create(win_info, ierr)
       call mpi_info_set(win_info, "no_locks", "true", ierr)
       call mpi_info_set(win_info, "same_size", "true", ierr)
       call mpi_info_set(win_info, "same_disp_unit", "true", ierr)
 
       do n = 1, comm_vsize_max
          size = ginfo(gid)%size2D_WE * ka * 2 * rp
#ifdef _OPENACC
          block
            real(RP), pointer :: pack(:)
            call mpi_alloc_mem(size, mpi_info_null, ginfo(gid)%recvbuf_WE(n), ierr)
            call c_f_pointer(ginfo(gid)%recvbuf_WE(n), pack, (/ size/rp /))
            !$acc enter data create(pack)
            !$acc host_data use_device(pack)
            call mpi_win_create(pack, size, ginfo(gid)%size2D_WE*ka*rp, &
                                win_info, comm_world, &
                                ginfo(gid)%win_packWE(n), ierr)
            !$acc end host_data
          end block
#else
          call mpi_win_allocate(size, ginfo(gid)%size2D_WE*ka*rp, &
                                win_info, comm_world, &
                                ginfo(gid)%recvbuf_WE(n), ginfo(gid)%win_packWE(n), ierr)
#endif
          size = ginfo(gid)%size2D_NS4 * ka * 2 * rp
#ifdef _OPENACC
          block
            real(RP), pointer :: pack(:)
            call mpi_alloc_mem(size, mpi_info_null, ginfo(gid)%recvbuf_NS(n), ierr)
            call c_f_pointer(ginfo(gid)%recvbuf_NS(n), pack, (/ size/rp /))
            !$acc enter data create(pack)
            !$acc host_data use_device(pack)
            call mpi_win_create(pack, size, rp, &
                                win_info, comm_world, &
                                ginfo(gid)%win_packNS(n), ierr)
            !$acc end host_data
          end block
#else
          call mpi_win_allocate(size, rp, &
                                win_info, comm_world, &
                                ginfo(gid)%recvbuf_NS(n), ginfo(gid)%win_packNS(n), ierr)
#endif
       end do
 
       call mpi_info_free(win_info, ierr)
 
       do n = 1, comm_vsize_max
          call mpi_win_post( group_packwe, mpi_mode_nostore, ginfo(gid)%win_packWE(n), ierr )
          call mpi_win_post( group_packns, mpi_mode_nostore, ginfo(gid)%win_packNS(n), ierr )
       end do
 
       ginfo(gid)%vars_num = 0
       allocate( ginfo(gid)%packid(comm_vsize_max_pc) )
 
    else
 
       allocate( ginfo(gid)%recvpack_WE2P(ginfo(gid)%size2D_WE * ka, 2, comm_vsize_max) )
       !$acc enter data create(ginfo(gid)%recvpack_WE2P)
 
       allocate( ginfo(gid)%req_cnt (                     comm_vsize_max) )
       allocate( ginfo(gid)%req_list(ginfo(gid)%nreq_MAX, comm_vsize_max) )
       ginfo(gid)%req_cnt (:)   = -1
       ginfo(gid)%req_list(:,:) = mpi_request_null
 
       if ( comm_use_mpi_pc ) then
          ginfo(gid)%vars_num = 0
          allocate( ginfo(gid)%packid(comm_vsize_max_pc) )
          allocate( ginfo(gid)%preq_cnt (                      comm_vsize_max_pc) )
          allocate( ginfo(gid)%preq_list(ginfo(gid)%nreq_MAX+1,comm_vsize_max_pc) )
          ginfo(gid)%preq_cnt (:)   = -1
          ginfo(gid)%preq_list(:,:) = mpi_request_null
       end if
 
    end if
 
 
    log_newline
    log_info("COMM_regist",*) 'Register grid: id=', gid
    log_info_cont(*)          'Data size of var (3D,including halo) [byte] : ', rp*ka*ia*ja
    log_info_cont(*)          'Data size of halo                    [byte] : ', rp*ka*(2*ia*jhalo+2*jmax*ihalo)
    log_info_cont(*)          'Ratio of halo against the whole 3D grid     : ', real(2*ia*jhalo+2*jmax*ihalo) / real(ia*ja)
 
    return

References comm_world, scale_prc::prc_abort(), and scale_precision::rp.

Referenced by mod_rm_driver::rm_driver(), and mod_rm_prep::rm_prep().

Here is the call graph for this function:

Here is the caller graph for this function:

comm_finalize()

subroutine, public scale_comm_cartesc::comm_finalize

Finalize.

Definition at line 582 of file scale_comm_cartesC.F90.

    use mpi
    implicit none
 
    integer :: gid
    integer :: i, j, ierr
    !---------------------------------------------------------------------------
 
    do gid = 1, comm_gid
 
       if ( comm_use_mpi_onesided ) then
 
          do i = 1, comm_vsize_max
             call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(i), ierr )
             call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(i), ierr )
         end do
 
          do i = 1, comm_vsize_max
             call mpi_win_complete( ginfo(gid)%win_packWE(i), ierr )
             call mpi_win_complete( ginfo(gid)%win_packNS(i), ierr )
          end do
 
          do i = 1, comm_vsize_max
             call mpi_win_wait( ginfo(gid)%win_packWE(i), ierr )
             call mpi_win_wait( ginfo(gid)%win_packNS(i), ierr )
          end do
 
          do i = 1, comm_vsize_max
             call mpi_win_free(ginfo(gid)%win_packWE(i), ierr)
             call mpi_win_free(ginfo(gid)%win_packNS(i), ierr)
#ifdef _OPENACC
             block
               real(RP), pointer :: pack(:)
               integer :: KA
               ka = ginfo(gid)%KA
               call c_f_pointer( ginfo(gid)%recvbuf_WE(i), pack, (/ginfo(gid)%size2D_WE*ka*2/) )
               !$acc exit data delete(pack)
               call c_f_pointer( ginfo(gid)%recvbuf_NS(i), pack, (/ginfo(gid)%size2D_NS4*ka*2/) )
               !$acc exit data delete(pack)
             end block
             call mpi_free_mem(ginfo(gid)%recvbuf_WE(i), ierr)
             call mpi_free_mem(ginfo(gid)%recvbuf_NS(i), ierr)
#endif
          end do
 
          deallocate( ginfo(gid)%packid )
          ginfo(gid)%vars_num = 0
 
          deallocate( ginfo(gid)%win_packWE )
          deallocate( ginfo(gid)%win_packNS )
 
          deallocate( ginfo(gid)%recvbuf_WE )
          deallocate( ginfo(gid)%recvbuf_NS )
 
       else
 
          if ( comm_use_mpi_pc ) then
 
             do j = 1, comm_vsize_max_pc
                do i = 1, ginfo(gid)%nreq_MAX+1
                   if (ginfo(gid)%preq_list(i,j) .NE. mpi_request_null) &
                        call mpi_request_free(ginfo(gid)%preq_list(i,j), ierr)
                enddo
#ifdef _OPENACC
                if ( ginfo(gid)%device_alloc(j+comm_vsize_max) ) then
                   !$acc exit data delete(ginfo(gid)%device_ptr(j+COMM_vsize_max)%ptr)
                end if
#endif
             enddo
             deallocate( ginfo(gid)%preq_cnt )
             deallocate( ginfo(gid)%preq_list )
             deallocate( ginfo(gid)%packid )
             ginfo(gid)%vars_num = 0
 
          end if
 
          deallocate( ginfo(gid)%req_cnt )
          deallocate( ginfo(gid)%req_list )
 
          !$acc exit data delete(ginfo(gid)%recvpack_WE2P)
          deallocate( ginfo(gid)%recvpack_WE2P )
 
       end if
 
       !$acc exit data delete(ginfo(gid)%sendpack_P2WE)
       deallocate( ginfo(gid)%sendpack_P2WE )
#ifdef DEBUG
       deallocate( ginfo(gid)%use_packbuf )
#endif
 
    end do
 
    if ( comm_use_mpi_onesided ) then
       if ( group_packwe_created ) then
          call mpi_group_free(group_packwe, ierr)
          group_packwe_created = .false.
       end if
       if ( group_packns_created ) then
          call mpi_group_free(group_packns, ierr)
          group_packns_created = .false.
       end if
    end if
 
 
    comm_gid = 0
 
    initialized = .false.
 
    return

Referenced by mod_rm_driver::rm_driver(), and mod_rm_prep::rm_prep().

Here is the caller graph for this function:

comm_vars_init()

subroutine, public scale_comm_cartesc::comm_vars_init	(	character(len=*), intent(in)	varname,
		real(rp), dimension(:,:,:), intent(inout), target	var,
		integer, intent(inout)	vid,
		integer, intent(in), optional	gid
	)

Register variables.

Parameters

[in]	varname	variable name
[in,out]	var	variable array for register
[in,out]	vid	variable ID

Definition at line 699 of file scale_comm_cartesC.F90.

    implicit none
 
    character(len=*), intent(in)    :: varname
    real(RP), target, intent(inout) :: var(:,:,:)
    integer,          intent(inout) :: vid
 
    integer,          intent(in), optional :: gid
 
    integer :: gid_
    integer :: vars_id
    !---------------------------------------------------------------------------
 
    if ( .not. comm_use_mpi_pc ) return
#ifdef _OPENACC
    if ( .not. acc_is_present(var) ) return
#endif
 
    call prof_rapstart('COMM_init_pers', 2)
 
    gid_ = 1
    if ( present(gid) ) gid_ = gid
    if ( gid_ > comm_gid_max ) then
       log_error("COMM_vars_init",*) 'gid is invalid', gid_, comm_gid_max
       call prc_abort
    end if
 
    if ( vid > comm_vsize_max ) then
       log_error("COMM_vars_init",*) 'vid exceeds max', vid, comm_vsize_max, gid
       call prc_abort
    end if
 
    ginfo(gid_)%vars_num = ginfo(gid_)%vars_num + 1
    if ( ginfo(gid_)%vars_num > comm_vsize_max_pc ) then
       log_error("COMM_vars_init",*) 'number of variable for MPI PC exceeds max', ginfo(gid_)%vars_num, comm_vsize_max_pc
       call prc_abort
    end if
 
    vars_id = ginfo(gid_)%vars_num
    ginfo(gid_)%packid(vars_id) = vid
 
#ifdef _OPENACC
    if ( .not. acc_is_present(var) ) then
       ginfo(gid_)%device_alloc(vars_id+comm_vsize_max) = .true.
       ginfo(gid_)%device_ptr(vars_id*comm_vsize_max)%ptr => var
       !$acc enter data copyin(var)
    end if
#endif
 
    call vars_init_mpi_pc(var, gid_, vars_id, vid)
 
    vid = vars_id + comm_vsize_max
 
    log_info("COMM_vars_init",'(1x,A,I3.3,A,I3.3,2A)') 'Initialize variable (grid ID = ', gid_, '): ID = ', vid, &
                                                                                       ', name = ', trim(varname)
 
    call prof_rapend  ('COMM_init_pers', 2)
 
    return

References vars_init_mpi_pc().

Here is the call graph for this function:

comm_vars8_init()

subroutine, public scale_comm_cartesc::comm_vars8_init	(	character(len=*), intent(in)	varname,
		real(rp), dimension(:,:,:), intent(inout), target	var,
		integer, intent(inout)	vid,
		integer, intent(in), optional	gid
	)

Register variables.

Parameters

[in]	varname	variable name
[in,out]	var	variable array for register
[in,out]	vid	variable ID

Definition at line 766 of file scale_comm_cartesC.F90.

    implicit none
 
    character(len=*), intent(in)    :: varname
 
    real(RP), target, intent(inout) :: var(:,:,:)
    integer,          intent(inout) :: vid
 
    integer,          intent(in), optional :: gid
 
    integer :: gid_
    integer :: vars_id
    !---------------------------------------------------------------------------
 
    if ( .not. comm_use_mpi_pc ) return
#ifdef _OPENACC
    if ( .not. acc_is_present(var) ) return
#endif
 
    call prof_rapstart('COMM_init_pers', 2)
 
    gid_ = 1
    if ( present(gid) ) gid_ = gid
    if ( gid_ > comm_gid_max ) then
       log_error("COMM_vars8_init",*) 'gid is invalid', gid_, comm_gid_max
       call prc_abort
    end if
 
    if ( vid > comm_vsize_max ) then
       log_error("COMM_vars8_init",*) 'vid exceeds max', vid, comm_vsize_max
       call prc_abort
    end if
 
    ginfo(gid_)%vars_num = ginfo(gid_)%vars_num + 1
    if ( ginfo(gid_)%vars_num > comm_vsize_max_pc ) then
       log_error("COMM_vars8_init",*) 'number of variable for MPI PC exceeds max', ginfo(gid_)%vars_num, comm_vsize_max_pc
       call prc_abort
    end if
 
    vars_id = ginfo(gid_)%vars_num
    ginfo(gid_)%packid(vars_id) = vid
 
#ifdef _OPENACC
    if ( .not. acc_is_present(var) ) then
       ginfo(gid_)%device_alloc(vars_id+comm_vsize_max) = .true.
       ginfo(gid_)%device_ptr(vars_id+comm_vsize_max)%ptr => var
       !$acc enter data copyin(var)
    end if
#endif
 
    call vars8_init_mpi_pc(var, gid_, vars_id, vid)
 
    vid = vars_id + comm_vsize_max
 
    log_info("COMM_vars8_init",'(1x,A,I3.3,A,I3.3,2A)') 'Initialize variable (grid ID = ', gid_, '): ID = ', vid, &
                                                                                       ', name = ', trim(varname)
 
    call prof_rapend  ('COMM_init_pers', 2)
 
    return

References comm_world, scale_const::const_undef, copy_boundary_2d(), vars8_2d_mpi(), vars8_2d_mpi_onesided(), vars8_3d_mpi(), vars8_3d_mpi_onesided(), vars8_init_mpi_pc(), vars_2d_mpi(), vars_2d_mpi_onesided(), vars_3d_mpi(), vars_3d_mpi_onesided(), vars_3d_mpi_pc(), wait_2d_mpi(), wait_2d_mpi_onesided(), wait_3d_mpi(), wait_3d_mpi_onesided(), and wait_3d_mpi_pc().

Referenced by scale_atmos_dyn_fvm_numfilter::atmos_dyn_fvm_numfilter_setup(), scale_atmos_dyn::atmos_dyn_setup(), scale_atmos_dyn_tinteg_rkcommon::atmos_dyn_tinteg_rkcommon_setup(), scale_atmos_dyn_tinteg_short_rk11s8o::atmos_dyn_tinteg_short_rk11s8o_setup(), scale_atmos_dyn_tinteg_short_rk3::atmos_dyn_tinteg_short_rk3_setup(), scale_atmos_dyn_tinteg_short_rk4::atmos_dyn_tinteg_short_rk4_setup(), scale_atmos_dyn_tinteg_short_rk7s6o::atmos_dyn_tinteg_short_rk7s6o_setup(), scale_atmos_dyn_tinteg_tracer_linrk::atmos_dyn_tinteg_tracer_linrk_setup(), scale_atmos_dyn_tinteg_tracer_rk3::atmos_dyn_tinteg_tracer_rk3_setup(), and scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve_setup().

Here is the call graph for this function:

Here is the caller graph for this function:

comm_horizontal_mean_3d()

subroutine scale_comm_cartesc::comm_horizontal_mean_3d	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	IS,
		integer, intent(in)	IE,
		integer, intent(in)	JA,
		integer, intent(in)	JS,
		integer, intent(in)	JE,
		real(rp), dimension(ka,ia,ja), intent(in)	var,
		real(rp), dimension(ka), intent(out)	varmean
	)

calculate horizontal mean (global total with communication) 3D

Parameters

[in]	var	3D value
[out]	varmean	horizontal mean

Definition at line 1122 of file scale_comm_cartesC.F90.

    use scale_const, only: &
       const_undef
    implicit none
 
    integer,  intent(in)  :: KA
    integer,  intent(in)  :: IA, IS, IE
    integer,  intent(in)  :: JA, JS, JE
    real(RP), intent(in)  :: var(KA,IA,JA)
 
    real(RP), intent(out) :: varmean(KA)
 
    real(DP) :: stat   (KA,2)
    real(DP) :: allstat(KA,2)
    real(DP) :: zerosw
 
    integer :: ierr
    integer :: k, i, j
#ifdef _OPENACC
    logical :: flag_device
#endif
    !---------------------------------------------------------------------------
 
#ifdef _OPENACC
    flag_device = acc_is_present(var)
#endif
 
    !$acc data create(stat, allstat) if(flag_device)
 
    !$acc kernels if(flag_device)
    stat(:,:) = 0.0_dp
    !$acc end kernels
    !$acc kernels if(flag_device)
    !$acc loop independent
    do j = js, je
    !$acc loop independent
    do i = is, ie
    do k = 1,  ka
       if ( abs(var(k,i,j)) < abs(const_undef) ) then
          !$acc atomic update
          stat(k,1) = stat(k,1) + var(k,i,j)
          !$acc end atomic
          !$acc atomic update
          stat(k,2) = stat(k,2) + 1.0_dp
          !$acc end atomic
       endif
    enddo
    enddo
    enddo
    !$acc end kernels
 
 
    ! All reduce
    ! [NOTE] always communicate globally
    call prof_rapstart('COMM_Allreduce', 2)
    !$acc host_data use_device(stat, allstat) if(flag_device)
    call mpi_allreduce( stat,                 &
                        allstat,              &
                        ka * 2,               &
                        mpi_double_precision, &
                        mpi_sum,              &
                        comm_world,           &
                        ierr                  )
    !$acc end host_data
    call prof_rapend  ('COMM_Allreduce', 2)
 
    !$acc kernels if(flag_device)
    do k = 1, ka
       zerosw = 0.5_dp - sign(0.5_dp, allstat(k,2) - 1.e-12_dp )
       varmean(k) = allstat(k,1) / ( allstat(k,2) + zerosw ) * ( 1.0_dp - zerosw )
       !LOG_INFO("COMM_horizontal_mean_3D",*) k, varmean(k), allstatval(k), allstatcnt(k)
    enddo
    !$acc end kernels
 
    !$acc end data
 
    return

References comm_world, and scale_const::const_undef.

comm_gather_2d()

subroutine scale_comm_cartesc::comm_gather_2d	(	integer, intent(in)	IA,
		integer, intent(in)	JA,
		real(rp), dimension(ia,ja), intent(in)	send,
		real(rp), dimension(:,:,:), intent(out)	recv
	)

Get data from whole process value in 2D field.

Parameters

[in]	ja	dimension size
[in]	send	send buffer
[out]	recv	receive buffer (IA,JA,nprcs)

Definition at line 1206 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)  :: IA, JA
    real(RP), intent(in)  :: send(IA,JA)
 
    real(RP), intent(out) :: recv(:,:,:)
 
    integer :: sendcounts, recvcounts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    sendcounts = ia * ja
    recvcounts = ia * ja
 
    !$acc host_data use_device(send, recv) if(acc_is_present(send))
    call mpi_gather( send(:,:),      &
                     sendcounts,     &
                     comm_datatype,  &
                     recv(:,:,:),    &
                     recvcounts,     &
                     comm_datatype,  &
                     prc_masterrank, &
                     comm_world,     &
                     ierr            )
    !$acc end host_data
 
    return

References comm_datatype, comm_world, and scale_prc::prc_masterrank.

comm_gather_3d()

subroutine scale_comm_cartesc::comm_gather_3d	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	JA,
		real(rp), dimension(ka,ia,ja), intent(in)	send,
		real(rp), dimension(:,:,:,:), intent(out)	recv
	)

Get data from whole process value in 3D field.

Parameters

[in]	ja	dimension size
[in]	send	send buffer
[out]	recv	receive buffer(KA,IA,JA,nprcs)

Definition at line 1243 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)  :: KA, IA, JA
    real(RP), intent(in)  :: send(KA,IA,JA)
 
    real(RP), intent(out) :: recv(:,:,:,:)
 
    integer :: sendcounts, recvcounts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    sendcounts = ka * ia * ja
    recvcounts = ka * ia * ja
 
    !$acc host_data use_device(send, recv) if(acc_is_present(send))
    call mpi_gather( send(:,:,:),    &
                     sendcounts,     &
                     comm_datatype,  &
                     recv(:,:,:,:),  &
                     recvcounts,     &
                     comm_datatype,  &
                     prc_masterrank, &
                     comm_world,     &
                     ierr            )
    !$acc end host_data
 
    return

References comm_datatype, comm_world, and scale_prc::prc_masterrank.

comm_bcast_scr_sp()

subroutine scale_comm_cartesc::comm_bcast_scr_sp

(

real(sp), intent(inout)

var

)

Broadcast data for whole process value in scalar field.

Parameters

[in,out]

var

broadcast buffer

Definition at line 1277 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    real(SP), intent(inout) :: var
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = 1
 
    call mpi_bcast( var,            &
                    counts,         &
                    mpi_real,       &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_scr_dp()

subroutine scale_comm_cartesc::comm_bcast_scr_dp

(

real(dp), intent(inout)

var

)

Parameters

[in,out]

var

broadcast buffer

Definition at line 1303 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    real(DP), intent(inout) :: var
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = 1
 
    call mpi_bcast( var,            &
                    counts,         &
                    mpi_double_precision, &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_1d_sp()

subroutine scale_comm_cartesc::comm_bcast_1d_sp	(	integer, intent(in)	IA,
		real(sp), dimension(ia), intent(inout)	var
	)

Broadcast data for whole process value in 1D field.

Parameters

[in]	ia	dimension size
[in,out]	var	broadcast buffer

Definition at line 1332 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: IA
 
    real(SP), intent(inout) :: var(IA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:),         &
                    counts,         &
                    mpi_real,       &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_1d_dp()

subroutine scale_comm_cartesc::comm_bcast_1d_dp	(	integer, intent(in)	IA,
		real(dp), dimension(ia), intent(inout)	var
	)

Parameters

[in]	ia	dimension size
[in,out]	var	broadcast buffer

Definition at line 1362 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: IA
 
    real(DP), intent(inout) :: var(IA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:),         &
                    counts,         &
                    mpi_double_precision, &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_2d_sp()

subroutine scale_comm_cartesc::comm_bcast_2d_sp	(	integer, intent(in)	IA,
		integer, intent(in)	JA,
		real(sp), dimension(ia,ja), intent(inout)	var
	)

Broadcast data for whole process value in 2D field.

Parameters

[in]	ja	dimension size
[in,out]	var	broadcast buffer

Definition at line 1395 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: IA, JA
 
    real(SP), intent(inout) :: var(IA,JA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia * ja
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:),       &
                    counts,         &
                    mpi_real,       &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_2d_dp()

subroutine scale_comm_cartesc::comm_bcast_2d_dp	(	integer, intent(in)	IA,
		integer, intent(in)	JA,
		real(dp), dimension(ia,ja), intent(inout)	var
	)

Parameters

[in]	ja	dimension size
[in,out]	var	broadcast buffer

Definition at line 1425 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: IA, JA
 
    real(DP), intent(inout) :: var(IA,JA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia * ja
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:),       &
                    counts,         &
                    mpi_double_precision, &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_3d_sp()

subroutine scale_comm_cartesc::comm_bcast_3d_sp	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	JA,
		real(sp), dimension(ka,ia,ja), intent(inout)	var
	)

Broadcast data for whole process value in 3D field.

Parameters

[in]	ja	dimension size
[in,out]	var	broadcast buffer

Definition at line 1458 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: KA, IA, JA
 
    real(SP), intent(inout) :: var(KA,IA,JA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ka * ia * ja
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:,:),     &
                    counts,         &
                    mpi_real,       &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_3d_dp()

subroutine scale_comm_cartesc::comm_bcast_3d_dp	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	JA,
		real(dp), dimension(ka,ia,ja), intent(inout)	var
	)

Parameters

[in]	ja	dimension size
[in,out]	var	broadcast buffer

Definition at line 1488 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: KA, IA, JA
 
    real(DP), intent(inout) :: var(KA,IA,JA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ka * ia * ja
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:,:),     &
                    counts,         &
                    mpi_double_precision, &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_4d_sp()

subroutine scale_comm_cartesc::comm_bcast_4d_sp	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	JA,
		integer, intent(in)	NT,
		real(sp), dimension(ka,ia,ja,nt), intent(inout)	var
	)

Broadcast data for whole process value in 4D field.

Parameters

[in]	nt	dimension size
[in,out]	var	broadcast buffer

Definition at line 1521 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: KA, IA, JA, NT
 
    real(SP), intent(inout) :: var(KA,IA,JA,NT)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ka * ia * ja * nt
    if ( ka>0 .AND. ia>0 .AND. ja>0 .AND. nt>0 .AND. &
         counts < 0 ) then
       log_error("COMM_bcast_4D",*) 'counts overflow'
       call prc_abort
    end if
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:,:,:),   &
                    counts,         &
                    mpi_real,       &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_4d_dp()

subroutine scale_comm_cartesc::comm_bcast_4d_dp	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	JA,
		integer, intent(in)	NT,
		real(dp), dimension(ka,ia,ja,nt), intent(inout)	var
	)

Parameters

[in]	nt	dimension size
[in,out]	var	broadcast buffer

Definition at line 1556 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer,  intent(in)    :: KA, IA, JA, NT
 
    real(DP), intent(inout) :: var(KA,IA,JA,NT)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ka * ia * ja * nt
    if ( ka>0 .AND. ia>0 .AND. ja>0 .AND. nt>0 .AND. &
         counts < 0 ) then
       log_error("COMM_bcast_4D",*) 'counts overflow'
       call prc_abort
    end if
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:,:,:),   &
                    counts,         &
                    mpi_double_precision, &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_int_scr()

subroutine scale_comm_cartesc::comm_bcast_int_scr

(

integer, intent(inout)

var

)

Broadcast data for whole process value in scalar (integer)

Parameters

[in,out]

var

broadcast buffer

Definition at line 1594 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer, intent(inout) :: var
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = 1
 
    call mpi_bcast( var,            &
                    counts,         &
                    mpi_integer,    &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_int_1d()

subroutine scale_comm_cartesc::comm_bcast_int_1d	(	integer, intent(in)	IA,
		integer, dimension(ia), intent(inout)	var
	)

Broadcast data for whole process value in 1D field (integer)

Parameters

[in]	ia	dimension size
[in,out]	var	broadcast buffer

Definition at line 1623 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer, intent(in)    :: IA
    integer, intent(inout) :: var(IA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia
 
    call mpi_bcast( var(:),         &
                    counts,         &
                    mpi_integer,    &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_int_2d()

subroutine scale_comm_cartesc::comm_bcast_int_2d	(	integer, intent(in)	IA,
		integer, intent(in)	JA,
		integer, dimension(ia,ja), intent(inout)	var
	)

Broadcast data for whole process value in 2D field (integer)

Parameters

[in]	ja	dimension size
[in,out]	var	broadcast buffer

Definition at line 1653 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer, intent(in)    :: IA, JA
 
    integer, intent(inout) :: var(IA,JA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia * ja
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:,:),       &
                    counts,         &
                    mpi_integer,    &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_logical_scr()

subroutine scale_comm_cartesc::comm_bcast_logical_scr

(

logical, intent(inout)

var

)

Broadcast data for whole process value in scalar (logical)

Parameters

[in,out]

var

broadcast buffer

Definition at line 1686 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    logical, intent(inout) :: var
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = 1
 
    call mpi_bcast( var,            &
                    counts,         &
                    mpi_logical,    &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_logical_1d()

subroutine scale_comm_cartesc::comm_bcast_logical_1d	(	integer, intent(in)	IA,
		logical, dimension(ia), intent(inout)	var
	)

Broadcast data for whole process value in 1D (logical)

Parameters

[in]	ia	dimension size
[in,out]	var	broadcast buffer

Definition at line 1715 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    integer, intent(in)    :: IA
    logical, intent(inout) :: var(IA)
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = ia
 
    !$acc host_data use_device(var) if(acc_is_present(var))
    call mpi_bcast( var(:),         &
                    counts,         &
                    mpi_logical,    &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
    !$acc end host_data
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

comm_bcast_character()

subroutine scale_comm_cartesc::comm_bcast_character

(

character(len=*), intent(inout)

var

)

Broadcast data for whole process value in character.

Parameters

[in,out]

var

broadcast buffer

Definition at line 1747 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_masterrank
    implicit none
 
    character(len=*), intent(inout) :: var
 
    integer :: counts
    integer :: ierr
    !---------------------------------------------------------------------------
 
    call prof_rapstart('COMM_Bcast', 2)
 
    counts = len(var)
 
    call mpi_bcast( var,            &
                    counts,         &
                    mpi_character,  &
                    prc_masterrank, &
                    comm_world,     &
                    ierr            )
 
    call prof_rapend('COMM_Bcast', 2)
 
    return

References comm_world, and scale_prc::prc_masterrank.

vars_init_mpi_pc()

subroutine scale_comm_cartesc::vars_init_mpi_pc	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid,
		integer, intent(in)	seqid
	)

Definition at line 1777 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in) :: gid
    integer,  intent(in) :: vid
    integer,  intent(in) :: seqid
 
    integer :: ireq, tag, ierr
    logical :: flag
 
    integer :: KA
    integer :: JA, JS, JE, JHALO
 
    integer :: nreq
    integer :: i
 
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
#endif
 
    tag  = ( (gid - 1) * comm_vsize_max + vid ) * 100
    ireq = 1
 
    ka    = ginfo(gid)%KA
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    jhalo = ginfo(gid)%JHALO
 
    !$acc host_data use_device(var)
 
    ! register whole array to inner table of MPI and/or lower library
    ! otherwise a lot of sub small segments would be registered
    call mpi_send_init( var(:,:,:), size(var), comm_datatype,                 &
                        mpi_proc_null, tag+ginfo(gid)%nreq_max+1, comm_world, &
                        ginfo(gid)%preq_list(ginfo(gid)%nreq_max+1,vid), ierr )
 
    !--- From 4-Direction HALO communicate
    ! From S
    if ( prc_has_s ) then
       call mpi_recv_init( var(:,:,1:js-1), ginfo(gid)%size2D_NS4*ka, comm_datatype,                &
                           prc_next(prc_s), tag+1, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
       ireq = ireq + 1
    end if
    ! From N
    if ( prc_has_n ) then
       call mpi_recv_init( var(:,:,je+1:ja), ginfo(gid)%size2D_NS4*ka, comm_datatype,               &
                           prc_next(prc_n), tag+2, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
       ireq = ireq + 1
    end if
    if ( .not. prc_twod ) then
#ifdef _OPENACC
       ptr => ginfo(gid)%recvpack_WE2P(:,:,seqid)
       !$acc host_data use_device(ptr)
#endif
 
       ! From E
       if ( prc_has_e ) then
#ifdef _OPENACC
          call mpi_recv_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                              prc_next(prc_e), tag+3, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
       end if
       ! From W
       if ( prc_has_w ) then
#ifdef _OPENACC
          call mpi_recv_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                              prc_next(prc_w), tag+4, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr  )
          ireq = ireq + 1
       end if
       !$acc end host_data
    end if
 
    !--- To 4-Direction HALO communicate
    if ( .not. prc_twod ) then
#ifdef _OPENACC
       ptr => ginfo(gid)%sendpack_P2WE(:,:,seqid)
       !$acc host_data use_device(ptr)
#endif
       ! To W HALO
       if ( prc_has_w ) then
#ifdef _OPENACC
          call mpi_send_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                              prc_next(prc_w), tag+3, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr  )
          ireq = ireq + 1
       end if
       ! To E HALO
       if ( prc_has_e ) then
#ifdef _OPENACC
          call mpi_send_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                              prc_next(prc_e), tag+4, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr  )
          ireq = ireq + 1
       end if
       !$acc end host_data
    end if
    ! To N HALO
    if ( prc_has_n ) then
       call mpi_send_init( var(:,:,je-jhalo+1:je), ginfo(gid)%size2D_NS4*ka, comm_datatype,         &
                           prc_next(prc_n), tag+1, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
       ireq = ireq + 1
    end if
    ! To S HALO
    if ( prc_has_s ) then
       call mpi_send_init( var(:,:,js:js+jhalo-1), ginfo(gid)%size2D_NS4*ka, comm_datatype,         &
                           prc_next(prc_s), tag+2, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
       ireq = ireq + 1
    end if
 
    ginfo(gid)%preq_cnt(vid) = ireq - 1
 
    ! to finish initial processes of MPI
    nreq = ginfo(gid)%preq_cnt(vid)
    do i = 1, 32
       call mpi_testall( nreq, ginfo(gid)%preq_list(1:nreq,vid), &
                         flag, mpi_statuses_ignore, ierr         )
    enddo
 
    !$acc end host_data
 
    return

References comm_datatype, comm_world, and scale_prc_cartesc::prc_twod.

Referenced by comm_vars_init().

Here is the caller graph for this function:

vars8_init_mpi_pc()

subroutine scale_comm_cartesc::vars8_init_mpi_pc	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid,
		integer, intent(in)	seqid
	)

Definition at line 1914 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in) :: gid
    integer,  intent(in) :: vid
    integer,  intent(in) :: seqid
 
    integer :: ireq, tag, tagc
    integer :: ierr
    logical :: flag
 
    integer :: KA
    integer :: IS, IE, IHALO
    integer :: JA, JS, JE, JHALO
 
    integer :: nreq
    integer :: i, j
 
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
#endif
 
    ka    = ginfo(gid)%KA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ihalo = ginfo(gid)%IHALO
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    jhalo = ginfo(gid)%JHALO
 
    tag  = ( (gid - 1) * comm_vsize_max + vid ) * 100
    ireq = 1
 
    !$acc host_data use_device(var)
 
    ! register whole array to inner table of MPI and/or lower library
    ! otherwise a lot of sub small segments would be registered
    call mpi_send_init( var(:,:,:), size(var), comm_datatype,                 &
                        mpi_proc_null, tag+ginfo(gid)%nreq_max+1, comm_world, &
                        ginfo(gid)%preq_list(ginfo(gid)%nreq_max+1,vid), ierr )
 
 
    if ( comm_isallperiodic ) then ! periodic condition
 
       !--- From 8-Direction HALO communicate
       if ( .not. prc_twod ) then
          ! From SE
          tagc = 0
          do j = 1, js-1
             call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                       &
                                 prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From SW
          tagc = 10
          do j = 1, js-1
             call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                           &
                                  prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From NE
          tagc = 20
          do j = je+1, ja
             call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                       &
                                 prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From NW
          tagc = 30
          do j = je+1, je+jhalo
             call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                          &
                                 prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From E
          tagc = 60
#ifdef _OPENACC
          ptr => ginfo(gid)%recvpack_WE2P(:,:,seqid)
          !$acc host_data use_device(ptr)
          call mpi_recv_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
          call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                              prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
          ! From W
          tagc = 70
#ifdef _OPENACC
          call mpi_recv_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
          call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                              prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          !$acc end host_data
          ireq = ireq + 1
       end if
       ! From S
       tagc = 40
       do j = 1, js-1
          call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                       &
                              prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
       ! From N
       tagc = 50
       do j = je+1, ja
          call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                       &
                              prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
 
       !--- To 8-Direction HALO communicate
       ! To N HALO
       tagc = 40
       do j = je-jhalo+1, je
          call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                   &
                          prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
       ! To S HALO
       tagc = 50
       do j = js, js+jhalo-1
          call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                   &
                          prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
       if ( .not. prc_twod ) then
          ! To W HALO
          tagc = 60
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,seqid)
          !$acc host_data use_device(ptr)
          call mpi_send_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
          call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                              prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          ireq = ireq + 1
          ! To E HALO
          tagc = 70
#ifdef _OPENACC
          call mpi_send_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
          call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                              prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
          !$acc end host_data
          ireq = ireq + 1
          ! To NW HALO
          tagc = 0
          do j = je-jhalo+1, je
             call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                 prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! To NE HALO
          tagc = 10
          do j = je-jhalo+1, je
             call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                 &
                                 prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! To SW HALO
          tagc = 20
          do j = js, js+jhalo-1
             call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                 prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! To SE HALO
          tagc = 30
          do j = js, js+jhalo-1
             call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                 &
                                 prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       end if
 
    else ! non-periodic condition
 
       !--- From 8-Direction HALO communicate
       if ( .not. prc_twod ) then
          ! From SE
          if ( prc_has_s .AND. prc_has_e ) then
             tagc = 0
             do j = 1, js-1
                call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                       &
                                    prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 0
             do j = 1, js-1
                call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                    prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 0
             do j = 1, js-1
                call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                    prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! From SW
          if ( prc_has_s .AND. prc_has_w ) then
             tagc = 10
             do j = 1, js-1
                call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                          &
                                    prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 10
             do j = 1, js-1
                call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 10
             do j = 1, js-1
                call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! From NE
          if ( prc_has_n .AND. prc_has_e ) then
             tagc = 20
             do j = je+1, ja
                call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                       &
                                    prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 20
             do j = je+1, ja
                call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                    prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 20
             do j = je+1, ja
                call mpi_recv_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                    prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! From NW
          if ( prc_has_n .AND. prc_has_w ) then
             tagc = 30
             do j = je+1, ja
                call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                          &
                                    prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 30
             do j = je+1, ja
                call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 30
             do j = je+1, ja
                call mpi_recv_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
#ifdef _OPENACC
          ptr => ginfo(gid)%recvpack_WE2P(:,:,seqid)
          !$acc host_data use_device(ptr)
#endif
          ! From E
          if ( prc_has_e ) then
             tagc = 60
#ifdef _OPENACC
             call mpi_recv_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
             call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                                 prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          ! From W
          if ( prc_has_w ) then
             tagc = 70
#ifdef _OPENACC
             call mpi_recv_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
             call mpi_recv_init( ginfo(gid)%recvpack_WE2P(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                                 prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          !$acc end host_data
       end if
       ! From S
       if ( prc_has_s ) then
          tagc = 40
          do j = 1, js-1
             call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                   &
                             prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
       ! From N
       if ( prc_has_n ) then
          tagc = 50
          do j = je+1, ja
             call mpi_recv_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                   &
                             prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
 
       !--- To 8-Direction HALO communicate
       ! To N HALO
       if ( prc_has_n ) then
          tagc = 40
          do j = je-jhalo+1, je
             call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                   &
                             prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
       ! To S HALO
       if ( prc_has_s ) then
          tagc = 50
          do j = js, js+jhalo-1
             call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                   &
                             prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
       if ( .not. prc_twod ) then
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,seqid)
          !$acc host_data use_device(ptr)
#endif
          ! To W HALO
          if ( prc_has_w ) then
             tagc = 60
#ifdef _OPENACC
             call mpi_send_init( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
             call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,1,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                                 prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          ! To E HALO
          if ( prc_has_e ) then
             tagc = 70
#ifdef _OPENACC
             call mpi_send_init( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#else
             call mpi_send_init( ginfo(gid)%sendpack_P2WE(:,2,seqid), ginfo(gid)%size2D_WE*ka, comm_datatype,   &
#endif
                                 prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          !$acc end host_data
          ! To NW HALO
          if ( prc_has_n .AND. prc_has_w ) then
             tagc = 0
             do j = je-jhalo+1, je
                call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 10
             do j = je-jhalo+1, je
                call mpi_send_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 20
             do j = je+1, ja
                call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                    prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! To NE HALO
          if ( prc_has_n .AND. prc_has_e ) then
             tagc = 10
             do j = je-jhalo+1, je
                call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                 &
                                    prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 0
             do j = je-jhalo+1, je
                call mpi_send_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                    prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 30
             do j = je+1, ja
                call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                &
                                    prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! To SW HALO
          if ( prc_has_s .AND. prc_has_w ) then
             tagc = 20
             do j = js, js+jhalo-1
                call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 30
             do j = js, js+jhalo-1
                call mpi_send_init( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                    prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 0
             do j = 1, js-1
                call mpi_send_init( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                    prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! To SE HALO
          if ( prc_has_s .AND. prc_has_e ) then
             tagc = 30
             do j = js, js+jhalo-1
                call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                 &
                                    prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 20
             do j = js, js+jhalo-1
                call mpi_send_init( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                    prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 10
             do j = 1, js-1
                call mpi_send_init( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                &
                                    prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%preq_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
       end if
 
    endif
 
    ginfo(gid)%preq_cnt(vid) = ireq - 1
 
    ! to finish initial processes of MPI
    nreq = ginfo(gid)%preq_cnt(vid)
    do i = 1, 32
       call mpi_testall( nreq, ginfo(gid)%preq_list(1:nreq,vid), &
                         flag, mpi_statuses_ignore, ierr         )
    enddo
 
    !$acc end host_data
 
    return

References comm_datatype, comm_world, and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

vars_3d_mpi()

subroutine scale_comm_cartesc::vars_3d_mpi	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Parameters

[in,out]	var	atmospheric 3D variable to communication
[in]	gid	grid ID
[in]	vid	request ID

Definition at line 2436 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
 
    integer :: ireq, tag
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer :: ierr
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
    logical :: flag_device
#endif
    !---------------------------------------------------------------------------
 
    tag  = ( (gid - 1) * comm_vsize_max + vid ) * 100
    ireq = 1
 
    ka    = ginfo(gid)%KA
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
#ifdef DEBUG
    if ( ginfo(gid)%use_packbuf(vid) ) then
       log_error("vars_3D_mpi",*) 'packing buffer is already used', vid
       call prc_abort
    end if
    ginfo(gid)%use_packbuf(vid) = .true.
#endif
 
#ifdef _OPENACC
    flag_device = acc_is_present(var)
#endif
 
    !$acc host_data use_device(var) if(flag_device)
 
    !--- From 4-Direction HALO communicate
    ! From S
    if ( prc_has_s ) then
       call mpi_irecv( var(:,:,1:js-1), ginfo(gid)%size2D_NS4*ka, comm_datatype,               &
                       prc_next(prc_s), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
    ! From N
    if ( prc_has_n ) then
       call mpi_irecv( var(:,:,je+1:ja), ginfo(gid)%size2D_NS4*ka, comm_datatype,              &
                       prc_next(prc_n), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
    if ( .not. prc_twod ) then
#ifdef _OPENACC
       ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
       !$acc host_data use_device(ptr) if(flag_device)
#endif
       ! From E
       if ( prc_has_e ) then
#ifdef _OPENACC
          call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                          prc_next(prc_e), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
       ! From W
       if ( prc_has_w ) then
#ifdef _OPENACC
          call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                          prc_next(prc_w), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
       !$acc end host_data
    end if
 
    !$acc end host_data
 
    !--- To 4-Direction HALO communicate
    if ( .not. prc_twod ) then
       call packwe_3d( ka, ia, is, ie, ja, js, je, &
                       ihalo, &
                       var, gid, vid)
    end if
 
    !$acc host_data use_device(var) if(flag_device)
 
    ! To N HALO
    if ( prc_has_n ) then
       call mpi_isend( var(:,:,je-jhalo+1:je), ginfo(gid)%size2D_NS4*ka, comm_datatype,        &
                       prc_next(prc_n), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
    ! To S HALO
    if ( prc_has_s ) then
       call mpi_isend( var(:,:,js:js+jhalo-1), ginfo(gid)%size2D_NS4*ka, comm_datatype,        &
                       prc_next(prc_s), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
 
    !$acc end host_data
 
    if ( .not. prc_twod ) then
#ifdef _OPENACC
       ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
       !$acc wait
       !$acc host_data use_device(ptr) if(flag_device)
#endif
       ! To W HALO
       if ( prc_has_w ) then
#ifdef _OPENACC
          call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                          prc_next(prc_w), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
       ! To E HALO
       if ( prc_has_e ) then
#ifdef _OPENACC
          call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                          prc_next(prc_e), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
 
       !$acc end host_data
    end if
 
    ginfo(gid)%req_cnt(vid) = ireq - 1
 
    return

References comm_datatype, comm_world, packwe_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars_3d_mpi_onesided()

subroutine scale_comm_cartesc::vars_3d_mpi_onesided	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Parameters

[in,out]	var	atmospheric 3D variable to communication
[in]	gid	grid ID
[in]	vid	request ID

Definition at line 2591 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer(kind=MPI_ADDRESS_KIND) :: disp
 
    integer :: ierr
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
#endif
    !---------------------------------------------------------------------------
 
    ka    = ginfo(gid)%KA
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    !$acc data copyin(var)
 
    call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
 
    !--- To 4-Direction HALO communicate
    if ( .not. prc_twod ) then
       call packwe_3d( ka, ia, is, ie, ja, js, je, &
                       ihalo, &
                       var, gid, vid)
    end if
 
    !$acc host_data use_device(var)
 
    ! To N HALO
    if ( prc_has_n ) then
       disp = 0
       call mpi_put( var(:,:,je-jhalo+1:je), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
                     prc_next(prc_n), disp, ginfo(gid)%size2D_NS4*ka, comm_datatype, &
                     ginfo(gid)%win_packNS(vid), ierr )
    endif
    ! To S HALO
    if ( prc_has_s ) then
       disp = ka * ia * jhalo
       call mpi_put( var(:,:,js:js+jhalo-1), ginfo(gid)%size2D_NS4*ka, comm_datatype, &
                     prc_next(prc_s), disp, ginfo(gid)%size2D_NS4*ka, comm_datatype, &
                     ginfo(gid)%win_packNS(vid), ierr )
    endif
 
    !$acc end host_data
 
    if ( .not. prc_twod ) then
#ifdef _OPENACC
       ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
       !$acc wait
       !$acc host_data use_device(ptr)
#endif
 
       ! To W HALO
       if ( prc_has_w ) then
          disp = 1
#ifdef _OPENACC
          call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                        prc_next(prc_w), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
       endif
       ! To E HALO
       if ( prc_has_e ) then
          disp = 0
#ifdef _OPENACC
          call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                        prc_next(prc_e), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
       endif
 
       !$acc end host_data
    end if
 
    call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
 
    !$acc end data
 
    return

References comm_datatype, packwe_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars8_3d_mpi()

subroutine scale_comm_cartesc::vars8_3d_mpi	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 2697 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: ireq, tag, tagc
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer :: ierr
    integer :: j
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
    logical :: flag_device
#endif
    !---------------------------------------------------------------------------
 
    tag  = ( (gid - 1) * comm_vsize_max + vid ) * 100
    tag  = vid * 100
    ireq = 1
 
    ka    = ginfo(gid)%KA
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
#ifdef DEBUG
    if ( ginfo(gid)%use_packbuf(vid) ) then
       log_error("vars8_3D_mpi",*) 'packing buffer is already used', vid
       call prc_abort
    end if
    ginfo(gid)%use_packbuf(vid) = .true.
#endif
 
#ifdef _OPENACC
    flag_device = acc_is_present(var)
#endif
 
    if ( comm_isallperiodic ) then ! periodic condition
 
       !$acc host_data use_device(var) if(flag_device)
 
       !--- From 8-Direction HALO communicate
       if ( .not. prc_twod ) then
          ! From SE
          tagc = 0
          do j = 1, js-1
             call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                             prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From SW
          tagc = 10
          do j = 1, js-1
             call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                             prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From NE
          tagc = 20
          do j = je+1, ja
             call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                             prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! From NW
          tagc = 30
          do j = je+1, ja
             call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                             prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
#ifdef _OPENACC
          ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
          !$acc host_data use_device(ptr) if(flag_device)
#endif
          ! From E
          tagc = 60
#ifdef _OPENACC
          call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
          call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                          prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          ! From W
          tagc = 70
#ifdef _OPENACC
          call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
          call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                          prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          !$acc end host_data
       end if
       ! From S
       tagc = 40
       do j = 1, js-1
          call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                          prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
       ! From N
       tagc = 50
       do j = je+1, ja
          call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                          prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
 
       !--- To 8-Direction HALO communicate
       ! To N HALO
       tagc = 40
       do j = je-jhalo+1, je
          call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                          prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
       ! To S HALO
       tagc = 50
       do j = js, js+jhalo-1
          call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                          prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          tagc = tagc + 1
       enddo
 
       !$acc end host_data
 
       if ( .not. prc_twod ) then
 
          call packwe_3d( ka, ia, is, ie, ja, js, je, &
                          ihalo, &
                          var, gid, vid)
 
          !$acc host_data use_device(var) if(flag_device)
 
          ! To NW HALO
          tagc = 0
          do j = je-jhalo+1, je
             call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                             prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! To NE HALO
          tagc = 10
          do j = je-jhalo+1, je
             call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                &
                             prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! To SW HALO
          tagc = 20
          do j = js, js+jhalo-1
             call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                             prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
          ! To SE HALO
          tagc = 30
          do j = js, js+jhalo-1
             call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                &
                             prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
 
          !$acc end host_data
 
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
          !$acc wait
          !$acc host_data use_device(ptr) if(flag_device)
#endif
          ! To W HALO
          tagc = 60
#ifdef _OPENACC
          call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
          call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                          prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
          ! To E HALO
          tagc = 70
#ifdef _OPENACC
          call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
          call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                          prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          !$acc end host_data
          ireq = ireq + 1
 
       end if
 
    else ! non-periodic condition
 
       !$acc host_data use_device(var) if(flag_device)
 
       !--- From 8-Direction HALO communicate
       if ( .not. prc_twod ) then
          ! From SE
          if ( prc_has_s .AND. prc_has_e ) then
             tagc = 0
             do j = 1, js-1
                call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 0
             do j = 1, js-1
                call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                     &
                                prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 0
             do j = 1, js-1
                call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                     &
                                prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! From SW
          if ( prc_has_s .AND. prc_has_w ) then
             tagc = 10
             do j = 1, js-1
                call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 10
             do j = 1, js-1
                call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 10
             do j = 1, js-1
                call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! From NE
          if ( prc_has_n .AND. prc_has_e ) then
             tagc = 20
             do j = je+1, ja
                call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                      &
                                prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 20
             do j = je+1, ja
                call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                     &
                                prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 20
             do j = je+1, ja
                call mpi_irecv( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                     &
                                prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! From NW
          if ( prc_has_n .AND. prc_has_w ) then
             tagc = 30
             do j = je+1, ja
                call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                         &
                                prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 30
             do j = je+1, ja
                call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 30
             do j = je+1, ja
                call mpi_irecv( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
#ifdef _OPENACC
          ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
          !$acc host_data use_device(ptr) if(flag_device)
#endif
          ! From E
          if ( prc_has_e ) then
             tagc = 60
#ifdef _OPENACC
             call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
             call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                             prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          ! From W
          if ( prc_has_w ) then
             tagc = 70
#ifdef _OPENACC
             call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
             call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                             prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          !$acc end host_data
       end if
       ! From S
       if ( prc_has_s ) then
          tagc = 40
          do j = 1, js-1
             call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                             prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
       ! From N
       if ( prc_has_n ) then
          tagc = 50
          do j = je+1, ja
             call mpi_irecv( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                             prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
 
       !--- To 8-Direction HALO communicate
       ! To N HALO
       if ( prc_has_n ) then
          tagc = 40
          do j = je-jhalo+1, je
             call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                             prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
       ! To S HALO
       if ( prc_has_s ) then
          tagc = 50
          do j = js, js+jhalo-1
             call mpi_isend( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype,                      &
                             prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
          enddo
       endif
 
       !$acc end host_data
 
       if ( .not. prc_twod ) then
 
          call packwe_3d( ka, ia, is, ie, ja, js, je, &
                          ihalo, &
                          var, gid, vid)
 
          !$acc host_data use_device(var) if(flag_device)
 
          ! To NW HALO
          if ( prc_has_n .AND. prc_has_w ) then
             tagc = 0
             do j = je-jhalo+1, je
                call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_nw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 10
             do j = je-jhalo+1, je
                call mpi_isend( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 20
             do j = je+1, ja
                call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                       &
                                prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! To NE HALO
          if ( prc_has_n .AND. prc_has_e ) then
             tagc = 10
             do j = je-jhalo+1, je
                call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                &
                                prc_next(prc_ne), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_n ) then
             tagc = 0
             do j = je-jhalo+1, je
                call mpi_isend( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                     &
                                prc_next(prc_n), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 30
             do j = je+1, ja
                call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,               &
                                prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! To SW HALO
          if ( prc_has_s .AND. prc_has_w ) then
             tagc = 20
             do j = js, js+jhalo-1
                call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_sw), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 30
             do j = js, js+jhalo-1
                call mpi_isend( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                        &
                                prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_w ) then
             tagc = 0
             do j = 1, js-1
                call mpi_isend( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                       &
                                prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
          ! To SE HALO
          if ( prc_has_s .AND. prc_has_e ) then
             tagc = 30
             do j = js, js+jhalo-1
                call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                &
                                prc_next(prc_se), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_s ) then
             tagc = 20
             do j = js, js+jhalo-1
                call mpi_isend( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,                     &
                                prc_next(prc_s), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          else if ( prc_has_e ) then
             tagc = 10
             do j = 1, js-1
                call mpi_isend( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype,               &
                                prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                ireq = ireq + 1
                tagc = tagc + 1
             enddo
          endif
 
          !$acc end host_data
 
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
          !$acc wait
          !$acc host_data use_device(ptr) if(flag_device)
#endif
 
          ! To W HALO
          if ( prc_has_w ) then
             tagc = 60
#ifdef _OPENACC
             call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
             call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                             prc_next(prc_w), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          ! To E HALO
          if ( prc_has_e ) then
             tagc = 70
#ifdef _OPENACC
             call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#else
             call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype,    &
#endif
                             prc_next(prc_e), tag+tagc, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
          endif
          !$acc end host_data
 
       end if
 
    endif
 
    ginfo(gid)%req_cnt(vid) = ireq - 1
 
    return

References comm_datatype, comm_world, packwe_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars8_3d_mpi_onesided()

subroutine scale_comm_cartesc::vars8_3d_mpi_onesided	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 3255 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer(kind=MPI_ADDRESS_KIND) :: disp
 
    integer :: ierr
    integer :: j
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
#endif
    !---------------------------------------------------------------------------
 
    ka    = ginfo(gid)%KA
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    !$acc data copyin(var)
    call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
 
    if ( comm_isallperiodic ) then ! periodic condition
 
       !$acc host_data use_device(var)
 
       !--- To 8-Direction HALO communicate
       ! To N HALO
       do j = je-jhalo+1, je
          disp = ka * ( ihalo + ia * ( j - je+jhalo-1 ) )
          call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                        prc_next(prc_n), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                        ginfo(gid)%win_packNS(vid), ierr )
       enddo
       ! To S HALO
       do j = js, js+jhalo-1
          disp = ka * ( ihalo + ia * ( j - js + jhalo ) )
          call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                        prc_next(prc_s), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                        ginfo(gid)%win_packNS(vid), ierr )
       enddo
 
       !$acc end host_data
 
       if ( .not. prc_twod ) then
 
          call packwe_3d( ka, ia, is, ie, ja, js, je, &
                          ihalo, &
                          var, gid, vid)
 
          !$acc host_data use_device(var)
          ! To NW HALO
          do j = je-jhalo+1, je
             disp = ka * ( ie + ia * ( j - je+jhalo-1 ) )
             call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           prc_next(prc_nw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
          ! To NE HALO
          do j = je-jhalo+1, je
             disp = ka * ( ia * ( j - je+jhalo-1 ) )
             call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           prc_next(prc_ne), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
          ! To SW HALO
          do j = js, js+jhalo-1
             disp = ka * ( ie + ia * ( j - js + jhalo ) )
             call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           prc_next(prc_sw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
          ! To SE HALO
          do j = js, js+jhalo-1
             disp = ka * ( ia * ( j - js + jhalo ) )
             call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           prc_next(prc_se), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
 
          !$acc end host_data
 
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
          !$acc wait
          !$acc host_data use_device(ptr)
#endif
          ! To W HALO
          disp = 1
#ifdef _OPENACC
          call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                        prc_next(prc_w), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
          ! To E HALO
          disp = 0
#ifdef _OPENACC
          call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                        prc_next(prc_e), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
          !$acc end host_data
 
       end if
 
    else ! non-periodic condition
 
       !$acc host_data use_device(var)
 
       !--- To 8-Direction HALO communicate
       ! To N HALO
       if ( prc_has_n ) then
          do j = je-jhalo+1, je
             disp = ka * ( ihalo + ia * ( j - je+jhalo-1 ) )
             call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                           prc_next(prc_n), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
       endif
       ! To S HALO
       if ( prc_has_s ) then
          do j = js, js+jhalo-1
             disp = ka * ( ihalo + ia * ( j - js + jhalo ) )
             call mpi_put( var(1,is,j), ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                           prc_next(prc_s), disp, ginfo(gid)%size2D_NS8*ka, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
       endif
 
       !$acc end host_data
 
       if ( .not. prc_twod ) then
 
          call packwe_3d( ka, ia, is, ie, ja, js, je, &
                          ihalo, &
                          var, gid, vid)
 
          !$acc host_data use_device(var)
 
          ! To NW HALO
          if ( prc_has_n .AND. prc_has_w ) then
             do j = je-jhalo+1, je
                disp = ka * ( ie + ia * ( j - je+jhalo-1 ) )
                call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_nw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_n ) then
             do j = je-jhalo+1, je
                disp = ka * ( ia * ( j - je+jhalo-1 ) )
                call mpi_put( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_n), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_w ) then
             do j = je+1, ja
                disp = ka * ( ie + ia * ( j - je-1 + jhalo ) )
                call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_w), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
          ! To NE HALO
          if ( prc_has_n .AND. prc_has_e ) then
             do j = je-jhalo+1, je
                disp = ka * ( ia * ( j - je+jhalo-1 ) )
                call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_ne), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_n ) then
             do j = je-jhalo+1, je
                disp = ka * ( ie + ia * ( j - je+jhalo-1 ) )
                call mpi_put( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_n), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_e ) then
             do j = je+1, ja
                disp = ka * ia * ( j - je-1 + jhalo )
                call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_e), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
          ! To SW HALO
          if ( prc_has_s .AND. prc_has_w ) then
             do j = js, js+jhalo-1
                disp = ka * ( ie + ia * ( j - js + jhalo ) )
                call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_sw), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_s ) then
             do j = js, js+jhalo-1
                disp = ka * ( ia * ( j - js + jhalo ) )
                call mpi_put( var(1,1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_s), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_w ) then
             do j = 1, js-1
                disp = ka * ( ie + ia * (j-1) )
                call mpi_put( var(1,is,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_w), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
          ! To SE HALO
          if ( prc_has_s .AND. prc_has_e ) then
             do j = js, js+jhalo-1
                disp = ka * ( ia * ( j - js + jhalo ) )
                call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_se), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_s ) then
             do j = js, js+jhalo-1
                disp = ka * ( ie + ia * ( j - js + jhalo ) )
                call mpi_put( var(1,ie+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_s), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_e ) then
             do j = 1, js-1
                disp = ka * ( ia * ( j - 1 ) )
                call mpi_put( var(1,ie-ihalo+1,j), ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              prc_next(prc_e), disp, ginfo(gid)%size2D_4C*ka, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
 
          !$acc end host_data
 
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
          !$acc wait
          !$acc host_data use_device(ptr)
#endif
 
          ! To W HALO
          if ( prc_has_w ) then
             disp = 1
#ifdef _OPENACC
             call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
             call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                           prc_next(prc_w), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
                           ginfo(gid)%win_packWE(vid), ierr )
          endif
          ! To E HALO
          if ( prc_has_e ) then
             disp = 0
#ifdef _OPENACC
             call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#else
             call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE*ka, comm_datatype, &
#endif
                           prc_next(prc_e), disp, ginfo(gid)%size2D_WE*ka, comm_datatype, &
                           ginfo(gid)%win_packWE(vid), ierr )
          endif
          !$acc end host_data
 
       end if
 
    endif
 
    call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
 
    !$acc end data
 
    return

References comm_datatype, packwe_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars_2d_mpi()

subroutine scale_comm_cartesc::vars_2d_mpi	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 3552 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:)
    integer, intent(in)     :: gid
    integer, intent(in)     :: vid
 
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer :: ireq, tag
    integer :: ierr
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
    logical :: flag_device
#endif
    !---------------------------------------------------------------------------
 
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    tag  = ( (gid - 1) * comm_vsize_max + vid ) * 100
    ireq = 1
 
#ifdef DEBUG
    if ( ginfo(gid)%use_packbuf(vid) ) then
       log_error("vars_2D_mpi",*) 'packing buffer is already used', vid
       call prc_abort
    end if
    ginfo(gid)%use_packbuf(vid) = .true.
#endif
 
#ifdef _OPENACC
    flag_device = acc_is_present(var)
#endif
 
    !$acc host_data use_device(var) if(flag_device)
 
    !--- From 4-Direction HALO communicate
    ! From S
    if ( prc_has_s ) then
       call mpi_irecv( var(:,1:js-1), ginfo(gid)%size2D_NS4, comm_datatype, &
                       prc_next(prc_s), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
    ! From N
    if ( prc_has_n ) then
       call mpi_irecv( var(:,je+1:ja), ginfo(gid)%size2D_NS4, comm_datatype, &
                       prc_next(prc_n), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
 
    if ( .not. prc_twod ) then
#ifdef _OPENACC
       ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
       !$acc host_data use_device(ptr) if(flag_device)
#endif
       ! From E
       if ( prc_has_e ) then
#ifdef _OPENACC
          call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                          prc_next(prc_e), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
       ! From W
       if ( prc_has_w ) then
#ifdef _OPENACC
          call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                          prc_next(prc_w), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
       !$acc end host_data
    end if
 
    !$acc end host_data
 
    !--- To 4-Direction HALO communicate
    if ( .not. prc_twod ) then
 
       call packwe_2d( ia, is, ie, ja, js, je, &
                       ihalo, &
                       var, gid, vid)
 
#ifdef _OPENACC
       ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
       !$acc host_data use_device(ptr) if(flag_device)
#endif
 
       ! To W HALO communicate
       if ( prc_has_w ) then
#ifdef _OPENACC
          call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                          prc_next(prc_w), tag+3, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
       ! To E HALO communicate
       if ( prc_has_e ) then
#ifdef _OPENACC
          call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                          prc_next(prc_e), tag+4, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
          ireq = ireq + 1
       endif
 
       !$acc end host_data
 
    end if
 
    !$acc host_data use_device(var) if(flag_device)
 
    ! To N HALO communicate
    if ( prc_has_n ) then
       call mpi_isend( var(:,je-jhalo+1:je), ginfo(gid)%size2D_NS4, comm_datatype, &
                     prc_next(prc_n), tag+1, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
    ! To S HALO communicate
    if ( prc_has_s ) then
       call mpi_isend( var(:,js:js+jhalo-1), ginfo(gid)%size2D_NS4, comm_datatype, &
            prc_next(prc_s), tag+2, comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
       ireq = ireq + 1
    endif
 
    !$acc end host_data
 
    ginfo(gid)%req_cnt(vid) = ireq - 1
 
    return

References comm_datatype, comm_world, scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars_2d_mpi_onesided()

subroutine scale_comm_cartesc::vars_2d_mpi_onesided	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 3704 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:)
    integer, intent(in)     :: gid
    integer, intent(in)     :: vid
 
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer(kind=MPI_ADDRESS_KIND) :: disp
 
    integer :: ierr
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
#endif
    !---------------------------------------------------------------------------
 
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    !$acc data copyin(var)
 
    call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
 
    !--- To 4-Direction HALO communicate
 
    if ( .not. prc_twod ) then
 
       call packwe_2d( ia, is, ie, ja, js, je, &
                       ihalo, &
                       var, gid, vid)
 
#ifdef _OPENACC
       ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
       !$acc host_data use_device(ptr)
#endif
 
       ! To W HALO communicate
       if ( prc_has_w ) then
          disp = 1
#ifdef _OPENACC
          call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                        prc_next(prc_w), disp, ginfo(gid)%size2D_WE, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
       endif
       ! To E HALO communicate
       if ( prc_has_e ) then
          disp = 0
#ifdef _OPENACC
          call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                        prc_next(prc_e), disp, ginfo(gid)%size2D_WE, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
       endif
 
       !$acc end host_data
 
    end if
 
    !$acc host_data use_device(var)
 
    ! To N HALO communicate
    if ( prc_has_n ) then
       disp = 0
       call mpi_put( var(:,je-jhalo+1:je), ginfo(gid)%size2D_NS4, comm_datatype, &
                     prc_next(prc_n), disp, ginfo(gid)%size2D_NS4, comm_datatype, &
                     ginfo(gid)%win_packNS(vid), ierr )
    endif
    ! To S HALO communicate
    if ( prc_has_s ) then
       disp = ia * jhalo
       call mpi_put( var(:,js:js+jhalo-1), ginfo(gid)%size2D_NS4, comm_datatype, &
                     prc_next(prc_s), disp, ginfo(gid)%size2D_NS4, comm_datatype, &
                     ginfo(gid)%win_packNS(vid), ierr )
    endif
 
    !$acc end host_data
 
    call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
 
    !$acc end data
 
    return

References comm_datatype, scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars8_2d_mpi()

subroutine scale_comm_cartesc::vars8_2d_mpi	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 3808 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    integer :: ireq, tag, tagc
 
    integer :: ierr
    integer :: j
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
    logical :: flag_device
#endif
    !---------------------------------------------------------------------------
 
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    tag  = ( (gid - 1) * comm_vsize_max + vid ) * 100
    ireq = 1
 
#ifdef DEBUG
    if ( ginfo(gid)%use_packbuf(vid) ) then
       log_error("vars8_2D_mpi",*) 'packing buffer is already used', vid
       call prc_abort
    end if
    ginfo(gid)%use_packbuf(vid) = .true.
#endif
 
#ifdef _OPENACC
    flag_device = acc_is_present(var)
#endif
 
    if ( comm_isallperiodic ) then
    !--- periodic condition
        !--- From 8-Direction HALO communicate
        !$acc host_data use_device(var) if(flag_device)
 
        if ( .not. prc_twod ) then
           ! From SE
           tagc = 0
           do j = 1, js-1
              call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                              comm_datatype, prc_next(prc_se), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
           ! From SW
           tagc = 10
           do j = 1, js-1
              call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                              comm_datatype, prc_next(prc_sw), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
           ! From NE
           tagc = 20
           do j = je+1, ja
              call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                              comm_datatype, prc_next(prc_ne), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
           ! From NW
           tagc = 30
           do j = je+1, ja
              call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                              comm_datatype, prc_next(prc_nw), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
#ifdef _OPENACC
           ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
           !$acc host_data use_device(ptr) if(flag_device)
#endif
           ! From E
#ifdef _OPENACC
           call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE, &
#else
           call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE, &
#endif
                           comm_datatype, prc_next(prc_e), tag+60,               &
                           comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
           ireq = ireq + 1
           ! From W
#ifdef _OPENACC
           call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE, &
#else
           call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE, &
#endif
                           comm_datatype, prc_next(prc_w), tag+70,               &
                           comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
           ireq = ireq + 1
           !$acc end host_data
        end if
        ! From S
        tagc = 40
        do j = 1, js-1
            call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8,               &
                            comm_datatype, prc_next(prc_s), tag+tagc,       &
                            comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
             ireq = ireq + 1
             tagc = tagc + 1
        enddo
        ! From N
        tagc = 50
        do j = je+1, ja
            call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8,               &
                            comm_datatype, prc_next(prc_n), tag+tagc,       &
                            comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
            ireq = ireq + 1
            tagc = tagc + 1
        enddo
 
 
        !--- To 8-Direction HALO communicate
 
        ! To N HALO communicate
        tagc = 40
        do j = je-jhalo+1, je
            call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8,               &
                            comm_datatype, prc_next(prc_n), tag+tagc,       &
                            comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
            ireq = ireq + 1
            tagc = tagc + 1
        enddo
 
        ! To S HALO communicate
        tagc = 50
        do j = js, js+jhalo-1
            call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8,               &
                            comm_datatype, prc_next(prc_s), tag+tagc,       &
                            comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
            ireq = ireq + 1
            tagc = tagc + 1
        enddo
 
        !$acc end host_data
 
        if ( .not. prc_twod ) then
 
           call packwe_2d( ia, is, ie, ja, js, je, &
                           ihalo, &
                           var, gid, vid)
 
           !$acc host_data use_device(var) if(flag_device)
#ifdef _OPENACC
           ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
           !$acc host_data use_device(ptr) if(flag_device)
#endif
 
           ! To W HALO communicate
#ifdef _OPENACC
           call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE, &
#else
           call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, &
#endif
                           comm_datatype, prc_next(prc_w), tag+60,               &
                           comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
           ireq = ireq + 1
 
           ! To E HALO communicate
#ifdef _OPENACC
           call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE, &
#else
           call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, &
#endif
                           comm_datatype, prc_next(prc_e), tag+70,               &
                           comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
           ireq = ireq + 1
           !$acc end host_data
 
           ! To NW HALO communicate
           tagc = 0
           do j = je-jhalo+1, je
              call mpi_isend( var(is,j), ginfo(gid)%size2D_4C,                &
                              comm_datatype, prc_next(prc_nw), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
 
           ! To NE HALO communicate
           tagc = 10
           do j = je-jhalo+1, je
              call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C,        &
                              comm_datatype, prc_next(prc_ne), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
 
           ! To SW HALO communicate
           tagc = 20
           do j = js, js+jhalo-1
              call mpi_isend( var(is,j), ginfo(gid)%size2D_4C,                &
                              comm_datatype, prc_next(prc_sw), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
 
           ! To SE HALO communicate
           tagc = 30
           do j = js, js+jhalo-1
              call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C,        &
                              comm_datatype, prc_next(prc_se), tag+tagc,      &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
 
           !$acc end host_data
 
        end if
 
    else
    !--- non-periodic condition
        !--- From 8-Direction HALO communicate
 
        !$acc host_data use_device(var) if(flag_device)
 
        if ( .not. prc_twod ) then
           ! From SE
           if ( prc_has_s .AND. prc_has_e ) then
              tagc = 0
              do j = 1, js-1
                 call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                                 comm_datatype, prc_next(prc_se), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_s ) then
              tagc = 0
              do j = 1, js-1
                 call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                                 comm_datatype, prc_next(prc_s), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_e ) then
              tagc = 0
              do j = 1, js-1
                 call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                                 comm_datatype, prc_next(prc_e), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           ! From SW
           if ( prc_has_s .AND. prc_has_w ) then
              tagc = 10
              do j = 1, js-1
                 call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                                 comm_datatype, prc_next(prc_sw), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_s ) then
              tagc = 10
              do j = 1, js-1
                 call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                                 comm_datatype, prc_next(prc_s), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_w ) then
              tagc = 10
              do j = 1, js-1
                 call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                                 comm_datatype, prc_next(prc_w), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           ! From NE
           if ( prc_has_n .AND. prc_has_e ) then
              tagc = 20
              do j = je+1, je+jhalo
                 call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                                 comm_datatype, prc_next(prc_ne), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_n ) then
              tagc = 20
              do j = je+1, ja
                 call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                                 comm_datatype, prc_next(prc_n), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_e ) then
              tagc = 20
              do j = je+1, ja
                 call mpi_irecv( var(ie+1,j), ginfo(gid)%size2D_4C,              &
                                 comm_datatype, prc_next(prc_e), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           ! From NW
           if ( prc_has_n .AND. prc_has_w ) then
              tagc = 30
              do j = je+1, ja
                 call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                                 comm_datatype, prc_next(prc_nw), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_n ) then
              tagc = 30
              do j = je+1, ja
                 call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                                 comm_datatype, prc_next(prc_n), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_w ) then
              tagc = 30
              do j = je+1, ja
                 call mpi_irecv( var(1,j), ginfo(gid)%size2D_4C,                 &
                                 comm_datatype, prc_next(prc_w), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
#ifdef _OPENACC
           ptr => ginfo(gid)%recvpack_WE2P(:,:,vid)
           !$acc host_data use_device(ptr) if(flag_device)
#endif
           ! From E
           if ( prc_has_e ) then
#ifdef _OPENACC
              call mpi_irecv( ptr(:,2), ginfo(gid)%size2D_WE, &
#else
              call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,2,vid), ginfo(gid)%size2D_WE, &
#endif
                              comm_datatype, prc_next(prc_e), tag+60,               &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
              ireq = ireq + 1
           endif
 
           ! From W
           if ( prc_has_w ) then
#ifdef _OPENACC
              call mpi_irecv( ptr(:,1), ginfo(gid)%size2D_WE, &
#else
              call mpi_irecv( ginfo(gid)%recvpack_WE2P(:,1,vid), ginfo(gid)%size2D_WE, &
#endif
                              comm_datatype, prc_next(prc_w), tag+70,               &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
              ireq = ireq + 1
           endif
           !$acc end host_data
 
        end if
 
        ! From S
        if ( prc_has_s ) then
           tagc = 40
           do j = 1, js-1
              call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8,               &
                              comm_datatype, prc_next(prc_s), tag+tagc,       &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
        endif
 
        ! From N
        if ( prc_has_n ) then
           tagc = 50
           do j = je+1, ja
              call mpi_irecv( var(is,j), ginfo(gid)%size2D_NS8,               &
                              comm_datatype, prc_next(prc_n), tag+tagc,       &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
        endif
 
 
        !! RECEIVE
 
        ! To N HALO communicate
        if ( prc_has_n ) then
           tagc = 40
           do j = je-jhalo+1, je
              call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8,               &
                              comm_datatype, prc_next(prc_n), tag+tagc,       &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
        endif
 
        ! To S HALO communicate
        if ( prc_has_s ) then
           tagc = 50
           do j = js, js+jhalo-1
              call mpi_isend( var(is,j), ginfo(gid)%size2D_NS8,               &
                              comm_datatype, prc_next(prc_s), tag+tagc,       &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
              ireq = ireq + 1
              tagc = tagc + 1
           enddo
        endif
 
        !$acc end host_data
 
        if ( .not. prc_twod ) then
 
           call packwe_2d( ia, is, ie, ja, js, je, &
                           ihalo, &
                           var, gid, vid)
 
           !$acc host_data use_device(var) if(flag_device)
#ifdef _OPENACC
           ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
           !$acc host_data use_device(ptr) if(flag_device)
#endif
 
           ! To W HALO communicate
           if ( prc_has_w ) then
#ifdef _OPENACC
              call mpi_isend( ptr(:,1), ginfo(gid)%size2D_WE, &
#else
              call mpi_isend( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, &
#endif
                              comm_datatype, prc_next(prc_w), tag+60,               &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
              ireq = ireq + 1
           endif
 
           ! To E HALO communicate
           if ( prc_has_e ) then
#ifdef _OPENACC
              call mpi_isend( ptr(:,2), ginfo(gid)%size2D_WE, &
#else
              call mpi_isend( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, &
#endif
                              comm_datatype, prc_next(prc_e), tag+70,               &
                              comm_world, ginfo(gid)%req_list(ireq,vid), ierr       )
              ireq = ireq + 1
           endif
           !$acc end host_data
 
           ! To NW HALO communicate
           if ( prc_has_n .AND. prc_has_w ) then
              tagc = 0
              do j = je-jhalo+1, je
                 call mpi_isend( var(is,j), ginfo(gid)%size2D_4C,                &
                                 comm_datatype, prc_next(prc_nw), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_n ) then
              tagc = 10
              do j = je-jhalo+1, je
                 call mpi_isend( var(1,j), ginfo(gid)%size2D_4C,                &
                                 comm_datatype, prc_next(prc_n), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_w ) then
              tagc = 20
              do j = je+1, ja
                 call mpi_isend( var(is,j), ginfo(gid)%size2D_4C,                &
                                 comm_datatype, prc_next(prc_w), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           ! To NE HALO communicate
           if ( prc_has_n .AND. prc_has_e ) then
              tagc = 10
              do j = je-jhalo+1, je
                 call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C,        &
                                 comm_datatype, prc_next(prc_ne), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_n ) then
              tagc = 0
              do j = je-jhalo+1, je
                 call mpi_isend( var(ie+1,j), ginfo(gid)%size2D_4C,        &
                                 comm_datatype, prc_next(prc_n), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_e ) then
              tagc = 30
              do j = je+1, ja
                 call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C,        &
                                 comm_datatype, prc_next(prc_e), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           ! To SW HALO communicate
           if ( prc_has_s .AND. prc_has_w ) then
              tagc = 20
              do j = js, js+jhalo-1
                 call mpi_isend( var(is,j), ginfo(gid)%size2D_4C,                &
                                 comm_datatype, prc_next(prc_sw), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_s ) then
              tagc = 30
              do j = js, js+jhalo-1
                 call mpi_isend( var(1,j), ginfo(gid)%size2D_4C,                &
                                 comm_datatype, prc_next(prc_s), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_w ) then
              tagc = 0
              do j = 1, js-1
                 call mpi_isend( var(is,j), ginfo(gid)%size2D_4C,                &
                                 comm_datatype, prc_next(prc_w), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           ! To SE HALO communicate
           if ( prc_has_s .AND. prc_has_e ) then
              tagc = 30
              do j = js, js+jhalo-1
                 call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C,        &
                                 comm_datatype, prc_next(prc_se), tag+tagc,      &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_s ) then
              tagc = 20
              do j = js, js+jhalo-1
                 call mpi_isend( var(ie+1,j), ginfo(gid)%size2D_4C,        &
                                 comm_datatype, prc_next(prc_s), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           else if ( prc_has_e ) then
              tagc = 10
              do j = 1, js-1
                 call mpi_isend( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C,        &
                                 comm_datatype, prc_next(prc_e), tag+tagc,       &
                                 comm_world, ginfo(gid)%req_list(ireq,vid), ierr )
                 ireq = ireq + 1
                 tagc = tagc + 1
              enddo
           endif
 
           !$acc end host_data
 
        end if
 
    endif
 
    ginfo(gid)%req_cnt(vid) = ireq - 1
 
    return

References comm_datatype, comm_world, scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars8_2d_mpi_onesided()

subroutine scale_comm_cartesc::vars8_2d_mpi_onesided	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4423 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: IA, IS, IE, IHALO
    integer :: JA, JS, JE, JHALO
 
    integer(kind=MPI_ADDRESS_KIND) :: disp
 
    integer :: ierr
    integer :: j
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:)
#endif
    !---------------------------------------------------------------------------
 
    ia    = ginfo(gid)%IA
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ihalo = ginfo(gid)%IHALO
    ja    = ginfo(gid)%JA
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    jhalo = ginfo(gid)%JHALO
 
    !$acc data copyin(var)
 
    call mpi_win_start( group_packwe, 0, ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_start( group_packns, 0, ginfo(gid)%win_packNS(vid), ierr )
 
    if ( comm_isallperiodic ) then
    !--- periodic condition
 
       !--- To 8-Direction HALO communicate
 
       !$acc host_data use_device(var)
 
       ! To N HALO communicate
       do j = je-jhalo+1, je
          disp = ihalo + ia * ( j - je+jhalo-1 )
          call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
                        prc_next(prc_n), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
                        ginfo(gid)%win_packNS(vid), ierr )
       enddo
       ! To S HALO communicate
       do j = js, js+jhalo-1
          disp = ihalo + ia * ( j - js + jhalo )
          call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
               prc_next(prc_s), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
               ginfo(gid)%win_packNS(vid), ierr )
       enddo
 
       !$acc end host_data
 
       if ( .not. prc_twod ) then
 
          call packwe_2d( ia, is, ie, ja, js, je, &
                          ihalo, &
                          var, gid, vid)
 
          !$acc host_data use_device(var)
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
          !$acc host_data use_device(ptr)
#endif
 
          ! To W HALO communicate
          disp = 1
#ifdef _OPENACC
          call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                        prc_next(prc_w), disp, ginfo(gid)%size2D_WE, comm_datatype, &
                        ginfo(gid)%win_packWE(vid), ierr )
          ! To E HALO communicate
          disp = 0
#ifdef _OPENACC
          call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
#else
          call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
               prc_next(prc_e), disp, ginfo(gid)%size2D_WE, comm_datatype, &
               ginfo(gid)%win_packWE(vid), ierr )
          !$acc end host_data
          ! To NW HALO communicate
          do j = je-jhalo+1, je
             disp = ie + ia * ( j - je+jhalo-1 )
             call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
                           prc_next(prc_nw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
          ! To NE HALO communicate
          do j = je-jhalo+1, je
             disp = ia * ( j - je+jhalo-1 )
             call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                           prc_next(prc_ne), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
          ! To SW HALO communicate
          do j = js, js+jhalo-1
             disp = ie + ia * ( j - js + jhalo )
             call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
                           prc_next(prc_sw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
          ! To SE HALO communicate
          do j = js, js+jhalo-1
             disp = ia * ( j - js + jhalo )
             call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                           prc_next(prc_se), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
 
          !$acc end host_data
 
       end if
    else
    !--- non-periodic condition
 
       !$acc host_data use_device(var)
 
       ! To N HALO communicate
       if ( prc_has_n ) then
          do j = je-jhalo+1, je
             disp = ihalo + ia * ( j - je+jhalo-1 )
             call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
                           prc_next(prc_n), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
       endif
       ! To S HALO communicate
       if ( prc_has_s ) then
          do j = js, js+jhalo-1
             disp = ihalo + ia * ( j - js + jhalo )
             call mpi_put( var(is,j), ginfo(gid)%size2D_NS8, comm_datatype, &
                           prc_next(prc_s), disp, ginfo(gid)%size2D_NS8, comm_datatype, &
                           ginfo(gid)%win_packNS(vid), ierr )
          enddo
       endif
 
       !$acc end host_data
 
       if ( .not. prc_twod ) then
 
          call packwe_2d( ia, is, ie, ja, js, je, &
                          ihalo, &
                          var, gid, vid)
 
          !$acc host_data use_device(var)
#ifdef _OPENACC
          ptr => ginfo(gid)%sendpack_P2WE(:,:,vid)
          !$acc host_data use_device(ptr)
#endif
 
          ! To W HALO communicate
          if ( prc_has_w ) then
             disp = 1
#ifdef _OPENACC
             call mpi_put( ptr(:,1), ginfo(gid)%size2D_WE, comm_datatype, &
#else
             call mpi_put( ginfo(gid)%sendpack_P2WE(:,1,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                           prc_next(prc_w), disp, ginfo(gid)%size2D_WE, comm_datatype, &
                           ginfo(gid)%win_packWE(vid), ierr )
          endif
          ! To E HALO communicate
          if ( prc_has_e ) then
             disp = 0
#ifdef _OPENACC
             call mpi_put( ptr(:,2), ginfo(gid)%size2D_WE, comm_datatype, &
#else
             call mpi_put( ginfo(gid)%sendpack_P2WE(:,2,vid), ginfo(gid)%size2D_WE, comm_datatype, &
#endif
                           prc_next(prc_e), disp, ginfo(gid)%size2D_WE, comm_datatype, &
                           ginfo(gid)%win_packWE(vid), ierr )
          endif
          !$acc end host_data
          ! To NW HALO communicate
          if ( prc_has_n .AND. prc_has_w ) then
             do j = je-jhalo+1, je
                disp = ie + ia * ( j - je+jhalo-1 )
                call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_nw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_n ) then
             do j = je-jhalo+1, je
                disp = ia * ( j - je+jhalo-1 )
                call mpi_put( var(1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_n), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_w ) then
             do j = je+1, ja
                disp = ie + ia * ( j - je-1 + jhalo )
                call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_w), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
          ! To NE HALO communicate
          if ( prc_has_n .AND. prc_has_e ) then
             do j = je-jhalo+1, je
                disp = ia * ( j - je+jhalo-1 )
                call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_ne), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_n ) then
             do j = je-jhalo+1, je
                disp = ie + ia * ( j - je+jhalo-1 )
                call mpi_put( var(ie+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_n), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_e ) then
             do j = je+1, ja
                disp = ia * ( j - je-1 + jhalo )
                call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_e), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
          ! To SW HALO communicate
          if ( prc_has_s .AND. prc_has_w ) then
             do j = js, js+jhalo-1
                disp = ie + ia * ( j - js + jhalo )
                call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_sw), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_s ) then
             do j = js, js+jhalo-1
                disp = ia * ( j - js + jhalo )
                call mpi_put( var(1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_s), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_w ) then
             do j = 1, js-1
                disp = ie + ia * ( j - 1 )
                call mpi_put( var(is,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_w), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
          ! To SE HALO communicate
          if ( prc_has_s .AND. prc_has_e ) then
             do j = js, js+jhalo-1
                disp = ia * ( j - js + jhalo )
                call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_se), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_s ) then
             do j = js, js+jhalo-1
                disp = ie + ia * ( j - js + jhalo )
                call mpi_put( var(ie+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_s), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          else if ( prc_has_e ) then
             do j = 1, js-1
                disp = ia * ( j - 1 )
                call mpi_put( var(ie-ihalo+1,j), ginfo(gid)%size2D_4C, comm_datatype, &
                              prc_next(prc_e), disp, ginfo(gid)%size2D_4C, comm_datatype, &
                              ginfo(gid)%win_packNS(vid), ierr )
             enddo
          endif
 
          !$acc end host_data
       end if
 
    endif
 
    call mpi_win_complete( ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_complete( ginfo(gid)%win_packNS(vid), ierr )
 
    !$acc end data
 
    return

References comm_datatype, scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

vars_3d_mpi_pc()

subroutine scale_comm_cartesc::vars_3d_mpi_pc	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4714 of file scale_comm_cartesC.F90.

    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    real(RP), intent(inout) :: var(:,:,:)
    integer, intent(in)     :: gid
    integer, intent(in)     :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
#ifdef DEBUG
    if ( ginfo(gid)%use_packbuf(ginfo(gid)%packid(vid)) ) then
       log_error("vars_3D_mpi_pc",*) 'packing buffer is already used', vid, ginfo(gid)%packid(vid)
       call prc_abort
    end if
    ginfo(gid)%use_packbuf(ginfo(gid)%packid(vid)) = .true.
#endif
 
#ifdef _OPENACC
    if ( ginfo(gid)%device_alloc(vid+comm_vsize_max) ) then
       !$acc update device(var)
    end if
#endif
 
    if ( .not. prc_twod ) then
       ka = ginfo(gid)%KA
       ia = ginfo(gid)%IA
       is = ginfo(gid)%IS
       ie = ginfo(gid)%IE
       ja = ginfo(gid)%JA
       js = ginfo(gid)%JS
       je = ginfo(gid)%JE
       ihalo = ginfo(gid)%IHALO
       call packwe_3d( ka, ia, is, ie, ja, js, je, &
                       ihalo, &
                       var, gid, ginfo(gid)%packid(vid))
       !$acc wait
    end if
 
    call mpi_startall(ginfo(gid)%preq_cnt(vid), ginfo(gid)%preq_list(1:ginfo(gid)%preq_cnt(vid),vid), ierr)
 
    return

References packwe_3d(), scale_prc::prc_abort(), and scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the call graph for this function:

Here is the caller graph for this function:

wait_3d_mpi()

subroutine scale_comm_cartesc::wait_3d_mpi	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4766 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    real(RP), intent(inout) :: var(:,:,:)
    integer, intent(in)     :: gid
    integer, intent(in)     :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    !--- wait packets
    call mpi_waitall( ginfo(gid)%req_cnt (vid),                           &
                      ginfo(gid)%req_list(1:ginfo(gid)%req_cnt(vid),vid), &
                      mpi_statuses_ignore,                                &
                      ierr                                                )
    if ( .not. prc_twod ) then
       ka = ginfo(gid)%KA
       ia = ginfo(gid)%IA
       is = ginfo(gid)%IS
       ie = ginfo(gid)%IE
       ja = ginfo(gid)%JA
       js = ginfo(gid)%JS
       je = ginfo(gid)%JE
       ihalo = ginfo(gid)%IHALO
       call unpackwe_3d( ka, ia, is, ie, ja, js, je, &
                         ihalo, &
                         var, ginfo(gid)%recvpack_WE2P(:,:,vid) )
       !$acc wait
    end if
 
#ifdef DEBUG
    ginfo(gid)%use_packbuf(vid) = .false.
#endif
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

wait_3d_mpi_onesided()

subroutine scale_comm_cartesc::wait_3d_mpi_onesided	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4809 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    real(RP), intent(inout) :: var(:,:,:)
    integer, intent(in)     :: gid
    integer, intent(in)     :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    real(RP), pointer :: pack(:)
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    ka = ginfo(gid)%KA
    ia = ginfo(gid)%IA
    is = ginfo(gid)%IS
    ie = ginfo(gid)%IE
    ja = ginfo(gid)%JA
    js = ginfo(gid)%JS
    je = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    call mpi_win_wait( ginfo(gid)%win_packWE(vid), ierr )
    if ( .not. prc_twod ) then
       call c_f_pointer( ginfo(gid)%recvbuf_WE(vid), pack, (/ginfo(gid)%size2D_WE*ka*2/) )
       call unpackwe_3d( ka, ia, is, ie, ja, js, je, &
                         ihalo, &
                         var, pack )
    end if
 
    call mpi_win_wait( ginfo(gid)%win_packNS(vid), ierr )
    call c_f_pointer( ginfo(gid)%recvbuf_NS(vid), pack, (/ginfo(gid)%size2D_NS4*ka*2/) )
    call unpackns_3d( ka, ia, is, ie, ja, js, je, &
                      jhalo, &
                      var, pack )
 
    !$acc wait
 
    call mpi_win_post( group_packwe, mpi_mode_nostore, ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_post( group_packns, mpi_mode_nostore, ginfo(gid)%win_packNS(vid), ierr )
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

wait_2d_mpi()

subroutine scale_comm_cartesc::wait_2d_mpi	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4859 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    real(RP), intent(inout) :: var(:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    !--- wait packets
    call mpi_waitall( ginfo(gid)%req_cnt(vid),                            &
                      ginfo(gid)%req_list(1:ginfo(gid)%req_cnt(vid),vid), &
                      mpi_statuses_ignore,                                &
                      ierr                                                )
    if ( .not. prc_twod ) then
       ka = ginfo(gid)%KA
       ia = ginfo(gid)%IA
       is = ginfo(gid)%IS
       ie = ginfo(gid)%IE
       ja = ginfo(gid)%JA
       js = ginfo(gid)%JS
       je = ginfo(gid)%JE
       ihalo = ginfo(gid)%IHALO
       call unpackwe_2d( ka, ia, is, ie, ja, js, je, &
                         ihalo, &
                         var, ginfo(gid)%recvpack_WE2P(:,:,vid) )
    end if
 
#ifdef DEBUG
    ginfo(gid)%use_packbuf(vid) = .false.
#endif
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

wait_2d_mpi_onesided()

subroutine scale_comm_cartesc::wait_2d_mpi_onesided	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4901 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    real(RP), intent(inout) :: var(:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO, JHALO
 
    real(RP), pointer :: pack(:)
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    ka = ginfo(gid)%KA
    ia = ginfo(gid)%IA
    is = ginfo(gid)%IS
    ie = ginfo(gid)%IE
    ja = ginfo(gid)%JA
    js = ginfo(gid)%JS
    je = ginfo(gid)%JE
    ihalo = ginfo(gid)%IHALO
    jhalo = ginfo(gid)%JHALO
 
    call mpi_win_wait( ginfo(gid)%win_packWE(vid), ierr )
    if ( .not. prc_twod ) then
       call c_f_pointer( ginfo(gid)%recvbuf_WE(vid), pack, (/ginfo(gid)%size2D_WE*ka*2/)  )
       call unpackwe_2d( ka, ia, is, ie, ja, js, je, &
                         ihalo, &
                         var, pack )
    end if
 
    call mpi_win_wait( ginfo(gid)%win_packNS(vid), ierr )
    call c_f_pointer( ginfo(gid)%recvbuf_NS(vid), pack, (/ginfo(gid)%size2D_NS4*ka*2/)  )
    call unpackns_2d( ia, is, ie, ja, js, je, &
                      jhalo, &
                      var, pack )
 
    call mpi_win_post( group_packwe, mpi_mode_nostore, ginfo(gid)%win_packWE(vid), ierr )
    call mpi_win_post( group_packns, mpi_mode_nostore, ginfo(gid)%win_packNS(vid), ierr )
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

wait_3d_mpi_pc()

subroutine scale_comm_cartesc::wait_3d_mpi_pc	(	real(rp), dimension(:,:,:), intent(inout)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 4949 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    real(RP), intent(inout) :: var(:,:,:)
    integer,  intent(in)    :: gid
    integer,  intent(in)    :: vid
 
    integer :: KA
    integer :: IA, IS, IE
    integer :: JA, JS, JE
    integer :: IHALO
 
    integer :: pid
    integer :: ierr
 
    !--- wait packets
    call mpi_waitall( ginfo(gid)%preq_cnt (vid),                            &
                      ginfo(gid)%preq_list(1:ginfo(gid)%preq_cnt(vid),vid), &
                      mpi_statuses_ignore,                                  &
                      ierr                                                  )
    if ( .not. prc_twod ) then
       ka = ginfo(gid)%KA
       ia = ginfo(gid)%IA
       is = ginfo(gid)%IS
       ie = ginfo(gid)%IE
       ja = ginfo(gid)%JA
       js = ginfo(gid)%JS
       je = ginfo(gid)%JE
       ihalo = ginfo(gid)%IHALO
       pid = ginfo(gid)%packid(vid)
       call unpackwe_3d( ka, ia, is, ie, ja, js, je, &
                         ihalo, &
                         var, ginfo(gid)%recvpack_WE2P(:,:,pid) )
       !$acc wait
    end if
 
#ifdef DEBUG
    ginfo(gid)%use_packbuf(ginfo(gid)%packid(vid)) = .false.
#endif
 
#ifdef _OPENACC
    if ( ginfo(gid)%device_alloc(vid+comm_vsize_max) ) then
       !$acc update host(var)
    end if
#endif
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

packwe_3d()

subroutine scale_comm_cartesc::packwe_3d	(	integer, intent(in)	KA,
		integer, intent(in)	IA,
		integer, intent(in)	IS,
		integer, intent(in)	IE,
		integer, intent(in)	JA,
		integer, intent(in)	JS,
		integer, intent(in)	JE,
		integer, intent(in)	IHALO,
		real(rp), dimension(ka,ia,ja), intent(in)	var,
		integer, intent(in)	gid,
		integer, intent(in)	vid
	)

Definition at line 5001 of file scale_comm_cartesC.F90.

    implicit none
    integer, intent(in) :: KA
    integer, intent(in) :: IA, IS, IE
    integer, intent(in) :: JA, JS, JE
    integer, intent(in) :: IHALO
    real(RP), intent(in) :: var(KA,IA,JA)
    integer,  intent(in) :: gid
    integer,  intent(in) :: vid
 
    integer :: k, i, j, n
 
#ifdef _OPENACC
    real(RP), pointer :: ptr(:,:,:)
    ptr => ginfo(gid)%sendpack_P2WE
#endif
 
    !$acc data copyin(var) if(acc_is_present(var))
 
    call prof_rapstart('COMM_pack', 3)
 
    if ( prc_has_w ) then
       !--- packing packets to West
       !$omp parallel do private(i,j,k,n) OMP_SCHEDULE_ collapse(2)
       !$acc parallel if(acc_is_present(var)) async
       !$acc loop collapse(2) gang
       do j = js, je
       do i = is, is+ihalo-1
       !$acc loop independent vector
       do k = 1, ka
          n = (j-js) * ka * ihalo &
            + (i-is) * ka         &
            + k
#ifdef _OPENACC
          ptr(n,1,vid) = var(k,i,j)
#else
          ginfo(gid)%sendpack_P2WE(n,1,vid) = var(k,i,j)
#endif
       enddo
       enddo
       enddo
       !$acc end parallel
    end if
 
    if ( prc_has_e ) then
       !--- packing packets to East
       !$omp parallel do private(i,j,k,n) OMP_SCHEDULE_ collapse(2)
       !$acc parallel if(acc_is_present(var)) async
       !$acc loop collapse(2) gang
       do j = js, je
       do i = ie-ihalo+1, ie
       !$acc loop independent vector
       do k = 1, ka
          n = (j-js)         * ka * ihalo &
            + (i-ie+ihalo-1) * ka         &
            + k
#ifdef _OPENACC
          ptr(n,2,vid) = var(k,i,j)
#else
          ginfo(gid)%sendpack_P2WE(n,2,vid) = var(k,i,j)
#endif
       enddo
       enddo
       enddo
       !$acc end parallel
    end if
 
    call prof_rapend('COMM_pack', 3)
 
    !$acc end data
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by vars8_3d_mpi(), vars8_3d_mpi_onesided(), vars_3d_mpi(), vars_3d_mpi_onesided(), and vars_3d_mpi_pc().

Here is the caller graph for this function:

copy_boundary_2d()

subroutine scale_comm_cartesc::copy_boundary_2d	(	real(rp), dimension(:,:), intent(inout)	var,
		integer, intent(in)	gid
	)

Definition at line 5702 of file scale_comm_cartesC.F90.

    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    real(RP), intent(inout) :: var(:,:)
    integer,  intent(in)    :: gid
 
    integer :: IS, IE, IHALO
    integer :: JS, JE, JHALO
 
    integer :: i, j
    !---------------------------------------------------------------------------
 
    !$acc data copy(var)
 
    is    = ginfo(gid)%IS
    ie    = ginfo(gid)%IE
    ihalo = ginfo(gid)%IHALO
    js    = ginfo(gid)%JS
    je    = ginfo(gid)%JE
    jhalo = ginfo(gid)%JHALO
 
    !$omp parallel
 
    !--- copy inner data to HALO(North)
    if( .NOT. prc_has_n ) then
       !$acc kernels async
       do j = je+1, je+jhalo
       !$omp do
       do i = is, ie
          var(i,j) = var(i,je)
       enddo
       !$omp end do nowait
       enddo
       !$acc end kernels
    endif
 
    !--- copy inner data to HALO(South)
    if( .NOT. prc_has_s ) then
       !$acc kernels async
       !$acc loop independent
       do j = js-jhalo, js-1
       !$omp do
       do i = is, ie
          var(i,j) = var(i,js)
       enddo
       !$omp end do nowait
       enddo
       !$acc end kernels
    endif
 
    if ( .not. prc_twod ) then
 
       if( .NOT. prc_has_e ) then
          !$omp do
          !$acc kernels async
          do j = js, je
          do i = ie+1, ie+ihalo
             var(i,j) = var(ie,j)
          enddo
          enddo
          !$acc end kernels
          !$omp end do nowait
       endif
 
       if( .NOT. prc_has_w ) then
          !$omp do
          !$acc kernels async
          do j = js, je
          !$acc loop independent
          do i = is-ihalo, is-1
             var(i,j) = var(is,j)
          enddo
          enddo
          !$acc end kernels
          !$omp end do nowait
       endif
 
       !--- copy inner data to HALO(NorthWest)
       if( .NOT. prc_has_n .AND. .NOT. prc_has_w ) then
          !$acc kernels async
          do j = je+1, je+jhalo
          !$acc loop independent
          do i = is-ihalo, is-1
             var(i,j) = var(is,je)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_n ) then
          !$acc kernels async
          do j = je+1, je+jhalo
          do i = is-ihalo, is-1
             var(i,j) = var(i,je)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_w ) then
          !$acc kernels async
          do j = je+1, je+jhalo
          !$acc loop independent
          do i = is-ihalo, is-1
             var(i,j) = var(is,j)
          enddo
          enddo
          !$acc end kernels
       endif
 
       !--- copy inner data to HALO(SouthWest)
       if( .NOT. prc_has_s .AND. .NOT. prc_has_w ) then
          !$acc kernels async
          !$acc loop independent
          do j = js-jhalo, js-1
          !$acc loop independent
          do i = is-ihalo, is-1
             var(i,j) = var(is,js)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_s ) then
          !$acc kernels async
          !$acc loop independent
          do j = js-jhalo, js-1
          do i = is-ihalo, is-1
             var(i,j) = var(i,js)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_w ) then
          !$acc kernels async
          do j = js-jhalo, js-1
          !$acc loop independent
          do i = is-ihalo, is-1
             var(i,j) = var(is,j)
          enddo
          enddo
          !$acc end kernels
       endif
 
       !--- copy inner data to HALO(NorthEast)
       if( .NOT. prc_has_n .AND. .NOT. prc_has_e ) then
          !$acc kernels async
          do j = je+1, je+jhalo
          do i = ie+1, ie+ihalo
             var(i,j) = var(ie,je)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_n ) then
          !$acc kernels async
          do j = je+1, je+jhalo
          do i = ie+1, ie+ihalo
             var(i,j) = var(i,je)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_e ) then
          !$acc kernels async
          do j = je+1, je+jhalo
          do i = ie+1, ie+ihalo
             var(i,j) = var(ie,j)
          enddo
          enddo
          !$acc end kernels
       endif
 
       !--- copy inner data to HALO(SouthEast)
       if( .NOT. prc_has_s .AND. .NOT. prc_has_e ) then
          !$acc kernels async
          do j = js-jhalo, js-1
          do i = ie+1, ie+ihalo
             var(i,j) = var(ie,js)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_s ) then
          !$acc kernels async
          !$acc loop independent
          do j = js-jhalo, js-1
          do i = ie+1, ie+ihalo
             var(i,j) = var(i,js)
          enddo
          enddo
          !$acc end kernels
       elseif( .NOT. prc_has_e ) then
          !$acc kernels async
          do j = js-jhalo, js-1
          do i = ie+1, ie+ihalo
             var(i,j) = var(ie,j)
          enddo
          enddo
          !$acc end kernels
       endif
 
    end if
 
    !$omp end parallel
 
    !$acc wait
 
    !$acc end data
 
    return

References scale_prc_cartesc::prc_twod.

Referenced by comm_vars8_init().

Here is the caller graph for this function:

Variable Documentation

comm_datatype

integer, public scale_comm_cartesc::comm_datatype

datatype of variable

Definition at line 103 of file scale_comm_cartesC.F90.

  integer, public :: COMM_datatype

Referenced by scale_atmos_phy_lt_sato2019::atmos_phy_lt_electric_field(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_judge_abse(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_f2013(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_mg2001(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_sato2019_adjustment(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_solve_bicgstab(), scale_comm_cartesc_nest::comm_cartesc_nest_domain_shape(), scale_comm_cartesc_nest::comm_cartesc_nest_intercomm_nestdown_3d(), scale_comm_cartesc_nest::comm_cartesc_nest_issuer_of_receive_3d(), comm_gather_2d(), comm_gather_3d(), comm_setup(), scale_dft::dft_g2s(), mod_realinput::realinput_surface(), scale_statistics::statistics_detail_2d(), scale_statistics::statistics_detail_3d(), scale_statistics::statistics_horizontal_max_2d(), scale_statistics::statistics_horizontal_max_3d(), scale_statistics::statistics_horizontal_min_2d(), scale_statistics::statistics_horizontal_min_3d(), vars8_2d_mpi(), vars8_2d_mpi_onesided(), vars8_3d_mpi(), vars8_3d_mpi_onesided(), vars8_init_mpi_pc(), vars_2d_mpi(), vars_2d_mpi_onesided(), vars_3d_mpi(), vars_3d_mpi_onesided(), and vars_init_mpi_pc().

comm_world

integer, public scale_comm_cartesc::comm_world

communication world ID

Definition at line 104 of file scale_comm_cartesC.F90.

  integer, public :: COMM_world

Referenced by scale_atmos_phy_lt_sato2019::atmos_phy_lt_electric_field(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_judge_abse(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_f2013(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_neutralization_mg2001(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_sato2019_adjustment(), scale_atmos_phy_lt_sato2019::atmos_phy_lt_solve_bicgstab(), comm_bcast_1d_dp(), comm_bcast_1d_sp(), comm_bcast_2d_dp(), comm_bcast_2d_sp(), comm_bcast_3d_dp(), comm_bcast_3d_sp(), comm_bcast_4d_dp(), comm_bcast_4d_sp(), comm_bcast_character(), comm_bcast_int_1d(), comm_bcast_int_2d(), comm_bcast_int_scr(), comm_bcast_logical_1d(), comm_bcast_logical_scr(), comm_bcast_scr_dp(), comm_bcast_scr_sp(), scale_comm_cartesc_nest::comm_cartesc_nest_domain_shape(), comm_gather_2d(), comm_gather_3d(), comm_horizontal_mean_3d(), comm_regist(), comm_setup(), comm_vars8_init(), mod_realinput::realinput_surface(), scale_atmos_dyn_tstep_short_fvm_hivi::solve_bicgstab(), vars8_2d_mpi(), vars8_3d_mpi(), vars8_init_mpi_pc(), vars_2d_mpi(), vars_3d_mpi(), and vars_init_mpi_pc().