module FElib / Data / Communication base More...

Data Types
type	localmeshcommdata
	Derived type to manage data communication at a face between adjacent local meshes. More...
type	meshfieldcommbase
	Base derived type to manage data communication. More...
interface	meshfieldcommbase_put
type	meshfieldcontainer
	Container to save a pointer of MeshField(1D, 2D, 3D) object. More...

Functions/Subroutines
subroutine, public	meshfieldcommbase_init (this, sfield_num, hvfield_num, htensorfield_num, bufsize_per_field, comm_face_num, nnode_lcmeshface, mesh)
	Initialize a base object to manage data communication of fields.
subroutine, public	meshfieldcommbase_final (this)
	Finalize a base object to manage data communication of fields.
subroutine, public	meshfieldcommbase_exchange_core (this, commdata_list, do_wait)
	Exchange halo data.
subroutine, public	meshfieldcommbase_wait_core (this, commdata_list, field_list, dim, varid_s, lcmesh_list)
	Wait data communication and move tmp data of LocalMeshCommData object to a recv buffer.
subroutine, public	meshfieldcommbase_extract_bounddata (var, refelem, mesh, buf)
	Extract halo data from data array with MeshField object and set it to the receiving buffer.
subroutine, public	meshfieldcommbase_extract_bounddata2 (var, vmapb, vmapb_size, npxnea, buf)
	Extract halo data from data array with MeshField object and set it to the receiving buffer.
subroutine, public	meshfieldcommbase_extract_bounddata_2 (field_list, dim, varid_s, lcmesh_list, vmapb_size, buf)
	Extract halo data from data array with MeshField object and set it to the receiving buffer.
subroutine, public	meshfieldcommbase_extract_bounddata_3 (field_list, dim, varid_s, lcmesh_list, vmapb2, vmapb2_size, buf)
	Extract halo data from data array with MeshField object and set it to the recieving buffer.
subroutine, public	meshfieldcommbase_set_bounddata (buf, refelem, mesh, var)
	Extract halo data from the receiving buffer and set it to data array with MeshField object.
subroutine, public	meshfieldcommbase_set_bounddata_3 (buf, refelem, mesh, vmapb, vmapb_size, var)
	Extract halo data from the recieving buffer and set it to data array with MeshField object.

Detailed Description

module FElib / Data / Communication base

Description: Base module to manage data communication for element-based methods

Author: Yuta Kawai, Team SCALE

Function/Subroutine Documentation

◆ meshfieldcommbase_init()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_init	(	class(meshfieldcommbase), intent(inout)	this,
		integer, intent(in)	sfield_num,
		integer, intent(in)	hvfield_num,
		integer, intent(in)	htensorfield_num,
		integer, intent(in)	bufsize_per_field,
		integer, intent(in)	comm_face_num,
		integer, dimension(comm_face_num,mesh%local_mesh_num), intent(in)	nnode_lcmeshface,
		class(meshbase), intent(in), target	mesh )

Initialize a base object to manage data communication of fields.

Parameters

sfield_num	Number of scalar fields
hvfield_num	Number of horizontal vector fields
htensorfield_num	Number of horizontal tensor fields
bufsize_per_field	Buffer size per a field
comm_face_num	Number of faces on a local mesh which perform data communication
Nnode_LCMeshFace	Array to store the number of nodes

