scale_meshfieldcomm_cubedom3d.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!> module FElib / Data / Communication 3D cubic domain
!!
!! @par Description
!!      A module to manage data communication with 3D cubic domain for element-based methods
!!
!! @author Yuta Kawai, Team SCALE
!<
#include "scaleFElib.h"
module scale_meshfieldcomm_cubedom3d
 
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
 
  use scale_element_base, only: elementbase, elementbase3d
  use scale_mesh_cubedom3d, only: meshcubedom3d
  use scale_meshfield_base, only: meshfield3d
  use scale_meshfieldcomm_base, only: &
    meshfieldcommbase,                               &
    meshfieldcommbase_init, meshfieldcommbase_final, &
    meshfieldcommbase_extract_bounddata,             &
    meshfieldcommbase_extract_bounddata_2,           &
    meshfieldcommbase_extract_bounddata_3,           &
    meshfieldcommbase_set_bounddata,                 &
    meshfieldcommbase_set_bounddata_3,               &
    meshfieldcontainer
  use scale_localmesh_3d, only: localmesh3d
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedure
  ! 
 
  !> Base derived type to manage data communication with 3D cubic domain
  type, public, extends(meshfieldcommbase) :: meshfieldcommcubedom3d
    class(meshcubedom3d), pointer :: mesh3d  !< Pointer to an object representing 3D cubic computational mesh
 
    integer :: halosize_h1d !< Halo size for 1D horizontal direction
    integer :: halosize_v   !< Halo size for vertical direction
  contains
    procedure, public :: init => meshfieldcommcubedom3d_init
    procedure, public :: put => meshfieldcommcubedom3d_put
    procedure, public :: get => meshfieldcommcubedom3d_get
    procedure, public :: exchange => meshfieldcommcubedom3d_exchange  
    procedure, public :: final => meshfieldcommcubedom3d_final
  end type meshfieldcommcubedom3d
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: push_localsendbuf
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  integer, parameter :: comm_face_num = 6  !< Number of faces with data communication
 
contains
!> Initialize an object to manage data communication with 3D cubic domain
  subroutine meshfieldcommcubedom3d_init( this,        &
    sfield_num, hvfield_num, htensorfield_num, mesh3d, &
    haloSize_h1D, haloSize_v )
 
    use scale_meshutil_3d, only: meshutil3d_genpatchboundarymap_wide
    implicit none
    
    class(meshfieldcommcubedom3d), intent(inout) :: this
    integer, intent(in) :: sfield_num                    !< Number of scalar fields
    integer, intent(in) :: hvfield_num                   !< Number of horizontal vector fields
    integer, intent(in) :: htensorfield_num              !< Number of horizontal vector fields
    class(meshcubedom3d), intent(in), target :: mesh3d   !< Object to manage a 3D cubic computational mesh
    integer, intent(in), optional :: halosize_h1d        !< Halo size for 1D horizontal direction (if not given, halo size of mesh3d is used)
    integer, intent(in), optional :: halosize_v          !< Halo size for vertical direction (if not given, halo size of mesh3d is used)
    
    type(localmesh3d), pointer :: lcmesh
    type(elementbase3d), pointer :: elem
    integer :: n
    integer :: nnode_lcmeshface(comm_face_num,mesh3d%local_mesh_num)
    !-----------------------------------------------------------------------------
    
    this%mesh3d => mesh3d
    lcmesh => mesh3d%lcmesh_list(1)
    elem => lcmesh%refElem3D
 
 
    !-
    if ( present(halosize_h1d) ) then
      this%haloSize_h1D = halosize_h1d
    else
      this%haloSize_h1D = 1
    end if
    if ( present(halosize_v) ) then
      this%haloSize_v = halosize_v
    else
      this%haloSize_v = 1
    end if
 
    !-
    allocate( this%VMapB_size(this%mesh3d%LOCAL_MESH_NUM) )
 
    this%bufsize_per_field =  2 * (lcmesh%NeX + lcmesh%NeY) * lcmesh%NeZ*elem%Nfp_h*this%haloSize_h1D &
                            + 2 * lcmesh%NeX*lcmesh%NeY * elem%Nfp_v*this%haloSize_v
    
 
    do n=1, this%mesh3d%LOCAL_MESH_NUM
      lcmesh => this%mesh3d%lcmesh_list(n)
      nnode_lcmeshface(:,n) = &
          (/ lcmesh%NeX, lcmesh%NeY, lcmesh%NeX, lcmesh%NeY, 0, 0 /) * lcmesh%NeZ * lcmesh%refElem3D%Nfp_h*this%haloSize_h1D &
        + (/ 0, 0, 0, 0, 1, 1 /) * lcmesh%NeX*lcmesh%NeY * lcmesh%refElem3D%Nfp_v*this%haloSize_v
    end do
 
    call meshfieldcommbase_init( this, sfield_num, hvfield_num, htensorfield_num, this%bufsize_per_field, comm_face_num, nnode_lcmeshface, mesh3d )  
  
    !-
    if ( this%haloSize_h1D > 1 .or. this%haloSize_v > 1) then
      this%use_vmap_wide_flag = .true.
      allocate( this%VMapB2(this%bufsize_per_field) )
 
      lcmesh => this%mesh3d%lcmesh_list(1)      
      call meshutil3d_genpatchboundarymap_wide( this%VMapB2, &
        lcmesh%VMapB, this%haloSize_h1D, this%haloSize_v,    &
        lcmesh%NeX, lcmesh%NeY, lcmesh%NeZ,                  &
        elem%Nfp_h, elem%Nfp_v, elem%Nnode_h1D, elem%Nnode_v )
      !$acc enter data copyin(this%VMapB2)
    else
      this%use_vmap_wide_flag = .false.
    end if
 
    do n=1, this%mesh3d%LOCAL_MESH_NUM
      lcmesh => this%mesh3d%lcmesh_list(n)
      if ( this%use_vmap_wide_flag ) then
        this%VMapB_size(n) = size(this%VMapB2)        
      else
        this%VMapB_size(n) = size(lcmesh%VMapB)
      end if
    end do
    !$acc enter data copyin(this%VMapB_size)
 
    return
  end subroutine meshfieldcommcubedom3d_init
 
