scale_mesh_hierarchy_base.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!> module FElib / Mesh / Hierarchy base
!!
!! @par Description
!!      A base module to provide a mesh hierarchy
!!
!! @author Yuta Kawai, Team SCALE
!<
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_mesh_hierarchy_base
 
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  !
  use scale_precision
  use scale_io
 
  use scale_localmesh_base, only: localmeshbase
 
  !-----------------------------------------------------------------------------
  implicit none
  private
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedure
  ! 
 
  !> Base type to manage local mesh data for multigrid
  type, public :: meshhierarchylocalmgdatabase
    real(rp), allocatable :: ic2f(:,:,:)    !< Matrix for correction operation in h-MG
    integer, allocatable :: ic2f_emap(:)    !< Mapping of elements used for correction operation in h-MG
    integer, allocatable :: if2c_emap(:,:)  !< Mapping of elements used for restriction operation in h-MG
 
    integer, allocatable :: coarselocalmesh_tileidlist(:)
    integer, allocatable :: coarselocalmesh_lcdomidlist(:)
  end type meshhierarchylocalmgdatabase
  public :: meshhierarchylocalmgdatabase_init
  public :: meshhierarchylocalmgdatabase_final
 
  type, public :: meshhierarchylevelbase
    integer :: hierarchy_type
    integer :: level_id   = 0
  end type meshhierarchylevelbase
 
  !> Base type for mesh hierarchy
  type, public :: meshhierarchybase
    integer :: num_tot_level   !< Total number of levels
    integer :: num_hmg_level   !< Number of h-MG levels
    integer :: num_pmg_level   !< Number of p-MG levels
  contains
  end type meshhierarchybase
  public :: meshhierarchybase_init
  public :: meshhierarchybase_final
  
  public :: meshhierarchy_construct_pmg_mat1d
  
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  integer, public, parameter :: mesh_hierarchy_pmg_finest_level = 1  !< Finest level index in p-MG
  integer, public, parameter :: mesh_hierarchy_hmg_finest_level = 1  !< Finest level index in h-MG
 
  integer, public, parameter :: mesh_hierarchy_type_pmg         = 1  !< Type ID of mesh hierarchy: p-MG
  integer, public, parameter :: mesh_hierarchy_type_hmg         = 2  !< Type ID of mesh hierarchy: h-MG
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
contains
  !> Initialize a base object for mesh hierarchy
!OCL SERIAL
  subroutine meshhierarchybase_init( this, &
    p_LEVEL_NUM, &
    h_LEVEL_NUM  )
    implicit none
    class(meshhierarchybase), intent(inout) :: this
    integer, intent(in) :: p_level_num   !< Number of p-mesh levels
    integer, intent(in) :: h_level_num   !< Number of h-mesh levels
    !-------------------------------------------------------------
 
    this%NUM_TOT_LEVEL = 0
    this%NUM_hMG_LEVEL = h_level_num
    this%NUM_pMG_LEVEL = p_level_num
 
    this%NUM_TOT_LEVEL = this%NUM_hMG_LEVEL + this%NUM_pMG_LEVEL
    return
  end subroutine meshhierarchybase_init
 
  !> Finalize a base object for mesh hierarchy
!OCL SERIAL
  subroutine meshhierarchybase_final(this)
    implicit none
    class(meshhierarchybase), intent(inout) :: this
    !-------------------------------------------------------------
    return
  end subroutine meshhierarchybase_final
 
  !> Construct a 1D p-multigrid matrix used for transfer between different p-levels
!OCL SERIAL
  subroutine meshhierarchy_construct_pmg_mat1d( mat1D, np_i, np_o )
    use scale_polynomial, only: &
      polynomial_genlagrangepoly, &
      polynomial_gengausslegendrept,        &
      polynomial_gengausslegendreptintweight
    use scale_element_line, only: lineelement
    implicit none
    integer, intent(in) :: np_i               !< Number of points with input DOF
    integer, intent(in) :: np_o               !< Number of points with output DOF
    real(rp), intent(out) :: mat1d(np_o,np_i) !< Transfer matrix with p-MG
 
    type(lineelement) :: elem1d_i
    type(lineelement) :: elem1d_o
 
    real(rp), allocatable :: lag_i(:,:)
    real(rp), allocatable :: lag_o(:,:)
 
    integer :: np_int
    real(rp), allocatable :: int_w(:)
    real(rp), allocatable :: int_pts(:)
 
    integer :: pi, po
    !---------------------------------------------------------------------
 
    call elem1d_i%Init( np_i-1, .false. )
    call elem1d_o%Init( np_o-1, .false. )
 
    !-
    np_int = max(np_i,np_o)
    
    allocate( int_pts(np_int) )
    int_pts(:) = polynomial_gengausslegendrept(np_int)
 
    allocate( int_w(np_int) )     
    int_w(:) = polynomial_gengausslegendreptintweight(np_int)
 
    !-
    allocate( lag_i(np_int,np_i) )
    lag_i(:,:) = polynomial_genlagrangepoly(elem1d_i%PolyOrder, elem1d_i%x1, int_pts)
 
    allocate( lag_o(np_int,np_o) )
    lag_o(:,:) = polynomial_genlagrangepoly(elem1d_o%PolyOrder, elem1d_o%x1, int_pts)
 
    do pi=1, np_i
    do po=1, np_o
      mat1d(po,pi) = sum( int_w(:) * lag_i(:,pi) * lag_o(:,po) )
    end do
    end do
    mat1d(:,:) = matmul( elem1d_o%invM, mat1d )
 
    !-
    call elem1d_i%Final()
    call elem1d_o%Final()
 
    return
  end subroutine meshhierarchy_construct_pmg_mat1d
 
!-
  !> Initialize a base object to manage local multigrid data for mesh hierarchy
!OCL SERIAL
  subroutine meshhierarchylocalmgdatabase_init( this, &
    lcmesh )
    implicit none
    class(meshhierarchylocalmgdatabase), intent(inout) :: this
    class(localmeshbase), intent(in) :: lcmesh
    !-------------------------------------------------------------
 
    allocate( this%Ic2f(lcmesh%refElem%Np,lcmesh%refElem%Nv,lcmesh%NeA) )
    allocate( this%Ic2f_emap(lcmesh%Ne) )
 
    allocate( this%CoarseLocalMesh_tileIDlist(1) )
    allocate( this%CoarseLocalMesh_lcdomIDlist(1) )
    return
  end subroutine meshhierarchylocalmgdatabase_init
 
  !> Finalize a base object to manage local multigrid data for mesh hierarchy
!OCL SERIAL
  subroutine meshhierarchylocalmgdatabase_final( this )
    implicit none
    class(meshhierarchylocalmgdatabase), intent(inout) :: this
    !------------------------------------------------------------- 
    deallocate( this%Ic2f )
    deallocate( this%Ic2f_emap )
    deallocate( this%CoarseLocalMesh_tileIDlist )
    deallocate( this%CoarseLocalMesh_lcdomIDlist )
    return
  end subroutine meshhierarchylocalmgdatabase_final
end module scale_mesh_hierarchy_base