Definition at line 172 of file scale_meshfieldcomm_base.F90.

 
    implicit none
    
    class(MeshFieldCommBase), intent(inout) :: this
    class(Meshbase), intent(in), target :: mesh
    integer, intent(in) :: sfield_num
    integer, intent(in) :: hvfield_num
    integer, intent(in) :: htensorfield_num
    integer, intent(in) :: bufsize_per_field
    integer, intent(in) :: comm_face_num
    integer, intent(in) :: Nnode_LCMeshFace(comm_face_num,mesh%LOCAL_MESH_NUM)
 
    integer :: n, f
    class(LocalMeshBase), pointer :: lcmesh
    !-----------------------------------------------------------------------------
 
    !$acc enter data create(this)
    this%mesh => mesh
    this%sfield_num = sfield_num
    this%hvfield_num = hvfield_num
    this%htensorfield_num = htensorfield_num
    this%field_num_tot = sfield_num + hvfield_num*2 + htensorfield_num*4
    this%nfaces_comm = comm_face_num
    !$acc update device(this%sfield_num, this%hvfield_num, this%htensorfield_num, this%field_num_tot, this%nfaces_comm)
    !$acc enter data attach(this%mesh)
 
    if (this%field_num_tot > 0) then
      allocate( this%send_buf(bufsize_per_field, this%field_num_tot, mesh%LOCAL_MESH_NUM) )
      allocate( this%recv_buf(bufsize_per_field, this%field_num_tot, mesh%LOCAL_MESH_NUM) )
      allocate( this%request_send(comm_face_num*mesh%LOCAL_MESH_NUM) )
      allocate( this%request_recv(comm_face_num*mesh%LOCAL_MESH_NUM) )
      !$acc enter data create(this%send_buf, this%recv_buf, this%request_send, this%request_recv)
 
      allocate( this%commdata_list(comm_face_num,mesh%LOCAL_MESH_NUM) )
      allocate( this%is_f(comm_face_num,mesh%LOCAL_MESH_NUM) ) 
      allocate( this%Nnode_LCMeshAllFace(mesh%LOCAL_MESH_NUM) )
      !$acc enter data create(this%is_f, this%Nnode_LCMeshAllFace)
 
      do n=1, mesh%LOCAL_MESH_NUM
        this%is_f(1,n) = 1
        do f=2, this%nfaces_comm
          this%is_f(f,n) = this%is_f(f-1,n) + nnode_lcmeshface(f-1,n)
        end do
        this%Nnode_LCMeshAllFace(n) = sum(nnode_lcmeshface(:,n))
 
        call mesh%GetLocalMesh(n, lcmesh)
        do f=1, this%nfaces_comm
          call this%commdata_list(f,n)%Init( this, lcmesh, f, nnode_lcmeshface(f,n) )
        end do
      end do
      !$acc update device(this%is_f, this%Nnode_LCMeshAllFace)
      !$acc enter data copyin(this%commdata_list)
#ifdef _OPENACC
      do n=1, mesh%LOCAL_MESH_NUM
      do f=1, this%nfaces_comm
        call localmeshcommdata_setupforgpu( this%commdata_list(f,n) )
      end do
      end do
#endif
    end if 
 
    this%MPI_pc_flag = .false.
 
    obj_ind = obj_ind + 1
    if ( obj_ind > obj_index_max ) then
      log_error("MeshFieldCommBase_Init",*) 'obj_ind > OBJ_INDEX_MAX. Check!'
      call prc_abort
    end if
    this%obj_ind = obj_ind
    
    return

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_final()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_final ( class(meshfieldcommbase), intent(inout) this )

Finalize a base object to manage data communication of fields.

Definition at line 251 of file scale_meshfieldcomm_base.F90.

    implicit none
    
    class(MeshFieldCommBase), intent(inout) :: this
 
    integer :: n, f
    integer :: ireq
    integer :: ierr
    !-----------------------------------------------------------------------------
 
    if (this%field_num_tot > 0) then
      !$acc exit data delete(this%send_buf, this%recv_buf)
      deallocate( this%send_buf, this%recv_buf )
      !$acc exit data delete(this%request_send, this%request_recv)
      deallocate( this%request_send, this%request_recv )
 
      do n=1, this%mesh%LOCAL_MESH_NUM
      do f=1, this%nfaces_comm
        call this%commdata_list(f,n)%Final()
      end do
      end do     
      !$acc exit data delete(this%commdata_list, this%is_f, this%Nnode_LCMeshAllFace)
      deallocate( this%commdata_list, this%is_f, this%Nnode_LCMeshAllFace )
 
      if ( this%MPI_pc_flag ) then
        do ireq=1, this%req_counter
          call mpi_request_free( this%request_pc(ireq), ierr )
        end do           
        deallocate( this%request_pc ) 
      end if
    end if
 
    if ( allocated(this%VMapB_size) ) then
      !$acc exit data delete(this%VMapB_size)
      deallocate(this%VMapB_size)
    end if
    if ( this%use_vmap_wide_flag ) then
      !$acc exit data delete(this%VMapB2)
      deallocate( this%VMapB2 )
    end if
 
    return

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_exchange_core()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_exchange_core	(	class(meshfieldcommbase), intent(inout)	this,
		type(localmeshcommdata), dimension(this%nfaces_comm, this%mesh%local_mesh_num), intent(inout), target	commdata_list,
		logical, intent(in), optional	do_wait )