!> Finalize an object to manage data communication with 3D cubic domain
  subroutine meshfieldcommcubedom3d_final( this )
    implicit none    
    class(meshfieldcommcubedom3d), intent(inout) :: this
    !-----------------------------------------------------------------------------        
    call meshfieldcommbase_final( this )
    return
  end subroutine meshfieldcommcubedom3d_final
 
!> Put field data into temporary buffers
  subroutine meshfieldcommcubedom3d_put(this, field_list, varid_s)
    implicit none
    class(meshfieldcommcubedom3d), intent(inout) :: this
    type(meshfieldcontainer), intent(in) :: field_list(:)  !< Array of objects with 3D mesh field
    integer, intent(in) :: varid_s                         !< Start index with variables when field_list(1) is written to buffers for data communication
 
    integer :: i, n
    type(localmesh3d), pointer :: lcmesh
    integer :: field_num
    !-----------------------------------------------------------------------------
 
!    call PROF_rapstart( 'comm_put', 2)    
!    call PROF_rapstart( 'meshfiled_comm_put', 3)
    if ( this%use_vmap_wide_flag ) then
      call meshfieldcommbase_extract_bounddata_3( field_list, 3, varid_s, this%mesh3d%lcmesh_list, this%VMapB2, this%VMapB_size(1), & ! (in)
        this%send_buf ) ! (out)
    else    
      call meshfieldcommbase_extract_bounddata_2( &
        field_list, 3, varid_s, this%mesh3d%lcmesh_list, size(this%mesh3d%lcmesh_list(1)%VMapB), & !(in)
        this%send_buf ) ! (out)
    end if
!    call PROF_rapend( 'meshfiled_comm_put', 3)
!    call PROF_rapend( 'comm_put', 2)
 
    return
  end subroutine meshfieldcommcubedom3d_put
 
!> Extract field data from temporary buffers
  subroutine meshfieldcommcubedom3d_get(this, field_list, varid_s)
    use scale_meshfieldcomm_base, only: &
      meshfieldcommbase_wait_core
    implicit none
    
    class(meshfieldcommcubedom3d), intent(inout) :: this
    type(meshfieldcontainer), intent(inout) :: field_list(:)  !< Array of objects with 3D mesh field
    integer, intent(in) :: varid_s                            !< Start index with variables when field_list(1) is written to buffers for data communication
 
    integer :: i
    integer :: n
    type(localmesh3d), pointer :: lcmesh
    !-----------------------------------------------------------------------------
