scale_model_meshbase_manager.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_model_meshbase_manager
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prc, only: &
    prc_abort
 
  use scale_element_base, only: elementbase3d
  use scale_mesh_base, only: meshbase
  use scale_mesh_base1d, only: meshbase1d
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: meshbase3d
 
  use scale_element_operation_base, only: elementoperationbase3d
  use scale_element_operation_general, only: elementoperationgeneral
  use scale_element_operation_tensorprod3d, only: elementoperationtensorprod3d
 
  use scale_sparsemat, only: sparsemat  
 
  !-----------------------------------------------------------------------------
  implicit none
  private
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
 
  type, abstract, public :: modelmeshbase
    type(sparsemat), allocatable :: doptrmat(:)
    type(sparsemat), allocatable :: soptrmat(:)
    type(sparsemat) :: liftoptrmat
    class(elementoperationbase3d), pointer :: element3d_operation
 
    integer :: communicator_num
  contains
    procedure :: modelmeshbase_init
    procedure :: modelmeshbase_final
    procedure :: get_communicatorid => modelmeshbase_get_communicatorid
    procedure(modelmeshbase_get_modelmesh), public, deferred :: getmodelmesh
  end type modelmeshbase
  
  interface
    subroutine modelmeshbase_get_modelmesh( this, ptr_mesh )
      import modelmeshbase
      import meshbase
      class(modelmeshbase), target, intent(in) :: this
      class(meshbase), pointer, intent(out) :: ptr_mesh
    end subroutine modelmeshbase_get_modelmesh
  end interface
 
  type, extends(modelmeshbase), public :: modelmeshbase1d
    class(meshbase1d), pointer :: ptr_mesh
  contains
    procedure, public :: modelmeshbase1d_init
    procedure, public :: modelmeshbase1d_final
    procedure, public :: getmodelmesh => modelmeshbase1d_get_modelmesh
  end type modelmeshbase1d
 
  type, extends(modelmeshbase), public :: modelmeshbase2d
    class(meshbase2d), pointer :: ptr_mesh
  contains
    procedure, public :: modelmeshbase2d_init
    procedure, public :: modelmeshbase2d_final
    procedure, public :: getmodelmesh => modelmeshbase2d_get_modelmesh
  end type modelmeshbase2d
 
  type, extends(modelmeshbase), abstract, public :: modelmeshbase3d
    class(meshbase3d), pointer :: ptr_mesh
    type(elementoperationgeneral) :: element_operation_general
    class(elementoperationtensorprod3d), allocatable :: element_operation_tensorprod
    logical :: initialized_element_operation
  contains
    procedure, public :: modelmeshbase3d_init
    procedure, public :: modelmeshbase3d_final
    procedure, public :: prepairelementoperation => modelmeshbase3d_prepair_elementoperation
    procedure, public :: getmodelmesh => modelmeshbase3d_get_modelmesh
  end type modelmeshbase3d
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures & variables
  !
  !------------------
 
contains
!OCL SERIAL
  subroutine modelmeshbase_init( this, nDim )
    implicit none
    class(modelmeshbase), intent(inout) :: this
    integer, intent(in) :: nDim
 
    integer :: d
    !--------------------------------------------
 
    this%communicator_num = 0    
    allocate( this%SOptrMat(ndim), this%DOptrMat(ndim) )
 
    return
  end subroutine modelmeshbase_init
 
!OCL SERIAL
  function modelmeshbase_get_communicatorid( this, max_communicator_num ) result(commid)
    implicit none
    class(modelmeshbase), intent(inout) :: this
    integer, intent(in) :: max_communicator_num
    integer :: commid
    !--------------------------------------------
 
    this%communicator_num = this%communicator_num + 1
    commid = this%communicator_num
 
    if ( commid > max_communicator_num ) then
      log_error('ModelMeshBase_get_communicatorID',*) 'The number of communicator exceeds expectation. Check!' 
      call prc_abort
    end if
 
    return
  end function modelmeshbase_get_communicatorid
 
!OCL SERIAL
  subroutine modelmeshbase_final( this )
    implicit none
    class(modelmeshbase), intent(inout) :: this
 
    integer :: d
    !--------------------------------------------
 
    do d = 1, size(this%DOptrMat)
      call this%DOptrMat(d)%Final()
      call this%SOptrMat(d)%Final()
    end do
    deallocate( this%SOptrMat, this%DOptrMat )
 
    call this%LiftOptrMat%Final()
 
    return
  end subroutine modelmeshbase_final
 
  !* 1D *************************************************************
 
  subroutine modelmeshbase1d_init( this, mesh )
    implicit none
    class(modelmeshbase1d), target, intent(inout) :: this
    class(meshbase1d), target, intent(in) :: mesh
    !-----------------------------------------------------
 
    this%ptr_mesh => mesh
    call this%ModelMeshBase_Init(1)
 
    return
  end subroutine modelmeshbase1d_init
 
!OCL SERIAL
  subroutine modelmeshbase1d_final( this )
    implicit none
    class(modelmeshbase1d), target, intent(inout) :: this
 
    integer :: d
    !-----------------------------------------------------
 
    nullify( this%ptr_mesh )
    call this%ModelMeshBase_Final()
 
    return
  end subroutine modelmeshbase1d_final
 