Exchange halo data.

Parameters

commdata_list	Array of LocalMeshCommData objects which manage information and halo data
do_wait	Flag whether MPI_waitall is called and move tmp data of LocalMeshCommData object to a recv buffer

Definition at line 354 of file scale_meshfieldcomm_base.F90.

#ifdef __FUJITSU
     use mpi_ext, only: &
       fjmpi_prequest_startall
#endif
!    use mpi, only: &
!      MPI_startall
    use scale_prof
    implicit none
  
    class(MeshFieldCommBase), intent(inout) :: this
    type(LocalMeshCommData), intent(inout), target :: commdata_list(this%nfaces_comm, this%mesh%LOCAL_MESH_NUM)
    logical, intent(in), optional :: do_wait
  
    integer :: n, f    
    integer :: ierr
    logical :: do_wait_
 
    integer :: i
    type(LocalMeshCommData), pointer :: lcommdata
    !-----------------------------------------------------------------------------
 
    if ( present(do_wait) ) then
      do_wait_ = do_wait
    else
      do_wait_ = .true.
    end if    
    
!    call PROF_rapstart( 'meshfiled_comm_ex_core', 3)
    !
    if ( this%MPI_pc_flag ) then
#ifdef _OPENACC
      do n=1, this%mesh%LOCAL_MESH_NUM      
      do f=1, this%nfaces_comm
        lcommdata => commdata_list(f,n)
        if ( lcommdata%s_rank /= lcommdata%lcmesh%PRC_myrank ) then
          !$acc update host(lcommdata%send_buf) async(1)
        end if
      end do
      end do
      !$acc wait(1)
 
#endif
      !$omp parallel
      !$omp master
      if ( this%use_mpi_pc_fujitsu_ext ) then
#ifdef __FUJITSU
        ! Use Fujitsu MPI extension for persistent communication
        call fjmpi_prequest_startall( this%req_counter, this%request_pc(1:this%req_counter), ierr )
#endif
      else
        call mpi_startall( this%req_counter, this%request_pc(1:this%req_counter), ierr )
      end if
      !$omp end master
      
      !$omp do collapse(2) private(lcommdata)
      do n=1, this%mesh%LOCAL_MESH_NUM      
      do f=1, this%nfaces_comm
        lcommdata => commdata_list(f,n)
        if ( lcommdata%s_rank == lcommdata%lcmesh%PRC_myrank ) then
#ifdef _OPENACC
          call set_recvbuf_from_sendbuf_lc( commdata_list(abs(lcommdata%s_faceID), lcommdata%s_tilelocalID)%recv_buf, &
                  lcommdata%send_buf, size(lcommdata%send_buf) )          
#else
          commdata_list(abs(lcommdata%s_faceID), lcommdata%s_tilelocalID)%recv_buf(:,:) &
            = lcommdata%send_buf(:,:)
#endif
        end if
      end do 
      end do
      !$acc wait(1)
      !$omp end parallel
    else
      this%req_counter = 0
      do n=1, this%mesh%LOCAL_MESH_NUM      
      do f=1, this%nfaces_comm
        call commdata_list(f,n)%SendRecv( &
          this%req_counter, this%request_send, this%request_recv, & ! (inout)
          commdata_list                                           ) ! (inout) 
      end do
      end do
      !$acc wait(1)
    end if
 
!    call PROF_rapend( 'meshfiled_comm_ex_core', 3)
 
    if ( do_wait_ ) then
      call meshfieldcommbase_wait_core( this, commdata_list )
      this%call_wait_flag_sub_get = .false.
    else
      this%call_wait_flag_sub_get = .true.
    end if
 
    return

References meshfieldcommbase_wait_core().

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_wait_core()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_wait_core	(	class(meshfieldcommbase), intent(inout)	this,
		type(localmeshcommdata), dimension(this%nfaces_comm, this%mesh%local_mesh_num), intent(inout), target	commdata_list,
		type(meshfieldcontainer), dimension(:), intent(inout), optional	field_list,
		integer, intent(in), optional	dim,
		integer, intent(in), optional	varid_s,
		class(localmeshbase), dimension(:), intent(in), optional, target	lcmesh_list )

