diff --git a/HySoP/src/scalesInterface/particles/advec.f90 b/HySoP/src/scalesInterface/particles/advec.f90
index d59b9b16737598f94ef8dc15cc1bd9ca5c0cd062..bd0ca16ab27446cafc6aa883d5c4111c84570383 100644
--- a/HySoP/src/scalesInterface/particles/advec.f90
+++ b/HySoP/src/scalesInterface/particles/advec.f90
@@ -5,8 +5,8 @@
! MODULE: advec
!
!
-! DESCRIPTION:
-!> The module advec provides all public interfaces to solve an advection equation
+! DESCRIPTION:
+!> The module advec provides all public interfaces to solve an advection equation
!! with a particle method.
!
!> @details
@@ -22,15 +22,15 @@
!------------------------------------------------------------------------------
module advec
- use string
+ use precision_tools
use advec_abstract_proc
implicit none
! ===== Private variables =====
!> numerical method use to advect the scalar
- character(len=str_short), private :: type_part_solv
+ character(len=str_short), private :: type_part_solv
!> dimensionnal splitting (eg classical, Strang or particle)
- character(len=str_short), private :: dim_splitting
+ character(len=str_short), private :: dim_splitting
!> Group size along current direction
integer, private, dimension(2) :: gsX, gsY, gsZ
@@ -46,9 +46,7 @@ module advec
public :: advec_step_Torder2 ! advec the scalar field during a time step.
! Remeshing formula
- procedure(AC_remesh), pointer, private :: advecX_remesh => null()
- procedure(AC_remesh), pointer, private :: advecY_remesh => null()
- procedure(AC_remesh), pointer, private :: advecZ_remesh => null()
+ procedure(AC_remesh), pointer, private :: advec_remesh => null()
contains
@@ -58,7 +56,7 @@ contains
!! @return type_part_solver = numerical method used for advection
function type_part_solver()
character(len=str_short) :: type_part_solver
-
+
type_part_solver = type_part_solv
end function
@@ -70,15 +68,11 @@ end function
!! Strang splitting or particle splitting)
!! @param[in] verbosity = to display info about chosen remeshing formula (optional)
subroutine advec_init(order, stab_coeff, verbosity, dim_split)
-
- use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
- use advecX ! solver for advection along X
- use advecY ! solver for advection along Y
- use advecZ ! solver for advection along Z
- use advec_common ! some procedures common to advection along all directions
- use advec_remesh_line ! contain "old" remeshing tools.
- use advec_remeshing_formula ! contain "old" remeshing tools.
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+ use advecX, only: advecX_remesh_init ! solver for advection along X
+ use advec_common ! some procedures common to advection along all directions
! Input/Output
character(len=*), optional, intent(in) :: order, dim_split
@@ -88,7 +82,7 @@ subroutine advec_init(order, stab_coeff, verbosity, dim_split)
! Use default solver if it is not chosen by the user.
if(present(order)) then
type_part_solv = order
- else
+ else
type_part_solv = 'p_O2'
end if
@@ -104,7 +98,7 @@ subroutine advec_init(order, stab_coeff, verbosity, dim_split)
! Default dimensionnal splitting if the user do not choose it
if(present(dim_split)) then
dim_splitting = dim_split
- else
+ else
dim_splitting = 'strang'
end if
@@ -123,30 +117,26 @@ subroutine advec_init(order, stab_coeff, verbosity, dim_split)
! Call the right remeshing formula
select case(type_part_solv)
case('p_O2')
- advecX_remesh => AC_remesh_lambda_group ! or Xremesh_O2
- advecY_remesh => AC_remesh_lambda_group ! or Yremesh_O2
- advecZ_remesh => AC_remesh_lambda_group ! or Zremesh_O2
+ advec_remesh => AC_remesh_lambda_group ! or Xremesh_O2
case('p_O4')
- advecX_remesh => AC_remesh_lambda_group ! or Xremesh_O4
- advecY_remesh => AC_remesh_lambda_group ! or Yremesh_O4
- advecZ_remesh => AC_remesh_lambda_group ! or Zremesh_O4
+ advec_remesh => AC_remesh_lambda_group ! or Xremesh_O4
+ case('p_L2')
+ advec_remesh => AC_remesh_limit_lambda_group ! limited and corrected lambda 2
case('p_M6')
- advecX_remesh => AC_remesh_Mprime6_group ! Xremesh_Mprime6
- advecY_remesh => AC_remesh_Mprime6_group ! Yremesh_Mprime6
- advecZ_remesh => AC_remesh_Mprime6_group ! Zremesh_Mprime6
+ advec_remesh => AC_remesh_Mprime_group ! Xremesh_Mprime6
+ case('p_M8')
+ advec_remesh => AC_remesh_Mprime_group ! Xremesh_Mprime6
case default
- advecX_remesh => AC_remesh_lambda_group ! or Xremesh_O2
- advecY_remesh => AC_remesh_lambda_group ! or Yremesh_O2
- advecZ_remesh => AC_remesh_lambda_group ! or Zremesh_O2
+ advec_remesh => AC_remesh_lambda_group ! or Xremesh_O2
end select
call AC_setup_init()
call advecX_remesh_init()
! Save group size
- gsX =group_size(1,:)
- gsY =group_size(2,:)
- gsZ =group_size(3,:)
+ gsX =group_size(1,:)
+ gsY =group_size(2,:)
+ gsZ =group_size(3,:)
end subroutine advec_init
@@ -155,44 +145,36 @@ end subroutine advec_init
!> Solve advection equation - order 1 in time (classic dimensional splitting)
!! @param[in] dt = time step
!! @param[in] Vx = velocity along x (could be discretised on a bigger mesh then the scalar)
-!! @param[in] Vy = velocity along y
+!! @param[in] Vy = velocity along y
!! @param[in] Vz = velocity along z
!! @param[in,out] scal = scalar field to advect
subroutine advec_step_Torder1(dt, Vx, Vy, Vz, scal)
- use advecX ! Method to advec along X
- use advecY ! Method to advec along Y
- use advecZ ! Method to advec along Z
-
! Input/Output
real(WP), intent(in) :: dt
real(WP), dimension(:,:,:), intent(in) :: Vx, Vy, Vz
real(WP), dimension(:,:,:), intent(inout) :: scal
-
+
call advecX_calc_no_com(dt, Vx, scal)
call advecY_calc(dt, Vy, scal)
call advecZ_calc(dt, Vz, scal)
end subroutine advec_step_Torder1
-
+
!> Solve advection equation - order 2 in time (order 2 dimensional splitting)
!! @param[in] dt = time step
!! @param[in] Vx = velocity along x (could be discretised on a bigger mesh then the scalar)
-!! @param[in] Vy = velocity along y
+!! @param[in] Vy = velocity along y
!! @param[in] Vz = velocity along z
!! @param[in,out] scal = scalar field to advect
subroutine advec_step_Torder2(dt, Vx, Vy, Vz, scal)
- use advecX ! Method to advec along X
- use advecY ! Method to advec along Y
- use advecZ ! Method to advec along Z
-
! Input/Output
real(WP), intent(in) :: dt
real(WP), dimension(:,:,:), intent(in) :: Vx, Vy, Vz
real(WP), dimension(:,:,:), intent(inout) :: scal
-
+
call advecX_calc_no_com(dt/2.0, Vx, scal)
call advecY_calc(dt/2.0, Vy, scal)
call advecZ_calc(dt/2.0, Vz, scal)
@@ -209,11 +191,10 @@ end subroutine advec_step_Torder2
!! @param[in,out] scal3D = scalar field to advect
subroutine advecX_calc(dt, Vx, scal3D)
- use advecX ! Procedure specific to advection along X
+ use advecX, only : advecX_init_group ! Procedure specific to advection along X
use advec_common ! Some procedures common to advection along all directions
use advec_variables ! contains info about solver parameters and others.
use cart_topology ! Description of mesh and of mpi topology
- use advec_remesh_line
! Input/Output
real(WP), intent(in) :: dt
@@ -254,7 +235,7 @@ subroutine advecX_calc(dt, Vx, scal3D)
p_pos_adim = p_pos_adim + dt*p_V/d_sc(direction)
! ===== Remeshing =====
- call advecX_remesh(direction, ind_group, gsX, p_pos_adim, p_V, j, k, scal3D, dt)
+ call advec_remesh(direction, ind_group, gsX, p_pos_adim, p_V, j, k, scal3D, dt)
end do
end do
@@ -320,11 +301,10 @@ end subroutine advecX_calc_no_com
!! @param[in,out] scal3D = scalar field to advect
subroutine advecY_calc(dt, Vy, scal3D)
- use advecY ! Procedure specific to advection along Y
+ use advecY, only : advecY_init ! Procedure specific to advection along Y
use advec_common ! Some procedures common to advection along all directions
use advec_variables ! contains info about solver parameters and others.
use cart_topology ! Description of mesh and of mpi topology
- use advec_remesh_line
! Input/Output
real(WP), intent(in) :: dt
@@ -365,7 +345,7 @@ subroutine advecY_calc(dt, Vy, scal3D)
p_pos_adim = p_pos_adim + dt*p_V/d_sc(direction)
! ===== Remeshing =====
- call advecY_remesh(direction, ind_group, gsY, p_pos_adim, p_V, i, k, scal3D, dt)
+ call advec_remesh(direction, ind_group, gsY, p_pos_adim, p_V, i, k, scal3D, dt)
end do
end do
@@ -382,11 +362,10 @@ end subroutine advecY_calc
!! @param[in,out] scal3D = scalar field to advect
subroutine advecZ_calc(dt, Vz, scal3D)
+ use advecZ, only : advecZ_init_group ! procdure devoted to advection along Z
use advec_variables ! contains info about solver parameters and others.
use cart_topology ! Description of mesh and of mpi topology
- use advecZ ! procdure devoted to advection along Z
use advec_common ! some procedures common to advection along all directions
- use advec_remesh_line
! Input/Output
real(WP), intent(in) :: dt
@@ -426,7 +405,7 @@ subroutine advecZ_calc(dt, Vz, scal3D)
p_pos_adim = p_pos_adim + dt*p_V/d_sc(direction)
! ===== Remeshing =====
- call advecZ_remesh(direction, ind_group, gsZ, p_pos_adim, p_V, i,j,scal3D, dt)
+ call advec_remesh(direction, ind_group, gsZ, p_pos_adim, p_V, i,j,scal3D, dt)
end do
end do
diff --git a/HySoP/src/scalesInterface/particles/advecX.f90 b/HySoP/src/scalesInterface/particles/advecX.f90
index b63c161e8726e43e3e3c8254b80d1fd8047c4882..7321d03652672183c2c07abf556e91ffa5d58f8d 100644
--- a/HySoP/src/scalesInterface/particles/advecX.f90
+++ b/HySoP/src/scalesInterface/particles/advecX.f90
@@ -5,7 +5,7 @@
! MODULE: advecX
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module advecX is devoted to the advection along X axis of a scalar field.
!! It used particle method and provides a parallel implementation.
!
@@ -29,7 +29,7 @@
module advecX
- use precision
+ use precision_tools
use advec_abstract_proc
implicit none
@@ -43,17 +43,24 @@ module advecX
! -- Remeshing algorithm --
public :: advecX_remesh_type_no_com
+ public :: advecX_remesh_limited_no_com
public :: advecX_remesh_no_type_no_com
- public :: advecX_remesh_in_buffer_gp
- public :: advecX_remesh_in_buffer_Mprime6
+ public :: advecX_remesh_in_buffer_lambda
+ public :: advecX_remesh_in_buffer_limit_lambda
+ public :: advecX_remesh_in_buffer_Mprime
+
+ ! ===== Private procedures =====
+ ! -- Compute limitator --
+ public :: advecX_limitator_group
+ !private:: advecX_limitator_group_no_com
procedure(advecX_remesh_type_no_com), pointer, public :: advecX_remesh_no_com => null()
- ! ===== Private porcedures =====
+ ! ===== Private procedures =====
! ===== Private variable ====
!> Current direction = along X
- integer, private, parameter :: direction=1
+ integer, private, parameter :: direction=1
contains
@@ -73,9 +80,14 @@ subroutine advecX_remesh_init()
use advec_variables ! solver context
select case(trim(type_solv))
+ case ('p_M8')
+ advecX_remesh_no_com => advecX_remesh_no_type_no_com
case ('p_M6')
!advecX_remesh_com => advecX_remesh_in_buffer_Mprime6
advecX_remesh_no_com => advecX_remesh_no_type_no_com
+ case ('p_L2')
+ !advecX_remesh_com => advecX_remesh_in_buffer_limited
+ advecX_remesh_no_com => advecX_remesh_limited_no_com
case default
!advecX_remesh_com => advecX_remesh_in_buffer_gp
advecX_remesh_no_com => advecX_remesh_type_no_com
@@ -84,25 +96,104 @@ subroutine advecX_remesh_init()
end subroutine advecX_remesh_init
-!> Remesh particle inside a buffer - for corrected lambda 2/4
+!>Remesh particle inside a buffer. Use corrected lambda remeshing polynoms.
+!!@autor Jean-Baptiste Lagaert
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] i,j = X- and Y-coordinates of the first line along X inside the current group of lines.
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
+!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] scalar = the initial scalar field transported by particles
+!! @param[out] buffer = buffer where particles are remeshed
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecX_remesh_in_buffer_lambda(gs, j, k, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
+ & scalar, buffer, pos_in_buffer)
+
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_abstract_proc ! profile of generic procedure
+ use advec_remeshing_lambda ! remeshing formula and wrapper for a line of particles
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ integer, intent(in) :: ind_min
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
+ real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ ! in part corresponding to different processes
+
+ ! Other local variables
+ integer, dimension(2) :: send_range_all ! maximal (among the lines group) distance between me and processus to wich I send information
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ type(real_pter),dimension(:),allocatable:: remeshX_pter ! pointer to send buffer in which scalar are sorted by line indice.
+ ! sorted by receivers
+ integer :: i1, i2 ! indice of a line into the group
+ integer :: ind ! indice of the current particle inside the current line.
+
+ ! ===== Remeshing into the buffer by using pointer array =====
+ ! -- Allocate remeshX_pter --
+ send_range_all(1) = minval(send_min)
+ send_range_all(2) = maxval(send_max)
+ allocate(remeshX_pter(send_range_all(1):send_range_all(2)))
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+
+ do ind = send_min(i1,i2), send_max(i1,i2)
+ proc_gap = floor(real(ind-1)/N_proc(direction)) - (ind_min-1)
+ remeshX_pter(ind)%pter => buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end do
+
+ ! -- Remesh the particles in the buffer --
+ call AC_remesh_lambda_pter(direction, p_pos_adim(:,i1,i2), scalar(:,j+i1-1,k+i2-1), &
+ & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_range_all(1), remeshX_pter)
+
+ end do
+ end do
+ deallocate(remeshX_pter)
+
+ ! Scalar must be re-init before ending the remeshing
+ scalar(:,j:j+gs(1)-1,k:k+gs(2)-1) = 0
+
+end subroutine advecX_remesh_in_buffer_lambda
+
+
+!> Remesh particle inside a buffer. Use corrected lambda remeshing polynoms.
!! @autor Jean-Baptiste Lagaert
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
-!! It actually start from ind_min and to avoid access out of range,
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] limit = limitator function
!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] scalar = the initial scalar field transported by particles
!! @param[out] buffer = buffer where particles are remeshed
-!! @param[in] remesh_line = subroutine wich remesh a line of particle with the right remeshing formula
-subroutine advecX_remesh_in_buffer_gp(gs, j, k, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
- & scalar, remesh_line, buffer, pos_in_buffer)
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecX_remesh_in_buffer_limit_lambda(gs, j, k, ind_min, p_pos_adim, bl_type, bl_tag, limit, &
+ & send_min, send_max, scalar, buffer, pos_in_buffer)
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
use advec_abstract_proc ! profile of generic procedure
- use advec_remeshing_formula ! remeshing formula and wrapper for a line of particles
+ use advec_remeshing_lambda ! remeshing formula and wrapper for a line of particles
! Input/Output
integer, dimension(2), intent(in) :: gs
@@ -111,16 +202,16 @@ subroutine advecX_remesh_in_buffer_gp(gs, j, k, ind_min, p_pos_adim, bl_type, bl
real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(:,:,:), intent(in) :: limit ! limitator function (divided by 8)
integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
- procedure(AC_remesh_line_pter), pointer, intent(in) :: remesh_line ! subroutine wich remesh a line of particle with the right remeshing formula
real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
! in part corresponding to different processes
- ! Other local variables
- integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
type(real_pter),dimension(:),allocatable:: remeshX_pter ! pointer to send buffer in which scalar are sorted by line indice.
! sorted by receivers
integer :: i1, i2 ! indice of a line into the group
@@ -141,8 +232,8 @@ subroutine advecX_remesh_in_buffer_gp(gs, j, k, ind_min, p_pos_adim, bl_type, bl
end do
! -- Remesh the particles in the buffer --
- call remesh_line(direction, p_pos_adim(:,i1,i2), scalar(:,j+i1-1,k+i2-1), &
- & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_j_min, remeshX_pter)
+ call AC_remesh_lambda2limited_pter(direction, p_pos_adim(:,i1,i2), scalar(:,j+i1-1,k+i2-1), &
+ & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_j_min, limit(:,i1,i2), remeshX_pter)
deallocate(remeshX_pter)
end do
@@ -151,27 +242,27 @@ subroutine advecX_remesh_in_buffer_gp(gs, j, k, ind_min, p_pos_adim, bl_type, bl
! Scalar must be re-init before ending the remeshing
scalar(:,j:j+gs(1)-1,k:k+gs(2)-1) = 0
-end subroutine advecX_remesh_in_buffer_gp
+end subroutine advecX_remesh_in_buffer_limit_lambda
-!> Remesh particle inside a buffer - for M'6
+!> Remesh particle inside a buffer - for M'6 or M'8 remeshing formula.
!! @autor Jean-Baptiste Lagaert
!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
-!! It actually start from ind_min and to avoid access out of range,
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] scalar = the initial scalar field transported by particles
!! @param[out] buffer = buffer where particles are remeshed
-subroutine advecX_remesh_in_buffer_Mprime6(gs, j, k, ind_min, p_pos_adim, send_min, send_max, &
+subroutine advecX_remesh_in_buffer_Mprime(gs, j, k, ind_min, p_pos_adim, send_min, send_max, &
& scalar, buffer, pos_in_buffer)
- use cart_topology ! Description of mesh and of mpi topology
+ use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
use advec_abstract_proc ! profile of generic procedure
- use advec_remeshing_formula ! remeshing formula and wrapper for a line of particles
+ use advec_remeshing_Mprime ! remeshing formula and wrapper for a line of particles
! Input/Output
integer, dimension(2), intent(in) :: gs
@@ -182,16 +273,16 @@ subroutine advecX_remesh_in_buffer_Mprime6(gs, j, k, ind_min, p_pos_adim, send_m
integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
! in part corresponding to different processes
- ! Other local variables
- integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
type(real_pter),dimension(:),allocatable:: remeshX_pter ! pointer to send buffer in which scalar are sorted by line indice.
! sorted by receivers
integer :: i1, i2 ! indice of a line into the group
integer :: ind ! indice of the current particle inside the current line.
- real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice
+ real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice
! are now starting from 1 and not ind_min
@@ -211,7 +302,7 @@ subroutine advecX_remesh_in_buffer_Mprime6(gs, j, k, ind_min, p_pos_adim, send_m
! -- Remesh the particles in the buffer --
do ind = 1, N_proc(direction)
- call AC_remesh_Mprime6_pter(pos_translat(ind), scalar(ind,j+i1-1,k+i2-1), remeshX_pter)
+ call AC_remesh_Mprime_pter(pos_translat(ind), scalar(ind,j+i1-1,k+i2-1), remeshX_pter)
end do
deallocate(remeshX_pter)
@@ -221,10 +312,10 @@ subroutine advecX_remesh_in_buffer_Mprime6(gs, j, k, ind_min, p_pos_adim, send_m
! Scalar must be re-init before ending the remeshing
scalar(:,j:j+gs(1)-1,k:k+gs(2)-1) = 0
-end subroutine advecX_remesh_in_buffer_Mprime6
+end subroutine advecX_remesh_in_buffer_Mprime
-!> Remesh particle inside a buffer - for M'6 - no communication variant
+!> Remesh particle inside a buffer - for corrected lambda 2 or lambda 4 - no communication variant
!! @autor Jean-Baptiste Lagaert
!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
!! @param[in] gs = size of group of line along the current direction
@@ -238,7 +329,7 @@ subroutine advecX_remesh_type_no_com(ind_group, gs, p_pos_adim, p_V, j, k , scal
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
use advec_correction ! Some procedures common to advection along all directions
- use advec_remeshing_formula ! remeshing formula and wrapper for a line of particles
+ use advec_remeshing_lambda ! remeshing formula and wrapper for a line of particles
! Input/Output
integer, dimension(2), intent(in) :: ind_group
@@ -280,7 +371,69 @@ subroutine advecX_remesh_type_no_com(ind_group, gs, p_pos_adim, p_V, j, k , scal
end subroutine advecX_remesh_type_no_com
-!> Remesh particle inside a buffer - for M'6 - no communication variant
+!> Remesh particle inside a buffer - for limited and corrected lambda 2 - no communication variant
+!! @autor Jean-Baptiste Lagaert
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] dt = time step (needed for tag and type)
+!! @param[in] p_V = particle velocity to compute block type and tag
+!! @param[in,out] scal = scalar field to advect
+subroutine advecX_remesh_limited_no_com(ind_group, gs, p_pos_adim, p_V, j, k , scal, dt)
+
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_correction ! Some procedures common to advection along all directions
+ use advec_remeshing_lambda ! remeshing formula and wrapper for a line of particles
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP),dimension(:,:,:),intent(inout) :: scal
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
+ real(WP), intent(in) :: dt
+
+ ! Other local variables
+ integer :: i1, i2 ! position insde the group of line
+ ! Type and block
+ logical, dimension(bl_nb(direction)+1,gs(1),gs(2)) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(bl_nb(direction),gs(1),gs(2)) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(N_proc(direction)+1,gs(1),gs(2)):: limit ! limitator function (divided by 8.)
+ ! Variable used to remesh particles in a buffer
+ real(WP),dimension(N(direction)) :: remesh_buffer! buffer use to remesh the scalar
+
+ ! ===== Pre-Remeshing I: Determine blocks type and tag particles =====
+ call AC_type_and_block_group(dt, direction, gs, ind_group, p_V, bl_type, bl_tag)
+
+ ! ===== Pre-Remeshing II: Compute the limitor function =====
+ ! Actually, this subroutine compute [limitator/8] as this is this fraction
+ ! wich appear always in the remeshing polynoms.
+ call advecX_limitator_group_no_com(gs, j, k, p_pos_adim, scal, limit)
+
+ ! ===== Initialize the general buffer =====
+
+ do i1 = 1, gs(1)
+ do i2 = 1, gs(2)
+
+ ! -- [re-] init buffer --
+ remesh_buffer = 0
+
+ ! -- Remesh the particles in the buffer --
+ call AC_remesh_lambda2limited_array(direction, p_pos_adim(:,i1,i2), &
+ & scal(:,j+i1-1,k+i2-1), bl_type(:,i1,i2), bl_tag(:,i1,i2), limit(:,i1,i2), remesh_buffer)
+
+ ! -- Update scalar from buffer --
+ scal(:,i1+j-1,k+i2-1) = remesh_buffer
+ end do
+ end do
+
+end subroutine advecX_remesh_limited_no_com
+
+
+!> Remesh particle inside a buffer - for M'6 or M'8 - no communication variant
!! @autor Jean-Baptiste Lagaert
!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
!! @param[in] gs = size of group of line along the current direction
@@ -294,7 +447,7 @@ subroutine advecX_remesh_no_type_no_com(ind_group, gs, p_pos_adim, p_V, j, k , s
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
- use advec_remeshing_formula ! remeshing formula and wrapper for a line of particles
+ use advec_remeshing_Mprime ! remeshing formula and wrapper for a line of particles
! Input/Output
integer, dimension(2), intent(in) :: ind_group
@@ -305,7 +458,7 @@ subroutine advecX_remesh_no_type_no_com(ind_group, gs, p_pos_adim, p_V, j, k , s
real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
real(WP), intent(in) :: dt
- ! Other local variables
+ ! Other local variables
integer :: i1, i2 ! indice of a line into the group
integer :: ind ! indice of the current particle inside the current line.
real(WP),dimension(N(direction)) :: remesh_buffer! buffer use to remesh the scalar
@@ -313,13 +466,13 @@ subroutine advecX_remesh_no_type_no_com(ind_group, gs, p_pos_adim, p_V, j, k , s
! ===== Remeshing into the buffer by using pointer array =====
do i2 = 1, gs(2)
do i1 = 1, gs(1)
-
+
! -- [re-] init buffer --
remesh_buffer = 0
! -- Remesh the particles in the buffer --
do ind = 1, N_proc(direction)
- call AC_remesh_Mprime6(direction, p_pos_adim(ind,i1,i2), scalar(ind,j+i1-1,k+i2-1), remesh_buffer)
+ call AC_remesh_Mprime_array(direction, p_pos_adim(ind,i1,i2), scalar(ind,j+i1-1,k+i2-1), remesh_buffer)
end do
! -- Update scalar from buffer --
@@ -337,10 +490,10 @@ end subroutine advecX_remesh_no_type_no_com
!! @param[in] j,k = Y- and Z-coordinate of the first line along X inside the current group of lines.
!! @param[in] ind_proc = algebric distance between me and the processus which send me the buffer. To read the right cartography.
!! @param[in] gap = algebric distance between my local indice and the local indices from the processus which send me the buffer.
-!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
+!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
!! array where indice along the the direction of the group of lines are stored.
-!! @param[in] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
+!! @param[in] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
!! of mesh points from where it requiers the velocity values.
!! @param[in] buffer = buffer containing to redistribute into the scalar field.
!! @param[out] scalar = scalar field (to update)
@@ -352,7 +505,7 @@ subroutine advecX_remesh_buffer_to_scalar(gs, j, k, ind_proc, gap, begin_i1, car
integer, intent(in) :: j, k
integer, intent(in) :: ind_proc ! to read the good cartography associate to the processus which send me the buffer.
integer,intent(in) :: gap ! gap between my local indices and the local indices from another processes
- integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
+ integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
! array where indice along the the direction of the group of lines are stored.
integer, dimension(:,:), intent(in) :: cartography
real(WP),dimension(:), intent(in) :: buffer ! buffer containing the data to redistribute into the local scalar field.
@@ -360,7 +513,7 @@ subroutine advecX_remesh_buffer_to_scalar(gs, j, k, ind_proc, gap, begin_i1, car
integer, intent(out) :: beg_buffer ! first indice inside where the scalar values are stored into the buffer for the current sender processus.
! To know where reading data into the buffer.
- ! Other local variables
+ ! Other local variables
integer :: i1, i2 ! indice of a line into the group
integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography?
integer :: ind_i1_range ! ito know where to read the first coordinate (i1) of the current line inside the cartography.
@@ -402,7 +555,7 @@ end subroutine advecX_remesh_buffer_to_scalar
!! @param[in] k = Z-indice of the current line
!! @param[in] Gsize = size of groups (along X direction)
!! @param[out] p_pos_adim = adimensioned particles postion
-!! @param[out] p_V = particle velocity
+!! @param[out] p_V = particle velocity
subroutine advecX_init_group(Vx, j, k, Gsize, p_pos_adim, p_V)
use cart_topology ! Description of mesh and of mpi topology
@@ -428,40 +581,169 @@ subroutine advecX_init_group(Vx, j, k, Gsize, p_pos_adim, p_V)
end subroutine advecX_init_group
-!> Redistribute a remeshing buffer into the scalar field
-!! @param[in] gp_s = size of group of line along the current direction
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in,out] scal3D = initial scalar field on all point inside the current group of lines
-!! @param[in,out] counter = table of 2 int : counter(1) = nb of
-!! recieved message, counter(2) = number of messag to received.
+
+! ######################################################################################
+! ##### #####
+! ##### Private procedure #####
+! ##### #####
+! ######################################################################################
+
+! ==================================================================================================================================
+! ==================== Compute scalar slope for introducing limitator (against numerical oscillations) ====================
+! ==================================================================================================================================
+
+!> Compute scalar slopes for introducing limitator
+!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] p_pos = particles position
+!! @param[in] scalar = scalar advected by particles
+!! @param[out] limit = limitator function
!! @details
-!! Remeshing are done in a local buffer. This subroutine distribute this buffer
-!! to the right processes, receive the buffer send and update the scalar field.
-!subroutine advecX_update_scalar_frod_scaer(gs, ind_group, j, k, cartography, remesh_buffer, scal3D, counter)
-!
-! use cart_topology ! info about mesh and mpi topology
-! use advec_variables ! contains info about solver parameters and others.
-! use mpi
-!
-! ! Input/Ouptut
-! integer, intent(in) :: j, k
-! integer, dimension(2), intent(in) :: gs
-! integer, dimension(2), intent(in) :: ind_group
-! real(WP), dimension(:), intent(in) :: rece_carto
-! real(WP), dimension(:,:,:), intent(inout) :: scal3D
-!
-! ! Local variables
-! real(WP), dimension(:) :: remesh_buffer
-! integer(kind=4) :: proc_gap ! gap between a processus coordinate (along the current
-! ! direction) into the mpi-topology and my coordinate
-! integer :: ind1, ind2 ! indice of the current line inside the group
-! integer :: indice ! internal indice
-!
-! do while(counter(1)<counter(2))
-!
-! call mpi_recv(remesh_buffer,max_size,)
-!
-!end subroutine advecX_update_scalar_frod_scaer
+!! This subroutine work on a groupe of line. For each line of this group, it
+!! determine the type of each block of this line and where corrected remeshing
+!! formula are required. In those points, it tagg block transition (ie the end of
+!! the current block and the beginning of the following one) in order to indicate
+!! that corrected weigth have to be used during the remeshing.
+!! Note that the subroutine actually computes limitator/8 as this is the
+!! expression which is used inside the remeshing formula and directly computes it
+!! minimize the number of operations.
+subroutine advecX_limitator_group(gp_s, ind_group, j, k, p_pos, &
+ & scalar, limit)
+
+ use mpi
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_correction! contains limitator computation
+ use precision_tools ! define working precision_tools (double or simple)
+
+ integer, dimension(2),intent(in) :: gp_s ! groupe size
+ integer, dimension(2), intent(in) :: ind_group ! group indice
+ integer , intent(in) :: j,k ! bloc coordinates
+ real(WP), dimension(:,:,:), intent(in) :: p_pos ! particle position
+ real(WP), dimension(:,:,:), intent(in) :: scalar ! scalar field to advect
+ real(WP), dimension(:,:,:), intent(out) :: limit ! limitator function
+
+ ! Local variables
+ real(WP),dimension(2,gp_s(1),gp_s(2)) :: Sbuffer, Rbuffer ! buffer to exchange scalar or limitator at boundaries with neighbors.
+ real(WP),dimension(gp_s(1),gp_s(2),N_proc(direction)+1) :: deltaS ! first order scalar variation
+ integer :: ind ! loop indice on particle indice
+ integer :: send_request ! mpi status of nonblocking send
+ integer :: rece_request ! mpi status of nonblocking receive
+ integer, dimension(MPI_STATUS_SIZE) :: rece_status ! mpi status (for mpi_wait)
+ integer, dimension(MPI_STATUS_SIZE) :: send_status ! mpi status (for mpi_wait)
+ integer, dimension(2) :: tag_table ! other tags for mpi message
+ integer :: com_size ! size of mpi message
+ integer :: ierr ! mpi error code
+
+ ! ===== Initialisation =====
+ com_size = 2*gp_s(1)*gp_s(2)
+
+ ! ===== Exchange ghost =====
+ ! Receive ghost value, ie value from neighbors boundaries.
+ tag_table = compute_tag(ind_group, tag_part_slope, direction)
+ call mpi_Irecv(Rbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,2), tag_table(1), D_comm(direction), rece_request, ierr)
+ ! Send ghost for the two first scalar values of each line
+ Sbuffer = scalar(1:2,j:j+gp_s(1)-1,k:k+gp_s(2)-1)
+ call mpi_ISsend(Sbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,1), tag_table(1), D_comm(direction), send_request, ierr)
+
+ ! ===== Compute scalar variation =====
+ ! -- For the "middle" block --
+ do ind = 1, N_proc(direction)-1
+ deltaS(:,:,ind) = scalar(ind+1,j:j+gp_s(1)-1,k:k+gp_s(2)-1) - scalar(ind,j:j+gp_s(1)-1,k:k+gp_s(2)-1)
+ end do
+ ! -- For the last elements of each line --
+ ! Check reception
+ call mpi_wait(rece_request, rece_status, ierr)
+ ! Compute delta
+ deltaS(:,:,N_proc(direction)) = Rbuffer(1,:,:) - scalar(ind,j:j+gp_s(1)-1,k:k+gp_s(2)-1) ! scalar(N+1) - scalar(N)
+ deltaS(:,:,N_proc(direction)+1) = Rbuffer(2,:,:) - Rbuffer(1,:,:) ! scalar(N+1) - scalar(N)
+
+
+ ! ===== Compute slope and limitator =====
+ call AC_limitator_from_slopes(direction, gp_s, p_pos, deltaS, &
+ & limit, tag_table(2), com_size)
+
+ ! ===== Close mpi_ISsend when done =====
+ call mpi_wait(send_request, send_status, ierr)
+
+end subroutine advecX_limitator_group
+
+
+!> Compute scalar slopes for introducing limitator - no communication variant
+!!(for topology without subdivision along X)
+!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] p_pos = particles position
+!! @param[in] scalar = scalar advected by particles
+!! @param[out] limit = limitator function
+!! @details
+!! This subroutine work on a groupe of line. For each line of this group, it
+!! determine the type of each block of this line and where corrected remeshing
+!! formula are required. In those points, it tagg block transition (ie the end of
+!! the current block and the beginning of the following one) in order to indicate
+!! that corrected weigth have to be used during the remeshing.
+!! Note that the subroutine actually computes limitator/8 as this is the
+!! expression which is used inside the remeshing formula and directly computes it
+!! minimize the number of operations.
+subroutine advecX_limitator_group_no_com(gp_s, j, k, p_pos, &
+ & scalar, limit)
+
+ use mpi
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use precision_tools ! define working precision_tools (double or simple)
+
+ integer, dimension(2),intent(in) :: gp_s ! groupe size
+ integer , intent(in) :: j,k ! bloc coordinates
+ real(WP), dimension(:,:,:), intent(in) :: p_pos ! particle position
+ real(WP), dimension(:,:,:), intent(in) :: scalar ! scalar field to advect
+ real(WP), dimension(:,:,:), intent(out) :: limit ! limitator function
+
+ ! Local variables
+ real(WP),dimension(gp_s(1),gp_s(2),0:N_proc(direction)+1) :: deltaS ! first order scalar variation
+ integer :: ind ! loop indice on particle indice
+ real(WP),dimension(gp_s(1),gp_s(2)) :: afl ! = cfl - [cfl] where [] denotes the nearest int.
+
+ ! ===== Compute scalar variation =====
+ ! -- For the "middle" block --
+ do ind = 1, N_proc(direction)-1
+ deltaS(:,:,ind) = scalar(ind+1,j:j+gp_s(1)-1,k:k+gp_s(2)-1) - scalar(ind,j:j+gp_s(1)-1,k:k+gp_s(2)-1)
+ end do
+ ! -- For the first element of each line --
+ deltaS(:,:,0) = scalar(1,j:j+gp_s(1)-1,k:k+gp_s(2)-1) - scalar(N(direction),j:j+gp_s(1)-1,k:k+gp_s(2)-1) ! scalar(1) - scalar(0)
+ ! -- For the last element of each line --
+ deltaS(:,:,N(direction)) = deltaS(:,:,0) ! scalar(N+1) - scalar(N)
+ deltaS(:,:,N(direction)+1) = deltaS(:,:,1) ! scalar(N+2) - scalar(N+1)
+
+
+ ! ===== Compute slope and limitator =====
+ ! Note that limit = limitator function/divided by 8
+ ! Van Leer limitator
+ do ind = 1, N_proc(direction)
+ where(deltaS(:,:,ind)/=0)
+ afl = p_pos(ind,:,:)
+ afl = afl - nint(afl)
+ ! If (p_pos-nint(p_pos))>=0)
+ where(afl>0)
+ limit(ind+1,:,:) = max(0.0_WP,(deltaS(:,:,ind-1)/deltaS(:,:,ind)))
+ limit(ind+1,:,:) = limit(ind+1,:,:)/(limit(ind+1,:,:)+1)
+ limit(ind+1,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl+0.5_WP)**2)*limit(ind+1,:,:)
+ elsewhere
+ limit(ind+1,:,:) = max(0.0_WP,(deltaS(:,:,ind+1)/deltaS(:,:,ind)))
+ limit(ind+1,:,:) = limit(ind+1,:,:)/(limit(ind+1,:,:)+1)
+ limit(ind+1,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl-0.5_WP)**2)*limit(ind+1,:,:)
+ end where
+ elsewhere
+ limit(ind+1,:,:) = 0.0_WP
+ end where
+ end do
+ limit(1,:,:) = limit(N_proc(direction)+1,:,:)
+ ! Classical (corrected) lambda formula: limitator function = 1
+ ! limit = 1._WP/8._WP
+
+end subroutine advecX_limitator_group_no_com
+
end module advecX
diff --git a/HySoP/src/scalesInterface/particles/advecY.f90 b/HySoP/src/scalesInterface/particles/advecY.f90
index 72dd6406c9d269fe2afdda3e81bde083ca23dd8d..80b8e176cca98612d7074af0cf0482e60197c58e 100644
--- a/HySoP/src/scalesInterface/particles/advecY.f90
+++ b/HySoP/src/scalesInterface/particles/advecY.f90
@@ -6,7 +6,7 @@
! MODULE: advecY
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module advecY is devoted to the advection along Y axis of a scalar field.
!! It used particle method and provide a parallel implementation.
!
@@ -30,17 +30,23 @@
module advecY
- use precision
+ use precision_tools
use advec_abstract_proc
implicit none
! ===== Public procedures =====
- public :: advecY_init_group! initialisation for a group of line of particles
- public :: advecY_remesh_in_buffer_gp
+ ! -- Init remeshing context --
+ public :: advecY_init_group
+ ! -- Remeshing algorithm --
+ public :: advecY_remesh_in_buffer_lambda
+ public :: advecY_remesh_in_buffer_limit_lambda
+ public :: advecY_remesh_in_buffer_Mprime
public :: advecY_remesh_buffer_to_scalar
- ! ===== Private porcedures =====
+ ! ===== Private procedures =====
+ ! -- Compute limitator --
+ public :: advecY_limitator_group
! ===== Private variables =====
!> current direction = alongY (to avoid redefinition and make more easy cut/paste)
@@ -64,25 +70,105 @@ contains
! ==================== Remeshing tools ====================
! ============================================================
-!> Remesh particle inside a buffer
+!>Remesh particle inside a buffer. Use corrected lambda remeshing polynoms.
+!!@autor Jean-Baptiste Lagaert
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] i,j = X- and Y-coordinates of the first line along X inside the current group of lines.
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
+!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] scalar = the initial scalar field transported by particles
+!! @param[out] buffer = buffer where particles are remeshed
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecY_remesh_in_buffer_lambda(gs, i, k, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
+ & scalar, buffer, pos_in_buffer)
+
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_abstract_proc ! profile of generic procedure
+ use advec_remeshing_lambda ! needed to remesh !!
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: i, k
+ integer, intent(in) :: ind_min
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
+ real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ ! in part corresponding to different processes
+
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ integer, dimension(2) :: send_range_all ! maximal (among the lines group) distance between me and processus to wich I send information
+ type(real_pter),dimension(:),allocatable:: remeshY_pter ! pointer to send buffer in which scalar are sorted by line indice.
+ ! sorted by receivers
+ integer :: i1, i2 ! indice of a line into the group
+ integer :: ind ! indice of the current particle inside the current line.
+
+ ! ===== Remeshing into the buffer by using pointer array =====
+ ! -- Allocate remeshY_pter --
+ send_range_all(1) = minval(send_min)
+ send_range_all(2) = maxval(send_max)
+ allocate(remeshY_pter(send_range_all(1):send_range_all(2)))
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+
+ do ind = send_min(i1,i2), send_max(i1,i2)
+ proc_gap = floor(real(ind-1)/N_proc(direction)) - (ind_min-1)
+ remeshY_pter(ind)%pter => buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end do
+
+ ! -- Remesh the particles in the buffer --
+ call AC_remesh_lambda_pter(direction, p_pos_adim(:,i1,i2), scalar(i+i1-1,:,k+i2-1), &
+ & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_range_all(1), remeshY_pter)
+
+ end do
+ end do
+ deallocate(remeshY_pter)
+
+ ! Now scalar is put in buffer. Therefore, scalar has to be
+ ! re-init to 0 before starting to redistribute to the scalar.
+ scalar(i:i+gs(1)-1,:,k:k+gs(2)-1) = 0
+
+end subroutine advecY_remesh_in_buffer_lambda
+
+
+!> Remesh particle inside a buffer. Use corrected limited (corrected) lambda remeshing polynoms.
!! @autor Jean-Baptiste Lagaert
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
-!! It actually start from ind_min and to avoid access out of range,
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] limit = limitator function
!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] scalar = the initial scalar field transported by particles
!! @param[out] buffer = buffer where particles are remeshed
-!! @param[in] remesh_line = subroutine wich remesh a line of particle with the right remeshing formula
-subroutine advecY_remesh_in_buffer_gp(gs, i, k, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
- & scalar, remesh_line, buffer, pos_in_buffer)
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecY_remesh_in_buffer_limit_lambda(gs, i, k, ind_min, p_pos_adim, bl_type, bl_tag, limit, &
+ & send_min, send_max, scalar, buffer, pos_in_buffer)
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
- use advec_abstract_proc ! profile of generic procedure
- use advec_remeshing_formula ! needed to remesh !!
+!use advec_abstract_proc ! profile of generic procedure
+ use advec_remeshing_lambda ! needed to remesh !!
! Input/Output
integer, dimension(2), intent(in) :: gs
@@ -91,16 +177,16 @@ subroutine advecY_remesh_in_buffer_gp(gs, i, k, ind_min, p_pos_adim, bl_type, bl
real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(:,:,:), intent(in) :: limit ! limitator function (divided by 8)
integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
- procedure(AC_remesh_line_pter), pointer, intent(in) :: remesh_line ! subroutine wich remesh a line of particle with the right remeshing formula
real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
! in part corresponding to different processes
- ! Other local variables
- integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
type(real_pter),dimension(:),allocatable:: remeshY_pter ! pointer to send buffer in which scalar are sorted by line indice.
! sorted by receivers
integer :: i1, i2 ! indice of a line into the group
@@ -121,8 +207,8 @@ subroutine advecY_remesh_in_buffer_gp(gs, i, k, ind_min, p_pos_adim, bl_type, bl
end do
! -- Remesh the particles in the buffer --
- call remesh_line(direction, p_pos_adim(:,i1,i2), scalar(i+i1-1,:,k+i2-1), &
- & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_j_min, remeshY_pter)
+ call AC_remesh_lambda2limited_pter(direction, p_pos_adim(:,i1,i2), scalar(i+i1-1,:,k+i2-1), &
+ & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_j_min, limit(:,i1,i2), remeshY_pter)
deallocate(remeshY_pter)
end do
@@ -132,26 +218,26 @@ subroutine advecY_remesh_in_buffer_gp(gs, i, k, ind_min, p_pos_adim, bl_type, bl
! re-init to 0 before starting to redistribute to the scalar.
scalar(i:i+gs(1)-1,:,k:k+gs(2)-1) = 0
-end subroutine advecY_remesh_in_buffer_gp
+end subroutine advecY_remesh_in_buffer_limit_lambda
-!> Remesh particle inside a buffer - for M'6 - direction = along Y
+!> Remesh particle inside a buffer - for M'6 or M'8 - direction = along Y
!! @autor Jean-Baptiste Lagaert
!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
-!! It actually start from ind_min and to avoid access out of range,
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] scalar = the initial scalar field transported by particles
!! @param[out] buffer = buffer where particles are remeshed
-subroutine advecY_remesh_in_buffer_Mprime6(gs, i, k, ind_min, p_pos_adim, send_min, send_max, &
+subroutine advecY_remesh_in_buffer_Mprime(gs, i, k, ind_min, p_pos_adim, send_min, send_max, &
& scalar, buffer, pos_in_buffer)
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
use advec_abstract_proc ! profile of generic procedure
- use advec_remeshing_formula ! remeshing formula and wrapper for a line of particles
+ use advec_remeshing_Mprime ! remeshing formula and wrapper for a line of particles
! Input/Output
integer, dimension(2), intent(in) :: gs
@@ -162,16 +248,16 @@ subroutine advecY_remesh_in_buffer_Mprime6(gs, i, k, ind_min, p_pos_adim, send_m
integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
! in part corresponding to different processes
- ! Other local variables
- integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
type(real_pter),dimension(:),allocatable:: remeshY_pter ! pointer to send buffer in which scalar are sorted by line indice.
! sorted by receivers
integer :: i1, i2 ! indice of a line into the group
integer :: ind ! indice of the current particle inside the current line.
- real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice
+ real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice
! are now starting from 1 and not ind_min
@@ -191,7 +277,7 @@ subroutine advecY_remesh_in_buffer_Mprime6(gs, i, k, ind_min, p_pos_adim, send_m
! -- Remesh the particles in the buffer --
do ind = 1, N_proc(direction)
- call AC_remesh_Mprime6_pter(pos_translat(ind), scalar(i+i1-1,ind,k+i2-1), remeshY_pter)
+ call AC_remesh_Mprime_pter(pos_translat(ind), scalar(i+i1-1,ind,k+i2-1), remeshY_pter)
end do
deallocate(remeshY_pter)
@@ -201,7 +287,7 @@ subroutine advecY_remesh_in_buffer_Mprime6(gs, i, k, ind_min, p_pos_adim, send_m
! Scalar must be re-init before ending the remeshing
scalar(i:i+gs(1)-1,:,k:k+gs(2)-1) = 0
-end subroutine advecY_remesh_in_buffer_Mprime6
+end subroutine advecY_remesh_in_buffer_Mprime
!> Update the scalar field with scalar stored into the buffer
@@ -209,10 +295,10 @@ end subroutine advecY_remesh_in_buffer_Mprime6
!! @param[in] i,k = Y- and Z-coordinate of the first line along X inside the current group of lines.
!! @param[in] ind_proc = algebric distance between me and the processus which send me the buffer. To read the right cartography.
!! @param[in] gap = algebric distance between my local indice and the local indices from the processus which send me the buffer.
-!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
+!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
!! array where indice along the the direction of the group of lines are stored.
-!! @param[in] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
+!! @param[in] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
!! of mesh points from where it requiers the velocity values.
!! @param[in] buffer = buffer containing to redistribute into the scalar field.
!! @param[out] scalar = scalar field (to update)
@@ -224,7 +310,7 @@ subroutine advecY_remesh_buffer_to_scalar(gs, i, k, ind_proc, gap, begin_i1, car
integer, intent(in) :: i, k
integer, intent(in) :: ind_proc ! to read the good cartography associate to the processus which send me the buffer.
integer,intent(in) :: gap ! gap between my local indices and the local indices from another processes
- integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
+ integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
! array where indice along the the direction of the group of lines are stored.
integer, dimension(:,:), intent(in) :: cartography
real(WP),dimension(:), intent(in) :: buffer ! buffer containing the data to redistribute into the local scalar field.
@@ -232,7 +318,7 @@ subroutine advecY_remesh_buffer_to_scalar(gs, i, k, ind_proc, gap, begin_i1, car
integer, intent(out) :: beg_buffer ! first indice inside where the scalar values are stored into the buffer for the current sender processus.
! To know where reading data into the buffer.
- ! Other local variables
+ ! Other local variables
integer :: i1, i2 ! indice of a line into the group
integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography?
integer :: ind_i1_range ! ito know where to read the first coordinate (i1) of the current line inside the cartography.
@@ -274,7 +360,7 @@ end subroutine advecY_remesh_buffer_to_scalar
!! @param[in] k = Z-indice of the current line
!! @param[in] Gsize = size of groups (along Y direction)
!! @param[out] p_pos_adim = adimensioned particles postion
-!! @param[out] p_V = particle velocity
+!! @param[out] p_V = particle velocity
subroutine advecY_init_group(Vy, i, k, Gsize, p_pos_adim, p_V)
use cart_topology ! description of mesh and of mpi topology
@@ -299,5 +385,100 @@ subroutine advecY_init_group(Vy, i, k, Gsize, p_pos_adim, p_V)
end subroutine advecY_init_group
+! ######################################################################################
+! ##### #####
+! ##### Private procedure #####
+! ##### #####
+! ######################################################################################
+
+! ==================================================================================================================================
+! ==================== Compute scalar slope for introducing limitator (against numerical oscillations) ====================
+! ==================================================================================================================================
+
+!> Compute scalar slopes for introducing limitator
+!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] p_pos = particles position
+!! @param[in] scalar = scalar advected by particles
+!! @param[out] limit = limitator function
+!! @details
+!! This subroutine work on a groupe of line. For each line of this group, it
+!! determine the type of each block of this line and where corrected remeshing
+!! formula are required. In those points, it tagg block transition (ie the end of
+!! the current block and the beginning of the following one) in order to indicate
+!! that corrected weigth have to be used during the remeshing.
+!! Note that the subroutine actually computes limitator/8 as this is the
+!! expression which is used inside the remeshing formula and directly computes it
+!! minimize the number of operations.
+subroutine advecY_limitator_group(gp_s, ind_group, i, k, p_pos, &
+ & scalar, limit)
+
+ use mpi
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_correction! contains limitator computation
+ use precision_tools ! define working precision_tools (double or simple)
+
+ integer, dimension(2),intent(in) :: gp_s ! groupe size
+ integer, dimension(2), intent(in) :: ind_group ! group indice
+ integer, intent(in) :: i,k ! bloc coordinates
+ real(WP), dimension(:,:,:), intent(in) :: p_pos ! particle position
+ real(WP), dimension(:,:,:), intent(in) :: scalar ! scalar field to advect
+ real(WP), dimension(:,:,:), intent(out) :: limit ! limitator function
+
+ ! Local variables
+ real(WP),dimension(gp_s(1),gp_s(2),2) :: Sbuffer, Rbuffer ! buffer to exchange scalar or limitator at boundaries with neighbors.
+ real(WP),dimension(gp_s(1),gp_s(2),N_proc(direction)+1) :: deltaS ! first order scalar variation
+ integer :: ind,i1,i2 ! loop indice
+ integer :: send_request ! mpi status of nonblocking send
+ integer :: rece_request ! mpi status of nonblocking receive
+ integer, dimension(MPI_STATUS_SIZE) :: rece_status ! mpi status (for mpi_wait)
+ integer, dimension(MPI_STATUS_SIZE) :: send_status ! mpi status (for mpi_wait)
+ integer, dimension(2) :: tag_table ! other tags for mpi message
+ integer :: com_size ! size of mpi message
+ integer :: ierr ! mpi error code
+
+ ! ===== Initialisation =====
+ com_size = 2*gp_s(1)*gp_s(2)
+
+ ! ===== Exchange ghost =====
+ ! Receive ghost value, ie value from neighbors boundaries.
+ tag_table = compute_tag(ind_group, tag_part_slope, direction)
+ call mpi_Irecv(Rbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,2), tag_table(1), D_comm(direction), rece_request, ierr)
+ ! Send ghost for the two first scalar values of each line
+ do i1 = 1, gp_s(1)
+ do i2 = 1, gp_s(2)
+ Sbuffer(i1,i2,1) = scalar(i+i1-1,1,k+i2-1)
+ Sbuffer(i1,i2,2) = scalar(i+i1-1,2,k+i2-1)
+ end do
+ end do
+ call mpi_ISsend(Sbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,1), tag_table(1), D_comm(direction), send_request, ierr)
+
+ ! ===== Compute scalar variation =====
+ ! -- For the "middle" block --
+ do ind = 1, N_proc(direction)-1
+ deltaS(:,:,ind) = scalar(i:i+gp_s(1)-1,ind+1,k:k+gp_s(2)-1) &
+ & - scalar(i:i+gp_s(1)-1,ind,k:k+gp_s(2)-1)
+ end do
+ ! -- For the last element of each line --
+ ! Check reception
+ call mpi_wait(rece_request, rece_status, ierr)
+ ! Compute delta
+ deltaS(:,:,N_proc(direction)) = Rbuffer(:,:,1) - scalar(i:i+gp_s(1)-1,ind,k:k+gp_s(2)-1) ! scalar(N+1) - scalar(N)
+ deltaS(:,:,N_proc(direction)+1) = Rbuffer(:,:,2) - Rbuffer(:,:,1) ! scalar(N+1) - scalar(N)
+
+
+ ! ===== Compute limitator =====
+ call AC_limitator_from_slopes(direction, gp_s, p_pos, deltaS, &
+ & limit, tag_table(2), com_size)
+
+ ! ===== Close mpi_ISsend when done =====
+ call mpi_wait(send_request, send_status, ierr)
+
+end subroutine advecY_limitator_group
+
+
end module advecY
!> @}
diff --git a/HySoP/src/scalesInterface/particles/advecZ.f90 b/HySoP/src/scalesInterface/particles/advecZ.f90
index 89a089e148c9f8d4dabd916f610472a974af7ced..df522818376979f439a6ce89b5da4494fb60f34d 100644
--- a/HySoP/src/scalesInterface/particles/advecZ.f90
+++ b/HySoP/src/scalesInterface/particles/advecZ.f90
@@ -6,7 +6,7 @@
! MODULE: advecZ
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module advecZ is devoted to the advection along Z axis of a scalar field.
!! It used particle method and provide a parallel implementation.
!
@@ -30,17 +30,24 @@
module advecZ
- use precision
+ use precision_tools
use advec_abstract_proc
implicit none
! ===== Public procedures =====
- ! Particles initialisation
- public :: advecZ_init_group! initialisation for a group of line of particles
- public :: advecZ_remesh_in_buffer_gp
+ ! -- Init remeshing context --
+ public :: advecZ_init_group
+ ! -- Remeshing algorithm --
+ public :: advecZ_remesh_in_buffer_lambda
+ public :: advecZ_remesh_in_buffer_limit_lambda
+ public :: advecZ_remesh_in_buffer_Mprime
public :: advecZ_remesh_buffer_to_scalar
+ ! ===== Private procedures =====
+ ! -- Compute limitator --
+ public :: advecZ_limitator_group
+
! ===== Private variable ====
!> Current direction = 3 ie along Z
integer, parameter, private :: direction = 3
@@ -57,25 +64,105 @@ contains
! ==================== Remeshing tools ====================
! ====================================================================
-!> Remesh particle inside a buffer
+!>Remesh particle inside a buffer. Use corrected lambda remeshing polynoms.
+!!@autor Jean-Baptiste Lagaert
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] i,j = X- and Y-coordinates of the first line along X inside the current group of lines.
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
+!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] send_range_all = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] scalar = the initial scalar field transported by particles
+!! @param[out] buffer = buffer where particles are remeshed
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecZ_remesh_in_buffer_lambda(gs, i, j, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
+ & scalar, buffer, pos_in_buffer)
+
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_abstract_proc ! profile of generic procedure
+ use advec_remeshing_lambda ! needed to remesh !!
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: i, j
+ integer, intent(in) :: ind_min
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
+ real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ ! in part corresponding to different processes
+
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ integer, dimension(2) :: send_range_all ! maximal (among the lines group) distance between me and processus to wich I send information
+ type(real_pter),dimension(:),allocatable:: remeshZ_pter ! pointer to send buffer in which scalar are sorted by line indice.
+ ! sorted by receivers
+ integer :: i1, i2 ! indice of a line into the group
+ integer :: ind ! indice of the current particle inside the current line.
+
+ ! ===== Remeshing into the buffer by using pointer array =====
+ ! -- Allocate remeshX_pter --
+ send_range_all(1) = minval(send_min)
+ send_range_all(2) = maxval(send_max)
+ allocate(remeshZ_pter(send_range_all(1):send_range_all(2)))
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+
+ do ind = send_min(i1,i2), send_max(i1,i2)
+ proc_gap = floor(real(ind-1)/N_proc(direction)) - (ind_min-1)
+ remeshZ_pter(ind)%pter => buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end do
+
+ ! -- Remesh the particles in the buffer --
+ call AC_remesh_lambda_pter(direction, p_pos_adim(:,i1,i2), scalar(i+i1-1,j+i2-1,:), &
+ & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_range_all(1), remeshZ_pter)
+
+ end do
+ end do
+ deallocate(remeshZ_pter)
+
+ ! Scalar must be re-init before ending the remeshing
+ scalar(i:i+gs(1)-1,j:j+gs(2)-1,:) = 0
+
+end subroutine advecZ_remesh_in_buffer_lambda
+
+
+!> Remesh particle inside a buffer. Use corrected lambda remeshing polynoms.
!! @autor Jean-Baptiste Lagaert
!! @param[in] gs = size of group of line along the current direction
!! @param[in] i,j = X- and Y-coordinates of the first line along X inside the current group of lines.
-!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
-!! It actually start from ind_min and to avoid access out of range,
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] limit = limitator function
!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] scalar = the initial scalar field transported by particles
!! @param[out] buffer = buffer where particles are remeshed
-!! @param[in] remesh_line = subroutine wich remesh a line of particle with the right remeshing formula
-subroutine advecZ_remesh_in_buffer_gp(gs, i, j, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
- & scalar, remesh_line, buffer, pos_in_buffer)
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecZ_remesh_in_buffer_limit_lambda(gs, i, j, ind_min, p_pos_adim, bl_type, bl_tag, limit, &
+ & send_min, send_max, scalar, buffer, pos_in_buffer)
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
use advec_abstract_proc ! profile of generic procedure
- use advec_remeshing_formula ! needed to remesh !!
+ use advec_remeshing_lambda ! needed to remesh !!
! Input/Output
integer, dimension(2), intent(in) :: gs
@@ -84,16 +171,16 @@ subroutine advecZ_remesh_in_buffer_gp(gs, i, j, ind_min, p_pos_adim, bl_type, bl
real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(:,:,:), intent(in) :: limit ! limitator function (divided by 8)
integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
- procedure(AC_remesh_line_pter), pointer, intent(in) :: remesh_line ! subroutine wich remesh a line of particle with the right remeshing formula
real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
! in part corresponding to different processes
- ! Other local variables
- integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
type(real_pter),dimension(:),allocatable:: remeshZ_pter ! pointer to send buffer in which scalar are sorted by line indice.
! sorted by receivers
integer :: i1, i2 ! indice of a line into the group
@@ -114,8 +201,8 @@ subroutine advecZ_remesh_in_buffer_gp(gs, i, j, ind_min, p_pos_adim, bl_type, bl
end do
! -- Remesh the particles in the buffer --
- call remesh_line(direction, p_pos_adim(:,i1,i2), scalar(i+i1-1,j+i2-1,:), &
- & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_j_min, remeshZ_pter)
+ call AC_remesh_lambda2limited_pter(direction, p_pos_adim(:,i1,i2), scalar(i+i1-1,j+i2-1,:), &
+ & bl_type(:,i1,i2), bl_tag(:,i1,i2), send_j_min, limit(:,i1,i2), remeshZ_pter)
deallocate(remeshZ_pter)
end do
@@ -124,27 +211,29 @@ subroutine advecZ_remesh_in_buffer_gp(gs, i, j, ind_min, p_pos_adim, bl_type, bl
! Scalar must be re-init before ending the remeshing
scalar(i:i+gs(1)-1,j:j+gs(2)-1,:) = 0
-end subroutine advecZ_remesh_in_buffer_gp
+end subroutine advecZ_remesh_in_buffer_limit_lambda
-!> Remesh particle inside a buffer - for M'6 - direction = along Z
+!> Remesh particle inside a buffer - for M'6 or M'8 - direction = along Z
!! @autor Jean-Baptiste Lagaert
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
-!! It actually start from ind_min and to avoid access out of range,
+!! @param[in] i,j = X- and Y-coordinates of the first line along X inside the current group of lines.
+!! @param[in] ind_min = indices from the original array "pos_in_buffer" does not start from 1.
+!! It actually start from ind_min and to avoid access out of range,
!! a gap of (-ind_min) will be added to each indices from "pos_in_buffer.
+!! @param[in] p_pos_adim = adimensionned particles position
!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
!! @param[in] scalar = the initial scalar field transported by particles
!! @param[out] buffer = buffer where particles are remeshed
-subroutine advecZ_remesh_in_buffer_Mprime6(gs, i, j, ind_min, p_pos_adim, send_min, send_max, &
+!! @param[in,out] pos_in_buffer = information about where remesing the particle inside the buffer
+subroutine advecZ_remesh_in_buffer_Mprime(gs, i, j, ind_min, p_pos_adim, send_min, send_max, &
& scalar, buffer, pos_in_buffer)
use cart_topology ! Description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
use advec_abstract_proc ! profile of generic procedure
- use advec_remeshing_formula ! remeshing formula and wrapper for a line of particles
+ use advec_remeshing_Mprime ! remeshing formula and wrapper for a line of particles
! Input/Output
integer, dimension(2), intent(in) :: gs
@@ -155,16 +244,16 @@ subroutine advecZ_remesh_in_buffer_Mprime6(gs, i, j, ind_min, p_pos_adim, send_m
integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
! in part corresponding to different processes
- ! Other local variables
- integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! Other local variables
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
type(real_pter),dimension(:),allocatable:: remeshZ_pter ! pointer to send buffer in which scalar are sorted by line indice.
! sorted by receivers
integer :: i1, i2 ! indice of a line into the group
integer :: ind ! indice of the current particle inside the current line.
- real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice
+ real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice
! are now starting from 1 and not ind_min
@@ -184,7 +273,7 @@ subroutine advecZ_remesh_in_buffer_Mprime6(gs, i, j, ind_min, p_pos_adim, send_m
! -- Remesh the particles in the buffer --
do ind = 1, N_proc(direction)
- call AC_remesh_Mprime6_pter(pos_translat(ind), scalar(i+i1-1,j+i2-1,ind), remeshZ_pter)
+ call AC_remesh_Mprime_pter(pos_translat(ind), scalar(i+i1-1,j+i2-1,ind), remeshZ_pter)
end do
deallocate(remeshZ_pter)
@@ -194,7 +283,7 @@ subroutine advecZ_remesh_in_buffer_Mprime6(gs, i, j, ind_min, p_pos_adim, send_m
! Scalar must be re-init before ending the remeshing
scalar(i:i+gs(1)-1,j:j+gs(2)-1,:) = 0
-end subroutine advecZ_remesh_in_buffer_Mprime6
+end subroutine advecZ_remesh_in_buffer_Mprime
!> Update the scalar field with scalar stored into the buffer
@@ -202,10 +291,10 @@ end subroutine advecZ_remesh_in_buffer_Mprime6
!! @param[in] i,j = X- and Y-coordinates of the first line along X inside the current group of lines.
!! @param[in] ind_proc = algebric distance between me and the processus which send me the buffer. To read the right cartography.
!! @param[in] gap = algebric distance between my local indice and the local indices from the processus which send me the buffer.
-!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
+!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
!! array where indice along the the direction of the group of lines are stored.
-!! @param[in] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
+!! @param[in] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
!! of mesh points from where it requiers the velocity values.
!! @param[in] buffer = buffer containing to redistribute into the scalar field.
!! @param[out] scalar = scalar field (to update)
@@ -217,7 +306,7 @@ subroutine advecZ_remesh_buffer_to_scalar(gs, i, j, ind_proc, gap, begin_i1, car
integer, intent(in) :: i, j
integer, intent(in) :: ind_proc ! to read the good cartography associate to the processus which send me the buffer.
integer,intent(in) :: gap ! gap between my local indices and the local indices from another processes
- integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
+ integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
! array where indice along the the direction of the group of lines are stored.
integer, dimension(:,:), intent(in) :: cartography
real(WP),dimension(:), intent(in) :: buffer ! buffer containing the data to redistribute into the local scalar field.
@@ -225,7 +314,7 @@ subroutine advecZ_remesh_buffer_to_scalar(gs, i, j, ind_proc, gap, begin_i1, car
integer, intent(out) :: beg_buffer ! first indice inside where the scalar values are stored into the buffer for the current sender processus.
! To know where reading data into the buffer.
- ! Other local variables
+ ! Other local variables
integer :: i1, i2 ! indice of a line into the group
integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography?
integer :: ind_i1_range ! ito know where to read the first coordinate (i1) of the current line inside the cartography.
@@ -292,5 +381,97 @@ subroutine advecZ_init_group(Vz, i, j, Gsize, p_pos_adim, p_V)
end subroutine advecZ_init_group
+
+! ######################################################################################
+! ##### #####
+! ##### Private procedure #####
+! ##### #####
+! ######################################################################################
+
+! ==================================================================================================================================
+! ==================== Compute scalar slope for introducing limitator (against numerical oscillations) ====================
+! ==================================================================================================================================
+
+!> Compute scalar slopes for introducing limitator
+!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] p_pos = particles position
+!! @param[in] scalar = scalar advected by particles
+!! @param[out] limit = limitator function
+!! @details
+!! This subroutine work on a groupe of line. For each line of this group, it
+!! determine the type of each block of this line and where corrected remeshing
+!! formula are required. In those points, it tagg block transition (ie the end of
+!! the current block and the beginning of the following one) in order to indicate
+!! that corrected weigth have to be used during the remeshing.
+!! Note that the subroutine actually computes limitator/8 as this is the
+!! expression which is used inside the remeshing formula and directly computes it
+!! minimize the number of operations.
+subroutine advecZ_limitator_group(gp_s, ind_group, i, j, p_pos, &
+ & scalar, limit)
+
+ use mpi
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_correction! contains limitator computation
+ use precision_tools ! define working precision_tools (double or simple)
+
+ integer, dimension(2),intent(in) :: gp_s ! groupe size
+ integer, dimension(2), intent(in) :: ind_group ! group indice
+ integer , intent(in) :: i,j ! bloc coordinates
+ real(WP), dimension(:,:,:), intent(in) :: p_pos ! particle position
+ real(WP), dimension(:,:,:), intent(in) :: scalar ! scalar field to advect
+ real(WP), dimension(:,:,:), intent(out) :: limit ! limitator function
+
+ ! Local variables
+ real(WP),dimension(gp_s(1),gp_s(2),2) :: Sbuffer, Rbuffer ! buffer to exchange scalar or limitator at boundaries with neighbors.
+ real(WP),dimension(gp_s(1),gp_s(2),N_proc(direction)+1) :: deltaS ! first order scalar variation
+ integer :: ind ! loop indice on particle indice
+ integer :: send_request ! mpi status of nonblocking send
+ integer :: rece_request ! mpi status of nonblocking receive
+ integer, dimension(MPI_STATUS_SIZE) :: rece_status ! mpi status (for mpi_wait)
+ integer, dimension(MPI_STATUS_SIZE) :: send_status ! mpi status (for mpi_wait)
+ integer, dimension(2) :: tag_table ! other tags for mpi message
+ integer :: com_size ! size of mpi message
+ integer :: ierr ! mpi error code
+
+ ! ===== Initialisation =====
+ com_size = 2*gp_s(1)*gp_s(2)
+
+ ! ===== Exchange ghost =====
+ ! Receive ghost value, ie value from neighbors boundaries.
+ tag_table = compute_tag(ind_group, tag_part_slope, direction)
+ call mpi_Irecv(Rbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,2), tag_table(1), D_comm(direction), rece_request, ierr)
+ ! Send ghost for the two first scalar values of each line
+ Sbuffer = scalar(i:i+gp_s(1)-1,j:j+gp_s(2)-1,1:2)
+ call mpi_ISsend(Sbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,1), tag_table(1), D_comm(direction), send_request, ierr)
+
+ ! ===== Compute scalar variation =====
+ ! -- For the "middle" block --
+ do ind = 1, N_proc(direction)-1
+ deltaS(:,:,ind) = scalar(i:i+gp_s(1)-1,j:j+gp_s(2)-1,ind+1) &
+ & - scalar(i:i+gp_s(1)-1,j:j+gp_s(2)-1,ind)
+ end do
+ ! -- For the last elements of each line --
+ ! Check reception
+ call mpi_wait(rece_request, rece_status, ierr)
+ ! Compute delta
+ deltaS(:,:,N_proc(direction)) = Rbuffer(:,:,1) &
+ & - scalar(i:i+gp_s(1)-1,j:j+gp_s(2)-1,ind) ! scalar(N+1) - scalar(N)
+ deltaS(:,:,N_proc(direction)+1) = Rbuffer(:,:,2) - Rbuffer(:,:,1) ! scalar(N+1) - scalar(N)
+
+
+ ! ===== Compute slope and limitator =====
+ call AC_limitator_from_slopes(direction, gp_s, p_pos, deltaS, &
+ & limit, tag_table(2), com_size)
+
+ ! ===== Close mpi_ISsend when done =====
+ call mpi_wait(send_request, send_status, ierr)
+
+end subroutine advecZ_limitator_group
+
+
end module advecZ
!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_Vector.F90 b/HySoP/src/scalesInterface/particles/advec_Vector.F90
new file mode 100644
index 0000000000000000000000000000000000000000..5cde64bc34a2dc043e83d07bbb127ca6c37354b3
--- /dev/null
+++ b/HySoP/src/scalesInterface/particles/advec_Vector.F90
@@ -0,0 +1,341 @@
+!> @addtogroup part
+!! @{
+!------------------------------------------------------------------------------
+!
+! MODULE: advec
+!
+!
+! DESCRIPTION:
+!> The module advec provides all public interfaces to solve an advection equation
+!! with a particle method.
+!
+!> @details
+!! This module contains the generic procedure to initialize and parametrise the
+!! advection solver based on particles method. It also contains the subroutine
+!! "advec_step" wich solves the equation for a given time step. It is the only one
+!! module which is supposed to be included by a code using this library of
+!! particle methods.
+!
+!> @author
+!! Jean-Baptiste Lagaert, LEGI
+!
+!------------------------------------------------------------------------------
+module advec_Vect
+
+ use precision_tools
+ use advec_abstract_proc
+ implicit none
+
+ ! ===== Private variables =====
+ !> numerical method use to advect the scalar
+ character(len=str_short), private :: type_part_solv
+ !> dimensionnal splitting (eg classical, Strang or particle)
+ character(len=str_short), private :: dim_splitting
+ !> Group size along current direction
+ integer, private, dimension(2) :: gsX, gsY, gsZ
+
+
+ ! ===== Public procedures =====
+ ! Scheme used to advec the scalar (order 2 or 4 ?)
+! public :: type_part_solver
+
+ ! Advection methods
+! public :: advec_init ! initialize the scalar solver
+ public :: advec_step_Vect ! advec the scalar field during a time step.
+! procedure(advec_step_Torder2), pointer, public :: advec_step => null()
+! public :: advec_step_Torder1 ! advec the scalar field during a time step.
+! public :: advec_step_Torder2 ! advec the scalar field during a time step.
+!
+ ! Remeshing formula
+ procedure(AC_remesh), pointer, private :: advec_remesh_bis => null()
+
+contains
+
+! ===== Public methods =====
+
+!> Return the name of the particle method used for the advection
+!! @return type_part_solver = numerical method used for advection
+function type_part_solver()
+ character(len=str_short) :: type_part_solver
+
+ type_part_solver = type_part_solv
+end function
+
+
+!> Initialise the particle advection methods
+!! @param[in] order = to choose the remeshing method (and thus the order)
+!! @param[out] stab_coeff = stability coefficient (condition stability is
+!! dt< stab_coeff/norm_inf(V))
+!! @param[in] dim_split = dimensionnal splitting (eg classical,
+!! Strang splitting or particle splitting)
+!! @param[in] verbosity = to display info about chosen remeshing formula (optional)
+subroutine advec_init_Vect(order, stab_coeff, verbosity, dim_split)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+ use advecX ! solver for advection along X
+ use advecY ! solver for advection along Y
+ use advecZ ! solver for advection along Z
+ use advec_common ! some procedures common to advection along all directions
+
+ ! Input/Output
+ character(len=*), optional, intent(in) :: order, dim_split
+ logical, optional, intent(in) :: verbosity
+ real(WP), optional, intent(out) :: stab_coeff
+
+ ! Use default solver if it is not chosen by the user.
+ if(present(order)) then
+ type_part_solv = order
+ else
+ type_part_solv = 'p_O2'
+ end if
+
+ ! Initialize the solver
+ if (present(verbosity)) then
+ call AC_solver_init(type_part_solv, verbosity)
+ else
+ call AC_solver_init(type_part_solv)
+ end if
+
+ if (present(stab_coeff)) stab_coeff = 1.0/(dble(bl_size))
+
+ ! Call the right remeshing formula
+ select case(type_part_solv)
+ case('p_O2')
+ advec_remesh_bis => AC_remesh_lambda_group
+ case('p_O4')
+ advec_remesh_bis => AC_remesh_lambda_group
+ case('p_L2')
+ advec_remesh_bis => AC_remesh_limit_lambda_group
+ case('p_M6')
+ advec_remesh_bis => AC_remesh_Mprime_group
+ case('p_M8')
+ advec_remesh_bis => AC_remesh_Mprime_group
+ case default
+ advec_remesh_bis => AC_remesh_lambda_group
+ end select
+
+ call AC_setup_init()
+
+ ! Save group size
+ gsX =group_size(1,:)
+ gsY =group_size(2,:)
+ gsZ =group_size(3,:)
+
+end subroutine advec_init_Vect
+
+
+!> Solve advection equation - order 2 in time (order 2 dimensional splitting)
+!! @param[in] dt = time step
+!! @param[in] Vx = velocity along x (could be discretised on a bigger mesh then the scalar)
+!! @param[in] Vy = velocity along y
+!! @param[in] Vz = velocity along z
+!! @param[in,out] scal = scalar field to advect
+subroutine advec_step_Vect(dt, Vx, Vy, Vz, scal_Vector)
+
+ use advecX ! Method to advec along X
+ use advecY ! Method to advec along Y
+ use advecZ ! Method to advec along Z
+
+ ! Input/Output
+ real(WP), intent(in) :: dt
+ real(WP), dimension(:,:,:), intent(in) :: Vx, Vy, Vz
+ real(WP), dimension(:,:,:,:), intent(inout) :: scal_Vector
+
+ call advecX_calc_Vect(dt/2.0, Vx, scal_Vector)
+ call advecY_calc_Vect(dt/2.0, Vy, scal_Vector)
+ call advecZ_calc_Vect(dt/2.0, Vz, scal_Vector)
+ call advecZ_calc_Vect(dt/2.0, Vz, scal_Vector)
+ call advecY_calc_Vect(dt/2.0, Vy, scal_Vector)
+ call advecX_calc_Vect(dt/2.0, Vx, scal_Vector)
+
+end subroutine advec_step_Vect
+
+
+!> Scalar advection (this procedure call the right solver, depending on the simulation setup)
+!! @param[in] dt = time step
+!! @param[in] Vx = velocity along X (could be discretised on a bigger mesh then the scalar)
+!! @param[in,out] scal_vect = scalar field to advect
+subroutine advecX_calc_Vect(dt, Vx, scal_vect)
+
+ use advecX ! Procedure specific to advection along X
+ use advec_common ! Some procedures common to advection along all directions
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+
+ ! Input/Output
+ real(WP), intent(in) :: dt
+ real(WP), dimension(N_proc(1), N_proc(2), N_proc(3)), intent(in) :: Vx
+ real(WP), dimension(:,:,:,:), intent(inout) :: scal_vect
+ ! Other local variables
+ integer, parameter :: direction =1 ! current direction
+ integer :: j,k ! indice of the currend mesh point
+ integer :: sca ! indice of the currend scalar field
+ integer, dimension(2) :: ind_group ! indice of the currend group of line (=(i,k) by default)
+ real(WP),dimension(N_proc(direction),gsX(1),gsX(2)) :: p_pos_adim ! adimensionned particles position
+ real(WP),dimension(N_proc(direction),gsX(1),gsX(2)) :: p_V ! particles velocity
+
+ ! Allocate send_ind_min/max
+ if(allocated(send_group_min)) deallocate(send_group_min)
+ allocate(send_group_min(group_size(direction,1),group_size(direction,2)))
+ if(allocated(send_group_max)) deallocate(send_group_max)
+ allocate(send_group_max(group_size(direction,1),group_size(direction,2)))
+
+ ! Initialise the pointer for optimized remeshing
+ call AC_setup_alongX()
+
+ ind_group = 0
+
+ do k = 1, N_proc(3), gsX(2)
+ ind_group(2) = ind_group(2) + 1
+ ind_group(1) = 0
+ do j = 1, N_proc(2), gsX(1)
+ ind_group(1) = ind_group(1) + 1
+
+ ! ===== Init particles =====
+ call advecX_init_group(Vx, j, k, gsX, p_pos_adim, p_V)
+
+ ! ===== Advection =====
+ ! -- Compute velocity (with a RK2 scheme) --
+ call AC_velocity_interpol_group(dt, direction, gsX, ind_group, p_pos_adim, p_V)
+
+ ! -- Advec particles --
+ p_pos_adim = p_pos_adim + dt*p_V/d_sc(direction)
+
+ ! ===== Remeshing =====
+ do sca = 1, size(scal_vect,4)
+ call advec_remesh_bis(direction, ind_group, gsX, &
+ & p_pos_adim, p_V, j, k, scal_Vect(:,:,:,sca), dt)
+ end do
+
+ end do
+ end do
+
+end subroutine advecX_calc_Vect
+
+
+!> Scalar advection along Y (this procedure call the right solver, depending on the simulation setup)
+!! @param[in] dt = time step
+!! @param[in] Vy = velocity along y (could be discretised on a bigger mesh then the scalar)
+!! @param[in,out] scal3D = scalar field to advect
+subroutine advecY_calc_Vect(dt, Vy, scal_vect)
+
+ use advecY ! Procedure specific to advection along Y
+ use advec_common ! Some procedures common to advection along all directions
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+
+ ! Input/Output
+ real(WP), intent(in) :: dt
+ real(WP), dimension(N_proc(1), N_proc(2), N_proc(3)), intent(in) :: Vy
+ real(WP), dimension(:,:,:,:), intent(inout) :: scal_vect
+ ! Other local variables
+ integer, parameter :: direction =2 ! current direction
+ integer :: i,k ! indice of the currend mesh point
+ integer :: sca ! indice of the currend scalar field
+ integer, dimension(2) :: ind_group ! indice of the currend group of line (=(i,k) by default)
+ real(WP),dimension(N_proc(direction),gsY(1),gsY(2)) :: p_pos_adim ! adimensionned particles position
+ real(WP),dimension(N_proc(direction),gsY(1),gsY(2)) :: p_V ! particles velocity
+
+ ! Allocate send_ind_min/max
+ if(allocated(send_group_min)) deallocate(send_group_min)
+ allocate(send_group_min(group_size(direction,1),group_size(direction,2)))
+ if(allocated(send_group_max)) deallocate(send_group_max)
+ allocate(send_group_max(group_size(direction,1),group_size(direction,2)))
+
+ ! Initialise the pointer for optimized remeshing
+ call AC_setup_alongY()
+
+ ind_group = 0
+
+ do k = 1, N_proc(3), gsY(2)
+ ind_group(2) = ind_group(2) + 1
+ ind_group(1) = 0
+ do i = 1, N_proc(1), gsY(1)
+ ind_group(1) = ind_group(1) + 1
+
+ ! ===== Init particles =====
+ call advecY_init(Vy, i, k, gsY, p_pos_adim, p_V)
+
+ ! ===== Advection =====
+ ! -- Compute velocity (with a RK2 scheme) --
+ call AC_velocity_interpol_group(dt, direction, gsY, ind_group, p_pos_adim, p_V)
+
+ ! -- Advec particles --
+ p_pos_adim = p_pos_adim + dt*p_V/d_sc(direction)
+
+ ! ===== Remeshing =====
+ do sca = 1, size(scal_vect,4)
+ call advec_remesh_bis(direction, ind_group, gsY, p_pos_adim, p_V, i, k, scal_vect(:,:,:,sca), dt)
+ end do
+
+ end do
+ end do
+
+end subroutine advecY_calc_Vect
+
+
+!> Scalar advection alongZ (this procedure call the right solver, depending on the simulation setup)
+!! @param[in] dt = time step
+!! @param[in] Vz = velocity along y (could be discretised on a bigger mesh then the scalar)
+!! @param[in,out] scal3D = scalar field to advect
+subroutine advecZ_calc_Vect(dt, Vz, scal_vect)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+ use advecZ ! procdure devoted to advection along Z
+ use advec_common ! some procedures common to advection along all directions
+
+ ! Input/Output
+ real(WP), intent(in) :: dt
+ real(WP), dimension(N_proc(1), N_proc(2), N_proc(3)), intent(in) :: Vz
+ real(WP), dimension(:,:,:,:), intent(inout) :: scal_vect
+ ! Other local variables
+ integer, parameter :: direction =3 ! current direction
+ integer :: i,j ! indice of the currend mesh point
+ integer :: sca ! indice of the currend scalar field
+ integer, dimension(2) :: ind_group ! indice of the currend group of line (=(i,k) by default)
+ real(WP), dimension(N_proc(direction),gsZ(1),gsZ(2)) :: p_pos_adim ! adimensionned particles position
+ real(WP), dimension(N_proc(direction),gsZ(1),gsZ(2)) :: p_V ! particles velocity
+
+ ! Allocate send_ind_min/max
+ if(allocated(send_group_min)) deallocate(send_group_min)
+ allocate(send_group_min(group_size(direction,1),group_size(direction,2)))
+ if(allocated(send_group_max)) deallocate(send_group_max)
+ allocate(send_group_max(group_size(direction,1),group_size(direction,2)))
+
+ ! Initialise the pointer for optimized remeshing
+ call AC_setup_alongZ()
+
+ ind_group = 0
+
+ do j = 1, N_proc(2), gsZ(2)
+ ind_group(2) = ind_group(2) + 1
+ ind_group(1) = 0
+ do i = 1, N_proc(1), gsZ(1)
+ ind_group(1) = ind_group(1) + 1
+
+ ! ===== Init particles =====
+ call advecZ_init_group(Vz, i, j, gsZ, p_pos_adim, p_V)
+
+ ! ===== Advection =====
+ ! -- Compute velocity (with a RK2 scheme) --
+ call AC_velocity_interpol_group(dt, direction, gsZ, ind_group, p_pos_adim, p_V)
+ ! -- Advec particles --
+ p_pos_adim = p_pos_adim + dt*p_V/d_sc(direction)
+
+ ! ===== Remeshing =====
+ do sca = 1, size(scal_vect,4)
+ call advec_remesh_bis(direction, ind_group, gsZ, p_pos_adim, p_V, i,j,scal_vect(:,:,:,sca), dt)
+ end do
+
+ end do
+ end do
+
+end subroutine advecZ_calc_Vect
+
+
+
+!> ===== Private procedure =====
+end module advec_Vect
+!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_common_group.f90 b/HySoP/src/scalesInterface/particles/advec_common_group.f90
index 8555fedb1501c705ffa280a94aaa1d6cdc8fa784..b34991e46fe2c8a1b250df8af6082a6f0d6bb665 100644
--- a/HySoP/src/scalesInterface/particles/advec_common_group.f90
+++ b/HySoP/src/scalesInterface/particles/advec_common_group.f90
@@ -5,16 +5,16 @@
! MODULE: advec_common
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module ``advec_common'' gather function and subroutines used to advec scalar
!! which are not specific to a direction
!! @details
!! This module gathers functions and routines used to advec scalar which are not
-!! specific to a direction. This is a parallel implementation using MPI and
-!! the cartesien topology it provides. It also contains the variables common to
+!! specific to a direction. This is a parallel implementation using MPI and
+!! the cartesien topology it provides. It also contains the variables common to
!! the solver along each direction and other generic variables used for the
!! advection based on the particle method.
-!!
+!!
!! Except for testing purpose, this module is not supposed to be used by the
!! main code but only by the other advection module. More precisly, an final user
!! must only used the generic "advec" module wich contain all the interface to
@@ -31,1619 +31,13 @@
module advec_common
- use precision
- use string
- use advec_abstract_proc
- use advec_remeshing_formula
+ ! Velocity interpolation at particle position
+ use advec_common_velo ,only:AC_velocity_interpol_group, AC_velocity_interpol_no_com
+ ! Particles remeshing
+ use advec_common_remesh,only: AC_setup_init, &
+ & AC_setup_alongX, AC_setup_alongY, AC_setup_alongZ,&
+ & AC_remesh_lambda_group, AC_remesh_limit_lambda_group, AC_remesh_Mprime_group
implicit none
-! XXX Si passage au fortran 2003 : basculer toutes ces variables dans le module
-! advec (fichier advec.F90) et mettre toutes les variables en protected.
-! Seul la procédure "advec_init" doit pouvoir les modifier, mais de nombreuses
-! procédures doivent pouvoir y accéder.
-
-
- ! Information about the particles and their bloc
- public
-
-
- ! ===== Public procedures =====
- !----- Init remeshing context -----
- public :: AC_setup_init
- public :: AC_setup_alongX
- public :: AC_setup_alongY
- public :: AC_setup_alongZ
- !----- To interpolate velocity -----
- public :: AC_velocity_interpol_group
- public :: AC_velocity_determine_communication
- !----- To remesh particles -----
- public :: AC_remesh_range
- public :: AC_remesh_determine_communication
- public :: AC_remesh_cartography
-
- ! ===== Public variables =====
-
- ! ===== Private variables =====
- !> Pointer to subroutine wich remesh particle to a buffer
- procedure(remesh_in_buffer), pointer, private :: remesh_in_buffer_pt => null()
- !> Pointer to subroutine wich remesh particle to a buffer - for formula
- !! without tag/type.
- procedure(remesh_in_buffer_notype), pointer, private :: remesh_in_buffer_notype_pt => null()
- !> Pointer to subroutine wich redistribute a buffer (containing remeshed
- !! particle) inside the original scalar field.
- procedure(remesh_buffer_to_scalar), pointer, private :: remesh_buffer_to_scalar_pt => null()
- !> Pointer to subroutine wich remesh a line of particle with the right remeshing formula
- procedure(AC_remesh_line_pter), pointer, private :: remesh_line_pt => null()
-
-
- contains
-
-! ===== Public procedure =====
-
-! ================================================================================ !
-! ============= To deal with remeshing setup and generecity ============= !
-! ================================================================================ !
-
-!> Init remesh_line_pt for the right remeshing formula
-subroutine AC_setup_init()
-
- use advec_remeshing_formula
- call AC_remesh_get_pointer(remesh_line_pt)
- call AC_remesh_init_array_pt()
-
-end subroutine AC_setup_init
-
-!> Setup remesh_in_buffer and remesh_in_buffer_to_scalar for remeshing along X
-subroutine AC_setup_alongX()
- use advecX
-
- remesh_in_buffer_pt => advecX_remesh_in_buffer_gp
- remesh_in_buffer_notype_pt => advecX_remesh_in_buffer_Mprime6
- remesh_buffer_to_scalar_pt => advecX_remesh_buffer_to_scalar
-
-end subroutine AC_setup_alongX
-
-
-!> Setup remesh_in_buffer and remesh_in_buffer_to_scalar for remeshing along X
-subroutine AC_setup_alongY()
- use advecY
-
- remesh_in_buffer_pt => advecY_remesh_in_buffer_gp
- remesh_in_buffer_notype_pt => advecY_remesh_in_buffer_Mprime6
- remesh_buffer_to_scalar_pt => advecY_remesh_buffer_to_scalar
-
-end subroutine AC_setup_alongY
-
-!> Setup remesh_in_buffer and remesh_in_buffer_to_scalar for remeshing along Z
-subroutine AC_setup_alongZ()
- use advecZ
-
- remesh_in_buffer_pt => advecZ_remesh_in_buffer_gp
- remesh_in_buffer_notype_pt => advecZ_remesh_in_buffer_Mprime6
- remesh_buffer_to_scalar_pt => advecZ_remesh_buffer_to_scalar
-
-end subroutine AC_setup_alongZ
-
-! ==================================================================================
-! ==================== Compute particle velocity (RK2) ====================
-! ==================================================================================
-
-!> Interpolate the velocity field used in a RK2 scheme for particle advection -
-!! version for a group of (more of one) line
-!! @param[in] dt = time step
-!! @param[in] direction = current direction (1 = along X, 2 = along Y and 3 = along Z)
-!! @param[in] gs = size of a group (ie number of line it gathers along the two other directions)
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in] p_pos_adim = adimensionned particle postion
-!! @param[in,out] p_V = particle velocity (along the current direction)
-!! @details
-!! A RK2 scheme is used to advect the particles : the midlle point scheme. An
-!! intermediary position "p_pos_bis(i) = p_pos(i) + V(i)*dt/2" is computed and then
-!! the numerical velocity of each particles is computed as the interpolation of V in
-!! this point. This field is used to advect the particles at the seconde order in time :
-!! p_pos(t+dt, i) = p_pos(i) + p_V(i).
-!! The group line indice is used to ensure using unicity of each mpi message tag.
-!! The interpolation is done for a group of lines, allowing to mutualise
-!! communications. Considering a group of Na X Nb lines, communication performed
-!! by this algorithm are around (Na x Nb) bigger than the alogorithm wich
-!! works on a single line but also around (Na x Nb) less frequent.
-subroutine AC_velocity_interpol_group(dt, direction, gs, ind_group, p_pos_adim, p_V)
-
- ! This code involve a recopy of p_V. It is possible to directly use the 3D velocity field but in a such code
- ! a memory copy is still needed to send velocity field to other processus : mpi send contiguous memory values
-
- use mpi
- use cart_topology ! info about mesh and mpi topology
- use advec_variables ! contains info about solver parameters and others.
-
- ! Input/Ouput
- real(WP), intent(in) :: dt ! time step
- integer, intent(in) :: direction ! current direction
- integer, dimension(2),intent(in) :: gs ! groupe size
- integer, dimension(2), intent(in) :: ind_group
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim
- real(WP), dimension(:,:,:),intent(inout),target :: p_V
- ! Others, local
- real(WP),dimension(N_proc(direction),gs(1),gs(2)), target :: p_posV_bis ! temporaily field to store middle point velocity and position
- real(WP), dimension(N_proc(direction),gs(1),gs(2)) :: weight ! interpolation weight
- type(real_pter),dimension(N_proc(direction),gs(1),gs(2)) :: Vp, Vm ! Velocity on previous and next mesh point
- real(WP), dimension(:), allocatable, target :: V_buffer ! Velocity buffer for postion outside of the local subdomain
- integer, dimension(:), allocatable :: pos_in_buffer! buffer size
- integer , dimension(gs(1), gs(2)) :: rece_ind_min ! minimal indice of mesh involved in remeshing particles (of my local subdomains)
- integer , dimension(gs(1), gs(2)) :: rece_ind_max ! maximal indice of mesh involved in remeshing particles (of my local subdomains)
- integer :: ind, ind_com ! indices
- integer :: i1, i2 ! indices in the lines group
- integer :: pos, pos_old ! indices of the mesh point wich preceed the particle position
- integer :: proc_gap, gap! distance between my (mpi) coordonate and coordinate of the
- ! processus associated to a given position
- integer, dimension(:), allocatable :: rece_rank ! rank of processus wich send me information
- integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
- integer :: rankP ! rank of processus ("source rank" returned by mpi_cart_shift)
- integer, dimension(:), allocatable :: send_carto ! cartogrpahy of what I have to send
- integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
- integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography ?
- real(WP), dimension(:), allocatable :: send_buffer ! to store what I have to send (on a contiguous way)
- integer, dimension(gs(1),gs(2),2) :: rece_gap ! distance between me and processus wich send me information
- integer, dimension(2 , 2) :: send_gap ! distance between me and processus to wich I send information
- integer, dimension(2) :: rece_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
- integer :: com_size ! size of message send/receive
- integer, dimension(:), allocatable :: size_com ! size of message send/receive
- integer :: min_size ! minimal size of cartography(:,proc_gap)
- integer :: max_size ! maximal size of cartography(:,proc_gap)
- integer :: tag ! mpi message tag
- integer, dimension(:), allocatable :: tag_proc ! mpi message tag
- integer :: ierr ! mpi error code
- integer, dimension(:), allocatable :: s_request ! mpi communication request (handle) of nonblocking send
- integer, dimension(:), allocatable :: s_request_bis! mpi communication request (handle) of nonblocking send
- integer, dimension(:), allocatable :: rece_request ! mpi communication request (handle) of nonblocking receive
- integer, dimension(MPI_STATUS_SIZE) :: rece_status ! mpi status (for mpi_wait)
- integer, dimension(:,:), allocatable :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block for wich the
- ! current processus requiers data from proc_gap and for each of these lines the range
- ! of mesh points from where it requiers the velocity values.
-! XXX Todo : à vérifier mais il semble inutile de stocker send_rank : il n'est
-! utilisé que pour les mpi_wait mais une initialisation des request Ã
-! MPI_REQUEST_NULL devrait permettre de s'en débarrasser.
-
- ! -- Initialisation --
- do i2 = 1, gs(2)
- do i1 = 1, gs(1)
- do ind = 1, N_proc(direction)
- nullify(Vp(ind,i1,i2)%pter)
- nullify(Vm(ind,i1,i2)%pter)
- end do
- end do
- end do
- ! Compute the midlle point
- p_posV_bis = p_pos_adim + (dt/2.0)*p_V/d_sc(direction)
-
-! XXX Todo / Optim
-! Ici recopie de la vitesse. On doit la faire car on calcule la vitesse
-! interpolée à partir d' "elle-même" : la variable calculée dépend de sa
-! précédente valeur en des points qui peuvent différé. Si on l'écrase au fur et
-! Ã mesure on fait des calculs faux.
-! On pourrait utiliser directement le champ de vitesse V en entrée pour donner
-! p_V en sortie, mais cela pose un problème car selon les directions il faudrait
-! changer l'ordre des indices i, i1 et i2. Ce qui est un beau bordel !!
-! XXX
- ! Compute range of the set of point where I need the velocity value
- rece_ind_min = floor(p_posV_bis(1,:,:))
- rece_ind_max = floor(p_posV_bis(N_proc(direction),:,:)) + 1
-
- ! ===== Exchange velocity field if needed =====
- ! It uses non blocking message to do the computations during the communication process
- ! -- What have I to communicate ? --
- rece_gap(:,:,1) = floor(real(rece_ind_min-1)/N_proc(direction))
- rece_gap(:,:,2) = floor(real(rece_ind_max-1)/N_proc(direction))
- rece_gap_abs(1) = minval(rece_gap(:,:,1))
- rece_gap_abs(2) = maxval(rece_gap(:,:,2))
- max_size = 2 + gs(2)*(2+3*gs(1))
- allocate(cartography(max_size,rece_gap_abs(1):rece_gap_abs(2)))
- allocate(rece_rank(rece_gap_abs(1):rece_gap_abs(2)))
- call AC_velocity_determine_communication(direction, ind_group, gs, send_gap, &
- & rece_gap, rece_gap_abs, rece_rank, cartography)
-
- ! -- Send messages about what I want --
- allocate(s_request_bis(rece_gap_abs(1):rece_gap_abs(2)))
- allocate(size_com(rece_gap_abs(1):rece_gap_abs(2)))
- allocate(tag_proc(rece_gap_abs(1):rece_gap_abs(2)))
- min_size = 2 + gs(2)
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- if (rece_rank(proc_gap) /= D_rank(direction)) then
- cartography(1,proc_gap) = 0
- ! Use the cartography to know which lines are concerned
- size_com(proc_gap) = cartography(2,proc_gap)
- ! Range I want - store into the cartography
- gap = proc_gap*N_proc(direction)
- ! Position in cartography(:,proc_gap) of the current i1 indice
- ind_for_i1 = min_size
- do i2 = 1, gs(2)
- do ind = ind_for_i1+1, ind_for_i1 + cartography(2+i2,proc_gap), 2
- do i1 = cartography(ind,proc_gap), cartography(ind+1,proc_gap)
- ! Interval start from:
- cartography(size_com(proc_gap)+1,proc_gap) = max(rece_ind_min(i1,i2), gap+1) ! fortran => indice start from 0
- ! and ends at:
- cartography(size_com(proc_gap)+2,proc_gap) = min(rece_ind_max(i1,i2), gap+N_proc(direction))
- ! update number of element to receive
- cartography(1,proc_gap) = cartography(1,proc_gap) &
- & + cartography(size_com(proc_gap)+2,proc_gap) &
- & - cartography(size_com(proc_gap)+1,proc_gap) + 1
- size_com(proc_gap) = size_com(proc_gap)+2
- end do
- end do
- ind_for_i1 = ind_for_i1 + cartography(2+i2,proc_gap)
- end do
- ! Tag = concatenation of (rank+1), ind_group(1), ind_group(2), direction et unique Id.
- tag_proc(proc_gap) = compute_tag(ind_group, tag_velo_range, direction, proc_gap)
- ! Send message
- call mpi_ISsend(cartography(1,proc_gap), size_com(proc_gap), MPI_INTEGER, rece_rank(proc_gap), &
- & tag_proc(proc_gap), D_comm(direction), s_request_bis(proc_gap),ierr)
- end if
- end do
-
- ! -- Send the velocity field to processus which need it --
- allocate(s_request(send_gap(1,1):send_gap(1,2)))
- allocate(send_rank(send_gap(1,1):send_gap(1,2)))
- allocate(send_carto(max_size))
-! XXX Todo : compter le nombre de messages à recevoir puis les traiter dans
-! l'ordre où ils arrivent via un MPI_ANY_PROC ? Mais alors il faut lier rang et
-! coordonnées ... ce qui signifie ajouter un appel à un mpi_cart_cood ... ou
-! envoyer le rand dans la cartographie !!
-! A voir ce qui est le mieux.
- do proc_gap = send_gap(1,1), send_gap(1,2)
- call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, send_rank(proc_gap), ierr)
- if (send_rank(proc_gap) /= D_rank(direction)) then
- ! I - Receive messages about what I have to send
- ! Ia - Compute reception tag = concatenation of (rank+1), ind_group(1), ind_group(2), direction et unique Id.
- tag = compute_tag(ind_group, tag_velo_range, direction, -proc_gap)
- ! Ib - Receive the message
- call mpi_recv(send_carto(1), max_size, MPI_INTEGER, send_rank(proc_gap), tag, D_comm(direction), rece_status, ierr)
- ! II - Send it
- ! IIa - Create send buffer
- allocate(send_buffer(send_carto(1)))
- gap = proc_gap*N_proc(direction)
- com_size = 0
- ind_1Dtable = send_carto(2)
- ! Position in cartography(:,proc_gap) of the current i1 indice
- ind_for_i1 = min_size
- do i2 = 1, gs(2)
- do ind = ind_for_i1+1, ind_for_i1 + send_carto(2+i2), 2
- do i1 = send_carto(ind), send_carto(ind+1)
- do ind_com = send_carto(ind_1Dtable+1)+gap, send_carto(ind_1Dtable+2)+gap ! indice inside the current line
- com_size = com_size + 1
- send_buffer(com_size) = p_V(ind_com, i1,i2)
- end do
- ind_1Dtable = ind_1Dtable + 2
- end do
- end do
- ind_for_i1 = ind_for_i1 + send_carto(2+i2)
- end do
- ! IIb - Compute send tag
- tag = compute_tag(ind_group, tag_velo_V, direction, proc_gap)
- ! IIc - Send message
- call mpi_Isend(send_buffer(1), com_size, MPI_DOUBLE_PRECISION, &
- & send_rank(proc_gap), tag, D_comm(direction), s_request(proc_gap), ierr)
- deallocate(send_buffer)
- end if
- end do
- deallocate(send_carto)
-
- ! -- Non blocking reception of the velocity field --
- ! Allocate the pos_in_buffer to compute V_buffer size and to be able to
- ! allocate it.
- allocate(pos_in_buffer(rece_gap_abs(1):rece_gap_abs(2)))
- pos_in_buffer(rece_gap_abs(1)) = 1
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)-1
- pos_in_buffer(proc_gap+1)= pos_in_buffer(proc_gap) + cartography(1,proc_gap)
- end do
- allocate(V_buffer(pos_in_buffer(rece_gap_abs(2)) &
- & + cartography(1,rece_gap_abs(2))))
- V_buffer = 0
- allocate(rece_request(rece_gap_abs(1):rece_gap_abs(2)))
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- if (rece_rank(proc_gap) /= D_rank(direction)) then
- ! IIa - Compute reception tag
- tag = compute_tag(ind_group, tag_velo_V, direction, -proc_gap)
- ! IIb - Receive message
- call mpi_Irecv(V_buffer(pos_in_buffer(proc_gap)), cartography(1,proc_gap), MPI_DOUBLE_PRECISION, &
- & rece_rank(proc_gap), tag, D_comm(direction), rece_request(proc_gap), ierr)
- end if
- end do
-
- !-- Free som ISsend buffer and some array --
-! XXX Todo : préférer un call MPI_WAIT_ALL couplé avec une init de s_request_bis
-! sur MPI_REQUEST_NULL et enlever la boucle ET le if.
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- if (rece_rank(proc_gap) /= D_rank(direction)) then
- call MPI_WAIT(s_request_bis(proc_gap),rece_status,ierr)
- end if
- end do
- deallocate(s_request_bis)
- deallocate(cartography) ! We do not need it anymore
- deallocate(tag_proc)
- deallocate(size_com)
-
- ! ===== Compute the interpolated velocity =====
- ! -- Compute the interpolation weight and update the pointers Vp and Vm --
- do i2 = 1, gs(2)
- do i1 = 1, gs(1)
- ! Initialisation of reccurence process
- ind = 1
- pos = floor(p_posV_bis(ind,i1,i2))
- weight(ind,i1,i2) = p_posV_bis(ind,i1,i2)-pos
- ! Vm = V(pos)
- proc_gap = floor(real(pos-1)/N_proc(direction))
- if (rece_rank(proc_gap) == D_rank(direction)) then
- Vm(ind,i1,i2)%pter => p_V(pos-proc_gap*N_proc(direction), i1,i2)
- else
- Vm(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
- pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
- end if
- ! Vp = V(pos+1)
- proc_gap = floor(real(pos+1-1)/N_proc(direction))
- if (rece_rank(proc_gap) == D_rank(direction)) then
- Vp(ind,i1,i2)%pter => p_V(pos+1-proc_gap*N_proc(direction), i1,i2)
- else
- Vp(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
- pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
- end if
- pos_old = pos
-
- ! Following indice : we use previous work (already done)
- do ind = 2, N_proc(direction)
- pos = floor(p_posV_bis(ind,i1,i2))
- weight(ind,i1,i2) = p_posV_bis(ind,i1,i2)-pos
- select case(pos-pos_old)
- case(0)
- ! The particle belongs to the same segment than the previous one
- Vm(ind,i1,i2)%pter => Vm(ind-1,i1,i2)%pter
- Vp(ind,i1,i2)%pter => Vp(ind-1,i1,i2)%pter
- case(1)
- ! The particle follows the previous one
- Vm(ind,i1,i2)%pter => Vp(ind-1,i1,i2)%pter
- ! Vp = V(pos+1)
- proc_gap = floor(real(pos+1-1)/N_proc(direction)) ! fortran -> indice starts from 1
- if (rece_rank(proc_gap) == D_rank(direction)) then
- Vp(ind,i1,i2)%pter => p_V(pos+1-proc_gap*N_proc(direction), i1,i2)
- else
- Vp(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
- pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
- end if
- case(2)
- ! pos = pos_old +2, wich correspond to "extention"
- ! Vm = V(pos)
- proc_gap = floor(real(pos-1)/N_proc(direction))
- if (rece_rank(proc_gap) == D_rank(direction)) then
- Vm(ind,i1,i2)%pter => p_V(pos-proc_gap*N_proc(direction), i1,i2)
- else
- Vm(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
- pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
- end if
- ! Vp = V(pos+1)
- proc_gap = floor(real(pos+1-1)/N_proc(direction))
- if (rece_rank(proc_gap) == D_rank(direction)) then
- Vp(ind,i1,i2)%pter => p_V(pos+1-proc_gap*N_proc(direction), i1,i2)
- else
- Vp(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
- pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
- end if
- case default
- print*, "unexpected case : pos = ", pos, " , pos_old = ", pos_old, &
- & " ind = ", ind, " i1 = ", i1, " i2 = ", i2
- end select
- pos_old = pos
- end do ! loop on particle indice inside the current line
- end do ! loop on first coordinate (i1) of a line inside the block of line
- end do ! loop on second coordinate (i2) of a line inside the block of line
-
- deallocate(pos_in_buffer) ! We do not need it anymore
-
- ! -- Compute the interpolate velocity --
- ! Check if communication are done
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- if (rece_rank(proc_gap)/=D_rank(direction)) then
- call mpi_wait(rece_request(proc_gap), rece_status, ierr)
- end if
- end do
- deallocate(rece_request)
-
- ! Then compute the field
- do i2 = 1, gs(2)
- do i1 = 1, gs(1)
- do ind = 1, N_proc(direction)
- p_posV_bis(ind,i1,i2) = weight(ind,i1,i2)*Vp(ind,i1,i2)%pter + (1.-weight(ind,i1,i2))*Vm(ind,i1,i2)%pter
- end do
- end do
- end do
- p_V = p_posV_bis
-
-
- ! ===== Free memory =====
- ! -- Pointeur --
- do i2 = 1, gs(2)
- do i1 = 1, gs(1)
- do ind = 1, N_proc(direction)
- nullify(Vp(ind,i1,i2)%pter)
- nullify(Vm(ind,i1,i2)%pter)
- end do
- end do
- end do
- ! -- Mpi internal buffer for non blocking communication --
- do proc_gap = send_gap(1,1), send_gap(1,2)
- if (send_rank(proc_gap) /= D_rank(direction)) then
- call MPI_WAIT(s_request(proc_gap),rece_status,ierr)
- end if
- end do
- deallocate(s_request)
- ! -- Deallocate dynamic array --
- deallocate(V_buffer)
- deallocate(rece_rank)
- deallocate(send_rank)
-
-end subroutine AC_velocity_interpol_group
-
-
-!> Determine the set of processes wich will send me information during the velocity interpolation and compute
-!! for each of these processes the range of wanted data.
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
-!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[out] send_gap = gap between my coordinate and the processes of minimal coordinate which will send information to me
-!! @param[in] rece_gap = gap between my coordinate and the processes of maximal coordinate which will receive information from me
-!! @param[in] rece_gap_abs = min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-!! @param[out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
-!! of mesh points from where it requiers the velocity values.
-!! @details
-!! Work on a group of line of size gs(1) x gs(2))
-!! Obtain the list of processus wich need a part of my local velocity field
-!! to interpolate the velocity used in the RK2 scheme to advect its particles.
-!! In the same time, it computes for each processus from which I need a part
-!! of the velocity field, the range of mesh point where I want data and store it
-!! by using some sparse matrix technics (see cartography defined in the
-!! algorithm documentation)
-subroutine AC_velocity_determine_communication(direction, ind_group, gs, send_gap, &
- & rece_gap, rece_gap_abs, rece_rank, cartography)
-! XXX Work only for periodic condition.
-
- use cart_topology ! info about mesh and mpi topology
- use advec_variables ! contains info about solver parameters and others.
- use mpi
-
-
- ! Input/Ouput
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(2), intent(in) :: gs
- integer, dimension(gs(1), gs(2), 2), intent(in) :: rece_gap
- integer, dimension(2), intent(in) :: rece_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
- integer,dimension(rece_gap_abs(1):rece_gap_abs(2))&
- &, intent(out) :: rece_rank ! rank of processus wich send me information
- integer, dimension(2, 2), intent(out) :: send_gap
- integer, dimension(2+gs(2)*(2+3*gs(1)), &
- & rece_gap_abs(1):rece_gap_abs(2)), intent(out) :: cartography
- ! Others
- integer :: proc_gap ! gap between a processus coordinate (along the current
- ! direction) into the mpi-topology and my coordinate
- integer, dimension(gs(1), gs(2)) :: rece_gapP ! gap between the coordinate of the previous processus (in the current direction)
- ! and the processes of maximal coordinate which will receive information from it
- integer, dimension(gs(1), gs(2)) :: rece_gapN ! same as above but for the next processus
- integer :: rankP ! processus rank for shift (P= previous, N = next)
- integer :: send_request_gh ! mpi status of noindicelocking send
- integer :: send_request_gh2 ! mpi status of noindicelocking send
- integer :: ierr ! mpi error code
- integer, dimension(2) :: tag_table ! some mpi message tag
- logical, dimension(:,:), allocatable:: test_request ! for mpi non blocking communication
- integer, dimension(:,:), allocatable:: send_request ! for mpi non blocking send
- integer :: ind1, ind2 ! indice of the current line inside the group
- integer,dimension(2) :: rece_buffer ! buffer for reception of rece_max
- integer, dimension(:,:), allocatable:: first, last ! Storage processus to which I will be the first (or the last) to receive
- integer :: min_size ! begin indice in first and last to stock indice along first dimension of the group line
- integer :: gp_size ! group size
- logical :: begin_interval ! ware we in the start of an interval ?
- logical :: not_myself ! Is the target processus myself ?
- integer, dimension(MPI_STATUS_SIZE) :: statut
-
- send_gap(1,1) = 3*N(direction)
- send_gap(1,2) = -3*N(direction)
- send_gap(2,:) = 0
- gp_size = gs(1)*gs(2)
-
- ! ===== Communicate with my neigbors -> obtain ghost ! ====
- ! Inform that about processus from which I need information
- tag_table = compute_tag(ind_group, tag_obtrec_ghost_NP, direction)
- call mpi_ISsend(rece_gap(1,1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(1), &
- & D_comm(direction), send_request_gh, ierr)
- call mpi_ISsend(rece_gap(1,1,2), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(2), &
- & D_comm(direction), send_request_gh2, ierr)
- ! Receive the same message form my neighbors
- call mpi_recv(rece_gapN(1,1), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(1), D_comm(direction), statut, ierr)
- call mpi_recv(rece_gapP(1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(2), D_comm(direction), statut, ierr)
-
- ! ===== Compute if I am first or last and determine the carography =====
- min_size = 2 + gs(2)
- ! Initialize first and last to determine if I am the the first or the last processes (considering the current direction)
- ! to require information from this processus
- allocate(first(2,rece_gap_abs(1):rece_gap_abs(2)))
- first(2,:) = 0 ! number of lines for which I am the first
- allocate(last(2,rece_gap_abs(1):rece_gap_abs(2)))
- last(2,:) = 0 ! number of lines for which I am the last
- ! Initialize cartography
- cartography(1,:) = 0 ! number of velocity values to receive
- cartography(2,:) = min_size ! number of element to send when sending cartography
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- first(1,proc_gap) = -proc_gap
- last(1,proc_gap) = -proc_gap
- call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, rece_rank(proc_gap), ierr)
- not_myself = (rece_rank(proc_gap) /= D_rank(direction)) ! Is the target processus myself ?
- do ind2 = 1, gs(2)
- cartography(2+ind2,proc_gap) = 0 ! 2 x number of interval of concern line into the column i2
- begin_interval = .true.
- do ind1 = 1, gs(1)
- ! Does proc_gap belongs to [rece_gap(i1,i2,1);rece_gap(i1,i2,2)]?
- if((proc_gap>=rece_gap(ind1,ind2,1)).and.(proc_gap<=rece_gap(ind1,ind2,2))) then
- ! Compute if I am the first.
- if (proc_gap>rece_gapP(ind1,ind2)-1) then
- first(2,proc_gap) = first(2,proc_gap)+1
- end if
- ! Compute if I am the last.
- if (proc_gap<rece_gapN(ind1,ind2)+1) then
- last(2,proc_gap) = last(2,proc_gap)+1
- end if
- ! Update cartography // Not need I target processus is myself
- if (not_myself) then
- if (begin_interval) then
- cartography(2+ind2,proc_gap) = cartography(2+ind2,proc_gap)+2
- cartography(cartography(2,proc_gap)+1,proc_gap) = ind1
- cartography(2,proc_gap) = cartography(2,proc_gap) + 2
- cartography(cartography(2,proc_gap),proc_gap) = ind1
- begin_interval = .false.
- else
- cartography(cartography(2,proc_gap),proc_gap) = ind1
- end if
- end if
- else
- begin_interval = .true.
- end if
- end do
- end do
- end do
-
- ! ===== Free Isend buffer from first communication =====
- call MPI_WAIT(send_request_gh,statut,ierr)
- call MPI_WAIT(send_request_gh2,statut,ierr)
-
- ! ===== Send information about first and last =====
- tag_table = compute_tag(ind_group, tag_obtrec_NP, direction)
- allocate(send_request(rece_gap_abs(1):rece_gap_abs(2),2))
- allocate(test_request(rece_gap_abs(1):rece_gap_abs(2),2))
- test_request = .false.
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- ! I am the first ?
- if (first(2,proc_gap)>0) then
- if(rece_rank(proc_gap)/= D_rank(direction)) then
- call mpi_ISsend(first(1,proc_gap), 2, MPI_INTEGER, rece_rank(proc_gap), tag_table(1), D_comm(direction), &
- & send_request(proc_gap,1), ierr)
- test_request(proc_gap,1) = .true.
- else
- send_gap(1,1) = min(send_gap(1,1), -proc_gap)
- send_gap(2,1) = send_gap(2,1) + first(2,proc_gap)
- end if
- end if
- ! I am the last ?
- if (last(2,proc_gap)>0) then
- if(rece_rank(proc_gap)/= D_rank(direction)) then
- call mpi_ISsend(last(1,proc_gap), 2, MPI_INTEGER, rece_rank(proc_gap), tag_table(2), D_comm(direction), &
- & send_request(proc_gap,2), ierr)
- test_request(proc_gap,2) = .true.
- else
- send_gap(1,2) = max(send_gap(1,2), -proc_gap)
- send_gap(2,2) = send_gap(2,2) + last(2,proc_gap)
- end if
- end if
- end do
-
-
-
- ! ===== Receive information form the first and the last processus which need a part of my local velocity field =====
- do while(send_gap(2,1) < gp_size)
- call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(1), D_comm(direction), statut, ierr)
- send_gap(1,1) = min(send_gap(1,1), rece_buffer(1))
- send_gap(2,1) = send_gap(2,1) + rece_buffer(2)
- end do
- do while(send_gap(2,2) < gp_size)
- call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(2), D_comm(direction), statut, ierr)
- send_gap(1,2) = max(send_gap(1,2), rece_buffer(1))
- send_gap(2,2) = send_gap(2,2) + rece_buffer(2)
- end do
-
- ! ===== Free Isend buffer =====
- !call MPI_WAIT(send_request_gh,statut,ierr)
- !call MPI_WAIT(send_request_gh2,statut,ierr)
- do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
- if (test_request(proc_gap,1).eqv. .true.) call MPI_WAIT(send_request(proc_gap,1),statut,ierr)
- if (test_request(proc_gap,2)) call MPI_WAIT(send_request(proc_gap,2),statut,ierr)
- end do
- deallocate(send_request)
- deallocate(test_request)
-
- ! ===== Deallocate array =====
- deallocate(first)
- deallocate(last)
-
-end subroutine AC_velocity_determine_communication
-
-
-!> Interpolate the velocity field used in a RK2 scheme for particle advection -
-!! version for direction with no domain subdivision ands thus no required
-!! communications
-!! @param[in] dt = time step
-!! @param[in] direction = current direction (1 = along X, 2 = along Y and 3 = along Z)
-!! @param[in] gs = size of a group (ie number of line it gathers along the two other directions)
-!! @param[in] p_pos_adim = adimensionned particle postion
-!! @param[in,out] p_V = particle velocity (along the current direction)
-!! @details
-!! A RK2 scheme is used to advect the particles : the midlle point scheme. An
-!! intermediary position "p_pos_bis(i) = p_pos(i) + V(i)*dt/2" is computed and then
-!! the numerical velocity of each particles is computed as the interpolation of V in
-!! this point. This field is used to advect the particles at the seconde order in time :
-!! p_pos(t+dt, i) = p_pos(i) + p_V(i).
-!! Variant for cases with no required communication.
-subroutine AC_velocity_interpol_no_com(dt, direction, gs, p_pos_adim, p_V)
-
- ! This code involve a recopy of p_V. It is possible to directly use the 3D velocity field but it will also limit the meroy access.
-
- use cart_topology ! info about mesh and mpi topology
- use advec_variables ! contains info about solver parameters and others.
-
- ! Input/Ouput
- real(WP), intent(in) :: dt ! time step
- integer, intent(in) :: direction ! current direction
- integer, dimension(2),intent(in) :: gs ! groupe size
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim
- real(WP), dimension(:,:,:), intent(inout) :: p_V
- ! Others, local
- real(WP),dimension(N_proc(direction),gs(1),gs(2)) :: p_posV_bis ! adimensionned position of the middle point
- integer :: ind ! indices
- integer :: i1, i2 ! indices in the lines group
- integer :: pos ! indices of the mesh point wich preceed the particle position
-
- ! ===== Initialisation =====
- ! Compute the midlle point
- p_posV_bis = p_pos_adim + (dt/2.0)*p_V/d_sc(direction)
-
-
- ! ===== Compute the interpolated velocity =====
- ! -- Compute the interpolation weight and update the velocity directly in p_posV_bis --
- do i2 = 1, gs(2)
- do i1 = 1, gs(1)
- do ind = 1, N(direction)
-
- pos = floor(p_posV_bis(ind,i1,i2))
- p_posV_bis(ind,i1,i2) = p_V(modulo(pos-1,N(direction))+1,i1,i2) + (p_posV_bis(ind,i1,i2)-pos)* &
- & (p_V(modulo(pos,N(direction))+1,i1,i2)-p_V(modulo(pos-1,N(direction))+1,i1,i2))
-
- end do ! loop on particle indice (ind)
- end do ! loop on first coordinate (i1) of a line inside the block of line
- end do ! loop on second coordinate (i2) of a line inside the block of line
-
- ! -- Recopy velocity in the right array --
- p_V = p_posV_bis
-
-end subroutine AC_velocity_interpol_no_com
-
-
-! ==============================================================================================
-! ==================== Remesh all the particles of a group of lines ====================
-! ==============================================================================================
-
-
-!> remeshing with an order 2 or 4 lambda method, corrected to allow large CFL number - group version
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in] gs = size of groups (along X direction)
-!! @param[in] p_pos_adim = adimensionned particles position
-!! @param[in] p_V = particles velocity (needed for tag and type)
-!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
-!! @param[in,out] scal = scalar field to advect
-!! @param[in] dt = time step (needed for tag and type)
-subroutine AC_remesh_lambda_group(direction, ind_group, gs, p_pos_adim, p_V, j, k, scal, dt)
-
- use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
- use advec_correction ! To compute type and tag
-
- ! Input/Output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
- real(WP), dimension(:,:,:), intent(inout) :: scal
- real(WP), intent(in) :: dt
- ! Other local variables
- ! To type and tag particles
- logical, dimension(bl_nb(direction)+1,gs(1),gs(2)) :: bl_type ! is the particle block a center block or a left one ?
- logical, dimension(bl_nb(direction),gs(1),gs(2)) :: bl_tag ! indice of tagged particles
- ! Others
- integer, dimension(gs(1),gs(2),2) :: send_gap ! distance between me and processus wich send me information
- integer, dimension(2) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
- integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
- integer, dimension(2 , 2) :: rece_gap ! distance between me and processus to wich I send information
- integer, dimension(:,:), allocatable :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
- ! Variable use to manage mpi communications
- integer :: max_size ! maximal size of cartography(:,proc_gap)
-
- ! ===== Pre-Remeshing: Determine blocks type and tag particles =====
- call AC_type_and_block_group(dt, direction, gs, ind_group, p_V, bl_type, bl_tag)
-
- ! ===== Compute range of remeshing data =====
- call AC_remesh_range(bl_type, p_pos_adim, direction, send_group_min, send_group_max, send_gap, send_gap_abs)
-
- ! ===== Determine the communication needed : who will communicate whit who ? (ie compute sender and recer) =====
- ! -- Allocation --
- max_size = 2 + gs(2)*(2+3*gs(1))
- allocate(cartography(max_size,send_gap_abs(1):send_gap_abs(2)))
- allocate(send_rank(send_gap_abs(1):send_gap_abs(2)))
- ! -- Determine which processes communicate together --
- call AC_remesh_determine_communication(direction, gs, ind_group, send_group_min, send_group_max, &
- & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
-
- ! ===== Proceed to remeshing via a local buffer =====
- call AC_remesh_via_buffer(direction, ind_group, gs, p_pos_adim, j, k, scal, &
- & send_group_min, send_group_max, send_gap_abs, send_rank, rece_gap, &
- & cartography, bl_type=bl_type, bl_tag=bl_tag)
-
- ! -- Free all communication buffer and data --
- deallocate(cartography)
- deallocate(send_rank)
-
-end subroutine AC_remesh_lambda_group
-
-
-!> remeshing with a M'6 remeshing formula - group version
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in] gs = size of groups (along X direction)
-!! @param[in] p_pos_adim = adimensionned particles position
-!! @param[in] p_V = particles velocity (needed for tag and type)
-!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
-!! @param[in,out] scal = scalar field to advect
-!! @param[in] dt = time step (needed for tag and type)
-subroutine AC_remesh_Mprime6_group(direction, ind_group, gs, p_pos_adim, p_V, j, k, scal, dt)
-
- use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
-
- ! Input/Output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
- real(WP), dimension(:,:,:), intent(inout) :: scal
- real(WP), intent(in) :: dt
- ! Other local variables
- integer, dimension(gs(1),gs(2),2) :: send_gap ! distance between me and processus wich send me information
- integer, dimension(2) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
- integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
- integer, dimension(2 , 2) :: rece_gap ! distance between me and processus to wich I send information
- integer, dimension(:,:), allocatable :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
- ! Variable use to manage mpi communications
- integer :: max_size ! maximal size of cartography(:,proc_gap)
-
- ! ===== Compute range of remeshing data =====
- call AC_remesh_range_notype(p_pos_adim, direction, send_group_min, send_group_max, send_gap, send_gap_abs)
-
- ! ===== Determine the communication needed : who will communicate whit who ? (ie compute sender and recer) =====
- ! -- Allocation --
- max_size = 2 + gs(2)*(2+3*gs(1))
- allocate(cartography(max_size,send_gap_abs(1):send_gap_abs(2)))
- allocate(send_rank(send_gap_abs(1):send_gap_abs(2)))
- ! -- Determine which processes communicate together --
- call AC_remesh_determine_communication_com(direction, gs, ind_group, &
- & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
-
- ! ===== Proceed to remeshing via a local buffer =====
- call AC_remesh_via_buffer(direction, ind_group, gs, p_pos_adim, j, k, &
- & scal, send_group_min, send_group_max, send_gap_abs, send_rank, &
- & rece_gap, cartography)
-
- ! -- Free all communication buffer and data --
- deallocate(cartography)
- deallocate(send_rank)
-
-end subroutine AC_remesh_Mprime6_group
-
-
-! ============================================================================
-! ==================== Tools to remesh particles ====================
-! ============================================================================
-
-
-!> Using input information to update the scalar field by creating particle
-!! weight (from scalar values), set scalar to 0, redistribute particle inside
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in] gs = size of groups (along X direction)
-!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
-!! @param[in] p_pos_adim = adimensionned particles position
-!! @param[in] bl_type = table of blocks type (center of left)
-!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
-!! and the begining of the following one is tagged)
-!! @param[in,out] scal = scalar field to advect
-!! @param[in] send_min = minimal indice of mesh involved in remeshing particles
-!! @param[in] send_max = maximal indice of mesh involved in remeshing particles
-!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-!! @param[in] send_rank = mpi rank of processes to which I will send messages.
-!! @param[in] rece_gap = coordinate range of processes which will send me information during the remeshing.
-!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
-!! of mesh points from where it requiers the velocity values.
-!! @details
-!! This procedure manage all communication needed. To minimize communications,
-!! particles are remeshing inside a local buffer wich is after send to the
-!! processus wich contain the right sub-domain depending off the particle
-!! position. There is no need of communication in order to remesh inside the
-!! buffer. To avoid recopy in creating particle weight (which will be weight
-!! = scalar), scalar is directly redistribute inside the local buffer.
-!! This provides:
-!! a - Remesh particle: redistribute scalar field inside a local buffer and
-!! set scalar = 0.
-!! b - Send local buffer to its target processus and update the scalar field,
-!! ie scalar = scalar + received buffer.
-!! "remesh_in_buffer_pt" do the part "a" and "remesh_buffer_to_scalar" the part
-!! B except the communication. The current subroutine manage all the
-!! communications (and other stuff needed to allow correctness).
-subroutine AC_remesh_via_buffer(direction, ind_group, gs, p_pos_adim, &
- & j, k, scal, send_min, send_max, send_gap_abs, send_rank, rece_gap,&
- & cartography, bl_type, bl_tag)
-
- use advec_remeshing_formula ! Remeshing formula
- use advec_variables ! contains info about solver parameters and others.
- use advec_abstract_proc ! contain some useful procedure pointers.
- use advecX ! procedure specific to advection alongX
- use advecY ! procedure specific to advection alongY
- use advecZ ! procedure specific to advection alongZ
- use cart_topology ! Description of mesh and of mpi topology
- use mpi
-
- ! Input/Output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- logical,dimension(:,:,:),intent(in),optional:: bl_type ! is the particle block a center block or a left one ?
- logical,dimension(:,:,:),intent(in),optional:: bl_tag ! indice of tagged particles
- real(WP),dimension(:,:,:),intent(inout) :: scal
- integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
- integer, dimension(2), intent(in) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
- integer, dimension(:), intent(in) :: send_rank ! rank of processus to wich I send information
- integer, dimension(2, 2), intent(in) :: rece_gap ! distance between me and processus to wich I send information
- integer, dimension(:,:), intent(inout) :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
- ! current processus will send data during remeshing and for each of these lines the range
- ! of mesh points from where it requiers the velocity values.
- ! Other local variables
- ! Others
- integer :: proc_gap, gap! distance between my (mpi) coordonate and coordinate of the
- ! processus associated to a given position
- integer :: ind_gap
- integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
- integer, dimension(:), allocatable :: rece_rank ! rank of processus wich send me information
- integer, dimension(:,:), allocatable :: rece_carto ! same as abobve but for what I receive
- integer :: min_size ! minimal size of cartography(:,proc_gap)
- integer :: max_size ! maximal size of cartography(:,proc_gap)
- ! Variable used to remesh particles in a buffer
- real(WP),dimension(:),allocatable,target:: send_buffer ! buffer use to remesh the scalar before to send it to the right subdomain
- ! sorted by receivers and not by coordinate.
- integer, dimension(:), allocatable :: pos_in_buffer! buffer size
- real(WP),dimension(:),allocatable,target:: rece_buffer ! buffer use to receive scalar field from other processes.
- integer, dimension(:), allocatable :: rece_pos ! cells of indice from rece_pos(i) to rece_proc(i+1) into rece_buffer
- ! are devoted to the processus of relative position = i
- ! Variable use to manage mpi communications
- integer :: com_size ! size of message send/receive
- integer, dimension(:), allocatable :: s_request_ran! mpi communication request (handle) of nonblocking send
- integer, dimension(:), allocatable :: r_request_ran! mpi communication request (handle) of nonblocking receive
- integer, dimension(:), allocatable :: s_request_sca! mpi communication request (handle) of nonblocking send
- integer, dimension(:), allocatable :: r_request_sca! mpi communication request (handle) of nonblocking receive
- integer, dimension(:,:), allocatable :: s_status ! mpi communication status of nonblocking send
- integer, dimension(:,:), allocatable :: r_status ! mpi communication status of nonblocking receive
- integer, dimension(mpi_status_size) :: mpi_status ! another mpi communication status
- integer :: tag ! mpi message tag
- integer :: ierr ! mpi error code
- integer :: missing_msg ! number of remeshing buffer not yet received
- integer :: nb_r, nb_s ! number of reception/send
-
- integer :: rankP
-
- ! ===== Receive cartography =====
- ! It is better to post recceive before sending.
- ! -- allocate cartography about what I receive --
- allocate(rece_rank(rece_gap(1,1):rece_gap(1,2)))
- nb_r = rece_gap(1,2) - rece_gap(1,1) + 1
- allocate(r_request_ran(1:nb_r))
- r_request_ran = MPI_REQUEST_NULL
- ! -- allocate cartography about what I receive --
- max_size = 2 + gs(2)*(2+3*gs(1))
- allocate(rece_carto(max_size,rece_gap(1,1):rece_gap(1,2)))
- ind_1Dtable = 0
- do proc_gap = rece_gap(1,1), rece_gap(1,2)
- ind_1Dtable = ind_1Dtable + 1
- call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, rece_rank(proc_gap), ierr)
- if (rece_rank(proc_gap)/= D_rank(direction)) then
- tag = compute_tag(ind_group, tag_bufToScal_range, direction, -proc_gap)
- call mpi_Irecv(rece_carto(1,proc_gap), max_size, MPI_INTEGER, &
- & rece_rank(proc_gap), tag, D_COMM(direction), r_request_ran(ind_1Dtable), ierr)
- else
- rece_carto(1,proc_gap) = 0
- end if
- end do
-
- ! ===== Complete cartography and send range about the particles I remesh =====
- nb_s = send_gap_abs(2) - send_gap_abs(1) + 1
- allocate(s_request_ran(1:nb_s))
- s_request_ran = MPI_REQUEST_NULL
- min_size = 2 + gs(2)
- do ind_gap = 1, nb_s !send_gap_abs(1), send_gap_abs(2)
- proc_gap = ind_gap+send_gap_abs(1)-1
- call AC_remesh_cartography(direction, gs, min_size, proc_gap, ind_gap, &
- & send_min, send_max, cartography, com_size)
- ! Tag = concatenation of (rank+1), ind_group(1), ind_group(2), direction and unique Id.
- tag = compute_tag(ind_group, tag_bufToScal_range, direction, proc_gap)
- ! Send message
- if (send_rank(ind_gap) /= D_rank(direction)) then
- call mpi_ISsend(cartography(1,ind_gap), com_size, MPI_INTEGER, send_rank(ind_gap), tag, &
- & D_comm(direction), s_request_ran(ind_gap),ierr)
- end if
- end do
-
- ! ===== Initialize the general buffer =====
- ! The same buffer is used to send data to all target processes. It size
- ! has to be computed as the part reserved to each processus.
- ! and it has to be splitted into parts for each target processes
- allocate(pos_in_buffer(0:nb_s))
- pos_in_buffer(0) = 1
- pos_in_buffer(1) = 1
- do ind_gap =1, send_gap_abs(2)-send_gap_abs(1)
- pos_in_buffer(ind_gap+1)= pos_in_buffer(ind_gap) + cartography(1,ind_gap)
- end do
- allocate(send_buffer(pos_in_buffer(nb_s) &
- & + cartography(1,nb_s)-1))
- send_buffer = 0.0
-
- ! ===== Remeshing into the buffer by using pointer array =====
- if (present(bl_type)) then
- call remesh_in_buffer_pt(gs, j, k, send_gap_abs(1)-1, p_pos_adim, bl_type, bl_tag, send_min, &
- & send_max, scal, remesh_line_pt, send_buffer, pos_in_buffer)
- else
- call remesh_in_buffer_notype_pt(gs, j, k, send_gap_abs(1)-1, p_pos_adim, send_min, &
- & send_max, scal, send_buffer, pos_in_buffer)
- end if
-
- ! ===== Wait for reception of all cartography =====
- allocate(r_status(MPI_STATUS_SIZE,1:nb_r))
- call mpi_waitall(nb_r,r_request_ran, r_status, ierr)
- deallocate(r_request_ran)
- deallocate(r_status)
- !allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
- !allocate(ind_array(send_gap_abs(1):send_gap_abs(2)))
- !call mpi_testsome(size(s_request_ran),s_request_ran, ind_1Dtable, ind_array, s_status, ierr)
- !deallocate(ind_array)
-
- ! ===== Receive buffer (init receive before send) =====
- ! -- Compute size of reception buffer and split it into part corresponding to each sender --
- allocate(rece_pos(rece_gap(1,1):rece_gap(1,2)+1))
- rece_pos(rece_gap(1,1)) = 1
- do proc_gap = rece_gap(1,1), rece_gap(1,2)
- rece_pos(proc_gap+1)= rece_pos(proc_gap) + rece_carto(1,proc_gap)
- end do
- allocate(rece_buffer(rece_pos(rece_gap(1,2)+1)-1))
- ! -- And initialize the reception --
- allocate(r_request_sca(1:nb_r))
- r_request_sca = MPI_REQUEST_NULL
- do proc_gap = rece_gap(1,1), rece_gap(1,2)
- call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, rece_rank(proc_gap), ierr)
- if (rece_rank(proc_gap)/= D_rank(direction)) then
- tag = compute_tag(ind_group, tag_bufToScal_buffer, direction, -proc_gap)
- call mpi_Irecv(rece_buffer(rece_pos(proc_gap)), rece_carto(1,proc_gap), &
- & MPI_DOUBLE_PRECISION, rece_rank(proc_gap), tag, D_COMM(direction), r_request_sca(proc_gap-rece_gap(1,1)+1), ierr)
- end if
- end do
-
- ! ===== Send buffer =====
- missing_msg = nb_r
- allocate(s_request_sca(1:nb_s))
- s_request_sca = MPI_REQUEST_NULL
- ! -- Send the buffer to the matching processus and update the scalar field --
- do ind_gap = 1, nb_s
- if (send_rank(ind_gap)/=D_rank(direction)) then
- ! Send buffer
- tag = compute_tag(ind_group, tag_bufToScal_buffer, direction, ind_gap-1+send_gap_abs(1))
- call mpi_ISsend(send_buffer(pos_in_buffer(ind_gap-1)), cartography(1,ind_gap), MPI_DOUBLE_PRECISION, &
- & send_rank(ind_gap), tag, D_comm(direction), s_request_sca(ind_gap),ierr)
- else
- ! Range I want - store into the cartography
- gap = -(ind_gap-1+send_gap_abs(1))*N_proc(direction)
- ! Update directly the scalar field
- call remesh_buffer_to_scalar_pt(gs, j, k, ind_gap, gap, min_size, &
- & cartography, send_buffer, scal, pos_in_buffer(ind_gap-1))
- missing_msg = missing_msg - 1
- end if
- end do
-
- ! ===== Update scalar field =====
- do while (missing_msg >= 1)
- ! --- Choose one of the first available message ---
- ! more precisly: the last reception ended (and not free) and if not such
- ! message available, the first reception ended.
- call mpi_waitany(nb_r, r_request_sca, ind_1Dtable, mpi_status, ierr)
- ! -- Update the scalar field by using the cartography --
- ! Range I want - store into the cartography
- proc_gap = ind_1Dtable + rece_gap(1,1)-1
- gap = proc_gap*N_proc(direction)
- call remesh_buffer_to_scalar_pt(gs, j, k, ind_1Dtable, gap, min_size, &
- & rece_carto, rece_buffer, scal, rece_pos(proc_gap))
- missing_msg = missing_msg - 1
- end do
-
- ! ===== Free memory and communication buffer ====
- ! -- Deallocate all field --
- deallocate(rece_pos)
- deallocate(rece_buffer)
- deallocate(rece_carto)
- deallocate(rece_rank)
- deallocate(r_request_sca)
- ! -- Check if Isend are done --
- allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
- call mpi_waitall(nb_s, s_request_ran, s_status, ierr)
- call mpi_waitall(nb_s, s_request_sca, s_status, ierr)
- deallocate(s_status)
- ! -- Free all communication buffer and data --
- deallocate(send_buffer)
- deallocate(pos_in_buffer)
- deallocate(s_request_ran)
- deallocate(s_request_sca)
-
-end subroutine AC_remesh_via_buffer
-
-
-!> Determine where the particles of each lines will be remeshed
-!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
-!! @param[in] p_pos_adim = adimensionned particles position
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
-!! @param[out] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
-!! @param[out] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
-!! @param[out] send_gap = distance between me and processus wich send me information (for each line of the group)
-!! @param[out] send_gap_abs = send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-subroutine AC_remesh_range(bl_type, p_pos_adim, direction, send_min, send_max, send_gap, send_gap_abs)
-
- use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
-
- ! Input/Output
- logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- integer, intent(in) :: direction
- integer, dimension(:,:), intent(out) :: send_min ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(out) :: send_max ! distance between me and processus wich send me information
- integer, dimension(:,:,:), intent(out) :: send_gap ! distance between me and processus wich send me information
- integer, dimension(2), intent(out) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-
- ! -- Compute ranges --
- where (bl_type(1,:,:))
- ! First particle is a centered one
- send_min = nint(p_pos_adim(1,:,:))-remesh_stencil(1)
- elsewhere
- ! First particle is a left one
- send_min = floor(p_pos_adim(1,:,:))-remesh_stencil(1)
- end where
- where (bl_type(bl_nb(direction)+1,:,:))
- ! Last particle is a centered one
- send_max = nint(p_pos_adim(N_proc(direction),:,:))+remesh_stencil(2)
- elsewhere
- ! Last particle is a left one
- send_max = floor(p_pos_adim(N_proc(direction),:,:))+remesh_stencil(2)
- end where
-
- ! -- What have I to communicate ? --
- send_gap(:,:,1) = floor(real(send_min-1)/N_proc(direction))
- send_gap(:,:,2) = floor(real(send_max-1)/N_proc(direction))
- send_gap_abs(1) = minval(send_gap(:,:,1))
- send_gap_abs(2) = maxval(send_gap(:,:,2))
-
-end subroutine AC_remesh_range
-
-
-!> Determine where the particles of each lines will be remeshed - Variant for
-!! remeshing without type/tag
-!! @param[in] p_pos_adim = adimensionned particles position
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
-!! @param[out] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
-!! @param[out] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
-!! @param[out] send_gap = distance between me and processus wich send me information (for each line of the group)
-!! @param[out] send_gap_abs = send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-subroutine AC_remesh_range_notype(p_pos_adim, direction, send_min, send_max, send_gap, send_gap_abs)
-
- use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
-
- ! Input/Output
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- integer, intent(in) :: direction
- integer, dimension(:,:), intent(out) :: send_min ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(out) :: send_max ! distance between me and processus wich send me information
- integer, dimension(:,:,:), intent(out) :: send_gap ! distance between me and processus wich send me information
- integer, dimension(2), intent(out) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-
- ! -- Compute ranges --
- send_min = floor(p_pos_adim(1,:,:))-remesh_stencil(1)
- send_max = floor(p_pos_adim(N_proc(direction),:,:))+remesh_stencil(2)
-
- ! -- What have I to communicate ? --
- send_gap(:,:,1) = floor(real(send_min-1)/N_proc(direction))
- send_gap(:,:,2) = floor(real(send_max-1)/N_proc(direction))
- send_gap_abs(1) = minval(send_gap(:,:,1))
- send_gap_abs(2) = maxval(send_gap(:,:,2))
-
-end subroutine AC_remesh_range_notype
-
-
-!> Determine the set of processes wich will send me information during the remeshing
-!! and compute for each of these processes the range of wanted data. Use implicit
-!! computation rather than communication (only possible if particle are gather by
-!! block whith contrainst on velocity variation - as corrected lambda formula.) -
-!! work directly on a group of particles lines.
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
-!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[in] remesh_min = minimal indice of meshes where I will remesh my particles.
-!! @param[in] remesh_max = maximal indice of meshes where I will remesh my particles.
-!! @param[out] rece_gap = coordinate range of processes which will send me information during the remeshing.
-!! @param[in] send_gap = distance between me and processus wich send me information (for each line of the group)
-!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-!! @param[out] send_rank = mpi rank of processes to which I will send messages.
-!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
-!! of mesh points from where it requiers the velocity values.
-!! @details
-!! Work on a group of line of size gs(1) x gs(2))
-!! Obtain the list of processus which are associated to sub-domain where my particles
-!! will be remeshed and the list of processes wich contains particles which
-!! have to be remeshed in my sub-domain. This way, this procedure determine
-!! which processus need to communicate together in order to proceed to the
-!! remeshing (as in a parrallel context the real space is subdivised and each
-!! processus contains a part of it)
-!! In the same time, it computes for each processus with which I will
-!! communicate, the range of mesh point involved for each line of particles
-!! inside the group and it stores it by using some sparse matrix technics
-!! (see cartography defined in the algorithm documentation)
-!! This routine does not involve any communication to determine if
-!! a processus is the first or the last processes (considering its coordinate along
-!! the current directory) to send remeshing information to a given processes.
-!! It directly compute it using contraints on velocity (as in corrected lambda
-!! scheme) When possible use it rather than AC_obtain_senders_com
-subroutine AC_remesh_determine_communication(direction, gs, ind_group, remesh_min, remesh_max, &
- & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
-! XXX Work only for periodic condition. For dirichlet conditions : it is
-! possible to not receive either rece_gap(1), either rece_gap(2) or none of
-! these two => detect it (track the first and the last particles) and deal with it.
-
- use cart_topology ! info about mesh and mpi topology
- use advec_variables ! contains info about solver parameters and others.
- use mpi
-
- ! Input/output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: gs ! a group size
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(:,:), intent(in) :: remesh_min ! minimal indice of meshes where I will remesh my particles.
- integer, dimension(:,:), intent(in) :: remesh_max ! maximal indice of meshes where I will remesh my particles.
- integer, dimension(2, 2), intent(out) :: rece_gap
- integer(kind=4), dimension(gs(1),gs(2),2),intent(in):: send_gap ! minimal and maximal processus which contains the sub-domains where my
- ! particles will be remeshed for each line of the line group
- integer, dimension(2), intent(in) :: send_gap_abs ! min and maximal processus which contains the sub-domains where my particles will be remeshed.
- integer,dimension(send_gap_abs(1):send_gap_abs(2))&
- &, intent(out) :: send_rank ! rank of processus to wich I will send data
- integer, dimension(2+gs(2)*(2+3*gs(1)), &
- & send_gap_abs(1):send_gap_abs(2)), intent(out) :: cartography
-
- ! To manage communications and to localize sub-domain
- integer(kind=4) :: proc_gap ! gap between a processus coordinate (along the current
- ! direction) into the mpi-topology and my coordinate
- integer :: rankP ! processus rank for shift (P= previous)
- integer, dimension(2) :: tag_table ! mpi message tag (for communicate rece_gap(1) and rece_gap(2))
- integer, dimension(:,:),allocatable :: send_request ! mpi status of nonblocking send
- integer :: ierr ! mpi error code
- integer, dimension(MPI_STATUS_SIZE) :: statut ! mpi status
- ! To determine which processus is the first/last to send data to another
- integer, dimension(:,:), allocatable :: first, last ! Storage processus to which I will be the first (or the last) to send
- ! remeshed particles
- integer :: first_condition ! allowed range of value of proc_min and proc_max for being the first
- integer :: last_condition ! allowed range of value of proc_min and proc_max for being the last
- ! Other local variable
- integer :: ind1, ind2 ! indice of the current line inside the group
- integer :: min_size ! begin indice in first and last to stock indice along first dimension of the group line
- integer :: gp_size ! group size
- integer,dimension(2) :: rece_buffer ! buffer for reception of rece_max
- logical :: begin_interval ! ware we in the start of an interval ?
-
- rece_gap(1,1) = 3*N(direction)
- rece_gap(1,2) = -3*N(direction)
- rece_gap(2,:) = 0
- gp_size = gs(1)*gs(2)
-
- allocate(send_request(send_gap_abs(1):send_gap_abs(2),3))
- send_request(:,3) = 0
-
- ! ===== Compute if I am first or last and determine the carography =====
- min_size = 2 + gs(2)
- ! Initialize first and last to determine if I am the the first or the last processes (considering the current direction)
- ! to require information from this processus
- allocate(first(2,send_gap_abs(1):send_gap_abs(2)))
- first(2,:) = 0 ! number of lines for which I am the first
- allocate(last(2,send_gap_abs(1):send_gap_abs(2)))
- last(2,:) = 0 ! number of lines for which I am the last
- ! Initialize cartography
- cartography(1,:) = 0 ! number of velocity values to receive
- cartography(2,:) = min_size ! number of element to send when sending cartography
- ! And compute cartography, first and last !
- do proc_gap = send_gap_abs(1), send_gap_abs(2)
- first(1,proc_gap) = -proc_gap
- last(1,proc_gap) = -proc_gap
- first_condition = 1-2*bl_bound_size + proc_gap*N_proc(direction)+1
- last_condition = -1+2*bl_bound_size + (proc_gap+1)*N_proc(direction)
- call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, send_rank(proc_gap), ierr)
- do ind2 = 1, gs(2)
- cartography(2+ind2,proc_gap) = 0 ! 2 x number of interval of concern line into the column i2
- begin_interval = .true.
- do ind1 = 1, gs(1)
- ! Does proc_gap belongs to [send_gap(i1,i2,1);send_gap(i1,i2,2)]?
- if((proc_gap>=send_gap(ind1,ind2,1)).and.(proc_gap<=send_gap(ind1,ind2,2))) then
- ! Compute if I am the first.
- if (remesh_min(ind1,ind2)< first_condition) first(2,proc_gap) = first(2,proc_gap)+1
- ! Compute if I am the last.
- if (remesh_max(ind1,ind2) > last_condition) last(2,proc_gap) = last(2,proc_gap)+1
- ! Update cartography // Needed even if target processus is myself as we us buffer
- ! in all the case (scalar field cannot be used directly during the remeshing)
- if (begin_interval) then
- cartography(2+ind2,proc_gap) = cartography(2+ind2,proc_gap)+2
- cartography(cartography(2,proc_gap)+1,proc_gap) = ind1
- cartography(2,proc_gap) = cartography(2,proc_gap) + 2
- cartography(cartography(2,proc_gap),proc_gap) = ind1
- begin_interval = .false.
- else
- cartography(cartography(2,proc_gap),proc_gap) = ind1
- end if
- else
- begin_interval = .true.
- end if
- end do
- end do
- end do
-
- ! ===== Send information about first and last =====
- tag_table = compute_tag(ind_group, tag_obtsend_NP, direction)
- do proc_gap = send_gap_abs(1), send_gap_abs(2)
- ! I am the first ?
- if (first(2,proc_gap)>0) then
- if(send_rank(proc_gap)/= D_rank(direction)) then
- call mpi_ISsend(first(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(1), D_comm(direction), &
- & send_request(proc_gap,1), ierr)
- send_request(proc_gap,3) = 1
- else
- rece_gap(1,1) = min(rece_gap(1,1), -proc_gap)
- rece_gap(2,1) = rece_gap(2,1) + first(2,proc_gap)
- end if
- end if
- ! I am the last ?
- if (last(2,proc_gap)>0) then
- if(send_rank(proc_gap)/= D_rank(direction)) then
- call mpi_ISsend(last(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(2), D_comm(direction), &
- & send_request(proc_gap,2), ierr)
- send_request(proc_gap,3) = send_request(proc_gap, 3) + 2
- else
- rece_gap(1,2) = max(rece_gap(1,2), -proc_gap)
- rece_gap(2,2) = rece_gap(2,2) + last(2,proc_gap)
- end if
- end if
- end do
-
- ! ===== Receive information form the first and the last processus which need a part of my local velocity field =====
- do while(rece_gap(2,1) < gp_size)
- call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(1), D_comm(direction), statut, ierr)
- rece_gap(1,1) = min(rece_gap(1,1), rece_buffer(1))
- rece_gap(2,1) = rece_gap(2,1) + rece_buffer(2)
- end do
- do while(rece_gap(2,2) < gp_size)
- call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(2), D_comm(direction), statut, ierr)
- rece_gap(1,2) = max(rece_gap(1,2), rece_buffer(1))
- rece_gap(2,2) = rece_gap(2,2) + rece_buffer(2)
- end do
-
- ! ===== Free Isend buffer =====
- do proc_gap = send_gap_abs(1), send_gap_abs(2)
- select case (send_request(proc_gap,3))
- case (3)
- call mpi_wait(send_request(proc_gap,1), statut, ierr)
- call mpi_wait(send_request(proc_gap,2), statut, ierr)
- case (2)
- call mpi_wait(send_request(proc_gap,2), statut, ierr)
- case (1)
- call mpi_wait(send_request(proc_gap,1), statut, ierr)
- end select
- end do
-
- ! ===== Deallocate fields =====
- deallocate(send_request)
- deallocate(first)
- deallocate(last)
-
-end subroutine AC_remesh_determine_communication
-
-
-!> Determine the set of processes wich will send me information during the remeshing
-!! and compute for each of these processes the range of wanted data. Version for M'6
-!! scheme (some implicitation can not be done anymore)
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
-!! @param[in] gs = size of group of line along the current direction
-!! @param[in] ind_group = coordinate of the current group of lines
-!! @param[out] rece_gap = coordinate range of processes which will send me information during the remeshing.
-!! @param[in] send_gap = distance between me and processus to wich I will send information (for each line of the group)
-!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
-!! @param[out] send_rank = mpi rank of processes to which I will send messages.
-!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
-!! of mesh points from where it requiers the velocity values.
-!! @details
-!! Work on a group of line of size gs(1) x gs(2))
-!! Obtain the list of processus which are associated to sub-domain where my particles
-!! will be remeshed and the list of processes wich contains particles which
-!! have to be remeshed in my sub-domain. This way, this procedure determine
-!! which processus need to communicate together in order to proceed to the
-!! remeshing (as in a parrallel context the real space is subdivised and each
-!! processus contains a part of it)
-!! In the same time, it computes for each processus with which I will
-!! communicate, the range of mesh point involved for each line of particles
-!! inside the group and it stores it by using some sparse matrix technics
-!! (see cartography defined in the algorithm documentation)
-!! This routine involves communication to determine if a processus is
-!! the first or the last processes (considering its coordinate along
-!! the current directory) to send remeshing information to a given processes.
-subroutine AC_remesh_determine_communication_com(direction, gs, ind_group, &
- & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
-! XXX Work only for periodic condition.
-
- use cart_topology ! info about mesh and mpi topology
- use advec_variables ! contains info about solver parameters and others.
- use mpi
-
- ! Input/output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: gs ! a group size
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(2, 2), intent(out) :: rece_gap ! minimal and maximal processus which will remesh inside me
- integer(kind=4), dimension(gs(1),gs(2),2),intent(in):: send_gap ! minimal and maximal processus which contains the sub-domains where my
- ! particles will be remeshed for each line of the line group
- integer, dimension(2), intent(in) :: send_gap_abs ! min and maximal processus which contains the sub-domains where my particles will be remeshed.
- integer,dimension(send_gap_abs(1):send_gap_abs(2))&
- &, intent(out) :: send_rank ! rank of processus to wich I will send data
- integer, dimension(2+gs(2)*(2+3*gs(1)), &
- & send_gap_abs(1):send_gap_abs(2)), intent(out) :: cartography
-
- ! To manage communications and to localize sub-domain
- integer(kind=4) :: proc_gap ! gap between a processus coordinate (along the current
- ! direction) into the mpi-topology and my coordinate
- integer :: rankP ! processus rank for shift (P= previous)
- integer, dimension(2) :: tag_table ! mpi message tag (for communicate rece_gap(1) and rece_gap(2))
- integer, dimension(:,:),allocatable :: send_request ! mpi status of nonblocking send
- integer :: ierr ! mpi error code
- integer, dimension(MPI_STATUS_SIZE) :: statut ! mpi status
- ! To determine which processus is the first/last to send data to another
- integer, dimension(gs(1), gs(2)) :: send_max_prev ! maximum gap between previous processus and the receivers of its remeshing buffer
- integer, dimension(gs(1), gs(2)) :: send_min_next ! minimum gap between next processus and the receivers of its remeshing buffer
- integer, dimension(:,:), allocatable :: first, last ! Storage processus to which I will be the first (or the last) to send
- ! remeshed particles
- ! Other local variable
- integer :: ind1, ind2 ! indice of the current line inside the group
- integer :: min_size ! begin indice in first and last to stock indice along first dimension of the group line
- integer :: gp_size ! group size
- integer,dimension(2) :: rece_buffer ! buffer for reception of rece_max
- logical :: begin_interval ! are we in the start of an interval ?
-
- rece_gap(1,1) = 3*N(direction)
- rece_gap(1,2) = -3*N(direction)
- rece_gap(2,:) = 0
- gp_size = gs(1)*gs(2)
-
- allocate(send_request(send_gap_abs(1):send_gap_abs(2),3))
- send_request(:,3) = 0
-
- ! ===== Exchange ghost =====
- ! Compute message tag - we re-use tag_part_tag_NP id as using this procedure
- ! suppose not using "AC_type_and_block"
- tag_table = compute_tag(ind_group, tag_part_tag_NP, direction)
- ! Exchange "ghost"
- call mpi_Sendrecv(send_gap(1,1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(1), &
- & send_min_next(1,1), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(1), &
- & D_comm(direction), statut, ierr)
- call mpi_Sendrecv(send_gap(1,1,2), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(2), &
- & send_max_prev(1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(2), &
- & D_comm(direction), statut, ierr)
- ! Translat to adapt gap to my position
- send_max_prev = send_max_prev - 1
- send_min_next = send_min_next + 1
-
- ! ===== Compute if I am first or last and determine the cartography =====
- min_size = 2 + gs(2)
- ! Initialize first and last to determine if I am the the first or the last processes (considering the current direction)
- ! to require information from this processus
- allocate(first(2,send_gap_abs(1):send_gap_abs(2)))
- first(2,:) = 0 ! number of lines for which I am the first
- allocate(last(2,send_gap_abs(1):send_gap_abs(2)))
- last(2,:) = 0 ! number of lines for which I am the last
- ! Initialize cartography
- cartography(1,:) = 0 ! number of velocity values to receive
- cartography(2,:) = min_size ! number of element to send when sending cartography
- ! And compute cartography, first and last !
- do proc_gap = send_gap_abs(1), send_gap_abs(2)
- first(1,proc_gap) = -proc_gap
- last(1,proc_gap) = -proc_gap
- call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, send_rank(proc_gap), ierr)
- do ind2 = 1, gs(2)
- cartography(2+ind2,proc_gap) = 0 ! 2 x number of interval of concern line into the column i2
- begin_interval = .true.
- do ind1 = 1, gs(1)
- ! Does proc_gap belongs to [send_gap(i1,i2,1);send_gap(i1,i2,2)]?
- if((proc_gap>=send_gap(ind1,ind2,1)).and.(proc_gap<=send_gap(ind1,ind2,2))) then
- ! Compute if I am the first.
- if(proc_gap > send_max_prev(ind1,ind2)) first(2,proc_gap) = first(2,proc_gap)+1
- ! Compute if I am the last.
- if(proc_gap < send_min_next(ind1,ind2)) last(2,proc_gap) = last(2,proc_gap)+1
- ! Update cartography // Needed even if target processus is myself as we us buffer
- ! in all the case (scalar field cannot be used directly during the remeshing)
- if (begin_interval) then
- cartography(2+ind2,proc_gap) = cartography(2+ind2,proc_gap)+2
- cartography(cartography(2,proc_gap)+1,proc_gap) = ind1
- cartography(2,proc_gap) = cartography(2,proc_gap) + 2
- cartography(cartography(2,proc_gap),proc_gap) = ind1
- begin_interval = .false.
- else
- cartography(cartography(2,proc_gap),proc_gap) = ind1
- end if
- else
- begin_interval = .true.
- end if
- end do
- end do
- end do
-
- ! ===== Send information about first and last =====
- tag_table = compute_tag(ind_group, tag_obtsend_NP, direction)
- do proc_gap = send_gap_abs(1), send_gap_abs(2)
- ! I am the first ?
- if (first(2,proc_gap)>0) then
- if(send_rank(proc_gap)/= D_rank(direction)) then
- call mpi_ISsend(first(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(1), D_comm(direction), &
- & send_request(proc_gap,1), ierr)
- send_request(proc_gap,3) = 1
- else
- rece_gap(1,1) = min(rece_gap(1,1), -proc_gap)
- rece_gap(2,1) = rece_gap(2,1) + first(2,proc_gap)
- end if
- end if
- ! I am the last ?
- if (last(2,proc_gap)>0) then
- if(send_rank(proc_gap)/= D_rank(direction)) then
- call mpi_ISsend(last(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(2), D_comm(direction), &
- & send_request(proc_gap,2), ierr)
- send_request(proc_gap,3) = send_request(proc_gap, 3) + 2
- else
- rece_gap(1,2) = max(rece_gap(1,2), -proc_gap)
- rece_gap(2,2) = rece_gap(2,2) + last(2,proc_gap)
- end if
- end if
- end do
-
- ! ===== Receive information form the first and the last processus which need a part of my local velocity field =====
- do while(rece_gap(2,1) < gp_size)
- call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(1), D_comm(direction), statut, ierr)
- rece_gap(1,1) = min(rece_gap(1,1), rece_buffer(1))
- rece_gap(2,1) = rece_gap(2,1) + rece_buffer(2)
- end do
- do while(rece_gap(2,2) < gp_size)
- call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(2), D_comm(direction), statut, ierr)
- rece_gap(1,2) = max(rece_gap(1,2), rece_buffer(1))
- rece_gap(2,2) = rece_gap(2,2) + rece_buffer(2)
- end do
-
- ! ===== Free Isend buffer =====
- do proc_gap = send_gap_abs(1), send_gap_abs(2)
- select case (send_request(proc_gap,3))
- case (3)
- call mpi_wait(send_request(proc_gap,1), statut, ierr)
- call mpi_wait(send_request(proc_gap,2), statut, ierr)
- case (2)
- call mpi_wait(send_request(proc_gap,2), statut, ierr)
- case (1)
- call mpi_wait(send_request(proc_gap,1), statut, ierr)
- end select
- end do
-
- ! ===== Deallocate fields =====
- deallocate(send_request)
- deallocate(first)
- deallocate(last)
-
-end subroutine AC_remesh_determine_communication_com
-
-
-!> Update the cartography of data which will be exchange from a processus to another in order to remesh particles.
-!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
-!! @param[in] gs = size of group of line along the current direction
-!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
-!! array where indice along the the direction of the group of lines are stored.
-!! @param[in] proc_gap = distance between my (mpi) coordonate and coordinate of the target processus
-!! @param[in] ind_carto = current column inside the cartography (different to proc_Gap as in this procedure
-!! therefore first indice = 1, carto range are not given into argument)
-!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
-!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
-!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
-!! current processus requiers data from proc_gap and for each of these lines the range
-!! of mesh points from where it requiers the velocity values.
-!! @param[out] com_size = number of elements (integers) stored into the cartography (which will be the size of some mpi communication)
-subroutine AC_remesh_cartography(direction, gs, begin_i1, proc_gap, ind_carto, send_min, send_max, cartography, com_size)
-
- use cart_topology ! Description of mesh and of mpi topology
-
- ! Input/Output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
- ! array where indice along the the direction of the group of
- ! lines are stored.
- integer, intent(in) :: proc_gap ! distance between my (mpi) coordonate and coordinate of the target
- integer, intent(in) :: ind_carto ! current column inside the cartography (different to proc_Gap as in this procedure
- ! therefore first indice = 1, carto range are not given into argument)
- integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(inout) :: cartography
- integer, intent(out) :: com_size ! number of elements (integers) stored into the cartography (which will
- ! be the size of some mpi communication)
-
- ! Other local variables
- integer :: gap ! gap between my local indices and the local indices from another processes
- integer :: i1, i2 ! indice of a line into the group
- integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography ?
- integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
-
- cartography(1,ind_carto) = 0
- ! Use the cartography to know which lines are concerned
- com_size = cartography(2,ind_carto)
- ! Range I want - store into the cartography
- gap = proc_gap*N_proc(direction)
- ! Position in cartography(:,ind_carto) of the current i1 indice
- ind_for_i1 = begin_i1
- do i2 = 1, gs(2)
- do ind_1Dtable = ind_for_i1+1, ind_for_i1 + cartography(2+i2,ind_carto), 2
- do i1 = cartography(ind_1Dtable,ind_carto), cartography(ind_1Dtable+1,ind_carto)
- ! Interval start from:
- cartography(com_size+1,ind_carto) = max(send_min(i1,i2), gap+1) ! fortran => indice start from 0
- ! and ends at:
- cartography(com_size+2,ind_carto) = min(send_max(i1,i2), gap+N_proc(direction))
- ! update number of element to send
- cartography(1,ind_carto) = cartography(1,ind_carto) &
- & + cartography(com_size+2,ind_carto) &
- & - cartography(com_size+1,ind_carto) + 1
- com_size = com_size+2
- end do
- end do
- ind_for_i1 = ind_for_i1 + cartography(2+i2,ind_carto)
- end do
-
-end subroutine AC_remesh_cartography
-
-
end module advec_common
-!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_common_remesh.f90 b/HySoP/src/scalesInterface/particles/advec_common_remesh.f90
new file mode 100644
index 0000000000000000000000000000000000000000..61014df656f06d594f9b00f693a29dec2eec8da6
--- /dev/null
+++ b/HySoP/src/scalesInterface/particles/advec_common_remesh.f90
@@ -0,0 +1,1557 @@
+!> @addtogroup part
+!! @{
+!------------------------------------------------------------------------------
+!
+! MODULE: advec_common
+!
+!
+! DESCRIPTION:
+!> The module ``advec_common'' gather function and subroutines used to advec scalar
+!! which are not specific to a direction
+!! @details
+!! This module gathers functions and routines used to advec scalar which are not
+!! specific to a direction. This is a parallel implementation using MPI and
+!! the cartesien topology it provides. It also contains the variables common to
+!! the solver along each direction and other generic variables used for the
+!! advection based on the particle method.
+!!
+!! Except for testing purpose, this module is not supposed to be used by the
+!! main code but only by the other advection module. More precisly, an final user
+!! must only used the generic "advec" module wich contain all the interface to
+!! solve the advection equation with the particle method, and to choose the
+!! remeshing formula, the dimensionnal splitting and everything else.
+!!
+!! The module "test_advec" can be used in order to validate the procedures
+!! embedded in this module.
+!
+!> @author
+!! Jean-Baptiste Lagaert, LEGI
+!
+!------------------------------------------------------------------------------
+
+module advec_common_remesh
+
+ use precision_tools
+ use advec_abstract_proc
+
+ implicit none
+
+
+ ! Information about the particles and their bloc
+ public
+
+
+ ! ===== Public procedures =====
+ !----- Init remeshing context -----
+ public :: AC_setup_init
+ public :: AC_setup_alongX
+ public :: AC_setup_alongY
+ public :: AC_setup_alongZ
+ !----- To remesh particles -----
+ public :: AC_remesh_lambda_group
+ public :: AC_remesh_Mprime_group
+ !----- Tools to remesh particles -----
+ public :: AC_remesh_range
+ public :: AC_remesh_determine_communication
+ public :: AC_remesh_cartography
+
+ ! ===== Private procedures =====
+ !----- Prepare and perform communication required during remeshing -----
+ private :: AC_remesh_init
+ private :: AC_remesh_finalize
+
+ ! ===== Public variables =====
+
+ ! ===== Private variables =====
+ !> Pointer to subroutine wich remesh particle to a buffer - for formula of lambda family (with tag/type).
+ procedure(remesh_in_buffer_type), pointer, private :: remesh_in_buffer_lambda_pt => null()
+ !> Pointer to subroutine wich remesh particle to a buffer - for formula of lambda family (with tag/type).
+ procedure(remesh_in_buffer_limit), pointer, private :: remesh_in_buffer_limit_lambda_pt => null()
+ !> Pointer to subroutine wich remesh particle to a buffer - for formula of M' family (without tag/type).
+ procedure(remesh_in_buffer_notype), pointer, private :: remesh_in_buffer_Mprime_pt => null()
+ !> Pointer to subroutine wich redistribute a buffer (containing remeshed
+ !! particle) inside the original scalar field.
+ procedure(remesh_buffer_to_scalar), pointer, private :: remesh_buffer_to_scalar_pt => null()
+ !> Pointer to subroutine which compute scalar slope along the current
+ !! direction and then computes the limitator function (divided by 8)
+ procedure(advec_limitator_group), pointer, private :: advec_limitator => null()
+
+
+contains
+
+! ===== Public procedure =====
+
+! ================================================================================ !
+! ============= To deal with remeshing setup and generecity ============= !
+! ================================================================================ !
+
+!> Init remesh_line_pt for the right remeshing formula
+subroutine AC_setup_init()
+
+ use advec_remeshing_lambda
+ use advec_remeshing_Mprime
+
+ call AC_remesh_init_lambda()
+ call AC_remesh_init_Mprime()
+
+end subroutine AC_setup_init
+
+!> Setup remesh_in_buffer and remesh_in_buffer_to_scalar for remeshing along X
+subroutine AC_setup_alongX()
+ use advecX
+
+ remesh_in_buffer_lambda_pt => advecX_remesh_in_buffer_lambda
+ remesh_in_buffer_limit_lambda_pt=> advecX_remesh_in_buffer_limit_lambda
+ remesh_in_buffer_Mprime_pt => advecX_remesh_in_buffer_Mprime
+
+ remesh_buffer_to_scalar_pt => advecX_remesh_buffer_to_scalar
+
+ advec_limitator => advecX_limitator_group
+
+end subroutine AC_setup_alongX
+
+!> Setup remesh_in_buffer and remesh_in_buffer_to_scalar for remeshing along X
+subroutine AC_setup_alongY()
+ use advecY
+
+ remesh_in_buffer_lambda_pt => advecY_remesh_in_buffer_lambda
+ remesh_in_buffer_limit_lambda_pt=> advecY_remesh_in_buffer_limit_lambda
+ remesh_in_buffer_Mprime_pt => advecY_remesh_in_buffer_Mprime
+ remesh_buffer_to_scalar_pt => advecY_remesh_buffer_to_scalar
+
+ advec_limitator => advecY_limitator_group
+
+end subroutine AC_setup_alongY
+
+!> Setup remesh_in_buffer and remesh_in_buffer_to_scalar for remeshing along Z
+subroutine AC_setup_alongZ()
+ use advecZ
+
+ remesh_in_buffer_lambda_pt => advecZ_remesh_in_buffer_lambda
+ remesh_in_buffer_limit_lambda_pt=> advecZ_remesh_in_buffer_limit_lambda
+ remesh_in_buffer_Mprime_pt => advecZ_remesh_in_buffer_Mprime
+ remesh_buffer_to_scalar_pt => advecZ_remesh_buffer_to_scalar
+
+ advec_limitator => advecZ_limitator_group
+
+end subroutine AC_setup_alongZ
+
+
+! ==============================================================================================
+! ==================== Remesh all the particles of a group of lines ====================
+! ==============================================================================================
+
+
+!> remeshing with an order 2 or 4 lambda method, corrected to allow large CFL number - group version
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] gs = size of groups (along X direction)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] p_V = particles velocity (needed for tag and type)
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in,out] scal = scalar field to advect
+!! @param[in] dt = time step (needed for tag and type)
+subroutine AC_remesh_lambda_group(direction, ind_group, gs, p_pos_adim, p_V, j, k, scal, dt)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_correction ! To compute type and tag
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
+ real(WP), dimension(:,:,:), intent(inout) :: scal
+ real(WP), intent(in) :: dt
+ ! Other local variables
+ ! To type and tag particles
+ logical, dimension(bl_nb(direction)+1,gs(1),gs(2)) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(bl_nb(direction),gs(1),gs(2)) :: bl_tag ! indice of tagged particles
+ ! Others
+ integer, dimension(gs(1),gs(2),2) :: send_gap ! distance between me and processus wich send me information
+ integer, dimension(2) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2 , 2) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:,:), allocatable :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! Variable use to manage mpi communications
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+
+ ! ===== Pre-Remeshing: Determine blocks type and tag particles =====
+ call AC_type_and_block_group(dt, direction, gs, ind_group, p_V, bl_type, bl_tag)
+
+ ! ===== Compute range of remeshing data =====
+ call AC_remesh_range(bl_type, p_pos_adim, direction, send_group_min, send_group_max, send_gap, send_gap_abs)
+
+ ! ===== Determine the communication needed : who will communicate whit who ? (ie compute sender and recer) =====
+ ! -- Allocation --
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(cartography(max_size,send_gap_abs(1):send_gap_abs(2)))
+ allocate(send_rank(send_gap_abs(1):send_gap_abs(2)))
+ ! -- Determine which processes communicate together --
+ call AC_remesh_determine_communication(direction, gs, ind_group, send_group_min, send_group_max, &
+ & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
+
+ ! ===== Proceed to remeshing via a local buffer =====
+ call AC_remesh_via_buffer_lambda(direction, ind_group, gs, p_pos_adim, j, k,&
+ & scal, send_group_min, send_group_max, send_gap_abs, send_rank, &
+ & rece_gap, cartography, bl_type, bl_tag)
+
+ ! -- Free all communication buffer and data --
+ deallocate(cartography)
+ deallocate(send_rank)
+
+end subroutine AC_remesh_lambda_group
+
+
+!> remeshing with an order 2 limited lambda method, corrected to allow large CFL number - group version
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] gs = size of groups (along X direction)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] p_V = particles velocity (needed for tag and type)
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in,out] scal = scalar field to advect
+!! @param[in] dt = time step (needed for tag and type)
+subroutine AC_remesh_limit_lambda_group(direction, ind_group, gs, p_pos_adim, p_V, j, k, scal, dt)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_correction ! To compute type and tag
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
+ real(WP), dimension(:,:,:), intent(inout) :: scal
+ real(WP), intent(in) :: dt
+ ! Other local variables
+ ! To type and tag particles
+ logical, dimension(bl_nb(direction)+1,gs(1),gs(2)) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(bl_nb(direction),gs(1),gs(2)) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(N_proc(direction)+1,gs(1),gs(2)):: limit ! limitator function (divided by 8.)
+ ! Others
+ integer, dimension(gs(1),gs(2),2) :: send_gap ! distance between me and processus wich send me information
+ integer, dimension(2) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2 , 2) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:,:), allocatable :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+ ! Variable use to manage mpi communications
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+
+ ! ===== Pre-Remeshing I: Determine blocks type and tag particles =====
+ call AC_type_and_block_group(dt, direction, gs, ind_group, p_V, bl_type, bl_tag)
+
+ ! ===== Compute range of remeshing data =====
+ call AC_remesh_range(bl_type, p_pos_adim, direction, send_group_min, send_group_max, send_gap, send_gap_abs)
+
+ ! ===== Determine the communication needed : who will communicate whit who ? (ie compute sender and recer) =====
+ ! -- Allocation --
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(cartography(max_size,send_gap_abs(1):send_gap_abs(2)))
+ allocate(send_rank(send_gap_abs(1):send_gap_abs(2)))
+ ! -- Determine which processes communicate together --
+ call AC_remesh_determine_communication(direction, gs, ind_group, send_group_min, send_group_max, &
+ & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
+
+ ! ===== Pre-Remeshing II: Compute the limitor function =====
+ ! Actually, this subroutine compute [limitator/8] as this is this fraction
+ ! wich appear always in the remeshing polynoms.
+ call advec_limitator(gs, ind_group, j, k, p_pos_adim, scal, limit)
+
+ ! ===== Proceed to remeshing via a local buffer =====
+ call AC_remesh_via_buffer_limit_lambda(direction, ind_group, gs, p_pos_adim,&
+ & j, k, scal, send_group_min, send_group_max, send_gap_abs, send_rank, &
+ & rece_gap, cartography, bl_type, bl_tag, limit)
+
+ ! -- Free all communication buffer and data --
+ deallocate(cartography)
+ deallocate(send_rank)
+
+end subroutine AC_remesh_limit_lambda_group
+
+
+!> remeshing with a M'6 or M'8 remeshing formula - group version
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] gs = size of groups (along X direction)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] p_V = particles velocity (needed for tag and type)
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in,out] scal = scalar field to advect
+!! @param[in] dt = time step (needed for tag and type)
+subroutine AC_remesh_Mprime_group(direction, ind_group, gs, p_pos_adim, p_V, j, k, scal, dt)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
+ real(WP), dimension(:,:,:), intent(inout) :: scal
+ real(WP), intent(in) :: dt
+ ! Other local variables
+ integer, dimension(gs(1),gs(2),2) :: send_gap ! distance between me and processus wich send me information
+ integer, dimension(2) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2 , 2) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:,:), allocatable :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+ ! Variable use to manage mpi communications
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+
+ ! ===== Compute range of remeshing data =====
+ call AC_remesh_range_notype(p_pos_adim, direction, send_group_min, send_group_max, send_gap, send_gap_abs)
+
+ ! ===== Determine the communication needed : who will communicate whit who ? (ie compute sender and recer) =====
+ ! -- Allocation --
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(cartography(max_size,send_gap_abs(1):send_gap_abs(2)))
+ allocate(send_rank(send_gap_abs(1):send_gap_abs(2)))
+ ! -- Determine which processes communicate together --
+ call AC_remesh_determine_communication_com(direction, gs, ind_group, &
+ & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
+
+ ! ===== Proceed to remeshing via a local buffer =====
+ call AC_remesh_via_buffer_Mprime(direction, ind_group, gs, p_pos_adim, &
+ & j, k, scal, send_group_min, send_group_max, send_gap_abs, &
+ & send_rank, rece_gap, cartography)
+
+ ! -- Free all communication buffer and data --
+ deallocate(cartography)
+ deallocate(send_rank)
+
+end subroutine AC_remesh_Mprime_group
+
+
+! ===================================================================================================
+! ===== Tools to remesh particles: variant of remeshing via buffer for each family of remeshing =====
+! ===================================================================================================
+
+
+!> Using input information to update the scalar field by creating particle
+!! weight (from scalar values), set scalar to 0, redistribute particle inside
+!! - variant for corrected lambda remeshing formula.
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] gs = size of groups (along X direction)
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in,out] scal = scalar field to advect
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles
+!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+!! @param[in] send_rank = mpi rank of processes to which I will send messages.
+!! @param[in] rece_gap = coordinate range of processes which will send me information during the remeshing.
+!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @details
+!! This procedure manage all communication needed. To minimize communications,
+!! particles are remeshing inside a local buffer wich is after send to the
+!! processus wich contain the right sub-domain depending off the particle
+!! position. There is no need of communication in order to remesh inside the
+!! buffer. To avoid recopy in creating particle weight (which will be weight
+!! = scalar), scalar is directly redistribute inside the local buffer.
+!! This provides:
+!! a - Remesh particle: redistribute scalar field inside a local buffer and
+!! set scalar = 0.
+!! b - Send local buffer to its target processus and update the scalar field,
+!! ie scalar = scalar + received buffer.
+!! "remesh_in_buffer_pt" do the part "a" and "remesh_buffer_to_scalar" the part
+!! B except the communication. The current subroutine manage all the
+!! communications (and other stuff needed to allow correctness).
+subroutine AC_remesh_via_buffer_lambda(direction, ind_group, gs, p_pos_adim, &
+ & j, k, scal, send_min, send_max, send_gap_abs, send_rank, rece_gap,&
+ & cartography, bl_type, bl_tag)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_abstract_proc ! contain some useful procedure pointers.
+ use advecX ! procedure specific to advection alongX
+ use advecY ! procedure specific to advection alongY
+ use advecZ ! procedure specific to advection alongZ
+ use cart_topology ! Description of mesh and of mpi topology
+ use mpi
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical,dimension(:,:,:),intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical,dimension(:,:,:),intent(in) :: bl_tag ! indice of tagged particles
+ real(WP),dimension(:,:,:),intent(inout) :: scal
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ integer, dimension(2), intent(in) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), intent(in) :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2, 2), intent(in) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:,:), intent(inout) :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+ ! Other local variables
+ ! Others
+ integer,dimension(rece_gap(1,1):rece_gap(1,2)) :: rece_rank ! rank of processus wich send me information
+ integer, dimension(:,:), allocatable :: rece_carto ! same as abobve but for what I receive
+ integer :: min_size ! minimal size of cartography(:,proc_gap)
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+ ! Variable used to remesh particles in a buffer
+ real(WP),dimension(:),allocatable,target:: send_buffer ! buffer use to remesh the scalar before to send it to the right subdomain
+ ! sorted by receivers and not by coordinate.
+ integer, dimension(:), allocatable :: pos_in_buffer! buffer size
+ ! Variable use to manage mpi communications
+ integer, dimension(:), allocatable :: s_request_ran! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), allocatable :: r_request_ran! mpi communication request (handle) of nonblocking receive
+ integer, dimension(:,:), allocatable :: r_status ! mpi communication status of nonblocking receive
+ integer, dimension(:,:), allocatable :: s_status ! mpi communication status of nonblocking send
+ integer :: ierr ! mpi error code
+ integer :: nb_r, nb_s ! number of reception/send
+
+
+ ! ===== Allocation =====
+ ! -- allocate request about cartography (non-blocking) reception --
+ nb_r = rece_gap(1,2) - rece_gap(1,1) + 1
+ allocate(r_request_ran(1:nb_r))
+ r_request_ran = MPI_REQUEST_NULL
+ ! -- allocate cartography about what I receive --
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(rece_carto(max_size,rece_gap(1,1):rece_gap(1,2)))
+ ! -- allocate request about cartography (non-blocking) send --
+ nb_s = send_gap_abs(2) - send_gap_abs(1) + 1
+ allocate(s_request_ran(1:nb_s))
+ ! -- To manage buffer --
+ ! Position of sub-buffer associated different mpi-processes
+ allocate(pos_in_buffer(0:nb_s))
+
+ ! ===== Init the remeshing process: pre-process =====
+ ! Perform a cartography of mesh points where particle will be remesh,
+ ! create a 1D to buffer where remeshing will be performed and create
+ ! tools to manage it.
+ call AC_remesh_init(direction, ind_group, gs, send_min, send_max, &
+ & send_gap_abs, send_rank, rece_gap, rece_rank, nb_s, cartography, &
+ & rece_carto, pos_in_buffer, min_size, max_size, s_request_ran, r_request_ran)
+
+
+ ! ===== Initialize the general buffer =====
+ allocate(send_buffer(pos_in_buffer(nb_s) &
+ & + cartography(1,nb_s)-1))
+ send_buffer = 0.0
+
+ ! ===== Remeshing into the buffer by using pointer array =====
+ call remesh_in_buffer_lambda_pt(gs, j, k, send_gap_abs(1)-1, p_pos_adim, bl_type, bl_tag, send_min, &
+ & send_max, scal, send_buffer, pos_in_buffer)
+ ! Observe that now:
+ ! => pos_in_buffer(i-1) = first (1D-)indice of the sub-array of send_buffer
+ ! associated to he i-rd mpi-processus to wich I will send remeshed particles.
+
+ ! ===== Wait for reception of all cartography =====
+ allocate(r_status(MPI_STATUS_SIZE,1:nb_r))
+ call mpi_waitall(nb_r,r_request_ran, r_status, ierr)
+ deallocate(r_request_ran)
+ deallocate(r_status)
+ !allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ !allocate(ind_array(send_gap_abs(1):send_gap_abs(2)))
+ !call mpi_testsome(size(s_request_ran),s_request_ran, ind_1Dtable, ind_array, s_status, ierr)
+ !deallocate(ind_array)
+
+ ! ===== Finish the remeshing process =====
+ ! Send buffer, receive some other buffers and update scalar field.
+ call AC_remesh_finalize(direction, ind_group, gs, j, k, scal, send_gap_abs, send_rank, rece_gap, &
+ & rece_rank, nb_r, nb_s, cartography, rece_carto, send_buffer, pos_in_buffer, min_size)
+
+
+ ! ===== Free memory and communication buffer ====
+ ! -- Deallocate all field --
+ deallocate(rece_carto)
+ ! -- Check if Isend are done --
+ allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ call mpi_waitall(nb_s, s_request_ran, s_status, ierr)
+ deallocate(s_status)
+ ! -- Free all communication buffer and data --
+ deallocate(send_buffer)
+ deallocate(pos_in_buffer)
+ deallocate(s_request_ran)
+
+end subroutine AC_remesh_via_buffer_lambda
+
+
+!> Using input information to update the scalar field by creating particle
+!! weight (from scalar values), set scalar to 0, redistribute particle inside
+!! - variant for corrected and limited lambda remeshing formula.
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] gs = size of groups (along X direction)
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] bl_type = table of blocks type (center of left)
+!! @param[in] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! and the begining of the following one is tagged)
+!! @param[in] limit = limitator function
+!! @param[in,out] scal = scalar field to advect
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles
+!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+!! @param[in] send_rank = mpi rank of processes to which I will send messages.
+!! @param[in] rece_gap = coordinate range of processes which will send me information during the remeshing.
+!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @details
+!! This procedure manage all communication needed. To minimize communications,
+!! particles are remeshing inside a local buffer wich is after send to the
+!! processus wich contain the right sub-domain depending off the particle
+!! position. There is no need of communication in order to remesh inside the
+!! buffer. To avoid recopy in creating particle weight (which will be weight
+!! = scalar), scalar is directly redistribute inside the local buffer.
+!! This provides:
+!! a - Remesh particle: redistribute scalar field inside a local buffer and
+!! set scalar = 0.
+!! b - Send local buffer to its target processus and update the scalar field,
+!! ie scalar = scalar + received buffer.
+!! "remesh_in_buffer_pt" do the part "a" and "remesh_buffer_to_scalar" the part
+!! B except the communication. The current subroutine manage all the
+!! communications (and other stuff needed to allow correctness).
+subroutine AC_remesh_via_buffer_limit_lambda(direction, ind_group, gs, p_pos_adim, &
+ & j, k, scal, send_min, send_max, send_gap_abs, send_rank, rece_gap,&
+ & cartography, bl_type, bl_tag, limit)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_abstract_proc ! contain some useful procedure pointers.
+ use advecX ! procedure specific to advection alongX
+ use advecY ! procedure specific to advection alongY
+ use advecZ ! procedure specific to advection alongZ
+ use cart_topology ! Description of mesh and of mpi topology
+ use mpi
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(:,:,:), intent(in) :: limit ! limitator function (divided by 8.)
+ real(WP),dimension(:,:,:),intent(inout) :: scal
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ integer, dimension(2), intent(in) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), intent(in) :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2, 2), intent(in) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:,:), intent(inout) :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+ ! Other local variables
+ ! Others
+ integer,dimension(rece_gap(1,1):rece_gap(1,2)) :: rece_rank ! rank of processus wich send me information
+ integer, dimension(:,:), allocatable :: rece_carto ! same as abobve but for what I receive
+ integer :: min_size ! minimal size of cartography(:,proc_gap)
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+ ! Variable used to remesh particles in a buffer
+ real(WP),dimension(:),allocatable,target:: send_buffer ! buffer use to remesh the scalar before to send it to the right subdomain
+ ! sorted by receivers and not by coordinate.
+ integer, dimension(:), allocatable :: pos_in_buffer! buffer size
+ ! Variable use to manage mpi communications
+ integer, dimension(:), allocatable :: s_request_ran! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), allocatable :: r_request_ran! mpi communication request (handle) of nonblocking receive
+ integer, dimension(:,:), allocatable :: r_status ! mpi communication status of nonblocking receive
+ integer, dimension(:,:), allocatable :: s_status ! mpi communication status of nonblocking send
+ integer :: ierr ! mpi error code
+ integer :: nb_r, nb_s ! number of reception/send
+
+
+ ! ===== Allocation =====
+ ! -- allocate request about cartography (non-blocking) reception --
+ nb_r = rece_gap(1,2) - rece_gap(1,1) + 1
+ allocate(r_request_ran(1:nb_r))
+ r_request_ran = MPI_REQUEST_NULL
+ ! -- allocate cartography about what I receive --
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(rece_carto(max_size,rece_gap(1,1):rece_gap(1,2)))
+ ! -- allocate request about cartography (non-blocking) send --
+ nb_s = send_gap_abs(2) - send_gap_abs(1) + 1
+ allocate(s_request_ran(1:nb_s))
+ ! -- To manage buffer --
+ ! Position of sub-buffer associated different mpi-processes
+ allocate(pos_in_buffer(0:nb_s))
+
+ ! ===== Init the remeshing process: pre-process =====
+ ! Perform a cartography of mesh points where particle will be remesh,
+ ! create a 1D to buffer where remeshing will be performed and create
+ ! tools to manage it.
+ call AC_remesh_init(direction, ind_group, gs, send_min, send_max, &
+ & send_gap_abs, send_rank, rece_gap, rece_rank, nb_s, cartography, &
+ & rece_carto, pos_in_buffer, min_size, max_size, s_request_ran, r_request_ran)
+
+
+ ! ===== Initialize the general buffer =====
+ allocate(send_buffer(pos_in_buffer(nb_s) &
+ & + cartography(1,nb_s)-1))
+ send_buffer = 0.0
+
+ ! ===== Remeshing into the buffer by using pointer array =====
+ call remesh_in_buffer_limit_lambda_pt(gs, j, k, send_gap_abs(1)-1, p_pos_adim, bl_type, bl_tag, limit, &
+ & send_min, send_max, scal, send_buffer, pos_in_buffer)
+ ! Observe that now:
+ ! => pos_in_buffer(i-1) = first (1D-)indice of the sub-array of send_buffer
+ ! associated to he i-rd mpi-processus to wich I will send remeshed particles.
+
+ ! ===== Wait for reception of all cartography =====
+ allocate(r_status(MPI_STATUS_SIZE,1:nb_r))
+ call mpi_waitall(nb_r,r_request_ran, r_status, ierr)
+ deallocate(r_request_ran)
+ deallocate(r_status)
+ !allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ !allocate(ind_array(send_gap_abs(1):send_gap_abs(2)))
+ !call mpi_testsome(size(s_request_ran),s_request_ran, ind_1Dtable, ind_array, s_status, ierr)
+ !deallocate(ind_array)
+
+ ! ===== Finish the remeshing process =====
+ ! Send buffer, receive some other buffers and update scalar field.
+ call AC_remesh_finalize(direction, ind_group, gs, j, k, scal, send_gap_abs, send_rank, rece_gap, &
+ & rece_rank, nb_r, nb_s, cartography, rece_carto, send_buffer, pos_in_buffer, min_size)
+
+
+ ! ===== Free memory and communication buffer ====
+ ! -- Deallocate all field --
+ deallocate(rece_carto)
+ ! -- Check if Isend are done --
+ allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ call mpi_waitall(nb_s, s_request_ran, s_status, ierr)
+ deallocate(s_status)
+ ! -- Free all communication buffer and data --
+ deallocate(send_buffer)
+ deallocate(pos_in_buffer)
+ deallocate(s_request_ran)
+
+end subroutine AC_remesh_via_buffer_limit_lambda
+
+
+!> Using input information to update the scalar field by creating particle
+!! weight (from scalar values), set scalar to 0, redistribute particle inside
+!! - variant for M' remeshing formula.
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] gs = size of groups (along X direction)
+!! @param[in] j,k = indice of of the current line (x-coordinate and z-coordinate)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in,out] scal = scalar field to advect
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles
+!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+!! @param[in] send_rank = mpi rank of processes to which I will send messages.
+!! @param[in] rece_gap = coordinate range of processes which will send me information during the remeshing.
+!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @details
+!! This procedure manage all communication needed. To minimize communications,
+!! particles are remeshing inside a local buffer wich is after send to the
+!! processus wich contain the right sub-domain depending off the particle
+!! position. There is no need of communication in order to remesh inside the
+!! buffer. To avoid recopy in creating particle weight (which will be weight
+!! = scalar), scalar is directly redistribute inside the local buffer.
+!! This provides:
+!! a - Remesh particle: redistribute scalar field inside a local buffer and
+!! set scalar = 0.
+!! b - Send local buffer to its target processus and update the scalar field,
+!! ie scalar = scalar + received buffer.
+!! "remesh_in_buffer_pt" do the part "a" and "remesh_buffer_to_scalar" the part
+!! B except the communication. The current subroutine manage all the
+!! communications (and other stuff needed to allow correctness).
+subroutine AC_remesh_via_buffer_Mprime(direction, ind_group, gs, p_pos_adim, &
+ & j, k, scal, send_min, send_max, send_gap_abs, send_rank, rece_gap, &
+ & cartography)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use advec_abstract_proc ! contain some useful procedure pointers.
+ use advecX ! procedure specific to advection alongX
+ use advecY ! procedure specific to advection alongY
+ use advecZ ! procedure specific to advection alongZ
+ use cart_topology ! Description of mesh and of mpi topology
+ use mpi
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ real(WP),dimension(:,:,:),intent(inout) :: scal
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ integer, dimension(2), intent(in) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), intent(in) :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2, 2), intent(in) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:,:), intent(inout) :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+ ! Other local variables
+ ! Others
+ integer,dimension(rece_gap(1,1):rece_gap(1,2)) :: rece_rank ! rank of processus wich send me information
+ integer, dimension(:,:), allocatable :: rece_carto ! same as abobve but for what I receive
+ integer :: min_size ! minimal size of cartography(:,proc_gap)
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+ ! Variable used to remesh particles in a buffer
+ real(WP),dimension(:),allocatable,target:: send_buffer ! buffer use to remesh the scalar before to send it to the right subdomain
+ ! sorted by receivers and not by coordinate.
+ integer, dimension(:), allocatable :: pos_in_buffer! buffer size
+ ! Variable use to manage mpi communications
+ integer, dimension(:), allocatable :: s_request_ran! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), allocatable :: r_request_ran! mpi communication request (handle) of nonblocking receive
+ integer, dimension(:,:), allocatable :: r_status ! mpi communication status of nonblocking receive
+ integer, dimension(:,:), allocatable :: s_status ! mpi communication status of nonblocking send
+ integer :: ierr ! mpi error code
+ integer :: nb_r, nb_s ! number of reception/send
+
+
+ ! ===== Allocation =====
+ ! -- allocate request about cartography (non-blocking) reception --
+ nb_r = rece_gap(1,2) - rece_gap(1,1) + 1
+ allocate(r_request_ran(1:nb_r))
+ r_request_ran = MPI_REQUEST_NULL
+ ! -- allocate cartography about what I receive --
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(rece_carto(max_size,rece_gap(1,1):rece_gap(1,2)))
+ ! -- allocate request about cartography (non-blocking) send --
+ nb_s = send_gap_abs(2) - send_gap_abs(1) + 1
+ allocate(s_request_ran(1:nb_s))
+ ! -- To manage buffer --
+ ! Position of sub-buffer associated different mpi-processes
+ allocate(pos_in_buffer(0:nb_s))
+
+ ! ===== Init the remeshing process: pre-process =====
+ ! Perform a cartography of mesh points where particle will be remesh,
+ ! create a 1D to buffer where remeshing will be performed and create
+ ! tools to manage it.
+ call AC_remesh_init(direction, ind_group, gs, send_min, send_max, &
+ & send_gap_abs, send_rank, rece_gap, rece_rank, nb_s, cartography, &
+ & rece_carto, pos_in_buffer, min_size, max_size, s_request_ran, r_request_ran)
+
+
+ ! ===== Initialize the general buffer =====
+ allocate(send_buffer(pos_in_buffer(nb_s) &
+ & + cartography(1,nb_s)-1))
+ send_buffer = 0.0
+
+ ! ===== Remeshing into the buffer by using pointer array =====
+ call remesh_in_buffer_Mprime_pt(gs, j, k, send_gap_abs(1)-1, p_pos_adim, send_min, &
+ & send_max, scal, send_buffer, pos_in_buffer)
+ ! Observe that now:
+ ! => pos_in_buffer(i-1) = first (1D-)indice of the sub-array of send_buffer
+ ! associated to he i-rd mpi-processus to wich I will send remeshed particles.
+
+ ! ===== Wait for reception of all cartography =====
+ allocate(r_status(MPI_STATUS_SIZE,1:nb_r))
+ call mpi_waitall(nb_r,r_request_ran, r_status, ierr)
+ deallocate(r_request_ran)
+ deallocate(r_status)
+ !allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ !allocate(ind_array(send_gap_abs(1):send_gap_abs(2)))
+ !call mpi_testsome(size(s_request_ran),s_request_ran, ind_1Dtable, ind_array, s_status, ierr)
+ !deallocate(ind_array)
+
+ ! ===== Finish the remeshing process =====
+ ! Send buffer, receive some other buffers and update scalar field.
+ call AC_remesh_finalize(direction, ind_group, gs, j, k, scal, send_gap_abs, send_rank, rece_gap, &
+ & rece_rank, nb_r, nb_s, cartography, rece_carto, send_buffer, pos_in_buffer, min_size)
+
+
+ ! ===== Free memory and communication buffer ====
+ ! -- Deallocate all field --
+ deallocate(rece_carto)
+ ! -- Check if Isend are done --
+ allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ call mpi_waitall(nb_s, s_request_ran, s_status, ierr)
+ deallocate(s_status)
+ ! -- Free all communication buffer and data --
+ deallocate(send_buffer)
+ deallocate(pos_in_buffer)
+ deallocate(s_request_ran)
+
+end subroutine AC_remesh_via_buffer_Mprime
+
+
+! ==================================================================================
+! ==================== Other tools to remesh particles ====================
+! ==================================================================================
+
+!> Determine where the particles of each lines will be remeshed
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[out] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[out] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[out] send_gap = distance between me and processus wich send me information (for each line of the group)
+!! @param[out] send_gap_abs = send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+subroutine AC_remesh_range(bl_type, p_pos_adim, direction, send_min, send_max, send_gap, send_gap_abs)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+
+ ! Input/Output
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ integer, intent(in) :: direction
+ integer, dimension(:,:), intent(out) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(out) :: send_max ! distance between me and processus wich send me information
+ integer, dimension(:,:,:), intent(out) :: send_gap ! distance between me and processus wich send me information
+ integer, dimension(2), intent(out) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+
+ ! -- Compute ranges --
+ where (bl_type(1,:,:))
+ ! First particle is a centered one
+ send_min = nint(p_pos_adim(1,:,:))-remesh_stencil(1)
+ elsewhere
+ ! First particle is a left one
+ send_min = floor(p_pos_adim(1,:,:))-remesh_stencil(1)
+ end where
+ where (bl_type(bl_nb(direction)+1,:,:))
+ ! Last particle is a centered one
+ send_max = nint(p_pos_adim(N_proc(direction),:,:))+remesh_stencil(2)
+ elsewhere
+ ! Last particle is a left one
+ send_max = floor(p_pos_adim(N_proc(direction),:,:))+remesh_stencil(2)
+ end where
+
+ ! -- What have I to communicate ? --
+ send_gap(:,:,1) = floor(real(send_min-1)/N_proc(direction))
+ send_gap(:,:,2) = floor(real(send_max-1)/N_proc(direction))
+ send_gap_abs(1) = minval(send_gap(:,:,1))
+ send_gap_abs(2) = maxval(send_gap(:,:,2))
+
+end subroutine AC_remesh_range
+
+
+!> Determine where the particles of each lines will be remeshed - Variant for
+!! remeshing without type/tag
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[out] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[out] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[out] send_gap = distance between me and processus wich send me information (for each line of the group)
+!! @param[out] send_gap_abs = send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+subroutine AC_remesh_range_notype(p_pos_adim, direction, send_min, send_max, send_gap, send_gap_abs)
+
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
+
+ ! Input/Output
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ integer, intent(in) :: direction
+ integer, dimension(:,:), intent(out) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(out) :: send_max ! distance between me and processus wich send me information
+ integer, dimension(:,:,:), intent(out) :: send_gap ! distance between me and processus wich send me information
+ integer, dimension(2), intent(out) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+
+ ! -- Compute ranges --
+ send_min = floor(p_pos_adim(1,:,:))-remesh_stencil(1)
+ send_max = floor(p_pos_adim(N_proc(direction),:,:))+remesh_stencil(2)
+
+ ! -- What have I to communicate ? --
+ send_gap(:,:,1) = floor(real(send_min-1)/N_proc(direction))
+ send_gap(:,:,2) = floor(real(send_max-1)/N_proc(direction))
+ send_gap_abs(1) = minval(send_gap(:,:,1))
+ send_gap_abs(2) = maxval(send_gap(:,:,2))
+
+end subroutine AC_remesh_range_notype
+
+
+!> Determine the set of processes wich will send me information during the remeshing
+!! and compute for each of these processes the range of wanted data. Use implicit
+!! computation rather than communication (only possible if particle are gather by
+!! block whith contrainst on velocity variation - as corrected lambda formula.) -
+!! work directly on a group of particles lines.
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] remesh_min = minimal indice of meshes where I will remesh my particles.
+!! @param[in] remesh_max = maximal indice of meshes where I will remesh my particles.
+!! @param[out] rece_gap = coordinate range of processes which will send me information during the remeshing.
+!! @param[in] send_gap = distance between me and processus wich send me information (for each line of the group)
+!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+!! @param[out] send_rank = mpi rank of processes to which I will send messages.
+!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @details
+!! Work on a group of line of size gs(1) x gs(2))
+!! Obtain the list of processus which are associated to sub-domain where my particles
+!! will be remeshed and the list of processes wich contains particles which
+!! have to be remeshed in my sub-domain. This way, this procedure determine
+!! which processus need to communicate together in order to proceed to the
+!! remeshing (as in a parrallel context the real space is subdivised and each
+!! processus contains a part of it)
+!! In the same time, it computes for each processus with which I will
+!! communicate, the range of mesh point involved for each line of particles
+!! inside the group and it stores it by using some sparse matrix technics
+!! (see cartography defined in the algorithm documentation)
+!! This routine does not involve any communication to determine if
+!! a processus is the first or the last processes (considering its coordinate along
+!! the current directory) to send remeshing information to a given processes.
+!! It directly compute it using contraints on velocity (as in corrected lambda
+!! scheme) When possible use it rather than AC_obtain_senders_com
+subroutine AC_remesh_determine_communication(direction, gs, ind_group, remesh_min, remesh_max, &
+ & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
+! XXX Work only for periodic condition. For dirichlet conditions : it is
+! possible to not receive either rece_gap(1), either rece_gap(2) or none of
+! these two => detect it (track the first and the last particles) and deal with it.
+
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use mpi
+
+ ! Input/output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: gs ! a group size
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(:,:), intent(in) :: remesh_min ! minimal indice of meshes where I will remesh my particles.
+ integer, dimension(:,:), intent(in) :: remesh_max ! maximal indice of meshes where I will remesh my particles.
+ integer, dimension(2, 2), intent(out) :: rece_gap
+ integer(kind=4), dimension(gs(1),gs(2),2),intent(in):: send_gap ! minimal and maximal processus which contains the sub-domains where my
+ ! particles will be remeshed for each line of the line group
+ integer, dimension(2), intent(in) :: send_gap_abs ! min and maximal processus which contains the sub-domains where my particles will be remeshed.
+ integer,dimension(send_gap_abs(1):send_gap_abs(2))&
+ &, intent(out) :: send_rank ! rank of processus to wich I will send data
+ integer, dimension(2+gs(2)*(2+3*gs(1)), &
+ & send_gap_abs(1):send_gap_abs(2)), intent(out) :: cartography
+
+ ! To manage communications and to localize sub-domain
+ integer(kind=4) :: proc_gap ! gap between a processus coordinate (along the current
+ ! direction) into the mpi-topology and my coordinate
+ integer :: rankP ! processus rank for shift (P= previous)
+ integer, dimension(2) :: tag_table ! mpi message tag (for communicate rece_gap(1) and rece_gap(2))
+ integer, dimension(:,:),allocatable :: send_request ! mpi status of nonblocking send
+ integer :: ierr ! mpi error code
+ integer, dimension(MPI_STATUS_SIZE) :: statut ! mpi status
+ ! To determine which processus is the first/last to send data to another
+ integer, dimension(:,:), allocatable :: first, last ! Storage processus to which I will be the first (or the last) to send
+ ! remeshed particles
+ integer :: first_condition ! allowed range of value of proc_min and proc_max for being the first
+ integer :: last_condition ! allowed range of value of proc_min and proc_max for being the last
+ ! Other local variable
+ integer :: ind1, ind2 ! indice of the current line inside the group
+ integer :: min_size ! begin indice in first and last to stock indice along first dimension of the group line
+ integer :: gp_size ! group size
+ integer,dimension(2) :: rece_buffer ! buffer for reception of rece_max
+ logical :: begin_interval ! ware we in the start of an interval ?
+
+ rece_gap(1,1) = 3*N(direction)
+ rece_gap(1,2) = -3*N(direction)
+ rece_gap(2,:) = 0
+ gp_size = gs(1)*gs(2)
+
+ allocate(send_request(send_gap_abs(1):send_gap_abs(2),3))
+ send_request(:,3) = 0
+
+ ! ===== Compute if I am first or last and determine the carography =====
+ min_size = 2 + gs(2)
+ ! Initialize first and last to determine if I am the the first or the last processes (considering the current direction)
+ ! to require information from this processus
+ allocate(first(2,send_gap_abs(1):send_gap_abs(2)))
+ first(2,:) = 0 ! number of lines for which I am the first
+ allocate(last(2,send_gap_abs(1):send_gap_abs(2)))
+ last(2,:) = 0 ! number of lines for which I am the last
+ ! Initialize cartography
+ cartography(1,:) = 0 ! number of velocity values to receive
+ cartography(2,:) = min_size ! number of element to send when sending cartography
+ ! And compute cartography, first and last !
+ do proc_gap = send_gap_abs(1), send_gap_abs(2)
+ first(1,proc_gap) = -proc_gap
+ last(1,proc_gap) = -proc_gap
+ first_condition = 1-2*bl_bound_size + proc_gap*N_proc(direction)+1
+ last_condition = -1+2*bl_bound_size + (proc_gap+1)*N_proc(direction)
+ call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, send_rank(proc_gap), ierr)
+ do ind2 = 1, gs(2)
+ cartography(2+ind2,proc_gap) = 0 ! 2 x number of interval of concern line into the column i2
+ begin_interval = .true.
+ do ind1 = 1, gs(1)
+ ! Does proc_gap belongs to [send_gap(i1,i2,1);send_gap(i1,i2,2)]?
+ if((proc_gap>=send_gap(ind1,ind2,1)).and.(proc_gap<=send_gap(ind1,ind2,2))) then
+ ! Compute if I am the first.
+ if (remesh_min(ind1,ind2)< first_condition) first(2,proc_gap) = first(2,proc_gap)+1
+ ! Compute if I am the last.
+ if (remesh_max(ind1,ind2) > last_condition) last(2,proc_gap) = last(2,proc_gap)+1
+ ! Update cartography // Needed even if target processus is myself as we us buffer
+ ! in all the case (scalar field cannot be used directly during the remeshing)
+ if (begin_interval) then
+ cartography(2+ind2,proc_gap) = cartography(2+ind2,proc_gap)+2
+ cartography(cartography(2,proc_gap)+1,proc_gap) = ind1
+ cartography(2,proc_gap) = cartography(2,proc_gap) + 2
+ cartography(cartography(2,proc_gap),proc_gap) = ind1
+ begin_interval = .false.
+ else
+ cartography(cartography(2,proc_gap),proc_gap) = ind1
+ end if
+ else
+ begin_interval = .true.
+ end if
+ end do
+ end do
+ end do
+
+ ! ===== Send information about first and last =====
+ tag_table = compute_tag(ind_group, tag_obtsend_NP, direction)
+ do proc_gap = send_gap_abs(1), send_gap_abs(2)
+ ! I am the first ?
+ if (first(2,proc_gap)>0) then
+ if(send_rank(proc_gap)/= D_rank(direction)) then
+ call mpi_ISsend(first(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(1), D_comm(direction), &
+ & send_request(proc_gap,1), ierr)
+ send_request(proc_gap,3) = 1
+ else
+ rece_gap(1,1) = min(rece_gap(1,1), -proc_gap)
+ rece_gap(2,1) = rece_gap(2,1) + first(2,proc_gap)
+ end if
+ end if
+ ! I am the last ?
+ if (last(2,proc_gap)>0) then
+ if(send_rank(proc_gap)/= D_rank(direction)) then
+ call mpi_ISsend(last(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(2), D_comm(direction), &
+ & send_request(proc_gap,2), ierr)
+ send_request(proc_gap,3) = send_request(proc_gap, 3) + 2
+ else
+ rece_gap(1,2) = max(rece_gap(1,2), -proc_gap)
+ rece_gap(2,2) = rece_gap(2,2) + last(2,proc_gap)
+ end if
+ end if
+ end do
+
+ ! ===== Receive information form the first and the last processus which need a part of my local velocity field =====
+ do while(rece_gap(2,1) < gp_size)
+ call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(1), D_comm(direction), statut, ierr)
+ rece_gap(1,1) = min(rece_gap(1,1), rece_buffer(1))
+ rece_gap(2,1) = rece_gap(2,1) + rece_buffer(2)
+ end do
+ do while(rece_gap(2,2) < gp_size)
+ call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(2), D_comm(direction), statut, ierr)
+ rece_gap(1,2) = max(rece_gap(1,2), rece_buffer(1))
+ rece_gap(2,2) = rece_gap(2,2) + rece_buffer(2)
+ end do
+
+ ! ===== Free Isend buffer =====
+ do proc_gap = send_gap_abs(1), send_gap_abs(2)
+ select case (send_request(proc_gap,3))
+ case (3)
+ call mpi_wait(send_request(proc_gap,1), statut, ierr)
+ call mpi_wait(send_request(proc_gap,2), statut, ierr)
+ case (2)
+ call mpi_wait(send_request(proc_gap,2), statut, ierr)
+ case (1)
+ call mpi_wait(send_request(proc_gap,1), statut, ierr)
+ end select
+ end do
+
+ ! ===== Deallocate fields =====
+ deallocate(send_request)
+ deallocate(first)
+ deallocate(last)
+
+end subroutine AC_remesh_determine_communication
+
+
+!> Determine the set of processes wich will send me information during the remeshing
+!! and compute for each of these processes the range of wanted data. Version for M'6
+!! scheme (some implicitation can not be done anymore)
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[out] rece_gap = coordinate range of processes which will send me information during the remeshing.
+!! @param[in] send_gap = distance between me and processus to wich I will send information (for each line of the group)
+!! @param[in] send_gap_abs= send_gap_abs(i) is the min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+!! @param[out] send_rank = mpi rank of processes to which I will send messages.
+!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @details
+!! Work on a group of line of size gs(1) x gs(2))
+!! Obtain the list of processus which are associated to sub-domain where my particles
+!! will be remeshed and the list of processes wich contains particles which
+!! have to be remeshed in my sub-domain. This way, this procedure determine
+!! which processus need to communicate together in order to proceed to the
+!! remeshing (as in a parrallel context the real space is subdivised and each
+!! processus contains a part of it)
+!! In the same time, it computes for each processus with which I will
+!! communicate, the range of mesh point involved for each line of particles
+!! inside the group and it stores it by using some sparse matrix technics
+!! (see cartography defined in the algorithm documentation)
+!! This routine involves communication to determine if a processus is
+!! the first or the last processes (considering its coordinate along
+!! the current directory) to send remeshing information to a given processes.
+subroutine AC_remesh_determine_communication_com(direction, gs, ind_group, &
+ & rece_gap, send_gap, send_gap_abs, send_rank, cartography)
+! XXX Work only for periodic condition.
+
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use mpi
+
+ ! Input/output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: gs ! a group size
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2, 2), intent(out) :: rece_gap ! minimal and maximal processus which will remesh inside me
+ integer(kind=4), dimension(gs(1),gs(2),2),intent(in):: send_gap ! minimal and maximal processus which contains the sub-domains where my
+ ! particles will be remeshed for each line of the line group
+ integer, dimension(2), intent(in) :: send_gap_abs ! min and maximal processus which contains the sub-domains where my particles will be remeshed.
+ integer,dimension(send_gap_abs(1):send_gap_abs(2))&
+ &, intent(out) :: send_rank ! rank of processus to wich I will send data
+ integer, dimension(2+gs(2)*(2+3*gs(1)), &
+ & send_gap_abs(1):send_gap_abs(2)), intent(out) :: cartography
+
+ ! To manage communications and to localize sub-domain
+ integer(kind=4) :: proc_gap ! gap between a processus coordinate (along the current
+ ! direction) into the mpi-topology and my coordinate
+ integer :: rankP ! processus rank for shift (P= previous)
+ integer, dimension(2) :: tag_table ! mpi message tag (for communicate rece_gap(1) and rece_gap(2))
+ integer, dimension(:,:),allocatable :: send_request ! mpi status of nonblocking send
+ integer :: ierr ! mpi error code
+ integer, dimension(MPI_STATUS_SIZE) :: statut ! mpi status
+ ! To determine which processus is the first/last to send data to another
+ integer, dimension(gs(1), gs(2)) :: send_max_prev ! maximum gap between previous processus and the receivers of its remeshing buffer
+ integer, dimension(gs(1), gs(2)) :: send_min_next ! minimum gap between next processus and the receivers of its remeshing buffer
+ integer, dimension(:,:), allocatable :: first, last ! Storage processus to which I will be the first (or the last) to send
+ ! remeshed particles
+ ! Other local variable
+ integer :: ind1, ind2 ! indice of the current line inside the group
+ integer :: min_size ! begin indice in first and last to stock indice along first dimension of the group line
+ integer :: gp_size ! group size
+ integer,dimension(2) :: rece_buffer ! buffer for reception of rece_max
+ logical :: begin_interval ! are we in the start of an interval ?
+
+ rece_gap(1,1) = 3*N(direction)
+ rece_gap(1,2) = -3*N(direction)
+ rece_gap(2,:) = 0
+ gp_size = gs(1)*gs(2)
+
+ allocate(send_request(send_gap_abs(1):send_gap_abs(2),3))
+ send_request(:,3) = 0
+
+ ! ===== Exchange ghost =====
+ ! Compute message tag - we re-use tag_part_tag_NP id as using this procedure
+ ! suppose not using "AC_type_and_block"
+ tag_table = compute_tag(ind_group, tag_part_tag_NP, direction)
+ ! Exchange "ghost"
+ call mpi_Sendrecv(send_gap(1,1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(1), &
+ & send_min_next(1,1), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(1), &
+ & D_comm(direction), statut, ierr)
+ call mpi_Sendrecv(send_gap(1,1,2), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(2), &
+ & send_max_prev(1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(2), &
+ & D_comm(direction), statut, ierr)
+ ! Translat to adapt gap to my position
+ send_max_prev = send_max_prev - 1
+ send_min_next = send_min_next + 1
+
+ ! ===== Compute if I am first or last and determine the cartography =====
+ min_size = 2 + gs(2)
+ ! Initialize first and last to determine if I am the the first or the last processes (considering the current direction)
+ ! to require information from this processus
+ allocate(first(2,send_gap_abs(1):send_gap_abs(2)))
+ first(2,:) = 0 ! number of lines for which I am the first
+ allocate(last(2,send_gap_abs(1):send_gap_abs(2)))
+ last(2,:) = 0 ! number of lines for which I am the last
+ ! Initialize cartography
+ cartography(1,:) = 0 ! number of velocity values to receive
+ cartography(2,:) = min_size ! number of element to send when sending cartography
+ ! And compute cartography, first and last !
+ do proc_gap = send_gap_abs(1), send_gap_abs(2)
+ first(1,proc_gap) = -proc_gap
+ last(1,proc_gap) = -proc_gap
+ call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, send_rank(proc_gap), ierr)
+ do ind2 = 1, gs(2)
+ cartography(2+ind2,proc_gap) = 0 ! 2 x number of interval of concern line into the column i2
+ begin_interval = .true.
+ do ind1 = 1, gs(1)
+ ! Does proc_gap belongs to [send_gap(i1,i2,1);send_gap(i1,i2,2)]?
+ if((proc_gap>=send_gap(ind1,ind2,1)).and.(proc_gap<=send_gap(ind1,ind2,2))) then
+ ! Compute if I am the first.
+ if(proc_gap > send_max_prev(ind1,ind2)) first(2,proc_gap) = first(2,proc_gap)+1
+ ! Compute if I am the last.
+ if(proc_gap < send_min_next(ind1,ind2)) last(2,proc_gap) = last(2,proc_gap)+1
+ ! Update cartography // Needed even if target processus is myself as we us buffer
+ ! in all the case (scalar field cannot be used directly during the remeshing)
+ if (begin_interval) then
+ cartography(2+ind2,proc_gap) = cartography(2+ind2,proc_gap)+2
+ cartography(cartography(2,proc_gap)+1,proc_gap) = ind1
+ cartography(2,proc_gap) = cartography(2,proc_gap) + 2
+ cartography(cartography(2,proc_gap),proc_gap) = ind1
+ begin_interval = .false.
+ else
+ cartography(cartography(2,proc_gap),proc_gap) = ind1
+ end if
+ else
+ begin_interval = .true.
+ end if
+ end do
+ end do
+ end do
+
+ ! ===== Send information about first and last =====
+ tag_table = compute_tag(ind_group, tag_obtsend_NP, direction)
+ do proc_gap = send_gap_abs(1), send_gap_abs(2)
+ ! I am the first ?
+ if (first(2,proc_gap)>0) then
+ if(send_rank(proc_gap)/= D_rank(direction)) then
+ call mpi_ISsend(first(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(1), D_comm(direction), &
+ & send_request(proc_gap,1), ierr)
+ send_request(proc_gap,3) = 1
+ else
+ rece_gap(1,1) = min(rece_gap(1,1), -proc_gap)
+ rece_gap(2,1) = rece_gap(2,1) + first(2,proc_gap)
+ end if
+ end if
+ ! I am the last ?
+ if (last(2,proc_gap)>0) then
+ if(send_rank(proc_gap)/= D_rank(direction)) then
+ call mpi_ISsend(last(1,proc_gap), 2, MPI_INTEGER, send_rank(proc_gap), tag_table(2), D_comm(direction), &
+ & send_request(proc_gap,2), ierr)
+ send_request(proc_gap,3) = send_request(proc_gap, 3) + 2
+ else
+ rece_gap(1,2) = max(rece_gap(1,2), -proc_gap)
+ rece_gap(2,2) = rece_gap(2,2) + last(2,proc_gap)
+ end if
+ end if
+ end do
+
+ ! ===== Receive information form the first and the last processus which need a part of my local velocity field =====
+ do while(rece_gap(2,1) < gp_size)
+ call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(1), D_comm(direction), statut, ierr)
+ rece_gap(1,1) = min(rece_gap(1,1), rece_buffer(1))
+ rece_gap(2,1) = rece_gap(2,1) + rece_buffer(2)
+ end do
+ do while(rece_gap(2,2) < gp_size)
+ call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(2), D_comm(direction), statut, ierr)
+ rece_gap(1,2) = max(rece_gap(1,2), rece_buffer(1))
+ rece_gap(2,2) = rece_gap(2,2) + rece_buffer(2)
+ end do
+
+ ! ===== Free Isend buffer =====
+ do proc_gap = send_gap_abs(1), send_gap_abs(2)
+ select case (send_request(proc_gap,3))
+ case (3)
+ call mpi_wait(send_request(proc_gap,1), statut, ierr)
+ call mpi_wait(send_request(proc_gap,2), statut, ierr)
+ case (2)
+ call mpi_wait(send_request(proc_gap,2), statut, ierr)
+ case (1)
+ call mpi_wait(send_request(proc_gap,1), statut, ierr)
+ end select
+ end do
+
+ ! ===== Deallocate fields =====
+ deallocate(send_request)
+ deallocate(first)
+ deallocate(last)
+
+end subroutine AC_remesh_determine_communication_com
+
+
+!> Update the cartography of data which will be exchange from a processus to another in order to remesh particles.
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[in] gs = size of group of line along the current direction
+!! @param[in] begin_i1 = indice corresponding to the first place into the cartography
+!! array where indice along the the direction of the group of lines are stored.
+!! @param[in] proc_gap = distance between my (mpi) coordonate and coordinate of the target processus
+!! @param[in] ind_carto = current column inside the cartography (different to proc_Gap as in this procedure
+!! therefore first indice = 1, carto range are not given into argument)
+!! @param[in] send_min = minimal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in] send_max = maximal indice of mesh involved in remeshing particles (of the particles in my local subdomains)
+!! @param[in,out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @param[out] com_size = number of elements (integers) stored into the cartography (which will be the size of some mpi communication)
+subroutine AC_remesh_cartography(direction, gs, begin_i1, proc_gap, ind_carto, send_min, send_max, cartography, com_size)
+
+ use cart_topology ! Description of mesh and of mpi topology
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
+ ! array where indice along the the direction of the group of
+ ! lines are stored.
+ integer, intent(in) :: proc_gap ! distance between my (mpi) coordonate and coordinate of the target
+ integer, intent(in) :: ind_carto ! current column inside the cartography (different to proc_Gap as in this procedure
+ ! therefore first indice = 1, carto range are not given into argument)
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(inout) :: cartography
+ integer, intent(out) :: com_size ! number of elements (integers) stored into the cartography (which will
+ ! be the size of some mpi communication)
+
+ ! Other local variables
+ integer :: gap ! gap between my local indices and the local indices from another processes
+ integer :: i1, i2 ! indice of a line into the group
+ integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography ?
+ integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
+
+ cartography(1,ind_carto) = 0
+ ! Use the cartography to know which lines are concerned
+ com_size = cartography(2,ind_carto)
+ ! Range I want - store into the cartography
+ gap = proc_gap*N_proc(direction)
+ ! Position in cartography(:,ind_carto) of the current i1 indice
+ ind_for_i1 = begin_i1
+ do i2 = 1, gs(2)
+ do ind_1Dtable = ind_for_i1+1, ind_for_i1 + cartography(2+i2,ind_carto), 2
+ do i1 = cartography(ind_1Dtable,ind_carto), cartography(ind_1Dtable+1,ind_carto)
+ ! Interval start from:
+ cartography(com_size+1,ind_carto) = max(send_min(i1,i2), gap+1) ! fortran => indice start from 0
+ ! and ends at:
+ cartography(com_size+2,ind_carto) = min(send_max(i1,i2), gap+N_proc(direction))
+ ! update number of element to send
+ cartography(1,ind_carto) = cartography(1,ind_carto) &
+ & + cartography(com_size+2,ind_carto) &
+ & - cartography(com_size+1,ind_carto) + 1
+ com_size = com_size+2
+ end do
+ end do
+ ind_for_i1 = ind_for_i1 + cartography(2+i2,ind_carto)
+ end do
+
+end subroutine AC_remesh_cartography
+
+
+!> Perform all the pre-process in order to remesh particle and to perform associated communication.
+!! @ detail
+!! As geometric domain is subdivise among the different mpi-processes, the
+!! particle remeshing involve mpi-communication in order to re-distribuate
+!! particle weight to the rigth place.
+!! In order to gather theses communications for different particles lines,
+!! the particle remeshing is performed into a buffer. The buffer is an 1D-array
+!! which structure ensure that all the value that has to be send to a given
+!! processus is memory continguous.
+!! This subroutine create this buffer and provide a map to manage it. This
+!! map allow to associate a XYZ-coordinate (into the geometrical domain) to each
+!! element of this 1D-array.
+subroutine AC_remesh_init(direction, ind_group, gs, send_min, send_max, &
+ & send_gap_abs, send_rank, rece_gap, rece_rank, nb_s, cartography, &
+ & rece_carto, pos_in_buffer, min_size, max_size, s_request_ran, r_request_ran)
+
+ use mpi
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and first processus wich send me information (for each line of particle)
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and last processus wich send me information
+ integer, dimension(2), intent(in) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), intent(in) :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2, 2), intent(in) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(rece_gap(1,1):rece_gap(1,2)), intent(inout) :: rece_rank ! rank of processus wich send me information
+ integer, intent(in) :: nb_s ! number of reception/send
+ integer, dimension(:,:), intent(inout) :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ integer, dimension(:,:), intent(inout) :: rece_carto ! same as abobve but for what I receive
+ ! of mesh points from where it requiers the velocity values.
+ integer,dimension(0:nb_s),intent(inout) :: pos_in_buffer! information about organization of the 1D buffer used to remesh
+ ! a 3D set of particles.
+ integer, intent(out) :: min_size ! tool to manage cartography
+ integer, intent(in) :: max_size ! tool to manage cartography
+ integer, dimension(:), intent(inout) :: s_request_ran! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), intent(inout) :: r_request_ran! mpi communication request (handle) of nonblocking receive
+
+ ! Others
+ integer :: proc_gap ! distance between my (mpi) coordonate and coordinate of the
+ ! processus associated to a given position
+ integer :: ind_gap ! loop indice
+ integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
+ ! Variable use to manage mpi communications
+ integer :: com_size ! size of message send/receive
+ integer :: tag ! mpi message tag
+ integer :: ierr ! mpi error code
+ integer :: rankP ! mpi rank (mpi_cart_shif need to argument wich are rank)
+
+ ! ===== Receive cartography =====
+ ! It is better to post recceive before sending.
+ ind_1Dtable = 0
+ do proc_gap = rece_gap(1,1), rece_gap(1,2)
+ ind_1Dtable = ind_1Dtable + 1
+ call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, rece_rank(proc_gap), ierr)
+ if (rece_rank(proc_gap)/= D_rank(direction)) then
+ tag = compute_tag(ind_group, tag_bufToScal_range, direction, -proc_gap)
+ call mpi_Irecv(rece_carto(1,ind_1Dtable), max_size, MPI_INTEGER, &
+ & rece_rank(proc_gap), tag, D_COMM(direction), r_request_ran(ind_1Dtable), ierr)
+ else
+ rece_carto(1,ind_1Dtable) = 0
+ end if
+ end do
+
+ ! ===== Complete cartography and send range about the particles I remesh =====
+ s_request_ran = MPI_REQUEST_NULL
+ min_size = 2 + gs(2)
+ proc_gap = send_gap_abs(1) - 1
+ do ind_gap = 1, nb_s !send_gap_abs(2), send_gap_abs(1) + 1
+ proc_gap = proc_gap + 1
+ !proc_gap = ind_gap+send_gap_abs(1)-1
+ call AC_remesh_cartography(direction, gs, min_size, proc_gap, ind_gap, &
+ & send_min, send_max, cartography, com_size)
+ ! Tag = concatenation of (rank+1), ind_group(1), ind_group(2), direction and unique Id.
+ tag = compute_tag(ind_group, tag_bufToScal_range, direction, proc_gap)
+ ! Send message
+ if (send_rank(ind_gap) /= D_rank(direction)) then
+ call mpi_ISsend(cartography(1,ind_gap), com_size, MPI_INTEGER, send_rank(ind_gap), tag, &
+ & D_comm(direction), s_request_ran(ind_gap),ierr)
+ end if
+ end do
+
+ ! ===== Initialize the general buffer =====
+ ! The same buffer is used to send data to all target processes. It size
+ ! has to be computed as the part reserved to each processus.
+ ! and it has to be splitted into parts for each target processes
+ ! => pos_in_buffer(i) = first (1D-)indice of the sub-array of send_buffer
+ ! associated to he i-rd mpi-processus to wich I will send remeshed particles.
+ pos_in_buffer(0) = 1
+ pos_in_buffer(1) = 1
+ do ind_gap =1, nb_s - 1 !send_gap_abs(2)-send_gap_abs(1)
+ pos_in_buffer(ind_gap+1)= pos_in_buffer(ind_gap) + cartography(1,ind_gap)
+ end do
+ ! In writing values in the send buffer during the remeshing, pos_in_buffer will be update.
+ ! As it has one supplementary element (the "0" one), after this process pos_in_buffer(i-1)
+ ! will be equal to first (1D-)indice of the sub-array of send_buffer
+ ! associated to he i-rd mpi-processus to wich I will send remeshed particles.
+
+end subroutine AC_remesh_init
+
+!> Perform all the staff to compute scalar value at t+dt from the buffer
+!containing the remeshing of local particles.
+!! @ detail
+!! After having remeshing the particles of the local sub-domain into a
+!! buffer, it remains to send the buffer to the different processus according
+!! to the domain sub-division into each processus. Then, the local scalar field
+!! is update thanks to the received buffers.
+subroutine AC_remesh_finalize(direction, ind_group, gs, j, k, scal, send_gap_abs, send_rank, rece_gap, &
+ & rece_rank, nb_r, nb_s, cartography, rece_carto, send_buffer, pos_in_buffer, min_size)
+
+ use mpi
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP),dimension(:,:,:),intent(inout) :: scal
+ integer, dimension(2), intent(in) :: send_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer, dimension(:), intent(in) :: send_rank ! rank of processus to wich I send information
+ integer, dimension(2, 2), intent(in) :: rece_gap ! distance between me and processus to wich I send information
+ integer, dimension(:), intent(in) :: rece_rank ! rank of processus wich send me information
+ integer, intent(in) :: nb_r, nb_s ! number of reception/send
+ integer, dimension(:,:), intent(in) :: cartography ! cartography(proc_gap) contains the set of the lines indice in the block to wich the
+ ! current processus will send data during remeshing and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+ integer, dimension(:,:), intent(in) :: rece_carto ! same as above but for what I receive
+ real(WP),dimension(:), intent(in) :: send_buffer ! buffer use to remesh the scalar before to send it to the right subdomain
+ ! sorted by receivers and not by coordinate.
+ integer, dimension(0:nb_s), intent(inout) :: pos_in_buffer! buffer size
+ integer, intent(in) :: min_size ! tool to mange buffer - begin indice in first and last to stock indice along first dimension of the group line
+
+ ! Other local variables
+ integer :: proc_gap, gap! distance between my (mpi) coordonate and coordinate of the
+ ! processus associated to a given position
+ integer :: ind_gap
+ integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
+ ! Variable used to update scalar field from the buffers
+ real(WP),dimension(:),allocatable,target:: rece_buffer ! buffer use to receive scalar field from other processes.
+ integer, dimension(:), allocatable :: rece_pos ! cells of indice from rece_pos(i) to rece_proc(i+1) into rece_buffer
+ ! are devoted to the processus of relative position = i
+ ! Variable use to manage mpi communications
+ integer, dimension(:), allocatable :: s_request_sca! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), allocatable :: r_request_sca! mpi communication request (handle) of nonblocking receive
+ integer, dimension(:,:), allocatable :: s_status ! mpi communication status of nonblocking send
+ integer, dimension(mpi_status_size) :: r_status ! another mpi communication status
+ integer :: tag ! mpi message tag
+ integer :: ierr ! mpi error code
+ integer :: missing_msg ! number of remeshing buffer not yet received
+
+
+ ! ===== Receive buffer (init receive before send) =====
+ ! -- Compute size of reception buffer and split it into part corresponding to each sender --
+ allocate(rece_pos(rece_gap(1,1):rece_gap(1,2)+1))
+ rece_pos(rece_gap(1,1)) = 1
+ ind_gap = 0
+ do proc_gap = rece_gap(1,1), rece_gap(1,2)
+ ind_gap = ind_gap + 1
+ rece_pos(proc_gap+1)= rece_pos(proc_gap) + rece_carto(1,ind_gap)
+ end do
+ allocate(rece_buffer(rece_pos(rece_gap(1,2)+1)-1))
+ ! -- And initialize the reception --
+ allocate(r_request_sca(1:nb_r))
+ r_request_sca = MPI_REQUEST_NULL
+ ind_gap = 0
+ do proc_gap = rece_gap(1,1), rece_gap(1,2)
+ ind_gap = ind_gap + 1 ! = proc_gap - rece_gap(1,1)+1
+ if (rece_rank(ind_gap)/= D_rank(direction)) then
+ tag = compute_tag(ind_group, tag_bufToScal_buffer, direction, -proc_gap)
+ call mpi_Irecv(rece_buffer(rece_pos(proc_gap)), rece_carto(1,ind_gap), &
+ & MPI_DOUBLE_PRECISION, rece_rank(ind_gap), tag, D_COMM(direction), r_request_sca(ind_gap), ierr)
+ end if
+ end do
+
+ ! ===== Send buffer =====
+ missing_msg = nb_r
+ allocate(s_request_sca(1:nb_s))
+ s_request_sca = MPI_REQUEST_NULL
+ ! -- Send the buffer to the matching processus and update the scalar field --
+ do ind_gap = 1, nb_s
+ if (send_rank(ind_gap)/=D_rank(direction)) then
+ ! Send buffer
+ tag = compute_tag(ind_group, tag_bufToScal_buffer, direction, ind_gap-1+send_gap_abs(1))
+ call mpi_ISsend(send_buffer(pos_in_buffer(ind_gap-1)), cartography(1,ind_gap), MPI_DOUBLE_PRECISION, &
+ & send_rank(ind_gap), tag, D_comm(direction), s_request_sca(ind_gap),ierr)
+ else
+ ! Range I want - store into the cartography
+ gap = -(ind_gap-1+send_gap_abs(1))*N_proc(direction)
+ ! Update directly the scalar field
+ call remesh_buffer_to_scalar_pt(gs, j, k, ind_gap, gap, min_size, &
+ & cartography, send_buffer, scal, pos_in_buffer(ind_gap-1))
+ missing_msg = missing_msg - 1
+ end if
+ end do
+
+ ! ===== Update scalar field =====
+ do while (missing_msg >= 1)
+ ! --- Choose one of the first available message ---
+ ! more precisly: the last reception ended (and not free) and if not such
+ ! message available, the first reception ended.
+ call mpi_waitany(nb_r, r_request_sca, ind_1Dtable, r_status, ierr)
+ ! -- Update the scalar field by using the cartography --
+ ! Range I want - store into the cartography
+ proc_gap = ind_1Dtable + rece_gap(1,1)-1
+ gap = proc_gap*N_proc(direction)
+ call remesh_buffer_to_scalar_pt(gs, j, k, ind_1Dtable, gap, min_size, &
+ & rece_carto, rece_buffer, scal, rece_pos(proc_gap))
+ missing_msg = missing_msg - 1
+ end do
+
+ ! ===== Free memory and communication buffer ====
+ ! -- Deallocate all field --
+ deallocate(rece_pos)
+ deallocate(rece_buffer)
+ deallocate(r_request_sca)
+ ! -- Check if Isend are done --
+ allocate(s_status(MPI_STATUS_SIZE,1:nb_s))
+ call mpi_waitall(nb_s, s_request_sca, s_status, ierr)
+ deallocate(s_status)
+ ! -- Free all communication buffer and data --
+ deallocate(s_request_sca)
+
+end subroutine AC_remesh_finalize
+
+
+end module advec_common_remesh
+!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_common_velo.f90 b/HySoP/src/scalesInterface/particles/advec_common_velo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f492901f36e8f53da10cf6468a61a17a8e61c3ca
--- /dev/null
+++ b/HySoP/src/scalesInterface/particles/advec_common_velo.f90
@@ -0,0 +1,699 @@
+!> @addtogroup part
+!! @{
+!------------------------------------------------------------------------------
+!
+! MODULE: advec_common_velo
+!
+!
+! DESCRIPTION:
+!> The module ``advec_common_velo'' gather function and subroutines used to interpolate
+!! velocity at particle position which are not specific to a direction
+!! @details
+!! This module gathers functions and routines used to advec scalar which are not
+!! specific to a direction. This is a parallel implementation using MPI and
+!! the cartesien topology it provides. It also contains the variables common to
+!! the solver along each direction and other generic variables used for the
+!! advection based on the particle method.
+!!
+!! Except for testing purpose, this module is not supposed to be used by the
+!! main code but only by the other advection module. More precisly, an final user
+!! must only used the generic "advec" module wich contain all the interface to
+!! solve the advection equation with the particle method, and to choose the
+!! remeshing formula, the dimensionnal splitting and everything else. Except for
+!! testing purpose, the other advection modules have only to include
+!! "advec_common".
+!!
+!! The module "test_advec" can be used in order to validate the procedures
+!! embedded in this module.
+!
+!> @author
+!! Jean-Baptiste Lagaert, LEGI
+!
+!------------------------------------------------------------------------------
+
+module advec_common_velo
+
+ use precision_tools
+ use structure_tools
+ use advec_abstract_proc
+
+ implicit none
+
+
+ ! Information about the particles and their bloc
+ public
+
+
+ ! ===== Public procedures =====
+ !----- To interpolate velocity -----
+ public :: AC_velocity_interpol_group
+ public :: AC_velocity_interpol_no_com
+ public :: AC_velocity_determine_communication
+
+ ! ===== Public variables =====
+
+ ! ===== Private variables =====
+
+
+contains
+
+! ===== Public procedure =====
+
+! ==================================================================================
+! ==================== Compute particle velocity (RK2) ====================
+! ==================================================================================
+
+!> Interpolate the velocity field used in a RK2 scheme for particle advection -
+!! version for a group of (more of one) line
+!! @param[in] dt = time step
+!! @param[in] direction = current direction (1 = along X, 2 = along Y and 3 = along Z)
+!! @param[in] gs = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] p_pos_adim = adimensionned particle postion
+!! @param[in,out] p_V = particle velocity (along the current direction)
+!! @details
+!! A RK2 scheme is used to advect the particles : the midlle point scheme. An
+!! intermediary position "p_pos_bis(i) = p_pos(i) + V(i)*dt/2" is computed and then
+!! the numerical velocity of each particles is computed as the interpolation of V in
+!! this point. This field is used to advect the particles at the seconde order in time :
+!! p_pos(t+dt, i) = p_pos(i) + p_V(i).
+!! The group line indice is used to ensure using unicity of each mpi message tag.
+!! The interpolation is done for a group of lines, allowing to mutualise
+!! communications. Considering a group of Na X Nb lines, communication performed
+!! by this algorithm are around (Na x Nb) bigger than the alogorithm wich
+!! works on a single line but also around (Na x Nb) less frequent.
+subroutine AC_velocity_interpol_group(dt, direction, gs, ind_group, p_pos_adim, p_V)
+
+ ! This code involve a recopy of p_V. It is possible to directly use the 3D velocity field but in a such code
+ ! a memory copy is still needed to send velocity field to other processus : mpi send contiguous memory values
+
+ use mpi
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Ouput
+ real(WP), intent(in) :: dt ! time step
+ integer, intent(in) :: direction ! current direction
+ integer, dimension(2),intent(in) :: gs ! groupe size
+ integer, dimension(2), intent(in) :: ind_group
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim
+ real(WP), dimension(:,:,:),intent(inout),target :: p_V
+ ! Others, local
+ real(WP),dimension(N_proc(direction),gs(1),gs(2)), target :: p_posV_bis ! temporaily field to store middle point velocity and position
+ real(WP), dimension(N_proc(direction),gs(1),gs(2)) :: weight ! interpolation weight
+ type(real_pter),dimension(N_proc(direction),gs(1),gs(2)) :: Vp, Vm ! Velocity on previous and next mesh point
+ real(WP), dimension(:), allocatable, target :: V_buffer ! Velocity buffer for postion outside of the local subdomain
+ integer, dimension(:), allocatable :: pos_in_buffer! buffer size
+ integer , dimension(gs(1), gs(2)) :: rece_ind_min ! minimal indice of mesh involved in remeshing particles (of my local subdomains)
+ integer , dimension(gs(1), gs(2)) :: rece_ind_max ! maximal indice of mesh involved in remeshing particles (of my local subdomains)
+ integer :: ind, ind_com ! indices
+ integer :: i1, i2 ! indices in the lines group
+ integer :: pos, pos_old ! indices of the mesh point wich preceed the particle position
+ integer :: proc_gap, gap! distance between my (mpi) coordonate and coordinate of the
+ ! processus associated to a given position
+ integer, dimension(:), allocatable :: rece_rank ! rank of processus wich send me information
+ integer, dimension(:), allocatable :: send_rank ! rank of processus to wich I send information
+ integer :: rankP ! rank of processus ("source rank" returned by mpi_cart_shift)
+ integer, dimension(:), allocatable :: send_carto ! cartography of what I have to send
+ integer :: ind_1Dtable ! indice of my current position inside a one-dimensionnal table
+ integer :: ind_for_i1 ! where to read the first coordinate (i1) of the current line inside the cartography ?
+ type(real_1D_pter),dimension(:),allocatable :: send_buffer ! to store what I have to send (on a contiguous way)
+ !real(WP), dimension(:), allocatable :: send_buffer ! to store what I have to send (on a contiguous way)
+ integer, dimension(gs(1),gs(2),2) :: rece_gap ! distance between me and processus wich send me information
+ integer, dimension(2 , 2) :: send_gap ! distance between me and processus to wich I send information
+ integer, dimension(2) :: rece_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer :: com_size ! size of message send/receive
+ integer, dimension(:), allocatable :: size_com ! size of message send/receive
+ integer :: min_size ! minimal size of cartography(:,proc_gap)
+ integer :: max_size ! maximal size of cartography(:,proc_gap)
+ integer :: tag ! mpi message tag
+ integer, dimension(:), allocatable :: tag_proc ! mpi message tag
+ integer :: ierr ! mpi error code
+ integer, dimension(:), allocatable :: s_request ! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), allocatable :: s_request_bis! mpi communication request (handle) of nonblocking send
+ integer, dimension(:), allocatable :: rece_request ! mpi communication request (handle) of nonblocking receive
+ integer, dimension(MPI_STATUS_SIZE) :: rece_status ! mpi status (for mpi_wait)
+ type(int_1D_pter), dimension(:), allocatable:: cartography ! cartography(proc_gap) contains the set of the lines indice in the block for wich the
+ ! current processus requiers data from proc_gap and for each of these lines the range
+ ! of mesh points from where it requiers the velocity values.
+! XXX Todo : à vérifier mais il semble inutile de stocker send_rank : il n'est
+! utilisé que pour les mpi_wait mais une initialisation des request Ã
+! MPI_REQUEST_NULL devrait permettre de s'en débarrasser.
+
+ ! -- Initialisation --
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+ do ind = 1, N_proc(direction)
+ nullify(Vp(ind,i1,i2)%pter)
+ nullify(Vm(ind,i1,i2)%pter)
+ end do
+ end do
+ end do
+ ! Compute the midlle point
+ p_posV_bis = p_pos_adim + (dt/2.0)*p_V/d_sc(direction)
+
+! XXX Todo / Optim
+! Ici recopie de la vitesse. On doit la faire car on calcule la vitesse
+! interpolée à partir d' "elle-même" : la variable calculée dépend de sa
+! précédente valeur en des points qui peuvent différé. Si on l'écrase au fur et
+! Ã mesure on fait des calculs faux.
+! On pourrait utiliser directement le champ de vitesse V en entrée pour donner
+! p_V en sortie, mais cela pose un problème car selon les directions il faudrait
+! changer l'ordre des indices i, i1 et i2. Ce qui est un beau bordel !!
+! XXX
+ ! Compute range of the set of point where I need the velocity value
+ rece_ind_min = floor(p_posV_bis(1,:,:))
+ rece_ind_max = floor(p_posV_bis(N_proc(direction),:,:)) + 1
+
+ ! ===== Exchange velocity field if needed =====
+ ! It uses non blocking message to do the computations during the communication process
+ ! -- What have I to communicate ? --
+ rece_gap(:,:,1) = floor(real(rece_ind_min-1)/N_proc(direction))
+ rece_gap(:,:,2) = floor(real(rece_ind_max-1)/N_proc(direction))
+ rece_gap_abs(1) = minval(rece_gap(:,:,1))
+ rece_gap_abs(2) = maxval(rece_gap(:,:,2))
+ max_size = 2 + gs(2)*(2+3*gs(1))
+ allocate(cartography(rece_gap_abs(1):rece_gap_abs(2)))
+ allocate(rece_rank(rece_gap_abs(1):rece_gap_abs(2)))
+ call AC_velocity_determine_communication(direction, ind_group, gs, send_gap, &
+ & rece_gap, rece_gap_abs, rece_rank, cartography, max_size)
+
+ ! -- Send messages about what I want --
+ allocate(s_request_bis(rece_gap_abs(1):rece_gap_abs(2)))
+ allocate(size_com(rece_gap_abs(1):rece_gap_abs(2)))
+ allocate(tag_proc(rece_gap_abs(1):rece_gap_abs(2)))
+ min_size = 2 + gs(2)
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ if (rece_rank(proc_gap) /= D_rank(direction)) then
+ ! Use the cartography to know which lines are concerned
+ size_com(proc_gap) = cartography(proc_gap)%pter(2)
+ ! Range I want - store into the cartography
+ gap = proc_gap*N_proc(direction)
+ ! Position in cartography(proc_gap)%pter(:) of the current i1 indice
+ ind_for_i1 = min_size
+ do i2 = 1, gs(2)
+ do ind = ind_for_i1+1, ind_for_i1 + cartography(proc_gap)%pter(2+i2), 2
+ do i1 = cartography(proc_gap)%pter(ind), cartography(proc_gap)%pter(ind+1)
+ ! Interval start from:
+ cartography(proc_gap)%pter(size_com(proc_gap)+1) = max(rece_ind_min(i1,i2), gap+1) ! fortran => indice start from 0
+ ! and ends at:
+ cartography(proc_gap)%pter(size_com(proc_gap)+2) = min(rece_ind_max(i1,i2), gap+N_proc(direction))
+ ! update number of element to receive
+ cartography(proc_gap)%pter(1) = cartography(proc_gap)%pter(1) &
+ & + cartography(proc_gap)%pter(size_com(proc_gap)+2) &
+ & - cartography(proc_gap)%pter(size_com(proc_gap)+1) + 1
+ size_com(proc_gap) = size_com(proc_gap)+2
+ end do
+ end do
+ ind_for_i1 = ind_for_i1 + cartography(proc_gap)%pter(2+i2)
+ end do
+ ! Tag = concatenation of (rank+1), ind_group(1), ind_group(2), direction et unique Id.
+ tag_proc(proc_gap) = compute_tag(ind_group, tag_velo_range, direction, proc_gap)
+ ! Send message
+ call mpi_ISsend(cartography(proc_gap)%pter(1), size_com(proc_gap), MPI_INTEGER, rece_rank(proc_gap), &
+ & tag_proc(proc_gap), D_comm(direction), s_request_bis(proc_gap),ierr)
+ end if
+ end do
+
+ ! -- Send the velocity field to processus which need it --
+ allocate(s_request(send_gap(1,1):send_gap(1,2)))
+ allocate(send_rank(send_gap(1,1):send_gap(1,2)))
+ allocate(send_carto(max_size))
+ allocate(send_buffer(send_gap(1,1):send_gap(1,2)))
+! XXX Todo : compter le nombre de messages à recevoir puis les traiter dans
+! l'ordre où ils arrivent via un MPI_ANY_PROC ? Mais alors il faut lier rang et
+! coordonnées ... ce qui signifie ajouter un appel à un mpi_cart_cood ... ou
+! envoyer le rand dans la cartographie !!
+! A voir ce qui est le mieux.
+ do proc_gap = send_gap(1,1), send_gap(1,2)
+ call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, send_rank(proc_gap), ierr)
+ if (send_rank(proc_gap) /= D_rank(direction)) then
+ ! I - Receive messages about what I have to send
+ ! Ia - Compute reception tag = concatenation of (rank+1), ind_group(1), ind_group(2), direction et unique Id.
+ tag = compute_tag(ind_group, tag_velo_range, direction, -proc_gap)
+ ! Ib - Receive the message
+ call mpi_recv(send_carto(1), max_size, MPI_INTEGER, send_rank(proc_gap), tag, D_comm(direction), rece_status, ierr)
+ ! II - Send it
+ ! IIa - Create send buffer
+ allocate(send_buffer(proc_gap)%pter(send_carto(1)))
+ !allocate(send_buffer(send_carto(1)))
+ gap = proc_gap*N_proc(direction)
+ com_size = 0
+ ind_1Dtable = send_carto(2)
+ ! Position in cartography(:,proc_gap) of the current i1 indice
+ ind_for_i1 = min_size
+ do i2 = 1, gs(2)
+ do ind = ind_for_i1+1, ind_for_i1 + send_carto(2+i2), 2
+ do i1 = send_carto(ind), send_carto(ind+1)
+ do ind_com = send_carto(ind_1Dtable+1)+gap, send_carto(ind_1Dtable+2)+gap ! indice inside the current line
+ com_size = com_size + 1
+ send_buffer(proc_gap)%pter(com_size) = p_V(ind_com, i1,i2)
+ !send_buffer(com_size) = p_V(ind_com, i1,i2)
+ end do
+ ind_1Dtable = ind_1Dtable + 2
+ end do
+ end do
+ ind_for_i1 = ind_for_i1 + send_carto(2+i2)
+ end do
+ ! IIb - Compute send tag
+ tag = compute_tag(ind_group, tag_velo_V, direction, proc_gap)
+ ! IIc - Send message
+ !call mpi_Isend(send_buffer(1), com_size, MPI_DOUBLE_PRECISION, &
+ call mpi_ISsend(send_buffer(proc_gap)%pter(1), com_size, MPI_DOUBLE_PRECISION, &
+ & send_rank(proc_gap), tag, D_comm(direction), s_request(proc_gap), ierr)
+ !deallocate(send_buffer)
+ end if
+ end do
+ deallocate(send_carto)
+
+ ! -- Non blocking reception of the velocity field --
+ ! Allocate the pos_in_buffer to compute V_buffer size and to be able to
+ ! allocate it.
+ allocate(pos_in_buffer(rece_gap_abs(1):rece_gap_abs(2)))
+ pos_in_buffer(rece_gap_abs(1)) = 1
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)-1
+ pos_in_buffer(proc_gap+1)= pos_in_buffer(proc_gap) + cartography(proc_gap)%pter(1)
+ end do
+ allocate(V_buffer(pos_in_buffer(rece_gap_abs(2)) &
+ & + cartography(rece_gap_abs(2))%pter(1)))
+ V_buffer = 0
+ allocate(rece_request(rece_gap_abs(1):rece_gap_abs(2)))
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ if (rece_rank(proc_gap) /= D_rank(direction)) then
+ ! IIa - Compute reception tag
+ tag = compute_tag(ind_group, tag_velo_V, direction, -proc_gap)
+ ! IIb - Receive message
+ call mpi_Irecv(V_buffer(pos_in_buffer(proc_gap)), cartography(proc_gap)%pter(1), MPI_DOUBLE_PRECISION, &
+ & rece_rank(proc_gap), tag, D_comm(direction), rece_request(proc_gap), ierr)
+ end if
+ end do
+
+ !-- Free som ISsend buffer and some array --
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ !if (associated(cartography(proc_gap)%pter)) deallocate(cartography(proc_gap)%pter)
+ deallocate(cartography(proc_gap)%pter)
+ end do
+ deallocate(cartography) ! We do not need it anymore
+! XXX Todo : préférer un call MPI_WAIT_ALL couplé avec une init de s_request_bis
+! sur MPI_REQUEST_NULL et enlever la boucle ET le if.
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ if (rece_rank(proc_gap) /= D_rank(direction)) then
+ call MPI_WAIT(s_request_bis(proc_gap),rece_status,ierr)
+ end if
+ end do
+ deallocate(s_request_bis)
+ deallocate(tag_proc)
+ deallocate(size_com)
+
+ ! ===== Compute the interpolated velocity =====
+ ! -- Compute the interpolation weight and update the pointers Vp and Vm --
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+ ! Initialisation of reccurence process
+ ind = 1
+ pos = floor(p_posV_bis(ind,i1,i2))
+ weight(ind,i1,i2) = p_posV_bis(ind,i1,i2)-pos
+ ! Vm = V(pos)
+ proc_gap = floor(real(pos-1)/N_proc(direction))
+ if (rece_rank(proc_gap) == D_rank(direction)) then
+ Vm(ind,i1,i2)%pter => p_V(pos-proc_gap*N_proc(direction), i1,i2)
+ else
+ Vm(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end if
+ ! Vp = V(pos+1)
+ proc_gap = floor(real(pos+1-1)/N_proc(direction))
+ if (rece_rank(proc_gap) == D_rank(direction)) then
+ Vp(ind,i1,i2)%pter => p_V(pos+1-proc_gap*N_proc(direction), i1,i2)
+ else
+ Vp(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end if
+ pos_old = pos
+
+ ! Following indice : we use previous work (already done)
+ do ind = 2, N_proc(direction)
+ pos = floor(p_posV_bis(ind,i1,i2))
+ weight(ind,i1,i2) = p_posV_bis(ind,i1,i2)-pos
+ select case(pos-pos_old)
+ case(0)
+ ! The particle belongs to the same segment than the previous one
+ Vm(ind,i1,i2)%pter => Vm(ind-1,i1,i2)%pter
+ Vp(ind,i1,i2)%pter => Vp(ind-1,i1,i2)%pter
+ case(1)
+ ! The particle follows the previous one
+ Vm(ind,i1,i2)%pter => Vp(ind-1,i1,i2)%pter
+ ! Vp = V(pos+1)
+ proc_gap = floor(real(pos+1-1)/N_proc(direction)) ! fortran -> indice starts from 1
+ if (rece_rank(proc_gap) == D_rank(direction)) then
+ Vp(ind,i1,i2)%pter => p_V(pos+1-proc_gap*N_proc(direction), i1,i2)
+ else
+ Vp(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end if
+ case(2)
+ ! pos = pos_old +2, wich correspond to "extention"
+ ! Vm = V(pos)
+ proc_gap = floor(real(pos-1)/N_proc(direction))
+ if (rece_rank(proc_gap) == D_rank(direction)) then
+ Vm(ind,i1,i2)%pter => p_V(pos-proc_gap*N_proc(direction), i1,i2)
+ else
+ Vm(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end if
+ ! Vp = V(pos+1)
+ proc_gap = floor(real(pos+1-1)/N_proc(direction))
+ if (rece_rank(proc_gap) == D_rank(direction)) then
+ Vp(ind,i1,i2)%pter => p_V(pos+1-proc_gap*N_proc(direction), i1,i2)
+ else
+ Vp(ind,i1,i2)%pter => V_buffer(pos_in_buffer(proc_gap))
+ pos_in_buffer(proc_gap) = pos_in_buffer(proc_gap) + 1
+ end if
+ case default
+ print*, "unexpected case : pos = ", pos, " , pos_old = ", pos_old, &
+ & " ind = ", ind, " i1 = ", i1, " i2 = ", i2
+ end select
+ pos_old = pos
+ end do ! loop on particle indice inside the current line
+ end do ! loop on first coordinate (i1) of a line inside the block of line
+ end do ! loop on second coordinate (i2) of a line inside the block of line
+
+ deallocate(pos_in_buffer) ! We do not need it anymore
+
+ ! -- Compute the interpolate velocity --
+ ! Check if communication are done
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ if (rece_rank(proc_gap)/=D_rank(direction)) then
+ call mpi_wait(rece_request(proc_gap), rece_status, ierr)
+ end if
+ end do
+ deallocate(rece_request)
+
+ ! Then compute the field
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+ do ind = 1, N_proc(direction)
+ p_posV_bis(ind,i1,i2) = weight(ind,i1,i2)*Vp(ind,i1,i2)%pter + (1.-weight(ind,i1,i2))*Vm(ind,i1,i2)%pter
+ end do
+ end do
+ end do
+ p_V = p_posV_bis
+
+
+ ! ===== Free memory =====
+ ! -- Pointeur --
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+ do ind = 1, N_proc(direction)
+ nullify(Vp(ind,i1,i2)%pter)
+ nullify(Vm(ind,i1,i2)%pter)
+ end do
+ end do
+ end do
+ ! -- Mpi internal buffer for non blocking communication --
+ do proc_gap = send_gap(1,1), send_gap(1,2)
+ if (send_rank(proc_gap) /= D_rank(direction)) then
+ call MPI_WAIT(s_request(proc_gap),rece_status,ierr)
+ deallocate(send_buffer(proc_gap)%pter)
+ end if
+ end do
+ deallocate(send_buffer)
+ deallocate(s_request)
+ ! -- Deallocate dynamic array --
+ deallocate(V_buffer)
+ deallocate(rece_rank)
+ deallocate(send_rank)
+
+end subroutine AC_velocity_interpol_group
+
+
+!> Determine the set of processes wich will send me information during the velocity interpolation and compute
+!! for each of these processes the range of wanted data.
+!! @param[in] direction = current direction (1 = along X, 2 = along Y, 3 = along Z)
+!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[out] send_gap = gap between my coordinate and the processes of minimal coordinate which will send information to me
+!! @param[in] rece_gap = gap between my coordinate and the processes of maximal coordinate which will receive information from me
+!! @param[in] rece_gap_abs = min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+!! @param[out] cartography = cartography(proc_gap) contains the set of the lines indice in the block for wich the
+!! current processus requiers data from proc_gap and for each of these lines the range
+!! of mesh points from where it requiers the velocity values.
+!! @details
+!! Work on a group of line of size gs(1) x gs(2))
+!! Obtain the list of processus wich need a part of my local velocity field
+!! to interpolate the velocity used in the RK2 scheme to advect its particles.
+!! In the same time, it computes for each processus from which I need a part
+!! of the velocity field, the range of mesh point where I want data and store it
+!! by using some sparse matrix technics (see cartography defined in the
+!! algorithm documentation)
+subroutine AC_velocity_determine_communication(direction, ind_group, gs, send_gap, &
+ & rece_gap, rece_gap_abs, rece_rank, cartography, max_size)
+! XXX Work only for periodic condition.
+
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use mpi
+
+
+ ! Input/Ouput
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, dimension(gs(1), gs(2), 2), intent(in) :: rece_gap
+ integer, dimension(2), intent(in) :: rece_gap_abs ! min (resp max) value of rece_gap(:,:,i) with i=1 (resp 2)
+ integer,dimension(rece_gap_abs(1):rece_gap_abs(2))&
+ &, intent(out) :: rece_rank ! rank of processus wich send me information
+ integer, dimension(2, 2), intent(out) :: send_gap
+ type(int_1D_pter), dimension( &
+ & rece_gap_abs(1):rece_gap_abs(2)), intent(out) :: cartography
+ integer, intent(in) :: max_size
+ ! Others
+ integer :: proc_gap ! gap between a processus coordinate (along the current
+ ! direction) into the mpi-topology and my coordinate
+ integer, dimension(gs(1), gs(2)) :: rece_gapP ! gap between the coordinate of the previous processus (in the current direction)
+ ! and the processes of maximal coordinate which will receive information from it
+ integer, dimension(gs(1), gs(2)) :: rece_gapN ! same as above but for the next processus
+ integer :: rankP ! processus rank for shift (P= previous, N = next)
+ integer :: send_request_gh ! mpi status of noindicelocking send
+ integer :: send_request_gh2 ! mpi status of noindicelocking send
+ integer :: ierr ! mpi error code
+ integer, dimension(2) :: tag_table ! some mpi message tag
+ logical, dimension(:,:), allocatable:: test_request ! for mpi non blocking communication
+ integer, dimension(:,:), allocatable:: send_request ! for mpi non blocking send
+ integer :: ind1, ind2 ! indice of the current line inside the group
+ integer,dimension(2) :: rece_buffer ! buffer for reception of rece_max
+ integer, dimension(:,:), allocatable:: first, last ! Storage processus to which I will be the first (or the last) to receive
+ integer :: min_size ! begin indice in first and last to stock indice along first dimension of the group line
+ integer :: gp_size ! group size
+ logical :: begin_interval ! ware we in the start of an interval ?
+ logical :: not_myself ! Is the target processus myself ?
+ integer, dimension(MPI_STATUS_SIZE) :: statut
+
+ send_gap(1,1) = 3*N(direction)
+ send_gap(1,2) = -3*N(direction)
+ send_gap(2,:) = 0
+ gp_size = gs(1)*gs(2)
+
+ ! ===== Communicate with my neigbors -> obtain ghost ! ====
+ ! Inform that about processus from which I need information
+ tag_table = compute_tag(ind_group, tag_obtrec_ghost_NP, direction)
+ call mpi_ISsend(rece_gap(1,1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(1), &
+ & D_comm(direction), send_request_gh, ierr)
+ call mpi_ISsend(rece_gap(1,1,2), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(2), &
+ & D_comm(direction), send_request_gh2, ierr)
+ ! Receive the same message form my neighbors
+ call mpi_recv(rece_gapN(1,1), gp_size, MPI_INTEGER, neighbors(direction,2), tag_table(1), D_comm(direction), statut, ierr)
+ call mpi_recv(rece_gapP(1,1), gp_size, MPI_INTEGER, neighbors(direction,1), tag_table(2), D_comm(direction), statut, ierr)
+
+ ! ===== Compute if I am first or last =====
+ min_size = 2 + gs(2)
+ ! Initialize first and last to determine if I am the the first or the last processes (considering the current direction)
+ ! to require information from this processus
+ allocate(first(2,rece_gap_abs(1):rece_gap_abs(2)))
+ first(2,:) = 0 ! number of lines for which I am the first
+ allocate(last(2,rece_gap_abs(1):rece_gap_abs(2)))
+ last(2,:) = 0 ! number of lines for which I am the last
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ first(1,proc_gap) = -proc_gap
+ last(1,proc_gap) = -proc_gap
+ end do
+ ! Compute
+ do ind2 = 1, gs(2)
+ do ind1 = 1, gs(1)
+ ! Proc_gap must belongs to [rece_gap(ind1,ind2,1);rece_gap(ind1,ind2,2)].
+ ! I am the first if (proc_gap>rece_gapP(ind1,ind2)-1).
+ do proc_gap = rece_gapP(ind1,ind2), rece_gap(ind1,ind2,2)
+ first(2,proc_gap) = first(2,proc_gap)+1
+ end do
+ ! Proc_gap must belongs to [rece_gap(ind1,ind2,1);rece_gap(ind1,ind2,2)].
+ ! I am the last if (proc_gap<rece_gapN(ind1,ind2)+1).
+ do proc_gap = rece_gap(ind1,ind2,1), rece_gapN(ind1,ind2)
+ last(2,proc_gap) = last(2,proc_gap)+1
+ end do
+ end do
+ end do
+
+ ! ===== Determine the cartography =====
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ call mpi_cart_shift(D_comm(direction), 0, proc_gap, rankP, rece_rank(proc_gap), ierr)
+ !not_myself = (rece_rank(proc_gap) /= D_rank(direction)) ! Is the target processus myself ?
+ ! Nothing to do if target processus is myself
+ !if (not_myself) then
+ if (rece_rank(proc_gap) /= D_rank(direction)) then
+ ! Allocate cartography(proc_gap)
+ allocate(cartography(proc_gap)%pter(max_size))
+ ! Initialize cartography
+ cartography(proc_gap)%pter(1) = 0 ! number of velocity values to receive
+ cartography(proc_gap)%pter(2) = min_size ! number of element to send when sending cartography
+ ! Update cartography
+ do ind2 = 1, gs(2)
+ cartography(proc_gap)%pter(2+ind2) = 0 ! 2 x number of interval of concern line into the column i2
+ begin_interval = .true.
+ do ind1 = 1, gs(1)
+ ! Does proc_gap belongs to [rece_gap(i1,i2,1);rece_gap(i1,i2,2)]?
+ if((proc_gap>=rece_gap(ind1,ind2,1)).and.(proc_gap<=rece_gap(ind1,ind2,2))) then
+ if (begin_interval) then
+ cartography(proc_gap)%pter(2+ind2) = cartography(proc_gap)%pter(2+ind2)+2
+ cartography(proc_gap)%pter(cartography(proc_gap)%pter(2)+1) = ind1
+ cartography(proc_gap)%pter(2) = cartography(proc_gap)%pter(2) + 2
+ cartography(proc_gap)%pter(cartography(proc_gap)%pter(2)) = ind1
+ begin_interval = .false.
+ else ! begin_interval
+ cartography(proc_gap)%pter(cartography(proc_gap)%pter(2)) = ind1
+ end if ! begin_interval
+ else
+ begin_interval = .true.
+ end if ! rec_gap(1) <= proc_gap <= rece_gap(2)
+ end do ! ind1
+ end do ! ind2
+ else ! not myself
+ allocate(cartography(proc_gap)%pter(1))
+ cartography(proc_gap)%pter(1)=0
+ end if ! not myself
+ end do ! proc_gap
+
+ ! ===== Free Isend buffer from first communication =====
+ call MPI_WAIT(send_request_gh,statut,ierr)
+ call MPI_WAIT(send_request_gh2,statut,ierr)
+
+ ! ===== Send information about first and last =====
+ tag_table = compute_tag(ind_group, tag_obtrec_NP, direction)
+ allocate(send_request(rece_gap_abs(1):rece_gap_abs(2),2))
+ allocate(test_request(rece_gap_abs(1):rece_gap_abs(2),2))
+ test_request = .false.
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ ! I am the first ?
+ if (first(2,proc_gap)>0) then
+ if(rece_rank(proc_gap)/= D_rank(direction)) then
+ call mpi_ISsend(first(1,proc_gap), 2, MPI_INTEGER, rece_rank(proc_gap), tag_table(1), D_comm(direction), &
+ & send_request(proc_gap,1), ierr)
+ test_request(proc_gap,1) = .true.
+ else
+ send_gap(1,1) = min(send_gap(1,1), -proc_gap)
+ send_gap(2,1) = send_gap(2,1) + first(2,proc_gap)
+ end if
+ end if
+ ! I am the last ?
+ if (last(2,proc_gap)>0) then
+ if(rece_rank(proc_gap)/= D_rank(direction)) then
+ call mpi_ISsend(last(1,proc_gap), 2, MPI_INTEGER, rece_rank(proc_gap), tag_table(2), D_comm(direction), &
+ & send_request(proc_gap,2), ierr)
+ test_request(proc_gap,2) = .true.
+ else
+ send_gap(1,2) = max(send_gap(1,2), -proc_gap)
+ send_gap(2,2) = send_gap(2,2) + last(2,proc_gap)
+ end if
+ end if
+ end do
+
+
+
+ ! ===== Receive information form the first and the last processus which need a part of my local velocity field =====
+ do while(send_gap(2,1) < gp_size)
+ call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(1), D_comm(direction), statut, ierr)
+ send_gap(1,1) = min(send_gap(1,1), rece_buffer(1))
+ send_gap(2,1) = send_gap(2,1) + rece_buffer(2)
+ end do
+ do while(send_gap(2,2) < gp_size)
+ call mpi_recv(rece_buffer(1), 2, MPI_INTEGER, MPI_ANY_SOURCE, tag_table(2), D_comm(direction), statut, ierr)
+ send_gap(1,2) = max(send_gap(1,2), rece_buffer(1))
+ send_gap(2,2) = send_gap(2,2) + rece_buffer(2)
+ end do
+
+ ! ===== Free Isend buffer =====
+ do proc_gap = rece_gap_abs(1), rece_gap_abs(2)
+ if (test_request(proc_gap,1).eqv. .true.) call MPI_WAIT(send_request(proc_gap,1),statut,ierr)
+ if (test_request(proc_gap,2)) call MPI_WAIT(send_request(proc_gap,2),statut,ierr)
+ end do
+ deallocate(send_request)
+ deallocate(test_request)
+
+ ! ===== Deallocate array =====
+ deallocate(first)
+ deallocate(last)
+
+end subroutine AC_velocity_determine_communication
+
+
+!> Interpolate the velocity field used in a RK2 scheme for particle advection -
+!! version for direction with no domain subdivision ands thus no required
+!! communications
+!! @param[in] dt = time step
+!! @param[in] direction = current direction (1 = along X, 2 = along Y and 3 = along Z)
+!! @param[in] gs = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] p_pos_adim = adimensionned particle postion
+!! @param[in,out] p_V = particle velocity (along the current direction)
+!! @details
+!! A RK2 scheme is used to advect the particles : the midlle point scheme. An
+!! intermediary position "p_pos_bis(i) = p_pos(i) + V(i)*dt/2" is computed and then
+!! the numerical velocity of each particles is computed as the interpolation of V in
+!! this point. This field is used to advect the particles at the seconde order in time :
+!! p_pos(t+dt, i) = p_pos(i) + p_V(i).
+!! Variant for cases with no required communication.
+subroutine AC_velocity_interpol_no_com(dt, direction, gs, p_pos_adim, p_V)
+
+ ! This code involve a recopy of p_V. It is possible to directly use the 3D velocity field but it will also limit the meroy access.
+
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Ouput
+ real(WP), intent(in) :: dt ! time step
+ integer, intent(in) :: direction ! current direction
+ integer, dimension(2),intent(in) :: gs ! groupe size
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim
+ real(WP), dimension(:,:,:), intent(inout) :: p_V
+ ! Others, local
+ real(WP),dimension(N_proc(direction),gs(1),gs(2)) :: p_posV_bis ! adimensionned position of the middle point
+ integer :: ind ! indices
+ integer :: i1, i2 ! indices in the lines group
+ integer :: pos ! indices of the mesh point wich preceed the particle position
+
+ ! ===== Initialisation =====
+ ! Compute the midlle point
+ p_posV_bis = p_pos_adim + (dt/2.0)*p_V/d_sc(direction)
+
+
+ ! ===== Compute the interpolated velocity =====
+ ! -- Compute the interpolation weight and update the velocity directly in p_posV_bis --
+ do i2 = 1, gs(2)
+ do i1 = 1, gs(1)
+ do ind = 1, N(direction)
+
+ pos = floor(p_posV_bis(ind,i1,i2))
+ p_posV_bis(ind,i1,i2) = p_V(modulo(pos-1,N(direction))+1,i1,i2) + (p_posV_bis(ind,i1,i2)-pos)* &
+ & (p_V(modulo(pos,N(direction))+1,i1,i2)-p_V(modulo(pos-1,N(direction))+1,i1,i2))
+
+ end do ! loop on particle indice (ind)
+ end do ! loop on first coordinate (i1) of a line inside the block of line
+ end do ! loop on second coordinate (i2) of a line inside the block of line
+
+ ! -- Recopy velocity in the right array --
+ p_V = p_posV_bis
+
+end subroutine AC_velocity_interpol_no_com
+
+
+end module advec_common_velo
+!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_correction.f90 b/HySoP/src/scalesInterface/particles/advec_correction.f90
index ccbe68a6b4334f7ee3320ce0b035da918f908f69..6b273c3ddbec76437000cc0e3ac44c47c5d209a7 100644
--- a/HySoP/src/scalesInterface/particles/advec_correction.f90
+++ b/HySoP/src/scalesInterface/particles/advec_correction.f90
@@ -5,12 +5,12 @@
! MODULE: advec_correction
!
!
-! DESCRIPTION:
-!> The module ``advec_correction'' gather function and subroutines used to computed
+! DESCRIPTION:
+!> The module ``advec_correction'' gather function and subroutines used to computed
!! eventual correction or limitator if wanted. These tools are
!! independant from the direction.
!! @details
-!! This module gathers functions and routines used to determine when correction
+!! This module gathers functions and routines used to determine when correction
!! are required depending on the remeshing formula. It includes particle
!! type and tag (for corrected lambda schemes) and variation computation
!! for limitator.
@@ -31,15 +31,11 @@
module advec_correction
- use precision
- use string
- use advec_abstract_proc
- use advec_remeshing_formula
-
implicit none
!----- Determine block type and tag particles -----
- public :: AC_type_and_block_group
+ public :: AC_type_and_block_group
+ public :: AC_limitator_from_slopes
contains
@@ -47,7 +43,7 @@ contains
! ==================== Bloc type and particles tag for corrected lambda schemes ====================
! ===========================================================================================================
-!> Determine type (center or left) of each block and tagfor a complete group of
+!> Determine type (center or left) of each block and tag for a complete group of
!! lines.
!! corrected remeshing formula are recquired.
!! @param[in] dt = time step
@@ -56,7 +52,7 @@ contains
!! @param[in] ind_group = coordinate of the current group of lines
!! @param[in] p_V = particle velocity (along the current direction)
!! @param[out] bl_type = table of blocks type (center of left)
-!! @param[out] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
+!! @param[out] bl_tag = inform about tagged particles (bl_tag(ind_bl)=1 if the end of the bl_ind-th block
!! and the begining of the following one is tagged)
!! @details
!! This subroutine work on a groupe of line. For each line of this group, it
@@ -70,7 +66,7 @@ subroutine AC_type_and_block_group(dt, dir, gp_s, ind_group, p_V, &
use mpi
use cart_topology ! info about mesh and mpi topology
use advec_variables ! contains info about solver parameters and others.
- use precision ! define working precision (double or simple)
+ use precision_tools ! define working precision_tools (double or simple)
real(WP), intent(in) :: dt ! time step
integer, intent(in) :: dir
@@ -80,12 +76,12 @@ subroutine AC_type_and_block_group(dt, dir, gp_s, ind_group, p_V, &
logical,dimension(bl_nb(dir)+1,gp_s(1),gp_s(2)),intent(out) :: bl_type ! is the particle block a center block or a left one ?
logical,dimension(bl_nb(dir),gp_s(1),gp_s(2)),intent(out) :: bl_tag ! indice of tagged particles
- real(WP),dimension(bl_nb(dir)+1,gp_s(1),gp_s(2)) :: bl_lambdaMin ! for a particle, lamda = V*dt/dx ; bl_lambdaMin = min of
+ real(WP),dimension(bl_nb(dir)+1,gp_s(1),gp_s(2)) :: bl_lambdaMin ! for a particle, lamda = V*dt/dx ; bl_lambdaMin = min of
! lambda on a block (take also into account first following particle)
real(WP),dimension(gp_s(1),gp_s(2)) :: lambP, lambN ! buffer to exchange some lambda min with other processus
real(WP),dimension(gp_s(1),gp_s(2)) :: lambB, lambE ! min value of lambda of the begin of the line and at the end of the line
integer, dimension(bl_nb(dir)+1,gp_s(1),gp_s(2)) :: bl_ind ! block index : integer as lambda in (bl_ind,bl_ind+1) for a left block
- ! and lambda in (bl_ind-1/2, bl_ind+1/2) for a right block
+ ! and lambda in (bl_ind-1/2, bl_ind+1/2) for a right block
integer :: ind,i_p ! some indices
real(WP) :: cfl ! = d_sc
integer, dimension(2) :: send_request ! mpi status of nonblocking send
@@ -105,14 +101,14 @@ subroutine AC_type_and_block_group(dt, dir, gp_s, ind_group, p_V, &
! Receive ghost value, ie value from neighbors boundaries.
tag_table = compute_tag(ind_group, tag_part_tag_NP, dir)
call mpi_Irecv(lambN(1,1), com_size, MPI_DOUBLE_PRECISION, &
- & neighbors(dir,2), tag_table(1), D_comm(dir), rece_request(1), ierr)
+ & neighbors(dir,2), tag_table(1), D_comm(dir), rece_request(1), ierr)
call mpi_Irecv(lambP(1,1), com_size, MPI_DOUBLE_PRECISION, &
- & neighbors(dir,1), tag_table(2), D_comm(dir), rece_request(2), ierr)
+ & neighbors(dir,1), tag_table(2), D_comm(dir), rece_request(2), ierr)
! -- For the first block (1/2) --
! The domain contains only its second half => exchange ghost with the previous processus
lambB = minval(p_V(1:(bl_size/2)+1,:,:),1)*cfl
- tag_table = compute_tag(ind_group, tag_part_tag_NP, dir)
+ !tag_table = compute_tag(ind_group, tag_part_tag_NP, dir) ! Tag table is already equals to this.
! Send message
call mpi_ISsend(lambB(1,1), com_size, MPI_DOUBLE_PRECISION, &
& neighbors(dir,1), tag_table(1), D_comm(dir), send_request(1), ierr)
@@ -149,7 +145,6 @@ subroutine AC_type_and_block_group(dt, dir, gp_s, ind_group, p_V, &
bl_type = (bl_lambdaMin<dble(bl_ind))
! ===== Tag particles =====
-
do ind = 1, bl_nb(dir)
bl_tag(ind,:,:) = ((bl_ind(ind,:,:)/=bl_ind(ind+1,:,:)) .and. &
& (bl_type(ind,:,:).neqv.bl_type(ind+1,:,:)))
@@ -161,6 +156,109 @@ subroutine AC_type_and_block_group(dt, dir, gp_s, ind_group, p_V, &
end subroutine AC_type_and_block_group
+!> Compute a limitator function from scalar slope - only for corrected lambda 2 formula.
+!! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+!! @param[in] ind_group = coordinate of the current group of lines
+!! @param[in] p_pos = particles position
+!! @param[in] scalar = scalar advected by particles
+!! @param[out] limit = limitator function
+!! @details
+!! This subroutine work on a groupe of line. For each line of this group, it
+!! determine the type of each block of this line and where corrected remeshing
+!! formula are required. In those points, it tagg block transition (ie the end of
+!! the current block and the beginning of the following one) in order to indicate
+!! that corrected weigth have to be used during the remeshing.
+!! Note that the subroutine actually computes limitator/8 as this is the
+!! expression which is used inside the remeshing formula and directly computes it
+!! minimize the number of operations.
+subroutine AC_limitator_from_slopes(direction, gp_s, p_pos, &
+ & deltaS, limit, tag_mpi, com_size)
+
+ use mpi
+ use cart_topology ! info about mesh and mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+ use precision_tools ! define working precision_tools (double or simple)
+
+ integer :: direction ! current direction
+ integer, dimension(2),intent(in) :: gp_s ! groupe size
+ real(WP), dimension(:,:,:), intent(in) :: p_pos ! particle position
+ real(WP), dimension(:,:,:), intent(in) :: deltaS ! scalar slope: scalar(i+1)-scalar(i) - for i=1 N_proc+1
+ real(WP), dimension(:,:,:), intent(out) :: limit ! limitator function
+ integer, intent(in) :: tag_mpi ! tag for mpi message
+ integer, intent(in) :: com_size ! size of mpi message
+
+ ! Local variables
+ real(WP),dimension(2,gp_s(1),gp_s(2)) :: Sbuffer, Rbuffer ! buffer to exchange scalar or limitator at boundaries with neighbors.
+ integer :: ind ! loop indice on particle indice
+ real(WP),dimension(gp_s(1),gp_s(2)) :: afl ! = cfl - [cfl] where [] denotes the nearest int.
+! integer,dimension(gp_s(1),gp_s(2)) :: afl_sign ! = sign of afl, ie 1 if afl>=0, -1 if afl<0
+ integer :: send_request ! mpi status of nonblocking send
+ integer, dimension(MPI_STATUS_SIZE) :: rece_status ! mpi status (for mpi_wait)
+ integer, dimension(MPI_STATUS_SIZE) :: send_status ! mpi status (for mpi_wait)
+ integer :: ierr ! mpi error code
+
+ ! ===== Compute slope and limitator =====
+ ! Van Leer limitator function (limit = limitator/8)
+ ! -- For the "middle" and the "last" block --
+ do ind = 2, N_proc(direction)
+ where(deltaS(:,:,ind)/=0)
+ afl = p_pos(ind,:,:)
+ afl = afl - nint(afl)
+! afl_sign = int(sign(1._WP,afl))
+! limit(ind+1,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl_sign*afl+0.5_WP)**2)*(deltaS(:,:,ind-afl_sign)/deltaS(:,:,ind))/(1+(deltaS(:,:,ind-afl_sign)/deltaS(:,:,ind)))
+ ! If (p_pos-nint(p_pos))>=0)
+ where(afl>=0)
+ limit(ind+1,:,:) = max(0._WP,(deltaS(:,:,ind-1)/deltaS(:,:,ind)))
+ limit(ind+1,:,:) = limit(ind+1,:,:)/(limit(ind+1,:,:)+1)
+ limit(ind+1,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl+0.5_WP)**2)*limit(ind+1,:,:)
+ elsewhere
+ limit(ind+1,:,:) = max(0._WP,(deltaS(:,:,ind+1)/deltaS(:,:,ind)))
+ limit(ind+1,:,:) = limit(ind+1,:,:)/(limit(ind+1,:,:)+1)
+ limit(ind+1,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl-0.5_WP)**2)*limit(ind+1,:,:)
+ end where
+ elsewhere
+ limit(ind+1,:,:) = 0.0_WP
+ end where
+ end do
+ ! -- For the "first" block --
+ ! 1 - limit(1) - limitator at 1/2 is already compute on the previous mpi-rank (limit(N_proc+1) !)
+ ! 2 - limit(2) - limitator at 1+1/2 requires deltaS(0) = scalar slope between scalar(0) and scalar(-1) which is already compute on previous rank
+ ! Send these values
+ Sbuffer(1,:,:) = limit(N_proc(direction)+1,:,:)
+ Sbuffer(2,:,:) = deltaS(:,:,N_proc(direction))
+ call mpi_ISsend(Sbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,2), tag_mpi, D_comm(direction), send_request, ierr)
+ ! Receive it !
+ call mpi_recv(Rbuffer(1,1,1), com_size, MPI_DOUBLE_PRECISION, &
+ & neighbors(direction,1), tag_mpi, D_comm(direction),rece_status, ierr)
+ ! Get limit(1) = limitator at 1/2
+ limit(1,:,:) = Rbuffer(1,:,:)
+ ! Get limit(2) = limitator at 1+1/2
+ where(deltaS(:,:,1)/=0)
+ afl = p_pos(1,:,:)
+ afl = afl - nint(afl)
+ ! If (p_pos-nint(p_pos))>=0)
+ where(afl>=0)
+ limit(2,:,:) = max(0._WP,(Rbuffer(2,:,:)/deltaS(:,:,1)))
+ ! = ( deltaS(:,:,0)/deltaS(:,:,1))
+ limit(2,:,:) = limit(2,:,:)/(1+limit(2,:,:))
+ limit(2,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl+0.5_WP)**2)*limit(2,:,:)
+ elsewhere
+ limit(2,:,:) = max(0._WP,(deltaS(:,:,2)/deltaS(:,:,1)))
+ limit(2,:,:) = limit(2,:,:)/(1+limit(2,:,:))
+ limit(2,:,:) = (4.0_WP/8._WP)*min(0.9_WP,(afl-0.5_WP)**2)*limit(2,:,:)
+ end where
+ elsewhere
+ limit(2,:,:) = 0.0_WP
+ end where
+
+ ! Classical (corrected) lambda formula: limitator function = 1
+ ! limit = 1._WP/8._WP
-end module advec_correction
+ ! ===== Close mpi_ISsend when done =====
+ call mpi_wait(send_request, send_status, ierr)
+
+end subroutine AC_limitator_from_slopes
+
+end module advec_correction
diff --git a/HySoP/src/scalesInterface/particles/advec_line/advecX_line.F90 b/HySoP/src/scalesInterface/particles/advec_line/advecX_line.F90
index fb874926dc8fc7bfc6fa8b9ca5a5ed3dacfd4c07..80aabe3a2cf98600b98af72fca22a98c2666697c 100644
--- a/HySoP/src/scalesInterface/particles/advec_line/advecX_line.F90
+++ b/HySoP/src/scalesInterface/particles/advec_line/advecX_line.F90
@@ -5,19 +5,19 @@
! MODULE: advecX_line
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module advecX_line is devoted to the simplest implementation of
!! advection along X axis of a scalar field.
!
!> @details
!> The module advecX_line is devoted to the simplest implementation of
-!! advection along X axis of a scalar field. It is an unoptimized
+!! advection along X axis of a scalar field. It is an unoptimized
!! version, useful to understand the basis and to benchmark the
!! optimisation done.
!! It used particle method and provides a parallel implementation.
!!
!! This module can use the method and variables defined in the module
-!! "advec_common" which gather information and tools shared for advection along
+!! "advec_common_line" which gather information and tools shared for advection along
!! x, y and z-axis.
!!
!! The module "test_advec" can be used in order to validate the procedures
@@ -30,7 +30,7 @@
module advecX_line
- use precision
+ use precision_tools
use advec_abstract_proc
implicit none
@@ -47,9 +47,9 @@ module advecX_line
! ===== Private variable ====
! particles solver with different remeshing formula
- integer, dimension(2), private :: gpX_size
+ integer, dimension(2), private :: gpX_size
!> Current direction = along X
- integer, private, parameter :: direction=1
+ integer, private, parameter :: direction=1
!> Group size along current direction
!integer, private, dimension(2) :: gs
@@ -71,9 +71,9 @@ contains
!! @param[in,out] scal3D = scalar field to advect
subroutine advecX_calc_line(dt,Vx,scal3D)
- use advec_common ! Some procedures common to advection along all directions
- use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
+ use advec_common_line ! Some procedures common to advection along all directions
+ use advec_variables ! contains info about solver parameters and others.
+ use cart_topology ! Description of mesh and of mpi topology
! Input/Output
real(WP), intent(in) :: dt
@@ -136,10 +136,10 @@ end subroutine advecX_calc_line
!! @param[in,out] scal = scalar field to advect
subroutine Xremesh_O2_line(ind_group, p_pos_adim, bl_type, bl_tag,j,k,scal)
- use advec_common ! Some procedures common to advection along all directions
+ use advec_common_line ! Some procedures common to advection along all directions
use advec_remeshing_line ! Remeshing formula
use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
+ use cart_topology ! Description of mesh and of mpi topology
! Input/Output
integer, dimension(2), intent(in) :: ind_group
@@ -148,14 +148,14 @@ subroutine Xremesh_O2_line(ind_group, p_pos_adim, bl_type, bl_tag,j,k,scal)
logical, dimension(:), intent(in) :: bl_tag
real(WP), dimension(:), intent(in) :: p_pos_adim
real(WP), dimension(N_proc(1), N_proc(2), N_proc(3)), intent(inout) :: scal
- ! Other local variables
+ ! Other local variables
! Variable used to remesh particles in a buffer
real(WP),dimension(:),allocatable :: send_buffer ! buffer use to remesh the scalar before to send it to the right subdomain
integer, dimension(2) :: rece_proc ! minimal and maximal gap between my Y-coordinate and the one from which
! I will receive data
integer :: proc_min ! smaller gap between me and the processes to where I send data
integer :: proc_max ! smaller gap between me and the processes to where I send data
-
+
! -- Compute ranges --
if (bl_type(1)) then
@@ -182,7 +182,7 @@ subroutine Xremesh_O2_line(ind_group, p_pos_adim, bl_type, bl_tag,j,k,scal)
! -- Remesh the particles in the buffer --
call AC_remesh_lambda2corrected_basic(direction, p_pos_adim, scal(:,j,k), bl_type, bl_tag, send_j_min, send_j_max, send_buffer)
-
+
! -- Send the buffer to the matching processus and update the scalar field --
scal(:,j,k) = 0
call AC_bufferToScalar_line(direction, ind_group , send_j_min, send_j_max, proc_min, proc_max, &
@@ -203,7 +203,7 @@ end subroutine Xremesh_O2_line
!! @param[in] j = Y-indice of the current line
!! @param[in] k = Z-indice of the current line
!! @param[out] p_pos_adim = adimensioned particles postion
-!! @param[out] p_V = particle velocity
+!! @param[out] p_V = particle velocity
subroutine advecX_init_line(Vx, j, k, p_pos_adim, p_V)
use cart_topology ! Description of mesh and of mpi topology
diff --git a/HySoP/src/scalesInterface/particles/advec_line/advecY_line.f90 b/HySoP/src/scalesInterface/particles/advec_line/advecY_line.f90
index 87dddc3e6e1130abb8a0ccb94f0abada5310b572..f050f2474a98fa8a39f959c01a35bb0b7bc4b8e4 100644
--- a/HySoP/src/scalesInterface/particles/advec_line/advecY_line.f90
+++ b/HySoP/src/scalesInterface/particles/advec_line/advecY_line.f90
@@ -6,19 +6,19 @@
! MODULE: advecY_line
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module advecY_line is devoted to the simplest implementation of
!! advection along Y axis of a scalar field.
!
!> @details
!> The module advecY_line is devoted to the simplest implementation of
-!! advection along Y axis of a scalar field. It is an unoptimized
+!! advection along Y axis of a scalar field. It is an unoptimized
!! version, useful to understand the basis and to benchmark the
!! optimisation done.
!! It used particle method and provides a parallel implementation.
!!
!! This module can use the method and variables defined in the module
-!! "advec_common" which gather information and tools shared for advection along
+!! "advec_common_line" which gather information and tools shared for advection along
!! x, y and z-axis.
!!
!! The module "test_advec" can be used in order to validate the procedures
@@ -31,7 +31,7 @@
module advecY_line
- use precision
+ use precision_tools
use advec_abstract_proc
implicit none
@@ -68,8 +68,8 @@ contains
!! @param[in,out] scal3D = scalar field to advect
subroutine advecY_calc_line(dt,Vy,scal3D)
- use advec_common ! some procedures common to advection along all directions
- use advec_variables ! contains info about solver parameters and others.
+ use advec_common_line ! some procedures common to advection along all directions
+ use advec_variables ! contains info about solver parameters and others.
use cart_topology ! description of mesh and of mpi topology
! input/output
@@ -131,10 +131,10 @@ end subroutine advecY_calc_line
!! @param[in,out] scal = scalar field to advect
subroutine Yremesh_O2_line(ind_group, p_pos_adim, bl_type, bl_tag,i,k,scal)
- use advec_common ! Some procedures common to advection along all directions
+ use advec_common_line ! Some procedures common to advection along all directions
use advec_remeshing_line ! Remeshing formula
use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
+ use cart_topology ! Description of mesh and of mpi topology
! Input/Output
integer, dimension(2), intent(in) :: ind_group
diff --git a/HySoP/src/scalesInterface/particles/advec_line/advecZ_line.f90 b/HySoP/src/scalesInterface/particles/advec_line/advecZ_line.f90
index 945e068ba796536393e41e84e63e70c50a7c98b0..26d2e867a665502490f8066734d9d35d0369e2fe 100644
--- a/HySoP/src/scalesInterface/particles/advec_line/advecZ_line.f90
+++ b/HySoP/src/scalesInterface/particles/advec_line/advecZ_line.f90
@@ -18,7 +18,7 @@
!! It used particle method and provides a parallel implementation.
!!
!! This module can use the method and variables defined in the module
-!! "advec_common" which gather information and tools shared for advection along
+!! "advec_common_line" which gather information and tools shared for advection along
!! x, y and z-axis.
!!
!! The module "test_advec" can be used in order to validate the procedures
@@ -31,7 +31,7 @@
module advecZ_line
- use precision
+ use precision_tools
use advec_abstract_proc
implicit none
@@ -66,7 +66,7 @@ contains
!! @param[in,out] scal3D = scalar field to advect
subroutine advecZ_calc_line(dt,Vz,scal3D)
- use advec_common ! some procedures common to advection along all directions
+ use advec_common_line ! some procedures common to advection along all directions
use advec_variables ! contains info about solver parameters and others.
use cart_topology ! Description of mesh and of mpi topology
@@ -129,10 +129,10 @@ end subroutine advecZ_calc_line
!! @param[in,out] scal = scalar field to advect
subroutine Zremesh_O2_line(ind_group, p_pos_adim, bl_type, bl_tag,i,j,scal)
- use advec_common ! Some procedures common to advection along all directions
+ use advec_common_line ! Some procedures common to advection along all directions
use advec_remeshing_line ! Remeshing formula
use advec_variables ! contains info about solver parameters and others.
- use cart_topology ! Description of mesh and of mpi topology
+ use cart_topology ! Description of mesh and of mpi topology
! Input/Output
integer, dimension(2), intent(in) :: ind_group
diff --git a/HySoP/src/scalesInterface/particles/advec_line/advec_common_line.f90 b/HySoP/src/scalesInterface/particles/advec_line/advec_common_line.f90
index ba5328afbf94ddd73e054b69595ec7f1827fbb88..d33264d6ab982f430451e6c04171fb2e49b64b97 100644
--- a/HySoP/src/scalesInterface/particles/advec_line/advec_common_line.f90
+++ b/HySoP/src/scalesInterface/particles/advec_line/advec_common_line.f90
@@ -5,19 +5,19 @@
! MODULE: advec_common_line
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module ``advec_common_line'' gather function and subroutines used to advec scalar
!! which are not specific to a direction. It contains some ``old''
!! functions from ``advec_common'' which are not optimized.
!! @details
!! This module gathers functions and routines used to advec scalar which are not
-!! specific to a direction. More precisly, it provides function similar to
+!! specific to a direction. More precisly, it provides function similar to
!! ``advec_common'' but which only work on single line rather than of
!! group line. Considering how mpi parallelism works, working on single
!! line are not opptimal. Therefore, these function are onbly here for
!! debbugging and testing purposes. They also could be used to compute
!! some spped-up. They are more simple and basic but less efficients.
-!!
+!!
!! This module is automatically load when advec_common is used.
!! Moreover, advec_common contains all interface to automatically use
!! the right function whenever you want work on single line or on group of
@@ -35,11 +35,11 @@
!! Jean-Baptiste Lagaert, LEGI
!
!------------------------------------------------------------------------------
-
+
module advec_common_line
- use precision
- use string
+ use precision_tools
+ use structure_tools
implicit none
@@ -447,7 +447,7 @@ subroutine AC_type_and_block_line(dt, direction, ind_group, p_V, &
use mpi
use cart_topology
use advec_variables
- use precision
+ use precision_tools
! In/Out variables
real(WP), intent(in) :: dt ! time step
diff --git a/HySoP/src/scalesInterface/particles/advec_remesh_Mprime.f90 b/HySoP/src/scalesInterface/particles/advec_remesh_Mprime.f90
new file mode 100644
index 0000000000000000000000000000000000000000..89428a196e2e938a54041a80cd41ff8d74f7f528
--- /dev/null
+++ b/HySoP/src/scalesInterface/particles/advec_remesh_Mprime.f90
@@ -0,0 +1,391 @@
+!> @addtogroup part
+
+!------------------------------------------------------------------------------
+!
+! MODULE: advec_remeshing_formula
+!
+!
+! DESCRIPTION:
+!> This module gathers all the remeshing formula of ``Mprime'' family.
+!! These interpolation polynom allow to re-distribute particles on mesh grid at each
+!! iterations.
+!! @details
+!! It provides M'6 and M'8 remeshing formula.
+!! These M' formula appears as only involving stability condition depending of
+!! velocity gradient rather than CFL number. Thus, they allow us to use large
+!! time-step. The stability constant is equal to 1 (ie the condition is
+!! dt < gradiend(velocity)) where the numerical gradient is computed with
+!! finite-difference scheme.
+!! In praxis, the' M'6 method appears as offer the better ratio between
+!! precision and numerical cost. It is locally of order 4 and generically of order
+!! 2 (the spatial order is decrease in location associated with important
+!! velocity variation).
+!! The accuracy local accuracy of M'8 scheme can be better.
+!! This module also provide some wraper to remesh a complete line
+!! of particles (with the different formula) and to do it either on a
+!! array or into a array of pointer to reals. In order to gather
+!! communications between different lines of particles, it is better to
+!! use continguous memory space for mesh point with belong to the same
+!! processes and thus to use and array of pointer to easily deal with it.
+!
+!> @author
+!! Jean-Baptiste Lagaert, LEGI
+!
+!------------------------------------------------------------------------------
+
+module advec_remeshing_Mprime
+
+ use precision_tools
+ use advec_common_line
+
+ implicit none
+
+ ! #############################
+ ! ########## Hearder ##########
+ ! #############################
+
+! ! ===== Abstract profile of M' remeshing subroutines =====
+! ! --- Abstract profile of subroutine used to remesh a line of particles ---
+! ! Variant: the buffer is an array of pointer (and not a pointer to an array)
+! abstract interface
+! subroutine AC_remesh_Mprime(p_pos_adim, scal1D, bl_type, bl_tag, ind_min, buffer)
+! use precision_tools
+! use advec_variables
+
+! implicit none
+
+! ! Input/Output
+! real(WP), intent(in) :: p_pos_adim
+! real(WP), intent(in) :: scal1D
+! type(real_pter), dimension(:), intent(inout):: buffer
+! end subroutine AC_remesh_Mprime
+! end interface
+
+ ! ===== Public procedures =====
+ ! Wrapper to M' remeshing formula (actually pointer to the right subroutine)
+ procedure(AC_remesh_Mprime6_array), pointer, public :: AC_remesh_Mprime_array => null() !> wrapper to M' remeshing formula - buffer are stored in classical array
+ procedure(AC_remesh_Mprime6_pter), pointer, public :: AC_remesh_Mprime_pter => null() !> wrapper to M' remeshing formula - buffer are stored via an array of pointer
+ ! To get the right "line remeshing" wrapper
+ public :: AC_remesh_init_Mprime
+ !----- M'6 remeshing formula -----
+ public :: AC_remesh_Mprime6 ! use 6 grid point, 3 for each side of the particle.
+ public :: AC_remesh_Mprime6_array ! use 6 grid point, 3 for each side of the particle.
+ public :: AC_remesh_Mprime6_pter ! use 6 grid point, 3 for each side of the particle.
+ !----- M'8 remeshing formula -----
+ public :: AC_remesh_Mprime8 ! use 8 grid point, 4 for each side of the particle.
+ public :: AC_remesh_Mprime8_array
+ public :: AC_remesh_Mprime8_pter
+
+
+ !===== Interface =====
+ ! -- M'6: array of real or of pointer --
+ interface AC_remesh_Mprime6
+ module procedure AC_remesh_Mprime6_pter, AC_remesh_Mprime6_array
+ end interface AC_remesh_Mprime6
+
+ ! -- M'8: array of real or of pointer --
+ interface AC_remesh_Mprime8
+ module procedure AC_remesh_Mprime8_pter, AC_remesh_Mprime8_array
+ end interface AC_remesh_Mprime8
+
+contains
+
+! ===================================================================
+! ============ Pointer to the right remesh formula ===========
+! ===================================================================
+
+subroutine AC_remesh_init_Mprime()
+
+ use advec_variables ! solver context
+
+ select case(trim(type_solv))
+ case ('p_M8')
+ AC_remesh_Mprime_array => AC_remesh_Mprime8_array
+ AC_remesh_Mprime_pter => AC_remesh_Mprime8_pter
+ case default
+ AC_remesh_Mprime_array => AC_remesh_Mprime6_array
+ AC_remesh_Mprime_pter => AC_remesh_Mprime6_pter
+ end select
+
+end subroutine AC_remesh_init_Mprime
+
+! =========================================================================
+! ============ Interpolation polynom used for remeshing ============
+! =========================================================================
+
+!> M'6 remeshing formula - version for array of real
+!! @param[in] dir = current direction
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by the particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+subroutine AC_remesh_Mprime6_array(dir, pos_adim, sca, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ !Input/Ouput
+ integer, intent(in) :: dir
+ real(WP), intent(in) :: pos_adim, sca
+ real(WP), dimension(:), intent(inout) :: buffer
+ ! Ohter local variables
+ integer :: j0, j1 ! indice of the the nearest mesh points
+ real(WP) :: bM, bM2, b0, bP, bP2, bP3! interpolation weight for the particles
+ real(WP) :: y0 ! adimensionned distance to mesh points
+
+ ! Mesh point used in remeshing formula
+ j0 = floor(pos_adim)
+
+ ! Distance to mesh points
+ y0 = (pos_adim - dble(j0))
+
+ ! Interpolation weights
+ !bM2 =-(((y0+2.)-2)*(5.*(y0+2.)-8.)*((y0+2.)-3.)**3)/24.
+ bM2 = y0*(2. + y0*(-1. + y0*(-9. + (13. - 5.*y0)*y0)))/24.
+ !bM =(y0+1.-1.)*(y0+1.-2.)*(25.*(y0+1.)**3-114.*(y0+1.)**2+153.*(y0+1.)-48.)/24.
+ bM = y0*(-16. + y0*(16. + y0*(39. + y0*(-64. + 25.*y0))))/24.
+ !bP =-((1.-y0)-1.)*(25.*(1.-y0)**4-38.*(1.-y0)**3-3.*(1.-y0)**2+12.*(1.-y0)+12)/12.
+ bP = ( y0*(8. + y0*(8. + y0*(33. + y0*(-62. + 25.*y0)))))/12.
+ !bP2 = ((2.-y0)-1.)*((2.-y0)-2.)*(25.*(2.-y0)**3-114.*(2.-y0)**2+153.*(2.-y0)-48.)/24.
+ bP2 = (y0*(-2. + y0*(-1. + y0*(-33. + (61. - 25.*y0)*y0))))/24.
+ !bP3 =-(((3.-y0)-2)*(5.*(3.-y0)-8.)*((3.-y0)-3.)**3)/24.
+ bP3 = (y0**3)*(7. + y0*(5.*y0 - 12.))/24.
+ !b0 =-(y0-1.)*(25.*y0**4-38.*y0**3-3.*y0**2+12.*y0+12)/12.
+ !b0 = (12. + y0**2*(-15. + y0*(-35. + (63. - 25.*y0)*y0)))/12.
+ b0 = 1. - (bM2+bM+bP+bP2+bP3)
+
+ ! remeshing
+ j1 = modulo(j0-3,N(dir))+1 ! j0-2
+ buffer(j1) = buffer(j1) + sca*bM2
+ j1 = modulo(j0-2,N(dir))+1 ! j0-1
+ buffer(j1) = buffer(j1) + sca*bM
+ j1 = modulo(j0-1,N(dir))+1 ! j0
+ buffer(j1) = buffer(j1) + sca*b0
+ j1 = modulo(j0,N(dir))+1 ! j0+1
+ buffer(j1) = buffer(j1) + sca*bP
+ j1 = modulo(j0+1,N(dir))+1 ! j0+2
+ buffer(j1) = buffer(j1) + sca*bP2
+ j1 = modulo(j0+2,N(dir))+1 ! j0+3
+ buffer(j1) = buffer(j1) + sca*bP3
+
+end subroutine AC_remesh_Mprime6_array
+
+
+!> M'6 remeshing formula (order is more than 2, JM Ethancelin is working on
+!! determining order). - version for array of pointer
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by the particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+subroutine AC_remesh_Mprime6_pter(pos_adim, sca, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ !Input/Ouput
+ real(WP), intent(in) :: pos_adim, sca
+ type(real_pter), dimension(:), intent(inout) :: buffer
+ ! Ohter local variables
+ integer :: j0 ! indice of the the nearest mesh points
+ real(WP) :: bM, bM2, b0, bP, bP2, bP3! interpolation weight for the particles
+ real(WP) :: y0 ! adimensionned distance to mesh points
+
+ ! Mesh point used in remeshing formula
+ j0 = floor(pos_adim)
+
+ ! Distance to mesh points
+ y0 = (pos_adim - dble(j0))
+
+ ! Interpolation weights
+ !bM2 =-(((y0+2.)-2)*(5.*(y0+2.)-8.)*((y0+2.)-3.)**3)/24.
+ bM2 = y0*(2. + y0*(-1. + y0*(-9. + (13. - 5.*y0)*y0)))/24.
+ !bM =(y0+1.-1.)*(y0+1.-2.)*(25.*(y0+1.)**3-114.*(y0+1.)**2+153.*(y0+1.)-48.)/24.
+ bM = y0*(-16. + y0*(16. + y0*(39. + y0*(-64. + 25.*y0))))/24.
+ !bP =-((1.-y0)-1.)*(25.*(1.-y0)**4-38.*(1.-y0)**3-3.*(1.-y0)**2+12.*(1.-y0)+12)/12.
+ bP = ( y0*(8. + y0*(8. + y0*(33. + y0*(-62. + 25.*y0)))))/12.
+ !bP2 = ((2.-y0)-1.)*((2.-y0)-2.)*(25.*(2.-y0)**3-114.*(2.-y0)**2+153.*(2.-y0)-48.)/24.
+ bP2 = (y0*(-2. + y0*(-1. + y0*(-33. + (61. - 25.*y0)*y0))))/24.
+ !bP3 =-(((3.-y0)-2)*(5.*(3.-y0)-8.)*((3.-y0)-3.)**3)/24.
+ bP3 = (y0**3)*(7. + y0*(5.*y0 - 12.))/24.
+ !b0 =-(y0-1.)*(25.*y0**4-38.*y0**3-3.*y0**2+12.*y0+12)/12.
+ !b0 = (12. + y0**2*(-15. + y0*(-35. + (63. - 25.*y0)*y0)))/12.
+ b0 = 1. - (bM2+bM+bP+bP2+bP3)
+
+ ! remeshing
+ buffer(j0-2)%pter = buffer(j0-2)%pter + sca*bM2
+ buffer(j0-1)%pter = buffer(j0-1)%pter + sca*bM
+ buffer(j0 )%pter = buffer(j0 )%pter + sca*b0
+ buffer(j0+1)%pter = buffer(j0+1)%pter + sca*bP
+ buffer(j0+2)%pter = buffer(j0+2)%pter + sca*bP2
+ buffer(j0+3)%pter = buffer(j0+3)%pter + sca*bP3
+
+end subroutine AC_remesh_Mprime6_pter
+
+
+!> M'8 remeshing formula - version for array of pointer.
+!! @param[in] dir = current direction
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by the particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+subroutine AC_remesh_Mprime8_array(dir, pos_adim, sca, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ !Input/Ouput
+ integer, intent(in) :: dir
+ real(WP), intent(in) :: pos_adim, sca
+ real(WP), dimension(:), intent(inout) :: buffer
+ ! Ohter local variables
+ integer :: j0, j1 ! indice of the the nearest mesh points
+ real(WP) :: y0 ! adimensionned distance to mesh points
+ real(WP) :: bM, bM2, bM3, b0, bP, bP2, bP3, bP4 ! interpolation weight for the particles
+
+ ! Mesh point used in remeshing formula
+ j0 = floor(pos_adim)
+
+ ! Distance to mesh points
+ y0 = (pos_adim - dble(j0))
+
+ ! Interpolation weights
+ ! M'8 = 15/8*M8 + 9/8 * x * M'8 + 1/8 * x^2 * M''8
+ ! y8 = y1 + 4
+ ! bP4=(y0**7)/2688.-(4-y0)*(y0**6)/640.+((4-y0)**2)*(y0**5)/960
+ bP4=(y0**5)*(y0*(y0/336. - 7./480.) + 1./60.)
+ ! bM3=(1-y0)**7/2688.-(y0+3)*(1-y0)**6/640.+(y0+3)**2*(1-y0)**5/960
+ bM3=y0*(y0*(y0*(y0*(y0*(y0*(-y0/336. + 1./160.) + 1./120.) &
+ & - 1./32.) + 1./48.) + 1./96.) - 1./60.) + 17./3360.
+ ! bP3=(y0+1)**7/2688.-(3-y0)*(y0+1)**6/640.+(3-y0)**2*(y0+1)**5/960
+ ! -y0**7/336+(3-y0)*y0**6/80.-(3-y0)**2*y0**5/120.
+ bP3=y0*(y0*(y0*(y0*(y0*(y0*(-y0/48. + 3./32.) - 1./12.) &
+ & - 1./32.) - 1./48.) + 1./96.) + 1./60.) + 17./3360.
+ ! bM2=(2-y0)**7/2688.-(y0+2)*(2-y0)**6/640.+(y0+2)**2*(2-y0)**5/960
+ ! -xx2**7/336+(y0+2)*xx2**6/80.-(y0+2)**2*xx2**5/120.
+ bM2=y0*(y0*(y0*(y0*(y0*(y0*(y0/48. - 5./96.) - 1./24.) &
+ & + 11./48.) - 1./6.) - 5./48.) + 3./20.) - 17./560.
+ ! bP2=(y0+2)**7/2688.-(2-y0)*(y0+2)**6/640.+(2-y0)**2*(y0+2)**5/960
+ ! -(y0+1)**7/336+(2-y0)*(y0+1)**6/80.-(2-y0)**2*(y0+1)**5/120.
+ ! +y0**7/96.-7.*(2-y0)*y0**6/160.+7.*(2-y0)**2*y0**5/240.
+ bP2=y0*(y0*(y0*(y0*(y0*(y0*(y0/16. - 41./160.) + 19./120.) &
+ & + 11./48.) + 1./6.) - 5./48.) - 3./20.) - 17./560.
+ ! bM=(3-y0)**7/2688.-(y0+1)*(3-y0)**6/640.+(y0+1)**2*(3-y0)**5/960
+ ! -(2-y0)**7/336+(y0+1)*(2-y0)**6/80.-(y0+1)**2*(2-y0)**5/120.
+ ! +(1-y0)**7/96.-7.*(y0+1)*(1-y0)**6/160.+7.*(y0+1)**2*(1-y0)**5/240.
+ bM=y0*(y0*(y0*(y0*(y0*(y0*(-y0/16. + 29./160.) + 1./15.) &
+ & - 61./96.) + 13./48.) + 79./96.) - 3./4.) + 17./224.
+ ! bP=(y0+3)**7/2688.-(1-y0)*(y0+3)**6/640.+(1-y0)**2*(y0+3)**5/960
+ ! -(y0+2)**7/336+(1-y0)*(y0+2)**6/80.-(1-y0)**2*(y0+2)**5/120.
+ ! +(y0+1)**7/96.-7.*(1-y0)*(y0+1)**6/160.+7.*(1-y0)**2*(y0+1)**5/240.
+ ! -y0**7/48.+7.*(1-y0)*y0**6/80.-7.*(1-y0)**2*y0**5/120.
+ ! bP=y0*(y0*(y0*(y0*(y0*(y0*(-5.*y0/48. + 37./96.) - 1./8.) &
+ ! & - 61./96.) - 13./48.) + 79./96.) + 3./4.) + 17./224.
+ ! See below : bP = 1 - (b0+bM+bP2+bM2+bP3+q7+bP4)
+ ! b0=(4-y0)**7/2688.-y0*(4-y0)**6/640.+y0**2*(4-y0)**5/960
+ ! -(3-y0)**7/336+y0*(3-y0)**6/80.-y0**2*(3-y0)**5/120.
+ ! +(2-y0)**7/96.-7.*y0*(2-y0)**6/160.+7.*y0**2*(2-y0)**5/240.
+ ! -(1-y0)**7/48.+7.*y0*(1-y0)**6/80.-7.*y0**2*(1-y0)**5/120.
+ b0=y0**2*((y0**2)*(y0**2*(5.*y0/48. - 11./32.) + 7./8.) &
+ & - 35./24.) + 151./168.
+
+ bP = 1. - bM3 - bM2 - bM - b0 - bP2 - bP3 - bP4
+
+ ! remeshing
+ j1 = modulo(j0-4,N(dir))+1 ! j0-3
+ buffer(j1) = buffer(j1) + sca*bM3
+ j1 = modulo(j0-3,N(dir))+1 ! j0-2
+ buffer(j1) = buffer(j1) + sca*bM2
+ j1 = modulo(j0-2,N(dir))+1 ! j0-1
+ buffer(j1) = buffer(j1) + sca*bM
+ j1 = modulo(j0-1,N(dir))+1 ! j0
+ buffer(j1) = buffer(j1) + sca*b0
+ j1 = modulo(j0,N(dir))+1 ! j0+1
+ buffer(j1) = buffer(j1) + sca*bP
+ j1 = modulo(j0+1,N(dir))+1 ! j0+2
+ buffer(j1) = buffer(j1) + sca*bP2
+ j1 = modulo(j0+2,N(dir))+1 ! j0+3
+ buffer(j1) = buffer(j1) + sca*bP3
+ j1 = modulo(j0+3,N(dir))+1 ! j0+4
+ buffer(j1) = buffer(j1) + sca*bP4
+
+end subroutine AC_remesh_Mprime8_array
+
+
+!> M'8 remeshing formula - version for array of pointer.
+!! @param[in] dir = current direction
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by the particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+subroutine AC_remesh_Mprime8_pter(pos_adim, sca, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ !Input/Ouput
+ real(WP), intent(in) :: pos_adim, sca
+ type(real_pter), dimension(:), intent(inout) :: buffer
+ ! Ohter local variables
+ integer :: j0 ! indice of the the nearest mesh points
+ real(WP) :: y0 ! adimensionned distance to mesh points
+ real(WP) :: bM, bM2, bM3, b0, bP, bP2, bP3, bP4 ! interpolation weight for the particles
+
+ ! Mesh point used in remeshing formula
+ j0 = floor(pos_adim)
+
+ ! Distance to mesh points
+ y0 = (pos_adim - dble(j0))
+
+ ! Interpolation weights
+ ! M'8 = 15/8*M8 + 9/8 * x * M'8 + 1/8 * x^2 * M''8
+ ! y8 = y1 + 4
+ ! bP4=(y0**7)/2688.-(4-y0)*(y0**6)/640.+((4-y0)**2)*(y0**5)/960
+ bP4=(y0**5)*(y0*(y0/336. - 7./480.) + 1./60.)
+ ! bM3=(1-y0)**7/2688.-(y0+3)*(1-y0)**6/640.+(y0+3)**2*(1-y0)**5/960
+ bM3=y0*(y0*(y0*(y0*(y0*(y0*(-y0/336. + 1./160.) + 1./120.) &
+ & - 1./32.) + 1./48.) + 1./96.) - 1./60.) + 17./3360.
+ ! bP3=(y0+1)**7/2688.-(3-y0)*(y0+1)**6/640.+(3-y0)**2*(y0+1)**5/960
+ ! -y0**7/336+(3-y0)*y0**6/80.-(3-y0)**2*y0**5/120.
+ bP3=y0*(y0*(y0*(y0*(y0*(y0*(-y0/48. + 3./32.) - 1./12.) &
+ & - 1./32.) - 1./48.) + 1./96.) + 1./60.) + 17./3360.
+ ! bM2=(2-y0)**7/2688.-(y0+2)*(2-y0)**6/640.+(y0+2)**2*(2-y0)**5/960
+ ! -xx2**7/336+(y0+2)*xx2**6/80.-(y0+2)**2*xx2**5/120.
+ bM2=y0*(y0*(y0*(y0*(y0*(y0*(y0/48. - 5./96.) - 1./24.) &
+ & + 11./48.) - 1./6.) - 5./48.) + 3./20.) - 17./560.
+ ! bP2=(y0+2)**7/2688.-(2-y0)*(y0+2)**6/640.+(2-y0)**2*(y0+2)**5/960
+ ! -(y0+1)**7/336+(2-y0)*(y0+1)**6/80.-(2-y0)**2*(y0+1)**5/120.
+ ! +y0**7/96.-7.*(2-y0)*y0**6/160.+7.*(2-y0)**2*y0**5/240.
+ bP2=y0*(y0*(y0*(y0*(y0*(y0*(y0/16. - 41./160.) + 19./120.) &
+ & + 11./48.) + 1./6.) - 5./48.) - 3./20.) - 17./560.
+ ! bM=(3-y0)**7/2688.-(y0+1)*(3-y0)**6/640.+(y0+1)**2*(3-y0)**5/960
+ ! -(2-y0)**7/336+(y0+1)*(2-y0)**6/80.-(y0+1)**2*(2-y0)**5/120.
+ ! +(1-y0)**7/96.-7.*(y0+1)*(1-y0)**6/160.+7.*(y0+1)**2*(1-y0)**5/240.
+ bM=y0*(y0*(y0*(y0*(y0*(y0*(-y0/16. + 29./160.) + 1./15.) &
+ & - 61./96.) + 13./48.) + 79./96.) - 3./4.) + 17./224.
+ ! bP=(y0+3)**7/2688.-(1-y0)*(y0+3)**6/640.+(1-y0)**2*(y0+3)**5/960
+ ! -(y0+2)**7/336+(1-y0)*(y0+2)**6/80.-(1-y0)**2*(y0+2)**5/120.
+ ! +(y0+1)**7/96.-7.*(1-y0)*(y0+1)**6/160.+7.*(1-y0)**2*(y0+1)**5/240.
+ ! -y0**7/48.+7.*(1-y0)*y0**6/80.-7.*(1-y0)**2*y0**5/120.
+ ! bP=y0*(y0*(y0*(y0*(y0*(y0*(-5.*y0/48. + 37./96.) - 1./8.) &
+ ! & - 61./96.) - 13./48.) + 79./96.) + 3./4.) + 17./224.
+ ! See below : bP = 1 - (b0+bM+bP2+bM2+bP3+q7+bP4)
+ ! b0=(4-y0)**7/2688.-y0*(4-y0)**6/640.+y0**2*(4-y0)**5/960
+ ! -(3-y0)**7/336+y0*(3-y0)**6/80.-y0**2*(3-y0)**5/120.
+ ! +(2-y0)**7/96.-7.*y0*(2-y0)**6/160.+7.*y0**2*(2-y0)**5/240.
+ ! -(1-y0)**7/48.+7.*y0*(1-y0)**6/80.-7.*y0**2*(1-y0)**5/120.
+ b0=y0**2*((y0**2)*(y0**2*(5.*y0/48. - 11./32.) + 7./8.) &
+ & - 35./24.) + 151./168.
+
+ bP = 1. - bM3 - bM2 - bM - b0 - bP2 - bP3 - bP4
+
+ ! remeshing
+ buffer(j0-3)%pter = buffer(j0-3)%pter + sca*bM3
+ buffer(j0-2)%pter = buffer(j0-2)%pter + sca*bM2
+ buffer(j0-1)%pter = buffer(j0-1)%pter + sca*bM
+ buffer(j0 )%pter = buffer(j0 )%pter + sca*b0
+ buffer(j0+1)%pter = buffer(j0+1)%pter + sca*bP
+ buffer(j0+2)%pter = buffer(j0+2)%pter + sca*bP2
+ buffer(j0+3)%pter = buffer(j0+3)%pter + sca*bP3
+ buffer(j0+4)%pter = buffer(j0+4)%pter + sca*bP4
+
+end subroutine AC_remesh_Mprime8_pter
+
+
+end module advec_remeshing_Mprime
+!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_remesh_formula.f90 b/HySoP/src/scalesInterface/particles/advec_remesh_lambda.f90
similarity index 68%
rename from HySoP/src/scalesInterface/particles/advec_remesh_formula.f90
rename to HySoP/src/scalesInterface/particles/advec_remesh_lambda.f90
index 8395d0b0fc0a56c98544bc5491658b9c12ccdd9e..066394072bd83464e276f27384785cd9ca6a832b 100644
--- a/HySoP/src/scalesInterface/particles/advec_remesh_formula.f90
+++ b/HySoP/src/scalesInterface/particles/advec_remesh_lambda.f90
@@ -1,19 +1,31 @@
!> @addtogroup part
-!! @{
+
!------------------------------------------------------------------------------
!
+!
+! ===================================================================
+! ==================== Remesh particles ====================
+! ===================================================================
+!
! MODULE: advec_remeshing_formula
!
!
-! DESCRIPTION:
-!> This module gathers all the remeshing formula. These interpolation
-!!polynom allow to re-distribute particles on mesh grid at each
+! DESCRIPTION:
+!> This module gathers all the remeshing formula of type "corrected lambda".
+!! These interpolation polynoms allow to re-distribute particles on mesh grid at each
!! iterations.
!! @details
-!! It provides lambda 2 corrected, lambda 4 corrected and M'6 remeshing formula.
-!! The remeshing of type "lambda corrected" are design for large time
-!! step. The M'6 formula appears as being stable for large time step, but
-!! the numerical analysis remains todo.
+!! It provides lambda 2 corrected, lambda 4 corrected and limited lambda 2
+!! corrected.
+!! The remeshing of type "lambda corrected" are design for large time
+!! step. They are based on lambda formula. The stability condition does not
+!! involve the CFL number but only the velocity gradient:
+!! dt < constant*gradient(velocity)
+!! Note that such a remeshing formula involve different cases depending
+!! of variation of the local CFL number. Thus particle are gather by group
+!! and "if structure" (actually it is rather a "select case") is applied to
+!! avoid such an "if".
+!! each bloc to match to the right case. Only M' formula (see advec_remesh_Mprime)
!! This module also provide some wraper to remesh a complete line
!! of particles (with the different formula) and to do it either on a
!! array or into a array of pointer to reals. In order to gather
@@ -26,10 +38,9 @@
!
!------------------------------------------------------------------------------
-module advec_remeshing_formula
+module advec_remeshing_lambda
- use precision
- use string
+ use structure_tools
use advec_common_line
implicit none
@@ -39,39 +50,36 @@ module advec_remeshing_formula
! #############################
! ===== Public procedures =====
- ! To get the right "line remeshing" wrapper
- public :: AC_remesh_get_pointer
! "Line remeshing" wrapper (they remesh a complete line of particle using
! the adapted interpolation polynom)
+ procedure(AC_remesh_lambda2corrected_array), pointer, public :: AC_remesh_lambda_array => null() !> Generic wrapper to remesh a line of particle into an array of real
+ procedure(AC_remesh_lambda2corrected_pter) , pointer, public :: AC_remesh_lambda_pter => null() !> Generic wrapper to remesh a line of particle into an array of pointer
+ ! Line remeshing for each corrected lambda scheme.
public :: AC_remesh_lambda2corrected_pter
public :: AC_remesh_lambda4corrected_pter
public :: AC_remesh_lambda2corrected_array
public :: AC_remesh_lambda4corrected_array
- procedure(AC_remesh_lambda2corrected_array), pointer, public :: AC_remesh_lambda_array => null()
- !public :: AC_remesh_Mprime6_pter
- !----- Order 2 remeshing formula -----
- public :: AC_remesh_left ! left remeshing formula
- public :: AC_remesh_center ! centered remeshing formula
- public :: AC_remesh_tag_CL ! corrected formula for tagged particles : transition from C to L block.
- public :: AC_remesh_tag_LC ! corrected formula for tagged particles : transition from L to C block
- !----- Order 4 remeshing formula -----
- public :: AC_remesh_O4_left ! left remeshing formula
- public :: AC_remesh_O4_center ! centered remeshing formula
- public :: AC_remesh_O4_tag_CL ! corrected formula for tagged particles : transition from C to L block.
- public :: AC_remesh_O4_tag_LC ! corrected formula for tagged particles : transition from L to C block
- !----- M'6 remeshing formula -----
- public :: AC_remesh_Mprime6 ! use 6 grid point, 3 for each side of the particle.
- public :: AC_remesh_Mprime6_pter ! use 6 grid point, 3 for each side of the particle.
+ ! To get the right "line remeshing" wrapper
+! !public :: AC_remesh_get_pointer
! ===== Private procedures =====
!----- Order 2 remeshing formula -----
- private :: AC_remesh_left_array ! left remeshing formula
- private :: AC_remesh_left_pter ! left remeshing formula
- private :: AC_remesh_center_array ! centered remeshing formula
- private :: AC_remesh_center_pter ! left remeshing formula
+ ! Interface
+ private :: AC_remesh_O2 ! lambda 2 remeshing formula (for left or center block - no correction)
+ private :: AC_remesh_tag_CL ! corrected formula for tagged particles : transition from C to L block.
+ private :: AC_remesh_tag_LC ! corrected formula for tagged particles : transition from L to C block
+ ! Function used by the interfaces
+ private :: AC_remesh_O2_array ! lambda 2 remeshing formula (for left or center block - no correction)
+ private :: AC_remesh_O2_pter ! lambda 2 remeshing formula (for left or center block - no correction)
private :: AC_remesh_tag_CL_array ! corrected formula for tagged particles : transition from C to L block.
private :: AC_remesh_tag_CL_pter ! corrected formula for tagged particles : transition from C to L block.
!----- Order 4 remeshing formula -----
+ ! Interface
+ private :: AC_remesh_O4_left ! left remeshing formula
+ private :: AC_remesh_O4_center ! centered remeshing formula
+ private :: AC_remesh_O4_tag_CL ! corrected formula for tagged particles : transition from C to L block.
+ private :: AC_remesh_O4_tag_LC ! corrected formula for tagged particles : transition from L to C block
+ ! Function used by the interfaces
private :: AC_remesh_O4_left_array ! left remeshing formula - array of real
private :: AC_remesh_O4_left_pter ! left remeshing formula - array of pointer
private :: AC_remesh_O4_center_array! centered remeshing formula
@@ -81,24 +89,16 @@ module advec_remeshing_formula
private :: AC_remesh_O4_tag_LC_array! corrected formula for tagged particles : transition from L to C block
private :: AC_remesh_O4_tag_LC_pter ! corrected formula for tagged particles : transition from L to C block
-! XXX Si passage au fortran 2003 : basculer toutes ces variables dans le module
-! advec (fichier advec.F90) et mettre toutes les variables en protected.
-! Seul la procédure "advec_init" doit pouvoir les modifier, mais de nombreuses
-! procédures doivent pouvoir y accéder.
!===== Interface =====
! -- Order 2: array of real or of pointer --
interface AC_remesh_lambda2corrected
module procedure AC_remesh_lambda2corrected_pter, AC_remesh_lambda2corrected_array
end interface AC_remesh_lambda2corrected
-
- interface AC_remesh_left
- module procedure AC_remesh_left_pter, AC_remesh_left_array
- end interface AC_remesh_left
- interface AC_remesh_center
- module procedure AC_remesh_center_pter, AC_remesh_center_array
- end interface AC_remesh_center
+ interface AC_remesh_O2
+ module procedure AC_remesh_O2_pter, AC_remesh_O2_array
+ end interface AC_remesh_O2
interface AC_remesh_tag_CL
module procedure AC_remesh_tag_CL_pter, AC_remesh_tag_CL_array
@@ -129,13 +129,30 @@ module advec_remeshing_formula
module procedure AC_remesh_O4_tag_LC_pter, AC_remesh_O4_tag_LC_array
end interface AC_remesh_O4_tag_LC
+ ! -- Order 2 with limitator: array of real or of pointer --
+ !interface AC_remesh_lambda2corrected
+ ! module procedure AC_remesh_lambda2corrected_pter, AC_remesh_lambda2corrected_array
+ !end interface AC_remesh_lambda2corrected
+
+ interface AC_remesh_limitO2
+ module procedure AC_remesh_limitO2_pter, AC_remesh_limitO2_array
+ end interface AC_remesh_limitO2
+
+ interface AC_remesh_limitO2_tag_CL
+ module procedure AC_remesh_limitO2_tag_CL_pter, AC_remesh_limitO2_tag_CL_array
+ end interface AC_remesh_limitO2_tag_CL
+
+ interface AC_remesh_limitO2_tag_LC
+ module procedure AC_remesh_limitO2_tag_LC_pter, AC_remesh_limitO2_tag_LC_array
+ end interface AC_remesh_limitO2_tag_LC
! ===== Abstract procedure =====
! --- Abstract profile of subroutine used to remesh a line of particles ---
! Variant: the buffer is an array of pointer (and not a pointer to an array)
abstract interface
subroutine AC_remesh_line_pter(direction, p_pos_adim, scal1D, bl_type, bl_tag, ind_min, buffer)
- use precision
+ use structure_tools
+ ! use precision_tools ! already include in structure tools
use advec_variables
implicit none
@@ -153,15 +170,14 @@ module advec_remeshing_formula
contains
-! ===================================================================
-! ==================== Remesh particles ====================
-! ===================================================================
-! ===================================================================
-! ============ Pointer to the right remesh formula ===========
-! ===================================================================
+! ###################################################################
+! ############ ###########
+! ############ Pointer to the right remesh formula ###########
+! ############ ###########
+! ###################################################################
-subroutine AC_remesh_get_pointer(pointer)
+subroutine AC_remesh_get_lambda(pointer)
use advec_variables ! solver context
@@ -174,26 +190,30 @@ subroutine AC_remesh_get_pointer(pointer)
pointer => AC_remesh_lambda2corrected_pter
end select
-end subroutine AC_remesh_get_pointer
+end subroutine AC_remesh_get_lambda
-subroutine AC_remesh_init_array_pt()
+subroutine AC_remesh_init_lambda()
- use advec_variables ! solver context
+ use advec_variables ! solver cntext
select case(trim(type_solv))
case ('p_O4')
AC_remesh_lambda_array => AC_remesh_lambda4corrected_array
+ AC_remesh_lambda_pter => AC_remesh_lambda4corrected_pter
case default
AC_remesh_lambda_array => AC_remesh_lambda2corrected_array
+ AC_remesh_lambda_pter => AC_remesh_lambda2corrected_pter
end select
-end subroutine AC_remesh_init_array_pt
+end subroutine AC_remesh_init_lambda
-! ===================================================================
-! ============ Wrapper to remesh a complete line ===========
-! ===================================================================
+! ###################################################################
+! ############ ###########
+! ############ Wrapper to remesh a complete line ###########
+! ############ ###########
+! ###################################################################
!> Remesh particle line with corrected lambda 2 formula - remeshing is done into
!! an array of pointer to real
@@ -203,10 +223,9 @@ end subroutine AC_remesh_init_array_pt
!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
!! @param[in] bl_tag = contains information about bloc (is it tagged ?)
!! @param[in] ind_min = minimal indice of the send buffer
-!! @param[in] ind_max = maximal indice of the send buffer
!! @param[in, out] send_buffer = array of pointers to the buffer use to remesh the scalar before to send it to the right subdomain
!! @details
-!! Use corrected lambda 2 remeshing formula.
+!! Use corrected lambda 2 remeshing formula.
!! This remeshing formula depends on the particle type :
!! 1 - Is the particle tagged ?
!! 2 - Does it belong to a centered or a left block ?
@@ -255,20 +274,10 @@ subroutine AC_remesh_lambda2corrected_pter(direction, p_pos_adim, scal1D, bl_typ
call AC_remesh_tag_LC(pos_translat(p_ind), scal1D(p_ind), pos_translat(p_ind+1), scal1D(p_ind+1), send_buffer)
end if
else
- if (bl_type(bl_ind)) then
- ! First particle is remeshed with center formula
- call AC_remesh_center(pos_translat(p_ind),scal1D(p_ind), send_buffer)
- else
- ! First particle is remeshed with left formula
- call AC_remesh_left(pos_translat(p_ind),scal1D(p_ind), send_buffer)
- end if
- if (bl_type(bl_ind+1)) then
- ! Second particle is remeshed with center formula
- call AC_remesh_center(pos_translat(p_ind+1),scal1D(p_ind+1), send_buffer)
- else
- ! Second particle is remeshed with left formula
- call AC_remesh_left(pos_translat(p_ind+1),scal1D(p_ind+1), send_buffer)
- end if
+ ! First particle
+ call AC_remesh_O2(pos_translat(p_ind),scal1D(p_ind), bl_type(bl_ind), send_buffer)
+ ! Second particle is remeshed with left formula
+ call AC_remesh_O2(pos_translat(p_ind+1),scal1D(p_ind+1), bl_type(bl_ind+1), send_buffer)
end if
end do
@@ -284,7 +293,7 @@ end subroutine AC_remesh_lambda2corrected_pter
!! @param[in] bl_tag = contains information about bloc (is it tagged ?)
!! @param[in, out] remesh_buffer= buffer use to remesh the scalar
!! @details
-!! Use corrected lambda 2 remeshing formula.
+!! Use corrected lambda 2 remeshing formula.
!! This remeshing formula depends on the particle type :
!! 1 - Is the particle tagged ?
!! 2 - Does it belong to a centered or a left block ?
@@ -293,7 +302,7 @@ end subroutine AC_remesh_lambda2corrected_pter
!! tagged too.
!! The following algorithm is write for block of minimal size.
!! @author = Jean-Baptiste Lagaert, LEGI/Ljk
-subroutine ac_remesh_lambda2corrected_array(direction, p_pos_adim, scal1d, bl_type, bl_tag, remesh_buffer)
+subroutine AC_remesh_lambda2corrected_array(direction, p_pos_adim, scal1d, bl_type, bl_tag, remesh_buffer)
use cart_topology ! description of mesh and of mpi topology
use advec_variables ! contains info about solver parameters and others.
@@ -323,28 +332,16 @@ subroutine ac_remesh_lambda2corrected_array(direction, p_pos_adim, scal1d, bl_ty
! XXX Debug - end
if (bl_type(bl_ind)) then
! tagged, the first particle belong to a centered block and the last to left block.
- call AC_remesh_tag_CL(direction, p_pos_adim(p_ind), scal1D(p_ind), p_pos_adim(p_ind+1), &
- scal1D(p_ind+1), remesh_buffer)
+ call AC_remesh_tag_CL(direction, p_pos_adim(p_ind), scal1D(p_ind), p_pos_adim(p_ind+1), scal1D(p_ind+1), remesh_buffer)
else
! tagged, the first particle belong to a left block and the last to centered block.
- call AC_remesh_tag_LC(direction, p_pos_adim(p_ind), scal1D(p_ind), p_pos_adim(p_ind+1), &
- scal1D(p_ind+1), remesh_buffer)
+ call AC_remesh_tag_LC(direction, p_pos_adim(p_ind), scal1D(p_ind), p_pos_adim(p_ind+1), scal1D(p_ind+1), remesh_buffer)
end if
else
- if (bl_type(bl_ind)) then
- ! First particle is remeshed with center formula
- call AC_remesh_center(direction, p_pos_adim(p_ind),scal1D(p_ind), remesh_buffer)
- else
- ! First particle is remeshed with left formula
- call AC_remesh_left(direction, p_pos_adim(p_ind),scal1D(p_ind), remesh_buffer)
- end if
- if (bl_type(bl_ind+1)) then
- ! Second particle is remeshed with center formula
- call AC_remesh_center(direction, p_pos_adim(p_ind+1),scal1D(p_ind+1), remesh_buffer)
- else
- ! Second particle is remeshed with left formula
- call AC_remesh_left(direction, p_pos_adim(p_ind+1),scal1D(p_ind+1), remesh_buffer)
- end if
+ ! First particle
+ call AC_remesh_O2(direction, p_pos_adim(p_ind),scal1D(p_ind), bl_type(bl_ind), remesh_buffer)
+ ! Second particle is remeshed with left formula
+ call AC_remesh_O2(direction, p_pos_adim(p_ind+1),scal1D(p_ind+1), bl_type(bl_ind+1), remesh_buffer)
end if
end do
@@ -359,7 +356,7 @@ end subroutine AC_remesh_lambda2corrected_array
!! @param[in] bl_tag = contains information about bloc (is it tagged ?)
!! @param[in, out] remesh_buffer = buffer use to remesh the scalar before to send it to the right subdomain
!! @details
-!! Use corrected lambda 2 remeshing formula.
+!! Use corrected lambda 2 remeshing formula.
!! This remeshing formula depends on the particle type :
!! 1 - Is the particle tagged ?
!! 2 - Does it belong to a centered or a left block ?
@@ -386,7 +383,7 @@ subroutine AC_remesh_lambda4corrected_array(direction, p_pos_adim, scal1D, bl_ty
do p_ind = 1, N_proc(direction), bl_size
bl_ind = p_ind/bl_size + 1
- if (bl_tag(bl_ind)) then
+ if (bl_tag(bl_ind)) then
! Tagged case
if (bl_type(bl_ind)) then
! tagged, the first particle belong to a centered block and the last to left block.
@@ -399,14 +396,14 @@ subroutine AC_remesh_lambda4corrected_array(direction, p_pos_adim, scal1D, bl_ty
end if
else
! No tag
- if (bl_type(bl_ind)) then
+ if (bl_type(bl_ind)) then
call AC_remesh_O4_center(direction, p_pos_adim(p_ind),scal1D(p_ind), remesh_buffer)
call AC_remesh_O4_center(direction, p_pos_adim(p_ind+1),scal1D(p_ind+1), remesh_buffer)
else
call AC_remesh_O4_left(direction, p_pos_adim(p_ind),scal1D(p_ind), remesh_buffer)
call AC_remesh_O4_left(direction, p_pos_adim(p_ind+1),scal1D(p_ind+1), remesh_buffer)
end if
- if (bl_type(bl_ind+1)) then
+ if (bl_type(bl_ind+1)) then
call AC_remesh_O4_center(direction, p_pos_adim(p_ind+2),scal1D(p_ind+2), remesh_buffer)
call AC_remesh_O4_center(direction, p_pos_adim(p_ind+3),scal1D(p_ind+3), remesh_buffer)
else
@@ -428,7 +425,7 @@ end subroutine AC_remesh_lambda4corrected_array
!! @param[in] ind_min = minimal indice of the send buffer
!! @param[in, out] remesh_buffer = array of pointer to the buffer use to locally remesh the scalar
!! @details
-!! Use corrected lambda 4 remeshing formula.
+!! Use corrected lambda 4 remeshing formula.
!! This remeshing formula depends on the particle type :
!! 1 - Is the particle tagged ?
!! 2 - Does it belong to a centered or a left block ?
@@ -459,7 +456,7 @@ subroutine AC_remesh_lambda4corrected_pter(direction, p_pos_adim, scal1D, bl_typ
do p_ind = 1, N_proc(direction), bl_size
bl_ind = p_ind/bl_size + 1
- if (bl_tag(bl_ind)) then
+ if (bl_tag(bl_ind)) then
! Tagged case
if (bl_type(bl_ind)) then
! tagged, the first particle belong to a centered block and the last to left block.
@@ -472,14 +469,14 @@ subroutine AC_remesh_lambda4corrected_pter(direction, p_pos_adim, scal1D, bl_typ
end if
else
! No tag
- if (bl_type(bl_ind)) then
+ if (bl_type(bl_ind)) then
call AC_remesh_O4_center(pos_translat(p_ind),scal1D(p_ind), remesh_buffer)
call AC_remesh_O4_center(pos_translat(p_ind+1),scal1D(p_ind+1), remesh_buffer)
else
call AC_remesh_O4_left(pos_translat(p_ind),scal1D(p_ind), remesh_buffer)
call AC_remesh_O4_left(pos_translat(p_ind+1),scal1D(p_ind+1), remesh_buffer)
end if
- if (bl_type(bl_ind+1)) then
+ if (bl_type(bl_ind+1)) then
call AC_remesh_O4_center(pos_translat(p_ind+2),scal1D(p_ind+2), remesh_buffer)
call AC_remesh_O4_center(pos_translat(p_ind+3),scal1D(p_ind+3), remesh_buffer)
else
@@ -491,31 +488,196 @@ subroutine AC_remesh_lambda4corrected_pter(direction, p_pos_adim, scal1D, bl_typ
end subroutine AC_remesh_lambda4corrected_pter
-! =========================================================================
-! ============ Interpolation polynom used for remeshing ============
-! =========================================================================
-!> Left remeshing formula of order 2
+!> Remesh particle line with corrected and limited lambda 2 formula - remeshing is done into
+!! an array of pointer to real
+!! @param[in] direction = current direction (1 = along X, 2 = along Y and 3 = along Z)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] scal1D = scalar field to advect
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
+!! @param[in] bl_tag = contains information about bloc (is it tagged ?)
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
+!! @param[in] ind_min = minimal indice of the send buffer
+!! @param[in, out] send_buffer = array of pointers to the buffer use to remesh the scalar before to send it to the right subdomain
+!! @details
+!! Use corrected lambda 2 remeshing formula.
+!! This remeshing formula depends on the particle type :
+!! 1 - Is the particle tagged ?
+!! 2 - Does it belong to a centered or a left block ?
+!! Observe that tagged particles go by group of two : if the particles of a
+!! block end are tagged, the one first one of the following block are
+!! tagged too.
+!! The following algorithm is write for block of minimal size.
+!! Note that instead of the value of the limitator function, it is actually
+!! these values divided by 8 wich are given as arguments. As the limitator function
+!! always appear divided by 8 in the remeshing polynom, perform this division
+!! during the computation of the limitator function enhances the performances.
+!! @author = Jean-Baptiste Lagaert, LEGI/Ljk
+subroutine AC_remesh_lambda2limited_pter(direction, p_pos_adim, scal1D, bl_type, bl_tag, ind_min, limit, send_buffer)
+
+ use cart_topology ! Description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Output
+ integer, intent(in) :: direction
+ real(WP), dimension(:), intent(in) :: p_pos_adim
+ real(WP), dimension(:), intent(in) :: scal1D
+ real(WP), dimension(:), intent(in) :: limit
+ logical, dimension(:), intent(in) :: bl_type
+ logical, dimension(:), intent(in) :: bl_tag
+ integer, intent(in) :: ind_min
+ type(real_pter), dimension(:), intent(inout) :: send_buffer
+ ! Other local variables
+ integer :: bl_ind ! indice of the current "block end".
+ integer :: p_ind ! indice of the current particle
+ real(WP), dimension(N_proc(direction)) :: pos_translat ! translation of p_pos_adim as array indice are now starting from 1 and not ind_min
+
+ pos_translat = p_pos_adim - ind_min + 1
+
+ do p_ind = 1, N_proc(direction), bl_size
+ bl_ind = p_ind/bl_size + 1
+ if (bl_tag(bl_ind)) then
+ ! Tag case
+ ! XXX Debug : to activate only in purpose debug
+ !if (bl_type(ind).neqv. (.not. bl_type(ind+1))) then
+ ! write(*,'(a,x,3(L1,x),a,3(i0,a))'), 'error on remeshing particles: (tag,type(i), type(i+1)) =', &
+ ! & bl_tag(ind), bl_type(ind), bl_type(ind+1), ' and type must be different. Mesh point = (',i, ', ', j,', ',k,')'
+ ! write(*,'(a,x,i0)'), 'paramètres du blocs : ind =', bl_ind
+ ! stop
+ !end if
+ ! XXX Debug - end
+ if (bl_type(bl_ind)) then
+ ! tagged, the first particle belong to a centered block and the last to left block.
+ call AC_remesh_limitO2_tag_CL(pos_translat(p_ind), scal1D(p_ind), pos_translat(p_ind+1), &
+ & scal1D(p_ind+1), limit(p_ind:p_ind+2), send_buffer)
+ else
+ ! tagged, the first particle belong to a left block and the last to centered block.
+ call AC_remesh_limitO2_tag_LC(pos_translat(p_ind), scal1D(p_ind), pos_translat(p_ind+1), &
+ & scal1D(p_ind+1), limit(p_ind:p_ind+2), send_buffer)
+ end if
+ else
+ ! First particle
+ call AC_remesh_limitO2(pos_translat(p_ind),scal1D(p_ind), bl_type(bl_ind), limit(p_ind:p_ind+1), send_buffer)
+ ! Second particle is remeshed with left formula
+ call AC_remesh_limitO2(pos_translat(p_ind+1),scal1D(p_ind+1), bl_type(bl_ind+1), limit(p_ind+1:p_ind+2), send_buffer)
+ end if
+ end do
+
+end subroutine AC_remesh_lambda2limited_pter
+
+
+!> Remesh particle line with corrected lambda 2 formula - remeshing is done into
+!! an real array - no communication variant (buffer does not have the same size)
+!! @param[in] direction = current direction (1 = along X, 2 = along Y and 3 = along Z)
+!! @param[in] p_pos_adim = adimensionned particles position
+!! @param[in] scal1D = scalar field to advect
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
+!! @param[in] bl_tag = contains information about bloc (is it tagged ?)
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
+!! @param[in, out] remesh_buffer= buffer use to remesh the scalar
+!! @details
+!! Use corrected lambda 2 remeshing formula.
+!! This remeshing formula depends on the particle type :
+!! 1 - Is the particle tagged ?
+!! 2 - Does it belong to a centered or a left block ?
+!! Observe that tagged particles go by group of two : if the particles of a
+!! block end are tagged, the one first one of the following block are
+!! tagged too.
+!! The following algorithm is write for block of minimal size.
+!! Note that instead of the value of the limitator function, it is actually
+!! these values divided by 8 wich are given as arguments. As the limitator function
+!! always appear divided by 8 in the remeshing polynom, perform this division
+!! during the computation of the limitator function enhances the performances.
+!! @author = Jean-Baptiste Lagaert, LEGI/Ljk
+subroutine AC_remesh_lambda2limited_array(direction, p_pos_adim, scal1d, bl_type, bl_tag, limit, remesh_buffer)
+
+ use cart_topology ! description of mesh and of mpi topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! input/output
+ integer, intent(in) :: direction
+ real(wp), dimension(:), intent(in) :: p_pos_adim
+ real(wp), dimension(n_proc(direction)), intent(in) :: scal1d
+ real(WP), dimension(:), intent(in) :: limit
+ logical, dimension(:), intent(in) :: bl_type
+ logical, dimension(:), intent(in) :: bl_tag
+ real(wp), dimension(:), intent(inout) :: remesh_buffer
+ ! Other local variables
+ integer :: bl_ind ! indice of the current "block end".
+ integer :: p_ind ! indice of the current particle
+
+ do p_ind = 1, N_proc(direction), bl_size
+ bl_ind = p_ind/bl_size + 1
+ if (bl_tag(bl_ind)) then
+ ! Tag case
+ ! XXX Debug : to activate only in purpose debug
+ !if (bl_type(ind).neqv. (.not. bl_type(ind+1))) then
+ ! write(*,'(a,x,3(L1,x),a,3(i0,a))'), 'error on remeshing particles: (tag,type(i), type(i+1)) =', &
+ ! & bl_tag(ind), bl_type(ind), bl_type(ind+1), ' and type must be different. Mesh point = (',i, ', ', j,', ',k,')'
+ ! write(*,'(a,x,i0)'), 'paramètres du blocs : ind =', bl_ind
+ ! stop
+ !end if
+ ! XXX Debug - end
+ if (bl_type(bl_ind)) then
+ ! tagged, the first particle belong to a centered block and the last to left block.
+ call AC_remesh_limitO2_tag_CL(direction, p_pos_adim(p_ind), scal1D(p_ind), p_pos_adim(p_ind+1), &
+ & scal1D(p_ind+1), limit(p_ind:p_ind+2), remesh_buffer)
+ else
+ ! tagged, the first particle belong to a left block and the last to centered block.
+ call AC_remesh_limitO2_tag_LC(direction, p_pos_adim(p_ind), scal1D(p_ind), p_pos_adim(p_ind+1), &
+ & scal1D(p_ind+1), limit(p_ind:p_ind+2), remesh_buffer)
+ end if
+ else
+ ! First particle
+ call AC_remesh_limitO2(direction, p_pos_adim(p_ind),scal1D(p_ind), bl_type(bl_ind), limit(p_ind:p_ind+1), remesh_buffer)
+ ! Second particle is remeshed with left formula
+ call AC_remesh_limitO2(direction, p_pos_adim(p_ind+1),scal1D(p_ind+1), bl_type(bl_ind+1), limit(p_ind+1:p_ind+2), remesh_buffer)
+ end if
+ end do
+
+end subroutine AC_remesh_lambda2limited_array
+
+
+! #########################################################################
+! ############ ###########
+! ############ Interpolation polynom used for remeshing ###########
+! ############ ###########
+! #########################################################################
+
+! ============================================================
+! ============ Lambda 2 corrected formula ============
+! ============================================================
+
+!> (center or left) lambda remeshing formula of order 2 - version for classical array
!! @param[in] dir = current direction
!! @param[in] pos_adim= adimensionned particle position
!! @param[in] sca = scalar advected by the particle
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
!! @param[in,out] buffer = temporaly remeshed scalar field
-subroutine AC_remesh_left_array(dir, pos_adim, sca, buffer)
+subroutine AC_remesh_O2_array(dir, pos_adim, sca, bl_type, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
-
+
!Input/Ouput
real(WP), intent(in) :: pos_adim, sca
integer, intent(in) :: dir
+ logical, intent(in) :: bl_type
real(WP), dimension(:), intent(inout) :: buffer
! Ohter local variables
integer :: j0, j1 ! indice of the the nearest mesh points
real(WP) :: bM, b0, bP ! interpolation weight for the particles
real(WP) :: y0 ! adimensionned distance to mesh points
+
! Mesh point used in remeshing formula
- j0 = floor(pos_adim)
-
+ if (bl_type) then
+ ! Center remeshing
+ j0 = nint(pos_adim)
+ else
+ ! Left remeshing
+ j0 = floor(pos_adim)
+ end if
+
! Distance to mesh points
y0 = (pos_adim - dble(j0))
@@ -533,78 +695,350 @@ subroutine AC_remesh_left_array(dir, pos_adim, sca, buffer)
j1 = modulo(j0,N(dir))+1 ! j0+1
buffer(j1) = buffer(j1) + bP*sca
-end subroutine AC_remesh_left_array
+end subroutine AC_remesh_O2_array
+
+
+!> (center or left) lambda remeshing formula of order 2 - version for array of pointer
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by the particle
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
+!! @param[in,out] buffer = temporaly remeshed scalar field
+subroutine AC_remesh_O2_pter(pos_adim, sca, bl_type, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ !Input/Ouput
+ real(WP), intent(in) :: pos_adim, sca
+ logical, intent(in) :: bl_type
+ type(real_pter), dimension(:), intent(inout) :: buffer
+ ! Ohter local variables
+ integer :: j0 ! indice of the the nearest mesh points
+ real(WP) :: bM, b0, bP ! interpolation weight for the particles
+ real(WP) :: y0 ! adimensionned distance to mesh points
+
+ ! Mesh point used in remeshing formula
+ if (bl_type) then
+ ! Center remeshing
+ j0 = nint(pos_adim)
+ else
+ ! Left remeshing
+ j0 = floor(pos_adim)
+ end if
+
+ ! Distance to mesh points
+ y0 = (pos_adim - dble(j0))
+
+ ! Interpolation weights
+ bM=0.5*y0*(y0-1.)
+ b0=1.-y0**2
+ !bP=0.5*y0*(y0+1.)
+ bP=1. - (b0+bM)
+
+ ! remeshing
+ buffer(j0-1)%pter = buffer(j0-1)%pter + bM*sca
+ buffer(j0)%pter = buffer(j0)%pter + b0*sca
+ buffer(j0+1)%pter = buffer(j0+1)%pter + bP*sca
+
+end subroutine AC_remesh_O2_pter
+
+
+!> Corrected remeshing formula for transition from Centered block to a Left block with a different indice (tagged particles)
+!! @param[in] dir = current direction
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by this particle
+!! @param[in] posP_ad = adimensionned position of the second particle
+!! @param[in] scaP = scalar advected by this particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+!! @detail
+!! Remeshing formula devoted to tagged particles.
+!! The particle group send into argument is composed of a block end and of the
+!! begining of the next block. The first particles belong to a centered block
+!! and the last to a left one. The block have difference indice (tagged
+!! particles) and we have to use corrected formula.
+subroutine AC_remesh_tag_CL_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Output
+ integer, intent(in) :: dir
+ real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ real(WP), dimension(:), intent(inout) :: buffer
+ ! Other local variables
+ integer :: jM, j0, jP ! indice of the the nearest mesh points
+ ! (they depend on the block type)
+ integer :: j0_bis ! indice of the the nearest mesh point for the indP=ind+1 particle
+ real(WP) :: aM, a0, bP, b0 ! interpolation weight for the particles
+ real(WP) :: y0, y0_bis ! adimensionned distance to mesh points
+
+ j0 = nint(pos_adim)
+ !j0 = nint(pos/d_sc(2))
+ j0_bis = floor(posP_ad)
+ !j0_bis = floor(posP/d_sc(2))
+
+ y0 = (pos_adim - dble(j0))
+ !y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
+ y0_bis = (posP_ad - dble(j0_bis))
+ !y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
+
+ aM=0.5*y0*(y0-1)
+ a0=1.-aM
+ bP=0.5*y0_bis*(y0_bis+1.)
+ b0=1.-bP
+
+ ! Remeshing
+ jM = modulo(j0-2,N(dir))+1 ! j0-1
+ jP = modulo(j0,N(dir))+1 ! j0+1
+ j0 = modulo(j0-1,N(dir))+1 ! j0
+ buffer(jM)=buffer(jM)+aM*sca
+ buffer(j0)=buffer(j0)+a0*sca+b0*scaP
+ buffer(jP)=buffer(jP)+bP*scaP
+
+end subroutine AC_remesh_tag_CL_array
+
+
+!> Corrected remeshing formula for transition from Centered block to a Left block with a different indice (tagged particles)
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by this particle
+!! @param[in] posP_ad = adimensionned position of the second particle
+!! @param[in] scaP = scalar advected by this particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+!! @details
+!! Remeshing formula devoted to tagged particles.
+!! The particle group send into argument is composed of a block end and of the
+!! begining of the next block. The first particles belong to a centered block
+!! and the last to a left one. The block have difference indice (tagged
+!! particles) and we have to use corrected formula.
+subroutine AC_remesh_tag_CL_pter(pos_adim, sca, posP_ad, scaP, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Output
+ real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ type(real_pter), dimension(:), intent(inout) :: buffer
+ ! Other local variables
+ integer :: jM, j0, jP ! indice of the the nearest mesh points
+ ! (they depend on the block type)
+ integer :: j0_bis ! indice of the the nearest mesh point for the indP=ind+1 particle
+ real(WP) :: aM, a0, bP, b0 ! interpolation weight for the particles
+ real(WP) :: y0, y0_bis ! adimensionned distance to mesh points
+
+ j0 = nint(pos_adim)
+ !j0 = nint(pos/d_sc(2))
+ j0_bis = floor(posP_ad)
+ !j0_bis = floor(posP/d_sc(2))
+ jM=j0-1
+ jP=j0+1
+
+ y0 = (pos_adim - dble(j0))
+ !y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
+ y0_bis = (posP_ad - dble(j0_bis))
+ !y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
+
+ aM=0.5*y0*(y0-1)
+ a0=1.-aM
+ bP=0.5*y0_bis*(y0_bis+1.)
+ b0=1.-bP
+
+ ! Remeshing
+ buffer(jM)%pter=buffer(jM)%pter+aM*sca
+ buffer(j0)%pter=buffer(j0)%pter+a0*sca+b0*scaP
+ buffer(jP)%pter=buffer(jP)%pter+bP*scaP
+
+end subroutine AC_remesh_tag_CL_pter
+
+
+!> Corrected remeshing formula for transition from Left block to a Centered block with a different indice (tagged particles)
+!! @param[in] dir = current direction
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by this particle
+!! @param[in] posP_ad = adimensionned position of the second particle
+!! @param[in] scaP = scalar advected by this particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+!! @details
+!! Remeshing formula devoted to tagged particles.
+!! The particle group send into argument is composed of a block end and of the
+!! begining of the next block. The first particles belong to a left block
+!! and the last to a centered one. The block have difference indice (tagged
+!! particles) and we have to use corrected formula.
+subroutine AC_remesh_tag_LC_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
+
+ use cart_topology
+ use advec_variables ! contains info about solver parameters and others.
+
+ ! Input/Output
+ integer, intent(in) :: dir
+ real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ real(WP), dimension(:), intent(inout) :: buffer
+ ! Other local variables
+ integer :: jM, j0, jP, jP2, jP3 ! indice of the the nearest mesh points
+ ! (they depend on the block type)
+ integer :: j0_bis ! indice of the the nearest mesh point for the indP=ind+1 particle
+ real(WP) :: aM, a0, aP,aP2, b0, bP, bP2, bP3 ! interpolation weight for the particles
+ real(WP) :: y0, y0_bis ! adimensionned distance to mesh points
+
+
+ ! Indice of mesh point used in order to remesh
+ j0 = floor(pos_adim)
+ !j0 = floor(pos/d_sc(2))
+ j0_bis = nint(posP_ad)
+ !j0_bis = nint(posP/d_sc(2))
+ jM=j0-1
+ jP=j0+1
+ jP2=j0+2
+ jP3=j0+3
+
+ ! Distance to mesh point
+ y0 = (pos_adim - dble(j0))
+ !y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
+ y0_bis = (posP_ad - dble(j0_bis))
+ !y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
+
+ ! Interpolation weight
+ a0=1-y0**2
+ aP=y0
+ !aM=y0*yM/2.
+ aM = 0.5-(a0+aP)/2.
+ aP2=aM
+ bP=-y0_bis
+ bP2=1-y0_bis**2
+ !b0=y0_bis*yP_bis/2.
+ b0 = 0.5-(bP+bP2)/2.
+ bP3=b0
+
+ ! Remeshing
+ jM = modulo(j0-2,N(dir))+1 ! j0-1
+ jP = modulo(j0,N(dir))+1 ! j0+1
+ jP2= modulo(j0+1,N(dir))+1 ! j0+2
+ jP3= modulo(j0+2,N(dir))+1 ! j0+3
+ j0 = modulo(j0-1,N(dir))+1 ! j0
+ buffer(jM)= buffer(jM)+aM*sca
+ buffer(j0)= buffer(j0)+a0*sca+b0*scaP
+ buffer(jP)= buffer(jP)+aP*sca+bP*scaP
+ buffer(jP2)=buffer(jP2)+aP2*sca+bP2*scaP
+ buffer(jP3)=buffer(jP3)+bP3*scaP
+
+end subroutine AC_remesh_tag_LC_array
-!> Left remeshing formula of order 2
-!! @param[in] pos_adim= adimensionned particle position
-!! @param[in] sca = scalar advected by the particle
-!! @param[in,out] buffer = temporaly remeshed scalar field
-subroutine AC_remesh_left_pter(pos_adim, sca, buffer)
+!> Corrected remeshing formula for transition from Left block to a Centered block with a different indice (tagged particles)
+!! @param[in] pos_adim= adimensionned particle position
+!! @param[in] sca = scalar advected by this particle
+!! @param[in] posP_ad = adimensionned position of the second particle
+!! @param[in] scaP = scalar advected by this particle
+!! @param[in,out] buffer = temporaly remeshed scalar field
+!! @details
+!! Remeshing formula devoted to tagged particles.
+!! The particle group send into argument is composed of a block end and of the
+!! begining of the next block. The first particles belong to a left block
+!! and the last to a centered one. The block have difference indice (tagged
+!! particles) and we have to use corrected formula.
+subroutine AC_remesh_tag_LC_pter(pos_adim, sca, posP_ad, scaP, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
-
- !Input/Ouput
- real(WP), intent(in) :: pos_adim, sca
- type(real_pter), dimension(:), intent(inout) :: buffer
- ! Ohter local variables
- integer :: j0 ! indice of the the nearest mesh points
- real(WP) :: bM, b0, bP ! interpolation weight for the particles
- real(WP) :: y0 ! adimensionned distance to mesh points
- ! Mesh point used in remeshing formula
+ ! Input/Output
+ real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ type(real_pter), dimension(:), intent(inout) :: buffer
+ ! Other local variables
+ integer :: jM, j0, jP, jP2, jP3 ! indice of the the nearest mesh points
+ ! (they depend on the block type)
+ integer :: j0_bis ! indice of the the nearest mesh point for the indP=ind+1 particle
+ real(WP) :: aM, a0, aP,aP2, b0, bP, bP2, bP3 ! interpolation weight for the particles
+ real(WP) :: y0, y0_bis ! adimensionned distance to mesh points
+
+
+ ! Indice of mesh point used in order to remesh
j0 = floor(pos_adim)
!j0 = floor(pos/d_sc(2))
-
- ! Distance to mesh points
+ j0_bis = nint(posP_ad)
+ !j0_bis = nint(posP/d_sc(2))
+ jM=j0-1
+ jP=j0+1
+ jP2=j0+2
+ jP3=j0+3
+
+ ! Distance to mesh point
y0 = (pos_adim - dble(j0))
+ !y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
+ y0_bis = (posP_ad - dble(j0_bis))
+ !y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
+
+ ! Interpolation weight
+ a0=1-y0**2
+ aP=y0
+ !aM=y0*yM/2.
+ aM = 0.5-(a0+aP)/2.
+ aP2=aM
+ bP=-y0_bis
+ bP2=1-y0_bis**2
+ !b0=y0_bis*yP_bis/2.
+ b0 = 0.5-(bP+bP2)/2.
+ bP3=b0
- ! Interpolation weights
- bM=0.5*y0*(y0-1.)
- b0=1.-y0**2
- !bP=0.5*y0*(y0+1.)
- bP=1. - (b0+bM)
+ ! Remeshing
+ buffer(jM)%pter= buffer(jM)%pter+aM*sca
+ buffer(j0)%pter= buffer(j0)%pter+a0*sca+b0*scaP
+ buffer(jP)%pter= buffer(jP)%pter+aP*sca+bP*scaP
+ buffer(jP2)%pter=buffer(jP2)%pter+aP2*sca+bP2*scaP
+ buffer(jP3)%pter=buffer(jP3)%pter+bP3*scaP
- ! remeshing
- buffer(j0-1)%pter = buffer(j0-1)%pter + bM*sca
- buffer(j0)%pter = buffer(j0)%pter + b0*sca
- buffer(j0+1)%pter = buffer(j0+1)%pter + bP*sca
+end subroutine AC_remesh_tag_LC_pter
-end subroutine AC_remesh_left_pter
+! ========================================================================
+! ============ Lambda 2 corrected and limited formula ============
+! ========================================================================
-!> Centered remeshing formula of order 2
+!> (center or left) remeshing formula for lambda 2 corrected and limited - classical array
+!! version
!! @param[in] dir = current direction
!! @param[in] pos_adim= adimensionned particle position
!! @param[in] sca = scalar advected by the particle
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
!! @param[in,out] buffer = temporaly remeshed scalar field
-subroutine AC_remesh_center_array(dir, pos_adim, sca, buffer)
+!! @details
+!! Note that instead of the value of the limitator funciton, it is actually
+!! these values divided by 8 wich are given as arguments. As the limitator function
+!! always appear divided by 8 in the remeshing polynom, perform this division
+!! during the computation of the limitator function enhances the performances.
+subroutine AC_remesh_limitO2_array(dir, pos_adim, sca, bl_type, limit, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
- ! Input/output
- integer, intent(in) :: dir
+ !Input/Ouput
real(WP), intent(in) :: pos_adim, sca
+ logical, intent(in) :: bl_type
+ real(WP), dimension(2), intent(in) :: limit
+ integer, intent(in) :: dir
real(WP), dimension(:), intent(inout) :: buffer
- ! Other local variables
+ ! Ohter local variables
integer :: j0, j1 ! indice of the the nearest mesh points
real(WP) :: bM, b0, bP ! interpolation weight for the particles
real(WP) :: y0 ! adimensionned distance to mesh points
- j0 = nint(pos_adim)
- !j0 = nint(pos/d_sc(2))
+ ! Mesh point used in remeshing formula
+ if (bl_type) then
+ ! Center remeshing
+ j0 = nint(pos_adim)
+ else
+ ! Left remeshing
+ j0 = floor(pos_adim)
+ end if
! Distance to mesh points
y0 = (pos_adim - dble(j0))
- !y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
! Interpolation weights
- bM=0.5*y0*(y0-1.)
- b0=1.-y0**2
- !bP=0.5*y0*(y0+1.)
- bP=1. -b0 - bM
+ bM=0.5*((y0-0.5)**2) - limit(1)
+ b0=0.75_WP - y0**2 + limit(1) + limit(2)
+ !bP=0.5*((y0+0.5)**2) - limit(2)
+ bP=1. - (b0+bM)
! remeshing
j1 = modulo(j0-2,N(dir))+1 ! j0-1
@@ -613,46 +1047,63 @@ subroutine AC_remesh_center_array(dir, pos_adim, sca, buffer)
buffer(j1) = buffer(j1) + b0*sca
j1 = modulo(j0,N(dir))+1 ! j0+1
buffer(j1) = buffer(j1) + bP*sca
-
-end subroutine AC_remesh_center_array
+
+end subroutine AC_remesh_limitO2_array
-!> Centered remeshing formula of order 2
+!> Left remeshing formula for lambda 2 corrected and limited - array of pointer
+!! version
+!! @param[in] dir = current direction
!! @param[in] pos_adim= adimensionned particle position
!! @param[in] sca = scalar advected by the particle
+!! @param[in] bl_type = equal 0 (resp 1) if the block is left (resp centered)
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
!! @param[in,out] buffer = temporaly remeshed scalar field
-subroutine AC_remesh_center_pter(pos_adim, sca, buffer)
+!! @details
+!! Note that instead of the value of the limitator funciton, it is actually
+!! these values divided by 8 wich are given as arguments. As the limitator function
+!! always appear divided by 8 in the remeshing polynom, perform this division
+!! during the computation of the limitator function enhances the performances.
+subroutine AC_remesh_limitO2_pter(pos_adim, sca, bl_type, limit, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
- ! Input/output
+ !Input/Ouput
real(WP), intent(in) :: pos_adim, sca
+ logical, intent(in) :: bl_type
+ real(WP), dimension(2), intent(in) :: limit
type(real_pter), dimension(:), intent(inout) :: buffer
- ! Other local variables
+
+ ! Ohter local variables
integer :: j0 ! indice of the the nearest mesh points
real(WP) :: bM, b0, bP ! interpolation weight for the particles
real(WP) :: y0 ! adimensionned distance to mesh points
- j0 = nint(pos_adim)
- !j0 = nint(pos/d_sc(2))
+ ! Mesh point used in remeshing formula
+ if (bl_type) then
+ ! Center remeshing
+ j0 = nint(pos_adim)
+ else
+ ! Left remeshing
+ j0 = floor(pos_adim)
+ end if
! Distance to mesh points
y0 = (pos_adim - dble(j0))
- !y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
! Interpolation weights
- bM=0.5*y0*(y0-1.)
- b0=1.-y0**2
- !bP=0.5*y0*(y0+1.)
- bP=1. -b0 - bM
+ bM=0.5*((y0-0.5)**2) - limit(1)
+ b0=0.75_WP - y0**2 + limit(1) + limit(2)
+ !bP=0.5*((y0+0.5)**2) - limit(2)
+ bP=1. - (b0+bM)
! remeshing
- buffer(j0-1)%pter = buffer(j0-1)%pter + bM*sca
- buffer(j0)%pter = buffer(j0)%pter + b0*sca
- buffer(j0+1)%pter = buffer(j0+1)%pter + bP*sca
+ buffer(j0-1)%pter = buffer(j0-1)%pter + bM*sca
+ buffer(j0)%pter = buffer(j0)%pter + b0*sca
+ buffer(j0+1)%pter = buffer(j0+1)%pter + bP*sca
-end subroutine AC_remesh_center_pter
+end subroutine AC_remesh_limitO2_pter
!> Corrected remeshing formula for transition from Centered block to a Left block with a different indice (tagged particles)
@@ -661,14 +1112,15 @@ end subroutine AC_remesh_center_pter
!! @param[in] sca = scalar advected by this particle
!! @param[in] posP_ad = adimensionned position of the second particle
!! @param[in] scaP = scalar advected by this particle
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @detail
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a centered block
!! and the last to a left one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
-subroutine AC_remesh_tag_CL_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
+subroutine AC_remesh_limitO2_tag_CL_array(dir, pos_adim, sca, posP_ad, scaP, limit, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
@@ -676,6 +1128,7 @@ subroutine AC_remesh_tag_CL_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
! Input/Output
integer, intent(in) :: dir
real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ real(WP), dimension(3), intent(in) :: limit ! to remesh particles of indices i, i+1, limitator must be known at i-1/2, i+1/2=(i+1)-1/2 and (i+1)+1/2
real(WP), dimension(:), intent(inout) :: buffer
! Other local variables
integer :: jM, j0, jP ! indice of the the nearest mesh points
@@ -694,9 +1147,11 @@ subroutine AC_remesh_tag_CL_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
y0_bis = (posP_ad - dble(j0_bis))
!y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
- aM=0.5*y0*(y0-1)
+ aM=0.5*((y0-0.5)**2) - limit(1) ! = (lambda 2 limited) alpha(y0_bis)
a0=1.-aM
- bP=0.5*y0_bis*(y0_bis+1.)
+ bP=0.5*((y0_bis+0.5)**2) - limit(3) ! = (lambda 2 limited) gamma(y0_bis)
+ ! note that limit(3) is the limitator function at (i+1)+1/2), with (i+1) the
+ ! indice of particle of wieght scaP
b0=1.-bP
! Remeshing
@@ -707,7 +1162,7 @@ subroutine AC_remesh_tag_CL_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
buffer(j0)=buffer(j0)+a0*sca+b0*scaP
buffer(jP)=buffer(jP)+bP*scaP
-end subroutine AC_remesh_tag_CL_array
+end subroutine AC_remesh_limitO2_tag_CL_array
!> Corrected remeshing formula for transition from Centered block to a Left block with a different indice (tagged particles)
@@ -715,20 +1170,22 @@ end subroutine AC_remesh_tag_CL_array
!! @param[in] sca = scalar advected by this particle
!! @param[in] posP_ad = adimensionned position of the second particle
!! @param[in] scaP = scalar advected by this particle
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a centered block
!! and the last to a left one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
-subroutine AC_remesh_tag_CL_pter(pos_adim, sca, posP_ad, scaP, buffer)
+subroutine AC_remesh_limitO2_tag_CL_pter(pos_adim, sca, posP_ad, scaP, limit, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
! Input/Output
real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ real(WP), dimension(3), intent(in) :: limit ! to remesh particles of indices i, i+1, limitator must be known at i-1/2, i+1/2=(i+1)-1/2 and (i+1)+1/2
type(real_pter), dimension(:), intent(inout) :: buffer
! Other local variables
integer :: jM, j0, jP ! indice of the the nearest mesh points
@@ -749,9 +1206,11 @@ subroutine AC_remesh_tag_CL_pter(pos_adim, sca, posP_ad, scaP, buffer)
y0_bis = (posP_ad - dble(j0_bis))
!y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
- aM=0.5*y0*(y0-1)
+ aM=0.5*((y0-1.)**2) - limit(1) ! = (lambda 2 limited) alpha(y0_bis)
a0=1.-aM
- bP=0.5*y0_bis*(y0_bis+1.)
+ bP=0.5*((y0_bis+1.)**2) - limit(3) ! = (lambda 2 limited) gamma(y0_bis)
+ ! note that limit(3) is the limitator function at (i+1)+1/2), with (i+1) the
+ ! indice of particle of wieght scaP
b0=1.-bP
! Remeshing
@@ -759,7 +1218,7 @@ subroutine AC_remesh_tag_CL_pter(pos_adim, sca, posP_ad, scaP, buffer)
buffer(j0)%pter=buffer(j0)%pter+a0*sca+b0*scaP
buffer(jP)%pter=buffer(jP)%pter+bP*scaP
-end subroutine AC_remesh_tag_CL_pter
+end subroutine AC_remesh_limitO2_tag_CL_pter
!> Corrected remeshing formula for transition from Left block to a Centered block with a different indice (tagged particles)
@@ -768,14 +1227,15 @@ end subroutine AC_remesh_tag_CL_pter
!! @param[in] sca = scalar advected by this particle
!! @param[in] posP_ad = adimensionned position of the second particle
!! @param[in] scaP = scalar advected by this particle
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a left block
!! and the last to a centered one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
-subroutine AC_remesh_tag_LC_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
+subroutine AC_remesh_limitO2_tag_LC_array(dir, pos_adim, sca, posP_ad, scaP, limit, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
@@ -783,6 +1243,7 @@ subroutine AC_remesh_tag_LC_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
! Input/Output
integer, intent(in) :: dir
real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ real(WP), dimension(3), intent(in) :: limit ! to remesh particles of indices i, i+1, limitator must be known at i-1/2, i+1/2=(i+1)-1/2 and (i+1)+1/2
real(WP), dimension(:), intent(inout) :: buffer
! Other local variables
integer :: jM, j0, jP, jP2, jP3 ! indice of the the nearest mesh points
@@ -801,24 +1262,25 @@ subroutine AC_remesh_tag_LC_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
jP=j0+1
jP2=j0+2
jP3=j0+3
-
+
! Distance to mesh point
y0 = (pos_adim - dble(j0))
!y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
y0_bis = (posP_ad - dble(j0_bis))
!y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
-
+
! Interpolation weight
- a0=1-y0**2
+ ! Use limit(1) and limit(2) to remesh particle i (they are limitator at i-1/2, i+1/2)
+ aM = 0.5*((y0-0.5)**2) - limit(1)
+ a0=0.75_WP - y0**2 + limit(1) + limit(2)
aP=y0
- !aM=y0*yM/2.
- aM = 0.5-(a0+aP)/2.
- aP2=aM
- bP=-y0_bis
- bP2=1-y0_bis**2
- !b0=y0_bis*yP_bis/2.
- b0 = 0.5-(bP+bP2)/2.
- bP3=b0
+ aP2=1._WP - aM - a0 - aP
+
+ ! Use limit(2) and limit(3) to remesh particle i+1 (they are limitator at i+1-1/2, i+1+1/2)
+ bP = -y0_bis
+ bP2 = 0.75_WP - y0_bis**2 + limit(2) + limit(3)
+ bP3 = 0.5*((y0_bis+0.5)**2) - limit(3)
+ b0 = 1._WP - bP - bP2 - bP3
! Remeshing
jM = modulo(j0-2,N(dir))+1 ! j0-1
@@ -826,13 +1288,13 @@ subroutine AC_remesh_tag_LC_array(dir, pos_adim, sca, posP_ad, scaP, buffer)
jP2= modulo(j0+1,N(dir))+1 ! j0+2
jP3= modulo(j0+2,N(dir))+1 ! j0+3
j0 = modulo(j0-1,N(dir))+1 ! j0
- buffer(jM)= buffer(jM)+aM*sca
- buffer(j0)= buffer(j0)+a0*sca+b0*scaP
- buffer(jP)= buffer(jP)+aP*sca+bP*scaP
- buffer(jP2)=buffer(jP2)+aP2*sca+bP2*scaP
- buffer(jP3)=buffer(jP3)+bP3*scaP
+ buffer(jM)= buffer(jM) +aM *sca
+ buffer(j0)= buffer(j0) +a0 *sca+b0 *scaP
+ buffer(jP)= buffer(jP) +aP *sca+bP *scaP
+ buffer(jP2)=buffer(jP2) +aP2*sca+bP2*scaP
+ buffer(jP3)=buffer(jP3) +bP3*scaP
-end subroutine AC_remesh_tag_LC_array
+end subroutine AC_remesh_limitO2_tag_LC_array
!> Corrected remeshing formula for transition from Left block to a Centered block with a different indice (tagged particles)
@@ -840,20 +1302,22 @@ end subroutine AC_remesh_tag_LC_array
!! @param[in] sca = scalar advected by this particle
!! @param[in] posP_ad = adimensionned position of the second particle
!! @param[in] scaP = scalar advected by this particle
+!! @param[in] limit = limitator function value associated to the right and the left scalar variations
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a left block
!! and the last to a centered one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
-subroutine AC_remesh_tag_LC_pter(pos_adim, sca, posP_ad, scaP, buffer)
+subroutine AC_remesh_limitO2_tag_LC_pter(pos_adim, sca, posP_ad, scaP, limit, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
! Input/Output
real(WP), intent(in) :: pos_adim, sca, posP_ad, scaP
+ real(WP), dimension(3), intent(in) :: limit ! to remesh particles of indices i, i+1, limitator must be known at i-1/2, i+1/2=(i+1)-1/2 and (i+1)+1/2
type(real_pter), dimension(:), intent(inout) :: buffer
! Other local variables
integer :: jM, j0, jP, jP2, jP3 ! indice of the the nearest mesh points
@@ -872,24 +1336,25 @@ subroutine AC_remesh_tag_LC_pter(pos_adim, sca, posP_ad, scaP, buffer)
jP=j0+1
jP2=j0+2
jP3=j0+3
-
+
! Distance to mesh point
y0 = (pos_adim - dble(j0))
!y0 = (pos - dble(j0)*d_sc(2))/d_sc(2)
y0_bis = (posP_ad - dble(j0_bis))
!y0_bis = (posP - dble(j0_bis)*d_sc(2))/d_sc(2)
-
+
! Interpolation weight
- a0=1-y0**2
+ ! Use limit(1) and limit(2) to remesh particle i (they are limitator at i-1/2, i+1/2)
+ aM = 0.5*((y0-0.5)**2) - limit(1)
+ a0=0.75_WP - y0**2 + limit(1) + limit(2)
aP=y0
- !aM=y0*yM/2.
- aM = 0.5-(a0+aP)/2.
- aP2=aM
- bP=-y0_bis
- bP2=1-y0_bis**2
- !b0=y0_bis*yP_bis/2.
- b0 = 0.5-(bP+bP2)/2.
- bP3=b0
+ aP2=1._WP - aM - a0 - aP
+
+ ! Use limit(2) and limit(3) to remesh particle i+1 (they are limitator at i+1-1/2, i+1+1/2)
+ bP = -y0_bis
+ bP2 = 0.75_WP - y0_bis**2 + limit(2) + limit(3)
+ bP3 = 0.5*((y0_bis+0.5)**2) - limit(3)
+ b0 = 1._WP - bP - bP2 - bP3
! Remeshing
buffer(jM)%pter= buffer(jM)%pter+aM*sca
@@ -898,9 +1363,13 @@ subroutine AC_remesh_tag_LC_pter(pos_adim, sca, posP_ad, scaP, buffer)
buffer(jP2)%pter=buffer(jP2)%pter+aP2*sca+bP2*scaP
buffer(jP3)%pter=buffer(jP3)%pter+bP3*scaP
-end subroutine AC_remesh_tag_LC_pter
+end subroutine AC_remesh_limitO2_tag_LC_pter
+! ============================================================
+! ============ Lambda 4 corrected formula ============
+! ============================================================
+
!> Left remeshing formula of order 4
!! @param[in] pos_adim= adimensionned particle position
!! @param[in] sca = scalar advected by the particle
@@ -909,7 +1378,7 @@ subroutine AC_remesh_O4_left_array(dir, pos_adim, sca, buffer)
use cart_topology
use advec_variables ! contains info about solver parameters and others.
-
+
!Input/Ouput
integer, intent(in) :: dir
real(WP), intent(in) :: pos_adim, sca
@@ -921,7 +1390,7 @@ subroutine AC_remesh_O4_left_array(dir, pos_adim, sca, buffer)
! Mesh point used in remeshing formula
j0 = floor(pos_adim)
!j0 = floor(pos/d_sc(2))
-
+
! Distance to mesh points
y0 = (pos_adim - dble(j0))
@@ -1015,13 +1484,13 @@ subroutine AC_remesh_O4_center_array(dir, pos_adim, sca, buffer)
real(WP) :: y0 ! adimensionned distance to mesh points
! Mesh point used in remeshing formula
j0 = nint(pos_adim)
-
+
! Distance to mesh points
y0 = (pos_adim - dble(j0))
! Interpolation weights
!bM2=(y0-2.)*(y0-1.)*y0*(y0+1.)/24.0
- bM2=y0*(2._WP+y0*(-1.+y0*(-2._WP+y0)))/24._WP
+ bM2=y0*(2._WP+y0*(-1._WP+y0*(-2._WP+y0)))/24._WP
!bM =(2.-y0)*(y0-1.)*y0*(y0+2.)/6.0
bM =y0*(-4._WP+y0*(4._WP+y0*(1._WP-y0)))/6._WP
!bP =(2.-y0)*y0*(y0+1.)*(y0+2.)/6.0
@@ -1042,7 +1511,7 @@ subroutine AC_remesh_O4_center_array(dir, pos_adim, sca, buffer)
buffer(j1) = buffer(j1) + bP*sca
j1 = modulo(j0+1,N(dir))+1 ! j0+2
buffer(j1) = buffer(j1) + bP2*sca
-
+
end subroutine AC_remesh_O4_center_array
!> Centered remeshing formula of order 4 - array version
@@ -1063,7 +1532,7 @@ subroutine AC_remesh_O4_center_pter(pos_adim, sca, buffer)
real(WP) :: y0 ! adimensionned distance to mesh points
! Mesh point used in remeshing formula
j0 = nint(pos_adim)
-
+
! Distance to mesh points
y0 = (pos_adim - dble(j0))
@@ -1086,7 +1555,7 @@ subroutine AC_remesh_O4_center_pter(pos_adim, sca, buffer)
buffer(j0+1)%pter = buffer(j0+1)%pter + bP*sca
buffer(j0+2)%pter = buffer(j0+2)%pter + bP2*sca
-
+
end subroutine AC_remesh_O4_center_pter
@@ -1102,9 +1571,9 @@ end subroutine AC_remesh_O4_center_pter
!! @param[in] posP2_ad= adimensionned position of the fourth (and last) particle
!! @param[in] scaP2 = scalar advected by this particle
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a centered block
!! and the last to a left one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
@@ -1215,9 +1684,9 @@ end subroutine AC_remesh_O4_tag_CL_array
!! @param[in] posP2_ad= adimensionned position of the fourth (and last) particle
!! @param[in] scaP2 = scalar advected by this particle
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a centered block
!! and the last to a left one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
@@ -1315,9 +1784,9 @@ end subroutine AC_remesh_O4_tag_CL_pter
!! @param[in] posP2_ad= adimensionned position of the fourth (and last) particle
!! @param[in] scaP2 = scalar advected by this particle
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a left block
!! and the last to a centered one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
@@ -1461,9 +1930,9 @@ end subroutine AC_remesh_O4_tag_LC_array
!! @param[in] posP2_ad= adimensionned position of the fourth (and last) particle
!! @param[in] scaP2 = scalar advected by this particle
!! @param[in,out] buffer = temporaly remeshed scalar field
-!! @details
+!! @details
!! Remeshing formula devoted to tagged particles.
-!! The particle group send into argument is composed of a block end and of the
+!! The particle group send into argument is composed of a block end and of the
!! begining of the next block. The first particles belong to a left block
!! and the last to a centered one. The block have difference indice (tagged
!! particles) and we have to use corrected formula.
@@ -1562,7 +2031,7 @@ subroutine AC_remesh_O4_tag_LC_pter(posM_ad, scaM, pos_adim, sca, posP_ad, scaP,
eP = 1._WP - (e0+eP2+eP3+eP4+eP5)
! remeshing
- buffer(j0-3)%pter = buffer(j0-3)%pter +aM3*scaM
+ buffer(j0-3)%pter = buffer(j0-3)%pter +aM3*scaM
buffer(j0-2)%pter = buffer(j0-2)%pter +aM2*scaM +bM2*sca
buffer(j0-1)%pter = buffer(j0-1)%pter + aM*scaM + bM*sca + cM*scaP
buffer(j0 )%pter = buffer(j0 )%pter + a0*scaM + b0*sca + c0*scaP + e0*scaP2
@@ -1575,111 +2044,5 @@ subroutine AC_remesh_O4_tag_LC_pter(posM_ad, scaM, pos_adim, sca, posP_ad, scaP,
end subroutine AC_remesh_O4_tag_LC_pter
-!> M'6 remeshing formula - version for array of pointer.
-!! @param[in] dir = current direction
-!! @param[in] pos_adim= adimensionned particle position
-!! @param[in] sca = scalar advected by the particle
-!! @param[in,out] buffer = temporaly remeshed scalar field
-subroutine AC_remesh_Mprime6(dir, pos_adim, sca, buffer)
-
- use cart_topology
- use advec_variables ! contains info about solver parameters and others.
-
- !Input/Ouput
- integer, intent(in) :: dir
- real(WP), intent(in) :: pos_adim, sca
- real(WP), dimension(:), intent(inout) :: buffer
- ! Ohter local variables
- integer :: j0, j1 ! indice of the the nearest mesh points
- real(WP) :: bM, bM2, b0, bP, bP2, bP3! interpolation weight for the particles
- real(WP) :: y0 ! adimensionned distance to mesh points
-
- ! Mesh point used in remeshing formula
- j0 = floor(pos_adim)
-
- ! Distance to mesh points
- y0 = (pos_adim - dble(j0))
-
- ! Interpolation weights
- !bM2 =-(((y0+2.)-2)*(5.*(y0+2.)-8.)*((y0+2.)-3.)**3)/24.
- bM2 = y0*(2. + y0*(-1. + y0*(-9. + (13. - 5.*y0)*y0)))/24.
- !bM =(y0+1.-1.)*(y0+1.-2.)*(25.*(y0+1.)**3-114.*(y0+1.)**2+153.*(y0+1.)-48.)/24.
- bM = y0*(-16. + y0*(16. + y0*(39. + y0*(-64. + 25.*y0))))/24.
- !bP =-((1.-y0)-1.)*(25.*(1.-y0)**4-38.*(1.-y0)**3-3.*(1.-y0)**2+12.*(1.-y0)+12)/12.
- bP = ( y0*(8. + y0*(8. + y0*(33. + y0*(-62. + 25.*y0)))))/12.
- !bP2 = ((2.-y0)-1.)*((2.-y0)-2.)*(25.*(2.-y0)**3-114.*(2.-y0)**2+153.*(2.-y0)-48.)/24.
- bP2 = (y0*(-2. + y0*(-1. + y0*(-33. + (61. - 25.*y0)*y0))))/24.
- !bP3 =-(((3.-y0)-2)*(5.*(3.-y0)-8.)*((3.-y0)-3.)**3)/24.
- bP3 = (y0**3)*(7. + y0*(5.*y0 - 12.))/24.
- !b0 =-(y0-1.)*(25.*y0**4-38.*y0**3-3.*y0**2+12.*y0+12)/12.
- !b0 = (12. + y0**2*(-15. + y0*(-35. + (63. - 25.*y0)*y0)))/12.
- b0 = 1. - (bM2+bM+bP+bP2+bP3)
-
- ! remeshing
- j1 = modulo(j0-3,N(dir))+1 ! j0-2
- buffer(j1) = buffer(j1) + sca*bM2
- j1 = modulo(j0-2,N(dir))+1 ! j0-1
- buffer(j1) = buffer(j1) + sca*bM
- j1 = modulo(j0-1,N(dir))+1 ! j0
- buffer(j1) = buffer(j1) + sca*b0
- j1 = modulo(j0,N(dir))+1 ! j0+1
- buffer(j1) = buffer(j1) + sca*bP
- j1 = modulo(j0+1,N(dir))+1 ! j0+2
- buffer(j1) = buffer(j1) + sca*bP2
- j1 = modulo(j0+2,N(dir))+1 ! j0+3
- buffer(j1) = buffer(j1) + sca*bP3
-
-end subroutine AC_remesh_Mprime6
-
-
-!> M'6 remeshing formula (order is more than 2, JM Ethancelin is working on
-!! determining order).
-!! @param[in] pos_adim= adimensionned particle position
-!! @param[in] sca = scalar advected by the particle
-!! @param[in,out] buffer = temporaly remeshed scalar field
-subroutine AC_remesh_Mprime6_pter(pos_adim, sca, buffer)
-
- use cart_topology
- use advec_variables ! contains info about solver parameters and others.
-
- !Input/Ouput
- real(WP), intent(in) :: pos_adim, sca
- type(real_pter), dimension(:), intent(inout) :: buffer
- ! Ohter local variables
- integer :: j0 ! indice of the the nearest mesh points
- real(WP) :: bM, bM2, b0, bP, bP2, bP3! interpolation weight for the particles
- real(WP) :: y0 ! adimensionned distance to mesh points
-
- ! Mesh point used in remeshing formula
- j0 = floor(pos_adim)
-
- ! Distance to mesh points
- y0 = (pos_adim - dble(j0))
-
- ! Interpolation weights
- !bM2 =-(((y0+2.)-2)*(5.*(y0+2.)-8.)*((y0+2.)-3.)**3)/24.
- bM2 = y0*(2. + y0*(-1. + y0*(-9. + (13. - 5.*y0)*y0)))/24.
- !bM =(y0+1.-1.)*(y0+1.-2.)*(25.*(y0+1.)**3-114.*(y0+1.)**2+153.*(y0+1.)-48.)/24.
- bM = y0*(-16. + y0*(16. + y0*(39. + y0*(-64. + 25.*y0))))/24.
- !bP =-((1.-y0)-1.)*(25.*(1.-y0)**4-38.*(1.-y0)**3-3.*(1.-y0)**2+12.*(1.-y0)+12)/12.
- bP = ( y0*(8. + y0*(8. + y0*(33. + y0*(-62. + 25.*y0)))))/12.
- !bP2 = ((2.-y0)-1.)*((2.-y0)-2.)*(25.*(2.-y0)**3-114.*(2.-y0)**2+153.*(2.-y0)-48.)/24.
- bP2 = (y0*(-2. + y0*(-1. + y0*(-33. + (61. - 25.*y0)*y0))))/24.
- !bP3 =-(((3.-y0)-2)*(5.*(3.-y0)-8.)*((3.-y0)-3.)**3)/24.
- bP3 = (y0**3)*(7. + y0*(5.*y0 - 12.))/24.
- !b0 =-(y0-1.)*(25.*y0**4-38.*y0**3-3.*y0**2+12.*y0+12)/12.
- !b0 = (12. + y0**2*(-15. + y0*(-35. + (63. - 25.*y0)*y0)))/12.
- b0 = 1. - (bM2+bM+bP+bP2+bP3)
-
- ! remeshing
- buffer(j0-2)%pter = buffer(j0-2)%pter + sca*bM2
- buffer(j0-1)%pter = buffer(j0-1)%pter + sca*bM
- buffer(j0 )%pter = buffer(j0 )%pter + sca*b0
- buffer(j0+1)%pter = buffer(j0+1)%pter + sca*bP
- buffer(j0+2)%pter = buffer(j0+2)%pter + sca*bP2
- buffer(j0+3)%pter = buffer(j0+3)%pter + sca*bP3
-
-end subroutine AC_remesh_Mprime6_pter
-
-end module advec_remeshing_formula
+end module advec_remeshing_lambda
!> @}
diff --git a/HySoP/src/scalesInterface/particles/advec_type.f90 b/HySoP/src/scalesInterface/particles/advec_type.f90
index 213dad27e67cb6b63f7b89cb789810bf779980b9..6d3a8784bbd3b2f609455ce2c9130995263339f6 100644
--- a/HySoP/src/scalesInterface/particles/advec_type.f90
+++ b/HySoP/src/scalesInterface/particles/advec_type.f90
@@ -5,13 +5,13 @@
! MODULE: advec_abstract_proc
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module ``advec_abstract_procedure'' gather all user abstract procedure that are used by the different advection
!! modules. It allow to share that function/procediure profile and to safetly use procedural argument or pointer.
-!!
-!! This module is not supposed to be used by the main code but only by the other advection module.
-!! More precisly, a final user must only used the generic "advec" module wich contains all the interface
-!! to initialize the solver (eg choosing the remeshing formula and the dimension splitting) and to solve
+!!
+!! This module is not supposed to be used by the main code but only by the other advection module.
+!! More precisly, a final user must only used the generic "advec" module wich contains all the interface
+!! to initialize the solver (eg choosing the remeshing formula and the dimension splitting) and to solve
!! the advection equation with the particle method.
!!
!
@@ -33,48 +33,98 @@ module advec_abstract_proc
abstract interface
subroutine AC_remesh(direction, ind_group, gs, p_pos_adim, p_V, j, k, scal, dt)
- use cart_topology
+ use precision_tools
+ implicit none
- ! Input/Output
- integer, intent(in) :: direction
- integer, dimension(2), intent(in) :: ind_group
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
- real(WP), dimension(:,:,:), intent(inout) :: scal
- real(WP), intent(in) :: dt
+ ! Input/Output
+ integer, intent(in) :: direction
+ integer, dimension(2), intent(in) :: ind_group
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ real(WP), dimension(:,:,:), intent(in) :: p_V ! particles velocity
+ real(WP), dimension(:,:,:), intent(inout) :: scal
+ real(WP), intent(in) :: dt
end subroutine AC_remesh
end interface
- ! --- Abstract profile of subroutine used to remesh scalar inside a buffer ---
+ ! --- Abstract profile of subroutine used to compute limitator function ---
+ ! Note that such a function actually computes limitator/8 as it is always
+ ! this fraction which appears in the remeshing polynoms (and thsu directly
+ ! divided limitator function by 8 avoids to have to do it several times later)
+ abstract interface
+ !! @param[in] gp_s = size of a group (ie number of line it gathers along the two other directions)
+ !! @param[in] ind_group = coordinate of the current group of lines
+ !! @param[in] p_pos = particles position
+ !! @param[in] scalar = scalar advected by particles
+ !! @param[out] limit = limitator function
+ subroutine advec_limitator_group(gp_s, ind_group, j, k, p_pos, &
+ & scalar, limit)
+
+ use precision_tools
+ implicit none
+
+ integer, dimension(2),intent(in) :: gp_s ! groupe size
+ integer, dimension(2), intent(in) :: ind_group ! group indice
+ integer , intent(in) :: j,k ! bloc coordinates
+ real(WP), dimension(:,:,:), intent(in) :: p_pos ! particle position
+ real(WP), dimension(:,:,:), intent(in) :: scalar ! scalar field to advect
+ real(WP), dimension(:,:,:), intent(out) :: limit ! limitator function
+
+ end subroutine advec_limitator_group
+ end interface
+
+ ! --- Abstract profile of subroutine used to remesh scalar inside a buffer - lambda formula ---
+ abstract interface
+ subroutine remesh_in_buffer_type(gs, j, k, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
+ & scalar, buffer, pos_in_buffer)
+
+ use precision_tools
+ implicit none
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ integer, intent(in) :: ind_min
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
+ real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
+ integer, dimension(:), intent(inout) :: pos_in_buffer ! describe how the one dimensionnal array "buffer" are split
+ ! in part corresponding to different processes
+
+ end subroutine remesh_in_buffer_type
+ end interface
+
+ ! --- Abstract profile of subroutine used to remesh scalar inside a buffer - limited lambda formula ---
abstract interface
- subroutine remesh_in_buffer(gs, j, k, ind_min, p_pos_adim, bl_type, bl_tag, send_min, send_max, &
- & scalar, remesh_line, buffer, pos_in_buffer)
-
- use precision
- use advec_remeshing_formula
- implicit none
-
- ! Input/Output
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- integer, intent(in) :: ind_min
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
- logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
- integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
- real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
- procedure(AC_remesh_line_pter), pointer, intent(in) :: remesh_line ! subroutine wich remesh a line of particle with
- ! the right remeshing formula
- real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
- ! in part corresponding to different processes
-
- end subroutine remesh_in_buffer
+ subroutine remesh_in_buffer_limit(gs, j, k, ind_min, p_pos_adim, bl_type, bl_tag, limit,&
+ & send_min, send_max, scalar, buffer, pos_in_buffer)
+
+ use precision_tools
+ implicit none
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ integer, intent(in) :: ind_min
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ logical, dimension(:,:,:), intent(in) :: bl_type ! is the particle block a center block or a left one ?
+ logical, dimension(:,:,:), intent(in) :: bl_tag ! indice of tagged particles
+ real(WP), dimension(:,:,:), intent(in) :: limit ! limitator function (divided by 8)
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
+ real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ ! in part corresponding to different processes
+
+ end subroutine remesh_in_buffer_limit
end interface
! --- Abstract profile of subroutine used to remesh scalar inside a buffer - variant with no type/tag ---
@@ -82,21 +132,21 @@ module advec_abstract_proc
subroutine remesh_in_buffer_notype(gs, j, k, ind_min, p_pos_adim, send_min, send_max, &
& scalar, buffer, pos_in_buffer)
- use precision
- implicit none
-
- ! Input/Output
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- integer, intent(in) :: ind_min
- real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
- integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
- integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
- real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
- ! the right remeshing formula
- real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
- integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
- ! in part corresponding to different processes
+ use precision_tools
+ implicit none
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ integer, intent(in) :: ind_min
+ real(WP), dimension(:,:,:), intent(in) :: p_pos_adim ! adimensionned particles position
+ integer, dimension(:,:), intent(in) :: send_min ! distance between me and processus wich send me information
+ integer, dimension(:,:), intent(in) :: send_max ! distance between me and processus wich send me information
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the initial scalar field transported by particles
+ ! the right remeshing formula
+ real(WP),dimension(:), intent(out), target :: buffer ! buffer where particles are remeshed
+ integer, dimension(:), intent(inout) :: pos_in_buffer! describe how the one dimensionnal array "buffer" are split
+ ! in part corresponding to different processes
end subroutine remesh_in_buffer_notype
end interface
@@ -106,21 +156,21 @@ module advec_abstract_proc
abstract interface
subroutine remesh_buffer_to_scalar(gs, j, k, ind_proc, gap, begin_i1, cartography, buffer, scalar, beg_buffer)
- use precision
- implicit none
-
- ! Input/Output
- integer, dimension(2), intent(in) :: gs
- integer, intent(in) :: j, k
- integer, intent(in) :: ind_proc ! to read the good cartography associate to the processus which send me the buffer.
- integer,intent(in) :: gap ! gap between my local indices and the local indices from another processes
- integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
- ! array where indice along the the direction of the group of lines are stored.
- integer, dimension(:,:), intent(in) :: cartography
- real(WP),dimension(:), intent(in) :: buffer ! buffer containing the data to redistribute into the local scalar field.
- real(WP), dimension(:,:,:), intent(inout) :: scalar ! the scalar field.
- integer, intent(out) :: beg_buffer ! first indice inside where the scalar values are stored into the buffer
- ! for the current sender processus. To know where reading data into the buffer.
+ use precision_tools
+ implicit none
+
+ ! Input/Output
+ integer, dimension(2), intent(in) :: gs
+ integer, intent(in) :: j, k
+ integer, intent(in) :: ind_proc ! to read the good cartography associate to the processus which send me the buffer.
+ integer,intent(in) :: gap ! gap between my local indices and the local indices from another processes
+ integer, intent(in) :: begin_i1 ! indice corresponding to the first place into the cartography
+ ! array where indice along the the direction of the group of lines are stored.
+ integer, dimension(:,:), intent(in) :: cartography
+ real(WP),dimension(:), intent(in) :: buffer ! buffer containing the data to redistribute into the local scalar field.
+ real(WP), dimension(:,:,:), intent(inout) :: scalar ! the scalar field.
+ integer, intent(out) :: beg_buffer ! first indice inside where the scalar values are stored into the buffer
+ ! for the current sender processus. To know where reading data into the buffer.
end subroutine remesh_buffer_to_scalar
end interface
diff --git a/HySoP/src/scalesInterface/particles/advec_variables.f90 b/HySoP/src/scalesInterface/particles/advec_variables.f90
index aa9d77c3dfd2d12d53941008222069e16a4c37f4..2bb5d784cf097b32f4191a025a3e903e0122c093 100644
--- a/HySoP/src/scalesInterface/particles/advec_variables.f90
+++ b/HySoP/src/scalesInterface/particles/advec_variables.f90
@@ -5,17 +5,17 @@
! MODULE: advec_variables
!
!
-! DESCRIPTION:
+! DESCRIPTION:
!> The module ``advec_variables'' gather all variables that have to been shared by diffrenrent advection
!! modules. It also provide a set of method to set the protected or private variables to the right values.
!! @details
!! It contains the variables common to the solver along each direction and other generic variables used for the
!! advection based on the particle method. It provied functions to set
!! them to right values depending on the choosen remeshing formula.
-!!
-!! This module is not supposed to be used by the main code but only by the other advection module.
-!! More precisly, a final user must only used the generic "advec" module wich contains all the interface
-!! to initialize the solver (eg choosing the remeshing formula and the dimension splitting) and to solve
+!!
+!! This module is not supposed to be used by the main code but only by the other advection module.
+!! More precisly, a final user must only used the generic "advec" module wich contains all the interface
+!! to initialize the solver (eg choosing the remeshing formula and the dimension splitting) and to solve
!! the advection equation with the particle method.
!!
!
@@ -26,17 +26,10 @@
module advec_variables
- use string
- use precision
+ use precision_tools
implicit none
- ! --- In order to create an array of pointer ---
- type real_pter
- real(WP), pointer :: pter
- end type real_pter
- ! ---------------------------------------------
-
! ===== Public and protected variables =====
! ----- Minimal and maximal indice of the buffer used in the different communication -----
!> minimal indice of the send buffer
@@ -54,9 +47,9 @@ module advec_variables
integer, dimension(2), protected :: remesh_stencil
! ------ Block infromation -----
!> number of particles in a block
- integer, protected :: bl_size
+ integer, protected :: bl_size
!> distance between the "central" mesh point and the extream mesh point of the stencil of points used to remesh a particle
- integer, protected :: bl_bound_size
+ integer, protected :: bl_bound_size
!> Number of common meshes used in the remeshing of two successive particle
!! (in case off standart (ie non corrected) remeshing formula)).
integer, dimension(2), protected :: bl_remesh_superposition
@@ -83,6 +76,8 @@ module advec_variables
integer, dimension(2), parameter :: tag_obtrec_NP = (/ 0, 3/)
!> To create tag used in AC_obtain_receivers to send message about senders of minimal and maximal rank
integer, dimension(2), parameter :: tag_obtsend_NP = (/ 0, 4/)
+ !> To create tag used in advecY_limitator_group to exchange ghost with neighbors
+ integer, dimension(2), parameter :: tag_part_slope = (/ 0, 5/)
! ===== Public procedures =====
!----- Initialize solver -----
@@ -145,6 +140,16 @@ subroutine AC_solver_init(part_solv, verbosity)
write(*,'(6x,a)') ' particle method, corrected M prime 6'
write(*,'(6x,a)') '====================================='
end if
+ case('p_M8')
+ bl_size = 2
+ bl_bound_size = 4 ! Be aware : don't use it to compute superposition between
+ ! mpi processes (not as predictible as corrected scheme)
+ remesh_stencil = (/3,4/)
+ if ((cart_rank==0).and.(verbose)) then
+ write(*,'(6x,a)') '========== Advection scheme ========='
+ write(*,'(6x,a)') ' particle method, corrected M prime 8'
+ write(*,'(6x,a)') '====================================='
+ end if
case default
bl_size = 2
bl_bound_size = 1
diff --git a/HySoP/src/scalesInterface/precision.f90 b/HySoP/src/scalesInterface/precision_tools.f90
similarity index 70%
rename from HySoP/src/scalesInterface/precision.f90
rename to HySoP/src/scalesInterface/precision_tools.f90
index 3cb6a31bf92c85aea4319e3955eabd37cd64d85c..e5880487b9991ef0da198d96c11bf64027a089a3 100644
--- a/HySoP/src/scalesInterface/precision.f90
+++ b/HySoP/src/scalesInterface/precision_tools.f90
@@ -1,3 +1,5 @@
+!> @addtogroup toolbox
+!! @{
!------------------------------------------------------------------------------
!
! MODULE: precision
@@ -10,7 +12,7 @@
!> representation in the code. It is set to double precision for REAL.
!------------------------------------------------------------------------------
-MODULE precision
+MODULE precision_tools
IMPLICIT NONE
INTEGER, PARAMETER :: SP = kind(1.0)
@@ -20,9 +22,15 @@ MODULE precision
REAL(WP), PARAMETER :: MAX_REAL_WP = HUGE(sample_real_at_WP)
INTEGER, PRIVATE :: sample_int
INTEGER, PARAMETER :: MAX_INTEGER = HUGE(sample_int)
+ INTEGER, PARAMETER :: DI = selected_int_kind(r=12)
!> the MPI type for REAL exchanges in simple or double precision
- INTEGER, PUBLIC :: MPI_REAL_WP
+ INTEGER, PUBLIC :: MPI_REAL_WP
!> the MPI type for COMPLEX exchanges in simple or double precision
- INTEGER, PUBLIC :: MPI_COMPLEX_WP
+ INTEGER, PUBLIC :: MPI_COMPLEX_WP
+ !> the string size
+ INTEGER, PARAMETER :: str_short = 8
+ INTEGER, PARAMETER :: str_medium = 64
+ INTEGER, PARAMETER :: str_long = 4096
-END MODULE precision
+END MODULE precision_tools
+!> @}
diff --git a/HySoP/src/scalesInterface/string.f90 b/HySoP/src/scalesInterface/string.f90
deleted file mode 100644
index c54aadb3313aeaabf17ca6af6f51f0503fb1be89..0000000000000000000000000000000000000000
--- a/HySoP/src/scalesInterface/string.f90
+++ /dev/null
@@ -1,18 +0,0 @@
-!------------------------------------------------------------------------------
-!
-! MODULE: string
-!
-!> @author
-!> Guillaume Balarac, LEGI
-!
-! DESCRIPTION:
-!> The aim of this module is set some parameters to fix the sizes of
-!> strings datas in the code
-!------------------------------------------------------------------------------
-module string
- implicit none
- integer, parameter :: str_short = 8
- integer, parameter :: str_medium = 64
- integer, parameter :: str_long = 4096
-end module string
-