scale_multigrid_fieldset_base.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!> module FElib / Multigrid / Field set base
!!
!! @par Description
!!      Manage field sets for multigrid method
!!
!! @author Yuta Kawai, Team SCALE
!<
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_multigrid_fieldset_base
 
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  !
  use scale_precision
  use scale_io
  use scale_prc, only: prc_abort
 
  use scale_sparsemat, only: sparsemat
 
  use scale_element_base, only: elementbase2d
  use scale_element_quadrilateral, only: quadrilateralelement
 
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: meshbase3d
  use scale_mesh_rectdom2d, only: meshrectdom2d
  use scale_mesh_cubedspheredom2d, only: meshcubedspheredom2d
  use scale_mesh_cubedom3d, only: meshcubedom3d
  use scale_mesh_cubedspheredom3d, only: meshcubedspheredom3d
 
  use scale_meshfield_base, only: &
    meshfield2d, meshfield3d
  use scale_meshfieldcomm_base, only: meshfieldcommbase
  use scale_meshfieldcomm_rectdom2d, only: meshfieldcommrectdom2d
  use scale_meshfieldcomm_cubedspheredom2d, only: meshfieldcommcubedspheredom2d
  use scale_meshfieldcomm_cubedom3d, only: meshfieldcommcubedom3d
  use scale_meshfieldcomm_cubedspheredom3d, only: meshfieldcommcubedspheredom3d
 
  !-----------------------------------------------------------------------------
  implicit none
  private
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedure
  ! 
 
  !> Base type for multigrid field set
  type :: mgfieldbase
    integer :: var_num   !< Number of variables
    integer :: level_id  !< Level ID in multigrid hierarchy
 
    integer :: aux_var_num_tot !< Total number of auxiliary variables
 
    class(MeshFieldCommBase), pointer :: var_comm_ptr !< Pointer to communicator for main variables
    class(MeshFieldCommBase), pointer :: aux_comm_ptr !< Pointer to communicator for auxiliary variables
  end type mgfieldbase
 
  !> Derived type for 2D multigrid field set
  type, extends(mgfieldbase), public :: mgfieldset2d
    type(meshfield2d) :: dq
    type(meshfield2d) :: f
    type(meshfield2d) :: res
    type(meshfield2d), allocatable :: aux_var(:)
 
    type(sparsemat) :: dx
    type(sparsemat) :: dy
    type(sparsemat) :: lift
  contains
    procedure :: init => mgfieldset2d_init
    procedure :: final => mgfieldset2d_final
  end type mgfieldset2d
 
  !> Derived type for 3D multigrid field set
  type, extends(mgfieldbase), public :: mgfieldset3d
    type(meshfield3d) :: dq
    type(meshfield3d) :: f
    type(meshfield3d) :: res
    type(meshfield3d), allocatable :: aux_var(:)
 
    type(sparsemat) :: dx
    type(sparsemat) :: dy
    type(sparsemat) :: dz
    type(sparsemat) :: lift
  contains
    procedure :: init => mgfieldset3d_init
    procedure :: final => mgfieldset3d_final
  end type mgfieldset3d
 
contains
 
!- 2D
  !> Initialize an object to manage multigrid field set in 2D