Wait data communication and move tmp data of LocalMeshCommData object to a recv buffer.

Parameters

commdata_list Array of LocalMeshCommData objects which manage information and halo data

Definition at line 454 of file scale_meshfieldcomm_base.F90.

    use mpi, only: &
!      MPI_waitall,    &
      mpi_status_size
    use scale_prof
    implicit none
  
    class(MeshFieldCommBase), intent(inout) :: this
    type(LocalMeshCommData), intent(inout), target :: commdata_list(this%nfaces_comm, this%mesh%LOCAL_MESH_NUM)
    type(MeshFieldContainer), intent(inout), optional :: field_list(:)
    integer, intent(in), optional :: dim
    integer, intent(in), optional :: varid_s
    class(LocalMeshBase), intent(in), optional, target :: lcmesh_list(:)
 
    integer :: ierr
    integer :: stat_send(MPI_STATUS_SIZE, this%req_counter)
    integer :: stat_recv(MPI_STATUS_SIZE, this%req_counter)
    integer :: stat_pc(MPI_STATUS_SIZE, this%req_counter)
 
    integer :: n, f
    integer :: i, var_id
    integer :: irs(this%nfaces_comm,this%mesh%LOCAL_MESH_NUM), ire(this%nfaces_comm,this%mesh%LOCAL_MESH_NUM)
 
    class(LocalMeshBase), pointer :: lcmesh
    integer :: val_size(this%mesh%LOCAL_MESH_NUM)
    !----------------------------
 
!   call PROF_rapstart( 'meshfiled_comm_wait_core', 2)
    if ( this%MPI_pc_flag ) then
      if (this%req_counter > 0) then
        call mpi_waitall( this%req_counter, this%request_pc(1:this%req_counter), stat_pc, ierr )
      end if
    else
      if ( this%req_counter > 0 ) then
        call mpi_waitall( this%req_counter, this%request_recv(1:this%req_counter), stat_recv, ierr )
        call mpi_waitall( this%req_counter, this%request_send(1:this%req_counter), stat_send, ierr )
      end if
    end if
 
#ifdef _OPENACC
    do n=1, this%mesh%LOCAL_MESH_NUM
    do f=1, this%nfaces_comm
        if ( commdata_list(f,n)%s_rank /= commdata_list(f,n)%lcmesh%PRC_myrank ) then
          !$acc update device( commdata_list(f,n)%recv_buf ) async(1)
        end if
    end do
    end do
#endif
 
!   call PROF_rapend( 'meshfiled_comm_wait_core', 2)
  
    !---------------------
 
