sll_m_linear_operator_schur_eb_cl_1d.F90

Go to the documentation of this file.

module sll_m_linear_operator_schur_eb_cl_1d
#include "sll_working_precision.h"
  
  use sll_m_linear_operator_abstract
 
  use sll_m_matrix_csr, only: &
       sll_t_matrix_csr
 
  use sll_m_spline_fem_utilities_3d_clamped, only: &
       sll_s_multiply_g_clamped_1d, &
       sll_s_multiply_gt_clamped_1d
 
 
  implicit none
 
  public :: sll_t_linear_operator_schur_eb_cl_1d
 
  private
  type, extends(sll_t_linear_operator_abstract) :: sll_t_linear_operator_schur_eb_cl_1d
     
     type(sll_t_matrix_csr), pointer :: mass0
     type(sll_t_matrix_csr), pointer :: mass1
     sll_int32 :: n_dofs 
     sll_real64 :: delta_x 
     sll_real64 :: sign = 1.0_f64 
     sll_int32  :: s_deg_0 
     
   contains
     procedure :: create => create_linear_operator_schur_eb_cl_1d
     procedure :: free => free_schur_eb_cl_1d
     procedure :: dot => dot_schur_eb_cl_1d
     procedure :: print_info => print_info_schur_eb_cl_1d
 
  end type sll_t_linear_operator_schur_eb_cl_1d
 
 
contains
 
  subroutine create_linear_operator_schur_eb_cl_1d( self, mass0, mass1, n_dofs, delta_x, s_deg_0 )
    class(sll_t_linear_operator_schur_eb_cl_1d), intent( inout ) :: self
    type(sll_t_matrix_csr), target :: mass0
    type(sll_t_matrix_csr), target :: mass1
    sll_int32  :: n_dofs 
    sll_real64 :: delta_x 
    sll_int32  :: s_deg_0 
 
    self%mass0  => mass0
    self%mass1  => mass1
    self%n_dofs = n_dofs
    self%delta_x = delta_x
    self%s_deg_0 = s_deg_0
 
    self%n_rows = self%n_dofs
    self%n_cols = self%n_dofs
 
    self%n_global_rows = self%n_rows
    self%n_global_cols = self%n_cols
 
  end subroutine create_linear_operator_schur_eb_cl_1d
 
  subroutine free_schur_eb_cl_1d( self )
    class(sll_t_linear_operator_schur_eb_cl_1d), intent( inout ) :: self
 
    self%mass0=> null()
    self%mass1=> null()
 
  end subroutine free_schur_eb_cl_1d
 
 
  subroutine dot_schur_eb_cl_1d ( self, x, y )
    class(sll_t_linear_operator_schur_eb_cl_1d), intent( in ) :: self
    sll_real64, intent( in    ) :: x(:) 
    sll_real64, intent(   out ) :: y(:) 
 
    !local variables
    sll_real64 ::  scratch0(self%n_dofs), scratch1(self%n_dofs-1), scratch2(self%n_dofs-1)
 
    ! Compute D x
    call sll_s_multiply_g_clamped_1d( self%n_dofs, self%delta_x, self%s_deg_0, x, scratch1)
    
    ! Compute M1 D x
    call self%mass1%dot( scratch1, scratch2 )
 
    ! Compute D^T M1 D x + M_b D x
    call sll_s_multiply_gt_clamped_1d( self%n_dofs, self%delta_x, self%s_deg_0, scratch2, scratch0 )
 
    !scratch0(1)= scratch0(1)+scratch1(1)
    !scratch0(self%n_dofs)= scratch0(self%n_dofs)-scratch1(self%n_dofs-1)
 
    ! Compute M0 x
    call self%mass0%dot(  x, y )
 
    ! Sum up the two parts
    y = y + self%sign * scratch0
 
  end subroutine dot_schur_eb_cl_1d
 
  subroutine print_info_schur_eb_cl_1d( self )
    class(sll_t_linear_operator_schur_eb_cl_1d), intent(in) :: self
 
  end subroutine print_info_schur_eb_cl_1d
 
 
end module sll_m_linear_operator_schur_eb_cl_1d