sll_m_advection_2d_oblic.F90

Go to the documentation of this file.

!**************************************************************
!  Copyright INRIA
!  Authors :
!     CALVI project team
!
!  This code SeLaLib (for Semi-Lagrangian-Library)
!  is a parallel library for simulating the plasma turbulence
!  in a tokamak.
!
!  This software is governed by the CeCILL-B license
!  under French law and abiding by the rules of distribution
!  of free software.  You can  use, modify and redistribute
!  the software under the terms of the CeCILL-B license as
!  circulated by CEA, CNRS and INRIA at the following URL
!  "http://www.cecill.info".
!**************************************************************
 
module sll_m_advection_2d_oblic
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#include "sll_memory.h"
#include "sll_working_precision.h"
 
   use sll_m_advection_1d_base, only: &
      sll_c_advector_1d
 
   use sll_m_lagrange_interpolation, only: &
      sll_f_lagrange_interpolate
 
   implicit none
 
   public :: &
      sll_f_new_oblic_2d_advector, &
      sll_t_oblic_2d_advector, &
      sll_s_oblic_advect_2d_constant
 
   private
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   type  :: sll_t_oblic_2d_advector
      sll_int32 :: nc_x1
      class(sll_c_advector_1d), pointer :: adv_x1
      sll_int32 :: nc_x2
      sll_real64  :: x2_min
      sll_real64  :: x2_max
      sll_int32 :: stencil_r
      sll_int32 :: stencil_s
      sll_real64, dimension(:), pointer :: xx
      sll_real64, dimension(:, :), pointer :: buf
 
   end type sll_t_oblic_2d_advector
 
contains
   function sll_f_new_oblic_2d_advector( &
      Nc_x1, &
      adv_x1, &
      Nc_x2, &
      x2_min, &
      x2_max, &
      stencil_r, &
      stencil_s) &
      result(adv)
      type(sll_t_oblic_2d_advector), pointer :: adv
      sll_int32, intent(in) :: nc_x1
      class(sll_c_advector_1d), pointer :: adv_x1
      sll_int32, intent(in) :: nc_x2
      sll_real64, intent(in) :: x2_min
      sll_real64, intent(in) :: x2_max
      sll_int32, intent(in) :: stencil_r
      sll_int32, intent(in) :: stencil_s
      !local variables
      sll_int32 :: ierr
 
      sll_allocate(adv, ierr)
 
      call initialize_oblic_2d_advector( &
         adv, &
         nc_x1, &
         adv_x1, &
         nc_x2, &
         x2_min, &
         x2_max, &
         stencil_r, &
         stencil_s)
   end function sll_f_new_oblic_2d_advector
 
   subroutine initialize_oblic_2d_advector( &
      adv, &
      Nc_x1, &
      adv_x1, &
      Nc_x2, &
      x2_min, &
      x2_max, &
      stencil_r, &
      stencil_s)
      type(sll_t_oblic_2d_advector), intent(inout) :: adv
      sll_int32, intent(in) :: nc_x1
      class(sll_c_advector_1d), pointer :: adv_x1
      sll_int32, intent(in) :: nc_x2
      sll_real64, intent(in) :: x2_min
      sll_real64, intent(in) :: x2_max
      sll_int32, intent(in) :: stencil_r
      sll_int32, intent(in) :: stencil_s
      !local variables
      sll_int32 :: ierr
      sll_int32 :: r
      sll_int32 :: s
      sll_int32 :: i
 
      adv%Nc_x1 = nc_x1
      adv%adv_x1 => adv_x1
      adv%Nc_x2 = nc_x2
      adv%x2_min = x2_min
      adv%x2_max = x2_max
      adv%stencil_r = stencil_r
      adv%stencil_s = stencil_s
 
      r = adv%stencil_r
      s = adv%stencil_s
 
      sll_allocate(adv%xx(r:s), ierr)
      sll_allocate(adv%buf(r:s, nc_x1 + 1), ierr)
 
      do i = r, s
         adv%xx(i) = real(i, f64)
      end do
 
   end subroutine initialize_oblic_2d_advector
 
 
   subroutine sll_s_oblic_advect_2d_constant( &
      adv, &
      !iota, &
      A1, &
      A2, &
      dt, &
      input, &
      output)
      type(sll_t_oblic_2d_advector) :: adv
      !sll_real64, intent(in) :: iota
      sll_real64, intent(in) :: a1
      sll_real64, intent(in) :: a2
      sll_real64, intent(in) :: dt
      sll_real64, dimension(:, :), intent(in) :: input
      sll_real64, dimension(:, :), intent(out) :: output
      !local variables
      sll_int32 :: i1
      sll_int32 :: i2
      sll_int32 :: i2_loc
      sll_int32 :: i0
      sll_real64 :: alpha
      sll_int32 :: d
      sll_int32 :: r
      sll_int32 :: s
      sll_real64 :: dt_loc
      sll_int32 :: ell
      sll_real64, dimension(:, :), pointer :: buf
      sll_real64, dimension(:), pointer :: xx
      class(sll_c_advector_1d), pointer :: adv_x1
      sll_real64 :: delta_x2
      sll_int32 :: nc_x1
      sll_int32 :: nc_x2
 
      buf => adv%buf
      xx => adv%xx
      adv_x1 => adv%adv_x1
      nc_x1 = adv%Nc_x1
      nc_x2 = adv%Nc_x2
      delta_x2 = (adv%x2_max - adv%x2_min)/real(adv%Nc_x2, f64)
      r = adv%stencil_r
      s = adv%stencil_s
      alpha = a2*dt/delta_x2
      i0 = floor(alpha)
      alpha = alpha - i0
      d = s - r
 
      do i2 = 1, nc_x2 + 1
         !choose several dt_loc so that advection in x2 is exact
         do ell = r, s
            dt_loc = real(ell + i0, f64)*delta_x2/a2
            i2_loc = modulo(i2 - ell - i0 - 1, nc_x2) + 1
            call adv_x1%advect_1d_constant( &
               a1, &
               dt_loc, &
               input(1:nc_x1 + 1, i2_loc), &
               buf(ell, 1:nc_x1 + 1))
         end do
         !interpolate between these values
         do i1 = 1, nc_x1 + 1
            output(i1, i2) = sll_f_lagrange_interpolate(alpha, d, xx, buf(r:s, i1))
         end do
      end do
 
   end subroutine sll_s_oblic_advect_2d_constant
 
   subroutine oblic_advect_2d( &
      adv, &
      !iota, &
      A1, &
      A2, &
      dt, &
      input, &
      output)
      type(sll_t_oblic_2d_advector) :: adv
      !sll_real64, intent(in) :: iota
      sll_real64, dimension(:, :), intent(in) :: a1
      sll_real64, dimension(:, :), intent(in) :: a2
      sll_real64, intent(in) :: dt
      sll_real64, dimension(:, :), intent(in) :: input
      sll_real64, dimension(:, :), intent(out) :: output
 
      print *, '#oblic_advect_2d not implemented for the moment'
      print *, size(input, 1), size(input, 2), storage_size(adv)
      output = 0.0_f64 + a1*a2*dt
 
   end subroutine oblic_advect_2d
 
end module sll_m_advection_2d_oblic