!   call PROF_rapstart( 'meshfiled_comm_wait_post', 2)
 
    if ( present(field_list) ) then
      do n=1, this%mesh%LOCAL_MESH_NUM
        lcmesh => lcmesh_list(n)
        val_size(n) = lcmesh%refElem%Np * lcmesh%NeA
        irs(1,n) = lcmesh%refElem%Np * lcmesh%Ne + 1
        do f=1, this%nfaces_comm
          ire(f,n) = irs(f,n) + commdata_list(f,n)%Nnode_LCMeshFace - 1
          if (f<this%nfaces_comm) irs(f+1,n) = ire(f,n) + 1
        end do
      end do
      
      !$omp parallel do private(var_id,n,i,f) collapse(3)
      !$acc parallel loop gang collapse(3) present(field_list, commdata_list) copyin(irs, ire, val_size) async(1)
      do n=1, this%mesh%LOCAL_MESH_NUM
      do i=1, size(field_list)
      do f=1, this%nfaces_comm
        var_id = varid_s + i - 1
 
        if (dim==1) then
          call set_bounddata( field_list(var_id)%field1d%local(n)%val, val_size(n), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
        else if (dim==2) then
          call set_bounddata( field_list(var_id)%field2d%local(n)%val, val_size(n), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
        else if (dim==3) then
          call set_bounddata( field_list(var_id)%field3d%local(n)%val, val_size(n), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
        end if
      end do ! end loop for face
      end do
      end do
#ifdef _OPENACC
      do n=1, this%mesh%LOCAL_MESH_NUM
      do i=1, size(field_list)
      do f=1, this%nfaces_comm
        var_id = varid_s + i - 1
        if (dim==1) then
          !$acc update device( field_list(var_id)%field1d%local(n)%val(irs(f,n):ire(f,n)) ) async(1)
        else if (dim==2) then
          !$acc update device( field_list(var_id)%field2d%local(n)%val(irs(f,n):ire(f,n)) ) async(1)
        else if (dim==3) then
          !$acc update device( field_list(var_id)%field3d%local(n)%val(irs(f,n):ire(f,n)) ) async(1)
        end if
      end do ! end loop for face
      end do
      end do
#endif
 
    else
      
      do n=1, this%mesh%LOCAL_MESH_NUM
        irs(1,n) = 1
        do f=1, this%nfaces_comm
          ire(f,n) = irs(f,n) + commdata_list(f,n)%Nnode_LCMeshFace - 1
          if (f<this%nfaces_comm) irs(f+1,n) = ire(f,n) + 1
        end do
      end do
 
      !$omp parallel do private(n,var_id,f) collapse(3)
      !$acc parallel loop gang collapse(3) present(this%recv_buf, commdata_list) copyin(irs, ire) async(1)
      do n=1, this%mesh%LOCAL_MESH_NUM
      do var_id=1, this%field_num_tot
      do f=1, this%nfaces_comm
#ifdef _OPENACC
        call set_bounddata( this%recv_buf(:,var_id,n), size(this%recv_buf(:,var_id,n)), irs(f,n), ire(f,n), commdata_list(f,n)%recv_buf(:,var_id) )
#else        
        this%recv_buf(irs(f,n):ire(f,n),var_id,n) = commdata_list(f,n)%recv_buf(:,var_id)
#endif
      end do ! end loop for face
      end do
      end do
    end if
 
    !$acc wait(1)
!   call PROF_rapend( 'meshfiled_comm_wait_post', 2)
    return
  contains
!OCL SERIAL
    subroutine set_bounddata( var, IA, irs_, ire_, recv_buf )
      implicit none
      integer, intent(in) :: IA
      real(RP), intent(inout) :: var(IA)
      integer, intent(in) :: irs_, ire_
      real(RP), intent(in) :: recv_buf(ire_-irs_+1)
 
      integer :: ii
      !-----------------------------
      !$acc routine vector
 
      !$acc loop vector
      do ii=1, size(recv_buf)
        var(irs_+ii-1) = recv_buf(ii)
      end do
      return
    end subroutine set_bounddata

References set_bounddata().

Referenced by meshfieldcommbase_exchange_core(), and scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_extract_bounddata()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_extract_bounddata	(	real(rp), dimension(refelem%np * mesh%nea), intent(in)	var,
		class(elementbase), intent(in)	refelem,
		class(localmeshbase), intent(in)	mesh,
		real(rp), dimension(size(mesh%vmapb)), intent(out)	buf )

Extract halo data from data array with MeshField object and set it to the receiving buffer.

Definition at line 606 of file scale_meshfieldcomm_base.F90.

    implicit none
  
    class(ElementBase), intent(in) :: refElem
    class(LocalMeshBase), intent(in) :: mesh
    real(RP), intent(in) :: var(refElem%Np * mesh%NeA)
    real(RP), intent(out) :: buf(size(mesh%VmapB))
 
    integer :: i
    !-----------------------------------------------------------------------------
    !$omp parallel do
    !$acc parallel loop present(var, mesh%VmapB, buf)
!OCL PREFETCH
    do i=1, size(buf)
      buf(i) = var(mesh%VmapB(i))
    end do
    return

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_extract_bounddata2()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_extract_bounddata2	(	real(rp), dimension(npxnea), intent(in)	var,
		integer, dimension(vmapb_size), intent(in)	vmapb,
		integer, intent(in)	vmapb_size,
		integer, intent(in)	npxnea,
		real(rp), dimension(vmapb_size), intent(out)	buf )

Extract halo data from data array with MeshField object and set it to the receiving buffer.

Definition at line 627 of file scale_meshfieldcomm_base.F90.

    implicit none
    integer, intent(in) :: VMapB_size
    integer, intent(in) :: NpxNeA
    real(RP), intent(in) :: var(NpxNeA)
    integer, intent(in) :: VMapB(VMapB_size)
    real(RP), intent(out) :: buf(VMapB_size)
 
    integer :: i
    !-----------------------------------------------------------------------------
    !$omp parallel do
    !$acc parallel loop present(var, VmapB, buf) async(1)
!OCL PREFETCH
    do i=1, size(buf)
      buf(i) = var(vmapb(i))
    end do
    return

Referenced by meshfieldcommbase_extract_bounddata_2(), meshfieldcommbase_extract_bounddata_3(), and scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_extract_bounddata_2()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_extract_bounddata_2	(	type(meshfieldcontainer), dimension(:), intent(in), target	field_list,
		integer, intent(in)	dim,
		integer, intent(in)	varid_s,
		class(localmeshbase), dimension(:), intent(in), target	lcmesh_list,
		integer, intent(in)	vmapb_size,
		real(rp), dimension(vmapb_size,size(field_list),size(lcmesh_list)), intent(out)	buf )

Extract halo data from data array with MeshField object and set it to the receiving buffer.

Note: We assume that the size of VmapB is the same for all local meshes. For the future, this subroutine should be modified to handle the case with different sizes of VmapB among local meshes.

Parameters

[in]	varid_s	Starting variable ID to extract halo data
[in]	dim	Number of dimensions of the field (1, 2, or 3)
[in]	lcmesh_list	Array of local mesh objects to extract halo data
[in]	vmapb_size	Size of VmapB (we assume that the size of VmapB is the same for all local meshes)

Definition at line 652 of file scale_meshfieldcomm_base.F90.

    implicit none
    type(MeshFieldContainer), intent(in), target :: field_list(:)
    integer, intent(in) :: varid_s                                               !< Starting variable ID to extract halo data
    integer, intent(in) :: dim                                                   !< Number of dimensions of the field (1, 2, or 3)
    class(LocalMeshBase), intent(in), target :: lcmesh_list(:)                   !< Array of local mesh objects to extract halo data
    integer, intent(in) :: vmapB_size                                            !< Size of VmapB (we assume that the size of VmapB is the same for all local meshes)
    real(RP), intent(out) :: buf(vmapB_size,size(field_list),size(lcmesh_list))
 
    class(LocalMeshBase), pointer :: lcmesh
    integer :: varid
    integer :: i, n
 
    integer :: field_num
    !-----------------------------------------------------------------------------
 
    field_num = size(field_list)
 
    do n=1, size(lcmesh_list)
      lcmesh => lcmesh_list(n)
      i = 1
      do while( i <= field_num )
        varid = varid_s + i - 1
        if ( i+1 <= field_num ) then
          if (dim==1) then
            call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), field_list(varid)%field1d%local(n)%val, field_list(varid+1)%field1d%local(n)%val, lcmesh, lcmesh%refElem )
          else if(dim==2) then
            call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), field_list(varid)%field2d%local(n)%val, field_list(varid+1)%field2d%local(n)%val, lcmesh, lcmesh%refElem )
          else if(dim==3) then
            call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), field_list(varid)%field3d%local(n)%val, field_list(varid+1)%field3d%local(n)%val, lcmesh, lcmesh%refElem )
          end if
          i = i + 2
        else
          if (dim==1) then
            call meshfieldcommbase_extract_bounddata2( field_list(varid)%field1d%local(n)%val, lcmesh%VMapB, size(lcmesh%VMapB), lcmesh%refElem%Np*lcmesh%NeA,  buf(:,varid,n) )
          else if(dim==2) then
            call meshfieldcommbase_extract_bounddata2( field_list(varid)%field2d%local(n)%val, lcmesh%VMapB, size(lcmesh%VMapB), lcmesh%refElem%Np*lcmesh%NeA,  buf(:,varid,n) )
          else if(dim==3) then
            call meshfieldcommbase_extract_bounddata2( field_list(varid)%field3d%local(n)%val, lcmesh%VMapB, size(lcmesh%VMapB), lcmesh%refElem%Np*lcmesh%NeA,  buf(:,varid,n) )
          end if
          i = i + 1
        end if
      end do
      !!$acc update host( buf(:,varid_s:field_num,n) )
    end do
    !$acc wait(1)
 
    return
  contains