!OCL SERIAL
  subroutine mgfieldset2d_init(this, mesh2D, aux_scalar_num, aux_vec_num, level_id)
    use scale_mesh_rectdom2d, only: meshrectdom2d
    implicit none
    class(mgfieldset2d), intent(inout), target :: this
    class(meshbase2d), intent(in) :: mesh2D
    integer, intent(in) :: aux_scalar_num
    integer, intent(in) :: aux_vec_num
    integer, intent(in) :: level_id
 
    integer :: iv
 
    type(meshfieldcommrectdom2d), pointer :: var_comm2D
    type(meshfieldcommrectdom2d), pointer :: aux_comm2D
 
    type(meshfieldcommcubedspheredom2d), pointer :: var_comm2D_cs
    type(meshfieldcommcubedspheredom2d), pointer :: aux_comm2D_cs
    !---------------------------------
 
    this%level_id = level_id
    
    call this%dq%Init( "dq", "1", mesh2d )    
    call this%f%Init( "f", "1", mesh2d )
    call this%res%Init( "res", "1", mesh2d )
 
    this%aux_var_num_tot = aux_scalar_num + 2*aux_vec_num
    if ( this%aux_var_num_tot > 0 ) then
      allocate( this%aux_var(this%aux_var_num_tot) )
      do iv=1, this%aux_var_num_tot
        call this%aux_var(iv)%Init( "aux_var", "1", mesh2d )
      end do
    end if
    
    select type(mesh2d)
    type is (meshrectdom2d)
      allocate(var_comm2d)
      call var_comm2d%Init( 1, 0, 0, mesh2d )
      this%var_comm_ptr => var_comm2d
    type is (meshcubedspheredom2d)
      allocate(var_comm2d_cs)
      call var_comm2d_cs%Init( 1, 0, 0, mesh2d )
      this%var_comm_ptr => var_comm2d_cs
    end select
 
    if ( this%aux_var_num_tot > 0 ) then
      select type(mesh2d)
      type is (meshrectdom2d)
        allocate( aux_comm2d )
        call aux_comm2d%Init( aux_scalar_num, aux_vec_num, 0, mesh2d )
        this%aux_comm_ptr => aux_comm2d
      type is (meshcubedspheredom2d)
        allocate( aux_comm2d_cs )
        call aux_comm2d_cs%Init( aux_scalar_num, aux_vec_num, 0, mesh2d )
        this%aux_comm_ptr => aux_comm2d_cs
      end select
    end if
  
    call this%Dx%Init( mesh2d%refElem2D%Dx1, storage_format='ELL')
    call this%Dy%Init( mesh2d%refElem2D%Dx2, storage_format='ELL')
    call this%Lift%Init( mesh2d%refElem2D%Lift, storage_format='ELL')
    return
  end subroutine mgfieldset2d_init
 
  !> Finalize an object to manage multigrid field set in 2D
!OCL SERIAL
  subroutine mgfieldset2d_final(this)
    implicit none
    class(mgfieldset2d), intent(inout) :: this
 
    integer :: iv
    class(meshfieldcommbase), pointer :: comm_ptr
    !---------------------------------
 
    call this%dq%Final()    
    call this%f%Final()    
    call this%res%Final()
 
    select type(comm_ptr => this%var_comm_ptr)
    type is (meshfieldcommrectdom2d)
      call comm_ptr%Final()
    type is (meshfieldcommcubedspheredom2d)
      call comm_ptr%Final()
    end select
    deallocate(this%var_comm_ptr)
 
    if ( this%aux_var_num_tot > 0 ) then
      
      select type(comm_ptr => this%aux_comm_ptr)
      type is (meshfieldcommrectdom2d)
        call comm_ptr%Final()
      type is (meshfieldcommcubedspheredom2d)
        call comm_ptr%Final()
      end select
      deallocate(this%aux_comm_ptr)
 
      do iv=1, this%aux_var_num_tot
        call this%aux_var(iv)%Final()
      end do
    end if
 
    call this%Dx%Final()
    call this%Dy%Final()
 
    return
  end subroutine mgfieldset2d_final
 
!- 3D
  !> Initialize an object to manage multigrid field set in 3D
