scale_meshfieldcomm_1d.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_meshfieldcomm_1d
 
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
 
  use scale_element_base, only: elementbase, elementbase1d
  use scale_mesh_base1d, only: meshbase1d
  use scale_meshfield_base, only: meshfield1d
  use scale_meshfieldcomm_base, only: &
    meshfieldcommbase,                               &
    meshfieldcommbase_init, meshfieldcommbase_final, &
    meshfieldcommbase_extract_bounddata,             &
    meshfieldcommbase_set_bounddata,                 &
    meshfieldcontainer
  use scale_localmesh_1d, only: localmesh1d
   
  !-----------------------------------------------------------------------------
  implicit none
  private
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedure
  ! 
 
 
  type, public, extends(meshfieldcommbase) :: meshfieldcomm1d
    class(meshbase1d), pointer :: mesh1d
  contains
    procedure, public :: init => meshfieldcomm1d_init
    procedure, public :: put => meshfieldcomm1d_put
    procedure, public :: get => meshfieldcomm1d_get
    procedure, public :: exchange => meshfieldcomm1d_exchange  
    procedure, public :: final => meshfieldcomm1d_final
  end type meshfieldcomm1d
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: push_localsendbuf
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  integer, parameter :: comm_face_num = 2
 
contains
  subroutine meshfieldcomm1d_init( this, &
    sfield_num, hvfield_num, mesh1d )
 
    implicit none
    
    class(meshfieldcomm1d), intent(inout) :: this
    integer, intent(in) :: sfield_num
    integer, intent(in) :: hvfield_num
    class(meshbase1d), intent(in), target :: mesh1d
 
    integer :: n
    integer :: nnode_lcmeshface(comm_face_num,mesh1d%local_mesh_num)
    !-----------------------------------------------------------------------------
    
    this%mesh1d => mesh1d 
    ! Dummy
    do n=1, this%mesh1d%LOCAL_MESH_NUM
      nnode_lcmeshface(:,n) = (/ 1, 1 /)
    end do
    
    call meshfieldcommbase_init( this, sfield_num, hvfield_num, 0, mesh1d%refElem1D%Nfp * 2, 2, nnode_lcmeshface, mesh1d)  
  
    return
  end subroutine meshfieldcomm1d_init
 
  subroutine meshfieldcomm1d_final( this )
    implicit none
    
    class(meshfieldcomm1d), intent(inout) :: this
    !-----------------------------------------------------------------------------
 
    call meshfieldcommbase_final( this )
 
    return
  end subroutine meshfieldcomm1d_final
 
  subroutine meshfieldcomm1d_put(this, field_list, varid_s)
    implicit none
    class(meshfieldcomm1d), intent(inout) :: this
    type(meshfieldcontainer), intent(in) :: field_list(:)
    integer, intent(in) :: varid_s
  
    integer :: i
    integer :: n
    type(localmesh1d), pointer :: mesh
    !-----------------------------------------------------------------------------
    
    do i=1, size(field_list)
    do n=1, this%mesh%LOCAL_MESH_NUM
      mesh => this%mesh1d%lcmesh_list(n)
      call meshfieldcommbase_extract_bounddata( field_list(i)%field1d%local(n)%val, mesh%refElem, mesh, & ! (in)
        this%send_buf(:,varid_s+i-1,n) )                                                                  ! (out)
    end do
    end do
 
    return
  end subroutine meshfieldcomm1d_put
 
  subroutine meshfieldcomm1d_get(this, field_list, varid_s)
    use scale_meshfieldcomm_base, only: &
      meshfieldcommbase_wait_core
    implicit none
    
    class(meshfieldcomm1d), intent(inout) :: this
    type(meshfieldcontainer), intent(inout) :: field_list(:)
    integer, intent(in) :: varid_s
 
    integer :: i
    integer :: n
    type(localmesh1d), pointer :: mesh
    !-----------------------------------------------------------------------------
    
    if ( this%call_wait_flag_sub_get ) &
      call meshfieldcommbase_wait_core( this, this%commdata_list )
 
    do i=1, size(field_list) 
    do n=1, this%mesh1D%LOCAL_MESH_NUM
      mesh => this%mesh1d%lcmesh_list(n)
      call meshfieldcommbase_set_bounddata( this%recv_buf(:,varid_s+i-1,n), mesh%refElem, mesh, & !(in)
        field_list(i)%field1d%local(n)%val )                                                      !(out)
    end do
    end do
 
    return
  end subroutine meshfieldcomm1d_get
 
!OCL SERIAL
  subroutine meshfieldcomm1d_exchange( this, do_wait )
    use scale_meshfieldcomm_base, only: &
      meshfieldcommbase_exchange_core,  &
      meshfieldcommbase_wait_core,      &
      localmeshcommdata
 
    implicit none
  
    class(meshfieldcomm1d), intent(inout), target :: this
    logical, intent(in), optional :: do_wait
  
    integer :: n, f
    type(localmesh1d), pointer :: mesh
    type(localmeshcommdata), pointer :: commdata
    !-----------------------------------------------------------------------------
 
    do n=1, this%mesh%LOCAL_MESH_NUM
    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, f,        &  ! (in)
        commdata%Nnode_LCMeshFace, this%field_num_tot)        ! (in)
    end do
    end do
 
    !-----------------------
 
    call meshfieldcommbase_exchange_core( this, this%commdata_list(:,:), do_wait )
 
    !---------------------
 
    return
  end subroutine meshfieldcomm1d_exchange
 
!----------------------------
 
  subroutine push_localsendbuf( lc_send_buf, send_buf, s_faceID, f, Nnode_LCMeshFace, var_num )
    implicit none
 
    integer, intent(in) :: var_num
    integer, intent(in) ::  nnode_lcmeshface
    real(rp), intent(inout) :: lc_send_buf(nnode_lcmeshface,var_num)
    real(rp), intent(in) :: send_buf(nnode_lcmeshface*2,var_num)  
    integer, intent(in) :: s_faceid, f
  
    integer :: is, ie, lincrement
    !-----------------------------------------------------------------------------
  
    if ( s_faceid > 0 ) then
      is = 1 + (f-1)*nnode_lcmeshface
      ie = is + nnode_lcmeshface - 1
      lincrement = +1          
    else
      is   = f*nnode_lcmeshface
      ie   = 1 + (f - 1)*nnode_lcmeshface          
      lincrement = -1          
    end if 
    lc_send_buf(:,:) = send_buf(is:ie:lincrement,:) 
    
    return
  end subroutine push_localsendbuf
 
end module scale_meshfieldcomm_1d