!OCL SERIAL
    subroutine extract_bounddata_var2( buf1_, buf2_, var1, var2, lmesh, elem )
      implicit none
      class(LocalMeshBase), intent(in) :: lmesh
      class(ElementBase), intent(in) :: elem
      real(RP), intent(out) :: buf1_(size(lmesh%VMapB))
      real(RP), intent(out) :: buf2_(size(lmesh%VMapB))
      real(RP), intent(inout) :: var1(elem%Np*lmesh%NeA)
      real(RP), intent(inout) :: var2(elem%Np*lmesh%NeA)
 
      integer :: ii, b
      !-----------------------------
      !$omp parallel do
      !$acc parallel loop present(buf1_, buf2_, var1, var2, lmesh%vmapB) async(1)
!OCL PREFETCH
      do ii=1, size(buf1_)
        b = lmesh%vmapB(ii)
        buf1_(ii) = var1(b)
        buf2_(ii) = var2(b)
      end do
      return
    end subroutine extract_bounddata_var2

References meshfieldcommbase_extract_bounddata2().

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_extract_bounddata_3()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_extract_bounddata_3	(	class(meshfieldcontainer), dimension(:), intent(in), target	field_list,
		integer, intent(in)	dim,
		integer, intent(in)	varid_s,
		class(localmeshbase), dimension(:), intent(in), target	lcmesh_list,
		integer, dimension(vmapb2_size), intent(in)	vmapb2,
		integer, intent(in)	vmapb2_size,
		real(rp), dimension(vmapb2_size,size(field_list),size(lcmesh_list)), intent(out)	buf )