!OCL SERIAL
  subroutine mgfieldset3d_init(this, mesh3D, aux_scalar_num, aux_hvec_num, level_id)
    use scale_mesh_cubedom3d, only: meshcubedom3d
    implicit none
    class(mgfieldset3d), intent(inout), target :: this
    class(meshbase3d), intent(in) :: mesh3D
    integer, intent(in) :: aux_scalar_num
    integer, intent(in) :: aux_hvec_num
    integer, intent(in) :: level_id
 
    integer :: iv
 
    type(meshfieldcommcubedom3d), pointer :: var_comm3D
    type(meshfieldcommcubedom3d), pointer :: aux_comm3D
 
    type(meshfieldcommcubedspheredom3d), pointer :: var_comm3D_cs
    type(meshfieldcommcubedspheredom3d), pointer :: aux_comm3D_cs
    !---------------------------------
 
    this%level_id = level_id
    
    call this%dq%Init( "dq", "1", mesh3d )    
    call this%f%Init( "f", "1", mesh3d )
    call this%res%Init( "res", "1", mesh3d )
 
    this%aux_var_num_tot = aux_scalar_num + 2*aux_hvec_num
    if ( this%aux_var_num_tot > 0 ) then
      allocate( this%aux_var(this%aux_var_num_tot) )
      do iv=1, this%aux_var_num_tot
        call this%aux_var(iv)%Init( "aux_var", "1", mesh3d )
      end do
    end if
    
    select type(mesh3d)
    type is (meshcubedom3d)
      allocate(var_comm3d)
      call var_comm3d%Init( 1, 0, 0, mesh3d )
      this%var_comm_ptr => var_comm3d
    type is (meshcubedspheredom3d)
      allocate(var_comm3d_cs)
      call var_comm3d_cs%Init( 1, 0, 0, mesh3d )
      this%var_comm_ptr => var_comm3d_cs
    end select
 
    !-
    if ( this%aux_var_num_tot > 0 ) then
      select type(mesh3d)
      type is (meshcubedom3d)
        allocate( aux_comm3d )
        call aux_comm3d%Init( aux_scalar_num, aux_hvec_num, 0, mesh3d )
        this%aux_comm_ptr => aux_comm3d
      type is (meshcubedspheredom3d)
        allocate( aux_comm3d_cs )
        call aux_comm3d_cs%Init( aux_scalar_num, aux_hvec_num, 0, mesh3d )
        this%aux_comm_ptr => aux_comm3d_cs
      end select
    end if
 
    !-
    call this%Dx%Init( mesh3d%refElem3D%Dx1, storage_format='ELL')
    call this%Dy%Init( mesh3d%refElem3D%Dx2, storage_format='ELL')
    call this%Dz%Init( mesh3d%refElem3D%Dx3, storage_format='ELL')
    call this%Lift%Init( mesh3d%refElem3D%Lift, storage_format='ELL')
    return
  end subroutine mgfieldset3d_init
 
  !> Finalize an object to manage multigrid field set in 3D
!OCL SERIAL
  subroutine mgfieldset3d_final(this)
    implicit none
    class(mgfieldset3d), intent(inout) :: this
 
    integer :: iv
    class(meshfieldcommbase), pointer :: comm_ptr
    !---------------------------------
 
    call this%dq%Final()    
    call this%f%Final()    
    call this%res%Final()
 
    select type(comm_ptr => this%var_comm_ptr)
    type is (meshfieldcommcubedom3d)
      call comm_ptr%Final()
    type is (meshfieldcommcubedspheredom3d)
      call comm_ptr%Final()
    end select
    deallocate(this%var_comm_ptr)
 
    if ( this%aux_var_num_tot > 0 ) then
      
      select type(comm_ptr => this%aux_comm_ptr)
      type is (meshfieldcommcubedom3d)
        call comm_ptr%Final()
      type is (meshfieldcommcubedspheredom3d)
        call comm_ptr%Final()
      end select
      deallocate(this%aux_comm_ptr)
 
      do iv=1, this%aux_var_num_tot
        call this%aux_var(iv)%Final()
      end do
    end if
 
    call this%Dx%Final()
    call this%Dy%Final()
    call this%Dz%Final()
 
    return
  end subroutine mgfieldset3d_final
 
end module scale_multigrid_fieldset_base