!OCL SERIAL
  subroutine modelmeshbase1d_get_modelmesh( this, ptr_mesh )
    implicit none
    class(modelmeshbase1d), target, intent(in) :: this
    class(meshbase), pointer, intent(out) :: ptr_mesh
    !-----------------------------------------------------
 
    ptr_mesh => this%ptr_mesh
 
    return
  end subroutine modelmeshbase1d_get_modelmesh
 
  !* 2D *************************************************************
 
!OCL SERIAL
  subroutine modelmeshbase2d_init( this, mesh )
    implicit none
    class(modelmeshbase2d), target, intent(inout) :: this
    class(meshbase2d), target, intent(in) :: mesh
    !-----------------------------------------------------
 
    this%ptr_mesh => mesh
    call this%ModelMeshBase_Init(2)
 
    return
  end subroutine modelmeshbase2d_init
 
!OCL SERIAL
  subroutine modelmeshbase2d_final( this )
    implicit none
    class(modelmeshbase2d), target, intent(inout) :: this  
    !-----------------------------------------------------
 
    nullify( this%ptr_mesh )
    call this%ModelMeshBase_Final()
 
    return
  end subroutine modelmeshbase2d_final
 
!OCL SERIAL
  subroutine modelmeshbase2d_get_modelmesh( this, ptr_mesh )
    implicit none
    class(modelmeshbase2d), target, intent(in) :: this
    class(meshbase), pointer, intent(out) :: ptr_mesh
    !-----------------------------------------------------
 
    ptr_mesh => this%ptr_mesh
    return
  end subroutine modelmeshbase2d_get_modelmesh
 
  !* 3D *************************************************************
 
!OCL SERIAL
  subroutine modelmeshbase3d_init( this, mesh )
    implicit none
    class(modelmeshbase3d), target, intent(inout) :: this
    class(meshbase3d), target, intent(in) :: mesh
    !-----------------------------------------------------
 
    this%ptr_mesh => mesh
    call this%ModelMeshBase_Init(3)
 
    this%initialized_element_operation = .false.
 
    return
  end subroutine modelmeshbase3d_init  
 
!OCL SERIAL
  subroutine modelmeshbase3d_final( this )
    implicit none
    class(modelmeshbase3d), target, intent(inout) :: this
    !-----------------------------------------------------
 
    if ( this%initialized_element_operation ) then
      call this%element3D_operation%Final()
    end if
 
    nullify( this%ptr_mesh )
    call this%ModelMeshBase_Final()
 
    return
  end subroutine modelmeshbase3d_final
 
!OCL SERIAL
  subroutine modelmeshbase3d_prepair_elementoperation( this, element_operation_type, &
    SpMV_storage_format_ )
    use scale_prc, only: prc_abort
    use scale_element_operation_tensorprod3d, only: elementoperationtensorprod3d_create
    implicit none
    class(modelmeshbase3d), intent(inout), target :: this
    character(len=*), intent(in), optional :: element_operation_type
    character(len=*), intent(in), optional :: SpMV_storage_format_
 
    character(len=H_SHORT) :: element_operation_type_
    character(len=H_SHORT) :: SpMV_storage_format
 
    class(elementbase3d), pointer :: elem3D
    !-----------------------------------------------------
 
    if ( present(element_operation_type) ) then
      element_operation_type_ = element_operation_type
    else
      element_operation_type_ = "General"
    end if
    spmv_storage_format = "ELL"
    elem3d => this%ptr_mesh%refElem3D
    call this%DOptrMat(1)%Init( elem3d%Dx1, storage_format=spmv_storage_format )
    call this%DOptrMat(2)%Init( elem3d%Dx2, storage_format=spmv_storage_format )
    call this%DOptrMat(3)%Init( elem3d%Dx3, storage_format=spmv_storage_format )
 
    call this%SOptrMat(1)%Init( elem3d%Sx1, storage_format=spmv_storage_format )
    call this%SOptrMat(2)%Init( elem3d%Sx2, storage_format=spmv_storage_format )
    call this%SOptrMat(3)%Init( elem3d%Sx3, storage_format=spmv_storage_format )  
 
    call this%LiftOptrMat%Init( elem3d%Lift, storage_format=spmv_storage_format )
 
    select case(element_operation_type_)
    case ("General")
      call this%element_operation_general%Init( elem3d, this%DOptrMat(1), this%DOptrMat(2), this%DOptrMat(3), this%LiftOptrMat )
      this%element3D_operation => this%element_operation_general
    case ("TensorProd3D")
      call elementoperationtensorprod3d_create( elem3d, &
        this%element_operation_tensorprod ) ! (out)
        this%element3D_operation => this%element_operation_tensorprod
    case default
      log_info("ModelMeshBase3D_prepair_ElementOperation",*) "The specified element_operation_type is not supported. Check!", trim(element_operation_type_)
      call prc_abort
    end select
 
    this%initialized_element_operation = .true.
 
    return
  end subroutine modelmeshbase3d_prepair_elementoperation
 
!OCL SERIAL
  subroutine modelmeshbase3d_get_modelmesh( this, ptr_mesh )
    implicit none
    class(modelmeshbase3d), target, intent(in) :: this
    class(meshbase), pointer, intent(out) :: ptr_mesh
    !-----------------------------------------------------
 
    ptr_mesh => this%ptr_mesh
    return
  end subroutine modelmeshbase3d_get_modelmesh
 
end module scale_model_meshbase_manager