Extract halo data from data array with MeshField object and set it to the recieving buffer.

Definition at line 727 of file scale_meshfieldcomm_base.F90.

    implicit none
    class(MeshFieldContainer), intent(in), target :: field_list(:)
    integer, intent(in) :: varid_s
    integer, intent(in) :: dim
    class(LocalMeshBase), intent(in), target :: lcmesh_list(:)
    integer, intent(in) :: VMapB2_size
    integer, intent(in) :: VMapB2(VMapB2_size)
    real(RP), intent(out) :: buf(VMapB2_size,size(field_list),size(lcmesh_list))
 
    class(LocalMeshBase), pointer :: lcmesh
    integer :: varid
    integer :: i, n
 
    integer :: field_num
    !-----------------------------------------------------------------------------
 
    field_num = size(field_list)
 
    do n=1, size(lcmesh_list)
      lcmesh => lcmesh_list(n)
      i = 1
      do while( i <= field_num )
        varid = varid_s + i - 1
        if ( i+1 <= field_num ) then
          if (dim==1) then
            call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), &
              vmapb2, vmapb2_size, field_list(varid)%field1d%local(n)%val, field_list(varid+1)%field1d%local(n)%val, lcmesh%refElem%Np * lcmesh%NeA )
          else if(dim==2) then
            call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), &
              vmapb2, vmapb2_size, field_list(varid)%field2d%local(n)%val, field_list(varid+1)%field2d%local(n)%val, lcmesh%refElem%Np * lcmesh%NeA )
          else if(dim==3) then
            call extract_bounddata_var2( buf(:,varid,n), buf(:,varid+1,n), &
              vmapb2, vmapb2_size, field_list(varid)%field3d%local(n)%val, field_list(varid+1)%field3d%local(n)%val, lcmesh%refElem%Np * lcmesh%NeA )
          end if
          i = i + 2
        else
          if (dim==1) then
            call meshfieldcommbase_extract_bounddata2( field_list(varid)%field1d%local(n)%val, vmapb2, vmapb2_size, lcmesh%refElem%Np*lcmesh%NeA,  &
              buf(:,varid,n) )
          else if(dim==2) then
            call meshfieldcommbase_extract_bounddata2( field_list(varid)%field2d%local(n)%val, vmapb2, vmapb2_size, lcmesh%refElem%Np*lcmesh%NeA,  &
              buf(:,varid,n) )
          else if(dim==3) then
            call meshfieldcommbase_extract_bounddata2( field_list(varid)%field3d%local(n)%val, vmapb2, vmapb2_size, lcmesh%refElem%Np*lcmesh%NeA,  &
              buf(:,varid,n) )
          end if
          i = i + 1
        end if
      end do
    end do
    return
  contains
