math_ext.f90

module math_ext
  use num_types, only: rp, xp
  use comm, only: neko_comm, mpi_extra_precision
  use mpi_f08, only: mpi_allreduce, mpi_sum, mpi_in_place
  implicit none
 
contains
 
  subroutine copy_mask(a, b, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    real(kind=rp), dimension(size), intent(in) :: b
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = b(mask(i))
    end do
 
  end subroutine copy_mask
 
  subroutine cadd_mask(a, c, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    real(kind=rp), intent(in) :: c
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = a(mask(i)) + c
    end do
 
  end subroutine cadd_mask
 
  subroutine invcol1_mask(a, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = 1.0_rp / a(mask(i))
    end do
 
  end subroutine invcol1_mask
 
  subroutine cmult_mask(a, c, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    real(kind=rp), intent(in) :: c
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = c * a(mask(i))
    end do
 
  end subroutine cmult_mask
 
  subroutine col2_mask(a, b, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    real(kind=rp), dimension(size), intent(in) :: b
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = a(mask(i)) * b(mask(i))
    end do
 
  end subroutine col2_mask
 
  subroutine col3_mask(a, b, c, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    real(kind=rp), dimension(size), intent(in) :: b, c
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = b(mask(i)) * c(mask(i))
    end do
 
  end subroutine col3_mask
 
  subroutine sub3_mask(a, b, c, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(inout) :: a
    real(kind=rp), dimension(size), intent(in) :: b, c
    integer, dimension(mask_size), intent(in) :: mask
    integer :: i
 
    do i = 1, mask_size
       a(mask(i)) = b(mask(i)) - c(mask(i))
    end do
 
  end subroutine sub3_mask
 
  function glsc2_mask(a, b, size, mask, mask_size)
    integer, intent(in) :: size, mask_size
    real(kind=rp), dimension(size), intent(in) :: a
    real(kind=rp), dimension(size), intent(in) :: b
    integer, dimension(mask_size), intent(in) :: mask
    real(kind=rp) :: glsc2_mask
    real(kind=xp) :: tmp
    integer :: i, ierr
 
    tmp = 0.0_xp
    do i = 1, mask_size
       tmp = tmp + a(mask(i)) * b(mask(i))
    end do
 
    call mpi_allreduce(mpi_in_place, tmp, 1, &
         mpi_extra_precision, mpi_sum, neko_comm, ierr)
    glsc2_mask = tmp
  end function glsc2_mask
end module math_ext