scale_meshfieldcomm_base Module Reference

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 recieving buffer.
subroutine, public	meshfieldcommbase_extract_bounddata_2 (field_list, dim, varid_s, lcmesh_list, 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 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 161 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
    !-----------------------------------------------------------------------------
 
    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
 
    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) )
 
      allocate( this%commdata_list(comm_face_num,mesh%LOCAL_MESH_NUM) )
      allocate( this%is_f(comm_face_num,mesh%LOCAL_MESH_NUM) ) 
 
      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
 
        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  
    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 224 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
      deallocate( this%send_buf, this%recv_buf )
      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     
      deallocate( this%commdata_list, this%is_f )
 
      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
 
    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 315 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
      !$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
          commdata_list(abs(lcommdata%s_faceID), lcommdata%s_tilelocalID)%recv_buf(:,:) &
            = lcommdata%send_buf(:,:)
        end if
      end do 
      end do
      !$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      
    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 395 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
!   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)
      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
    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)
      do n=1, this%mesh%LOCAL_MESH_NUM
      do var_id=1, this%field_num_tot
      do f=1, this%nfaces_comm
        this%recv_buf(irs(f,n):ire(f,n),var_id,n) = commdata_list(f,n)%recv_buf(:,var_id)
      end do ! end loop for face
      end do
      end do
    end if
!   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)
      !-----------------------------
      var(irs_:ire_) = recv_buf(:)
      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 recieving buffer.

Definition at line 502 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
!OCL PREFETCH
    do i=1, size(buf)
      buf(i) = var(mesh%VmapB(i))
    end do
    return

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

meshfieldcommbase_extract_bounddata_2()

subroutine, public scale_meshfieldcomm_base::meshfieldcommbase_extract_bounddata_2	(	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,
		real(rp), dimension(size(lcmesh_list(1)%vmapb),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 522 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(:)
    real(RP), intent(out) :: buf(size(lcmesh_list(1)%VmapB),size(field_list),size(lcmesh_list))
 
    class(LocalMeshBase), pointer :: lcmesh
    integer :: varid
    integer :: i, n
    !-----------------------------------------------------------------------------
 
    do n=1, size(lcmesh_list)
      lcmesh => lcmesh_list(n)
      i = 1
      do while( i <= size(field_list) )
        varid = varid_s + i - 1
        if ( i+1 <= n ) 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_bounddata( field_list(varid)%field1d%local(n)%val, lcmesh%refElem, lcmesh,  buf(:,varid,n) )
          else if(dim==2) then
            call meshfieldcommbase_extract_bounddata( field_list(varid)%field2d%local(n)%val, lcmesh%refElem, lcmesh,  buf(:,varid,n) )
          else if(dim==3) then
            call meshfieldcommbase_extract_bounddata( field_list(varid)%field3d%local(n)%val, lcmesh%refElem, lcmesh,  buf(:,varid,n) )
          end if
          i = i + 1
        end if
      end do
    end do
    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
      !-----------------------------
      !$omp parallel do
!OCL PREFETCH
      do ii=1, size(buf)
        buf1_(ii) = var1(lmesh%vmapB(ii))
        buf2_(ii) = var2(lmesh%vmapB(ii))
      end do
      return
    end subroutine extract_bounddata_var2

References meshfieldcommbase_extract_bounddata().

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 recieving buffer and set it to data array with MeshField object.

Definition at line 586 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)
    !-----------------------------------------------------------------------------
 
    var(refelem%Np*mesh%NeE+1:refelem%Np*mesh%NeE+size(buf)) = buf(:)
    return

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