!OCL SERIAL
    subroutine extract_bounddata_var2( buf1_, buf2_, VMapB, VMapB_size, var1, var2, varSize )
      implicit none
      integer, intent(in) :: vmapB_size
      real(RP), intent(out) :: buf1_(vmapB_size)
      real(RP), intent(out) :: buf2_(vmapB_size)
      integer, intent(in) :: vmapB(vmapB_size)
      integer, intent(in) :: varSize
      real(RP), intent(inout) :: var1(varSize)
      real(RP), intent(inout) :: var2(varSize)
 
      integer :: ii
      !-----------------------------
      !$omp parallel do
!OCL PREFETCH
      do ii=1, vmapb_size
        buf1_(ii) = var1(vmapb(ii))
        buf2_(ii) = var2(vmapb(ii))
      end do
      return
    end subroutine extract_bounddata_var2

References meshfieldcommbase_extract_bounddata2().

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_set_bounddata()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_set_bounddata	(	real(rp), dimension(size(mesh%vmapb)), intent(in)	buf,
		class(elementbase), intent(in)	refelem,
		class(localmeshbase), intent(in)	mesh,
		real(rp), dimension(refelem%np * mesh%nea), intent(inout)	var )

Extract halo data from the receiving buffer and set it to data array with MeshField object.

Definition at line 804 of file scale_meshfieldcomm_base.F90.

    implicit none
    
    class(ElementBase), intent(in) :: refElem
    class(LocalMeshBase), intent(in) :: mesh
    real(RP), intent(in) :: buf(size(mesh%VmapB))
    real(RP), intent(inout) :: var(refElem%Np * mesh%NeA)
 
    integer :: ii, iis
    !-----------------------------------------------------------------------------
 
#ifdef _OPENACC
     iis = refelem%Np*mesh%NeE
     !$acc parallel loop present(buf, var) async(1)
     do ii=1, size(buf)
       var(iis+ii) = buf(ii)
     end do
#else
    var(refelem%Np*mesh%NeE+1:refelem%Np*mesh%NeE+size(buf)) = buf(:)
#endif
    return

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

◆ meshfieldcommbase_set_bounddata_3()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_set_bounddata_3	(	real(rp), dimension(vmapb_size), intent(in)	buf,
		class(elementbase), intent(in)	refelem,
		class(localmeshbase), intent(in)	mesh,
		integer, dimension(vmapb_size), intent(in)	vmapb,
		integer, intent(in)	vmapb_size,
		real(rp), dimension(refelem%np * mesh%nea), intent(inout)	var )

Extract halo data from the recieving buffer and set it to data array with MeshField object.

Definition at line 828 of file scale_meshfieldcomm_base.F90.

    implicit none
    
    class(ElementBase), intent(in) :: refElem
    class(LocalMeshBase), intent(in) :: mesh
    integer, intent(in) :: vmapB_size
    integer, intent(in) :: vmapB(vmapB_size)
    real(RP), intent(in) :: buf(vmapB_size)
    real(RP), intent(inout) :: var(refElem%Np * mesh%NeA)
    !-----------------------------------------------------------------------------
 
    var(refelem%Np*mesh%NeE+1:refelem%Np*mesh%NeE+size(buf)) = buf(:)
    return

Referenced by scale_meshfieldcomm_base::meshfieldcommbase::prepare_pc().

Data Types

Functions/Subroutines

Detailed Description

Function/Subroutine Documentation

◆ meshfieldcommbase_init()

◆ meshfieldcommbase_final()

◆ meshfieldcommbase_exchange_core()

◆ meshfieldcommbase_wait_core()

◆ meshfieldcommbase_extract_bounddata()

◆ meshfieldcommbase_extract_bounddata2()

◆ meshfieldcommbase_extract_bounddata_2()

◆ meshfieldcommbase_extract_bounddata_3()

◆ meshfieldcommbase_set_bounddata()

◆ meshfieldcommbase_set_bounddata_3()