!    call PROF_rapstart( 'comm_get', 2)
 
    if ( this%call_wait_flag_sub_get ) then
      ! call PROF_rapstart( 'meshfiled_comm_wait_get', 2)
      call meshfieldcommbase_wait_core( this, this%commdata_list, &
        field_list, 3, varid_s, this%mesh3d%lcmesh_list )
      ! call PROF_rapend( 'meshfiled_comm_wait_get', 2)
    else
      ! call PROF_rapstart( 'meshfiled_comm_get', 2)
      do i=1, size(field_list) 
      do n=1, this%mesh3d%LOCAL_MESH_NUM
        lcmesh => this%mesh3d%lcmesh_list(n)
        if ( this%use_vmap_wide_flag ) then
          call meshfieldcommbase_set_bounddata_3( this%recv_buf(:,varid_s+i-1,n), lcmesh%refElem, lcmesh, & ! (in)
            this%VMapB2, this%VMapB_size(1),                                                              & ! (in)          
            field_list(i)%field3d%local(n)%val )                                                            !(out)
        else
          call meshfieldcommbase_set_bounddata( this%recv_buf(:,varid_s+i-1,n), lcmesh%refElem, lcmesh, & !(in)
            field_list(i)%field3d%local(n)%val )                                                          !(out)
        end if
      end do
      end do
      !$acc wait(1)
      ! call PROF_rapend( 'meshfiled_comm_get', 2)
    end if
!    call PROF_rapend( 'comm_get', 2)
 
    return
  end subroutine meshfieldcommcubedom3d_get
 
!> Exchange field data between neighboring MPI processes
!!
!! @param do_wait Flag whether MPI_waitall is called and move tmp data of LocalMeshCommData object to a recv buffer
!OCL SERIAL
  subroutine meshfieldcommcubedom3d_exchange( this, do_wait )
    use scale_meshfieldcomm_base, only: &
      meshfieldcommbase_exchange_core,  &
      localmeshcommdata
    use scale_prof
    implicit none
  
    class(meshfieldcommcubedom3d), intent(inout), target :: this
    logical, intent(in), optional :: do_wait
 
    integer :: n, f
    type(localmesh3d), pointer :: lcmesh
    type(localmeshcommdata), pointer :: commdata
    !-----------------------------------------------------------------------------
    
!    call PROF_rapstart( 'comm_exchange_1', 2)
 
!    call PROF_rapstart( 'meshfiled_comm_ex_push_buf', 3)
    do n=1, this%mesh%LOCAL_MESH_NUM
      lcmesh => this%mesh3d%lcmesh_list(n)
      do f=1, this%nfaces_comm
        commdata => this%commdata_list(f,n)
        call push_localsendbuf( commdata%send_buf,                  &  ! (inout)
          this%send_buf(:,:,n), commdata%s_faceID, this%is_f(f,n),  &  ! (in)
          commdata%Nnode_LCMeshFace, this%bufsize_per_field,        &  ! (in)
          this%field_num_tot, lcmesh, this%haloSize_h1D )              ! (in)
      end do
    end do
    !$acc wait(1)
!    call PROF_rapend( 'meshfiled_comm_ex_push_buf', 3)
!    call PROF_rapend( 'comm_exchange_1', 2)
 
    !-----------------------
!    call PROF_rapstart( 'comm_exchange_2', 2)
 
    call meshfieldcommbase_exchange_core(this, this%commdata_list, do_wait )
!    call PROF_rapend( 'comm_exchange_2', 2)
 
    return
  end subroutine meshfieldcommcubedom3d_exchange
 
!----------------------------
 
!OCL SERIAL
  subroutine push_localsendbuf( lc_send_buf, &
    send_buf, s_faceID, is, Nnode_LCMeshFace, bufsize_per_field, var_num, &
    lcmesh, haloSize_h1D )
    use scale_prc, only: prc_abort
    implicit none
    integer, intent(in) ::  nnode_lcmeshface
    integer, intent(in) :: bufsize_per_field
    integer, intent(in) :: var_num
    real(rp), intent(out) :: lc_send_buf(nnode_lcmeshface,var_num)
    real(rp), intent(in) :: send_buf(bufsize_per_field,var_num)  
    integer, intent(in) :: s_faceid, is
    type(localmesh3d), intent(in) :: lcmesh
    integer, intent(in) :: halosize_h1d
  
    integer :: ie
    integer :: vid, i
    class(elementbase3d), pointer :: e3d
    !-----------------------------------------------------------------------------
 
    if ( s_faceid > 0 ) then
      !$omp parallel do
      !$acc parallel loop collapse(2) present(lc_send_buf, send_buf) async(1)
      do vid=1, var_num
      do i=1, nnode_lcmeshface
        lc_send_buf(i,vid) = send_buf(is+i-1,vid)
      end do
      end do
    else
      log_info("MeshFieldCommCubeDom3D",'(a,i0)') "Encountered s_faceID <= 0 in push_localsendbuf. Check! s_faceID=", s_faceid
      call prc_abort
    end if 
    return
  end subroutine push_localsendbuf
end module scale_meshfieldcomm_cubedom3d