484 lines
23 KiB
Fortran
Executable File
484 lines
23 KiB
Fortran
Executable File
module Agrif_Grids
|
|
|
|
use Agrif_Types
|
|
!
|
|
implicit none
|
|
!
|
|
!===================================================================================================
|
|
type Agrif_Grid_List
|
|
!---------------------------------------------------------------------------------------------------
|
|
!< List of grids.
|
|
!
|
|
integer :: nitems = 0 !< Number of elements in the list
|
|
type(Agrif_PGrid), pointer :: first => NULL() !< Pointer to the first grid in the list
|
|
type(Agrif_PGrid), pointer :: last => NULL() !< Pointer to the last grid inserted in the list
|
|
!---------------------------------------------------------------------------------------------------
|
|
end type Agrif_Grid_List
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
type Agrif_PGrid
|
|
!---------------------------------------------------------------------------------------------------
|
|
!< Data type to go over the grid hierarchy (used for the creation of this grid hierarchy
|
|
!< and during the time integration).
|
|
!
|
|
type(Agrif_Grid) , pointer :: gr => NULL() !< Pointer to the actual grid data structure
|
|
type(Agrif_PGrid), pointer :: next => NULL() !< Next grid in the list
|
|
!
|
|
!---------------------------------------------------------------------------------------------------
|
|
end type Agrif_PGrid
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
type Agrif_Grid
|
|
!---------------------------------------------------------------------------------------------------
|
|
!< Data type to define a grid (position, space and time refinement factors).
|
|
!
|
|
type(Agrif_Grid) , pointer :: parent => NULL() !< pointer on the parent grid
|
|
type(Agrif_Grid) , pointer :: save_grid => NULL() !< pointer on the save grid
|
|
type(Agrif_Grid_List) :: child_list !< List of child grids
|
|
type(Agrif_Variable), dimension(:), allocatable :: tabvars !< List of grid variables
|
|
type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c !< List of character grid variables
|
|
type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r !< List of real grid variables
|
|
type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l !< List of logical grid variables
|
|
type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i !< List of integer grid variables
|
|
!
|
|
real(kind=8), dimension(3) :: Agrif_x !< global x, y and z position
|
|
real(kind=8) , dimension(3) :: Agrif_dx !< global space step in the x, y and z direction
|
|
real , dimension(3) :: Agrif_dt !< global time step in the x, y and z direction
|
|
integer, dimension(3) :: nb = 1 !< number of cells in the x, y and z direction
|
|
integer, dimension(3) :: ix !< minimal position in the x, y and z direction
|
|
integer, dimension(3) :: spaceref !< space refinement factor in the x, y and z direction
|
|
integer, dimension(3) :: timeref !< Time refinement factor in the x, y and z direction
|
|
integer :: ngridstep !< number of time steps
|
|
integer :: rank
|
|
integer :: grid_id !< moving grid id
|
|
integer :: fixedrank !< number of the grid
|
|
logical :: fixed !< fixed or moving grid ?
|
|
logical :: oldgrid
|
|
!> \name Logicals indicating if the current grid has a common border with the root coarse grid
|
|
!> @{
|
|
logical, dimension(3) :: NearRootBorder
|
|
logical, dimension(3) :: DistantRootBorder
|
|
!> @}
|
|
!> \name Arrays for adaptive grid refinement
|
|
!> @{
|
|
integer, dimension(:) , allocatable :: tabpoint1D
|
|
integer, dimension(:,:) , allocatable :: tabpoint2D
|
|
integer, dimension(:,:,:), allocatable :: tabpoint3D
|
|
!> @}
|
|
!> \name Members for parallel integration
|
|
!> @{
|
|
type(Agrif_Rectangle), pointer :: rect_in_parent => NULL()
|
|
type(Agrif_Grid_List) :: neigh_list !< List of neighboring grids (ie. connected through a common proc)
|
|
type(Agrif_Proc_List) :: proc_def_list !< List of procs that will integrate this grid
|
|
type(Agrif_Proc_List) :: proc_def_in_parent_list !< List of procs that will integrate this grid (defined as in the parent grid)
|
|
type(Agrif_Proc_List) :: required_proc_list !< List of procs that are required for this grid
|
|
type(Agrif_Sequence_List), pointer :: child_seq => NULL() !< Sequence for childs
|
|
integer :: seq_num = 0
|
|
integer :: size = 0
|
|
integer :: dsat = 0
|
|
#if defined AGRIF_MPI
|
|
integer :: communicator = -1
|
|
#endif
|
|
!> @}
|
|
type(Agrif_Variables_List), pointer :: variables => NULL()
|
|
integer :: NbVariables = 0
|
|
integer :: level !< level of the grid in the hierarchy
|
|
logical :: allocation_is_done = .false.
|
|
logical :: grand_mother_grid = .false.
|
|
logical,dimension(4) :: periodicity = .false.
|
|
integer,dimension(4) :: periodicity_decal = 0
|
|
!---------------------------------------------------------------------------------------------------
|
|
end type Agrif_Grid
|
|
!===================================================================================================
|
|
!
|
|
!> this pointer always points on the root grid of the grid hierarchy
|
|
type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
|
|
|
|
!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
|
|
type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
|
|
|
|
!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
|
|
!> It contains the safeguard of the grid hierarchy.
|
|
type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
|
|
|
|
!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
|
|
type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
|
|
|
|
!> Pointer to the current child grid (the link is done before calls to procname)
|
|
type(Agrif_Grid) , pointer :: Agrif_CurChildgrid => NULL()
|
|
!
|
|
!===================================================================================================
|
|
type Agrif_Sequence
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List) :: gridlist
|
|
type(Agrif_Proc_List) :: proclist
|
|
!---------------------------------------------------------------------------------------------------
|
|
end type Agrif_Sequence
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
type Agrif_Sequence_List
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: nb_seqs
|
|
type(Agrif_Sequence), dimension(:), allocatable :: sequences
|
|
!---------------------------------------------------------------------------------------------------
|
|
end type Agrif_Sequence_List
|
|
!===================================================================================================
|
|
!
|
|
interface
|
|
function compare_grids ( grid1, grid2 ) result( res )
|
|
import Agrif_Grid
|
|
type(Agrif_Grid), intent(in) :: grid1
|
|
type(Agrif_Grid), intent(in) :: grid2
|
|
integer :: res !< Result of the comparison :
|
|
!! - res < 0 if grid1 < grid2
|
|
!! - res == 0 if grid1 == grid2
|
|
!! - res > 0 if grid1 > grid2
|
|
end function compare_grids
|
|
end interface
|
|
!
|
|
contains
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gl_print ( gridlist )
|
|
!
|
|
!< DEBUG : a virer à terme.
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(in) :: gridlist
|
|
!
|
|
type(Agrif_PGrid), pointer :: gridp
|
|
type(Agrif_Grid), pointer :: grid
|
|
!
|
|
gridp => gridlist % first
|
|
do while ( associated(gridp) )
|
|
grid => gridp % gr
|
|
write(*,'("G",i0,", ")', advance='no') grid % fixedrank
|
|
gridp => gridp % next
|
|
enddo
|
|
write(*,*)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gl_print
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gl_print_debug ( gridlist )
|
|
!
|
|
!< DEBUG : a virer à terme.
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(in) :: gridlist
|
|
!
|
|
type(Agrif_PGrid), pointer :: gridp
|
|
type(Agrif_Grid), pointer :: grid
|
|
!
|
|
write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
|
|
gridp => gridlist % first
|
|
do while ( associated(gridp) )
|
|
grid => gridp % gr
|
|
write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
|
|
grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
|
|
gridp => gridp % next
|
|
enddo
|
|
write(*,*)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gl_print_debug
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gl_append ( gridlist, grid )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(inout) :: gridlist
|
|
type(Agrif_Grid), pointer, intent(in) :: grid
|
|
!
|
|
type(Agrif_PGrid), pointer :: new_gp
|
|
!
|
|
allocate( new_gp )
|
|
!
|
|
new_gp % gr => grid
|
|
new_gp % next => NULL()
|
|
!
|
|
if ( associated(gridlist % last) ) then
|
|
! the list is not empty, append the new pointer at the end
|
|
gridlist % last % next => new_gp
|
|
else
|
|
! the list is empty, the new pointer is the first one
|
|
gridlist % first => new_gp
|
|
endif
|
|
! anyway, for next time 'grid' will be the last one.
|
|
gridlist % last => new_gp
|
|
gridlist % nitems = gridlist % nitems + 1
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gl_append
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function Agrif_gl_popfirst ( gridlist ) result ( grid )
|
|
!
|
|
!< Removes the first item of the list and returns it.
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(inout) :: gridlist
|
|
!
|
|
type(Agrif_PGrid), pointer :: grid_p
|
|
type(Agrif_Grid), pointer :: grid
|
|
!
|
|
grid_p => gridlist % first
|
|
!
|
|
if ( .not. associated( grid_p ) ) then
|
|
grid => NULL()
|
|
return
|
|
endif
|
|
!
|
|
grid => grid_p % gr
|
|
gridlist % first => grid_p % next
|
|
gridlist % nitems = gridlist % nitems - 1
|
|
if ( .not. associated(gridlist % first) ) then
|
|
nullify(gridlist % last)
|
|
endif
|
|
deallocate(grid_p)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_gl_popfirst
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gl_copy ( new_gl, model )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(out) :: new_gl
|
|
type(Agrif_Grid_List), intent(in) :: model
|
|
!
|
|
type(Agrif_PGrid), pointer :: gp
|
|
!
|
|
call Agrif_gl_clear(new_gl)
|
|
gp => model % first
|
|
!
|
|
do while( associated(gp) )
|
|
call Agrif_gl_append( new_gl, gp % gr )
|
|
gp => gp % next
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gl_copy
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_PGrid), pointer, intent(in) :: gridp
|
|
!
|
|
type(Agrif_Grid_List), pointer :: gridlist
|
|
type(Agrif_PGrid), pointer :: gp
|
|
!
|
|
allocate(gridlist)
|
|
!
|
|
gp => gridp
|
|
!
|
|
do while ( associated( gp ) )
|
|
call Agrif_gl_append( gridlist, gp % gr )
|
|
gp => gp % next
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_gl_build_from_gp
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gp_delete ( gridp )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_PGrid), pointer, intent(inout) :: gridp
|
|
!
|
|
type(Agrif_PGrid), pointer :: gp, gpd
|
|
!
|
|
if ( .not. associated( gridp ) ) return
|
|
!
|
|
gp => gridp
|
|
!
|
|
do while( associated(gp) )
|
|
gpd => gp
|
|
gp => gp % next
|
|
deallocate(gpd)
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gp_delete
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gl_clear ( gridlist )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(inout) :: gridlist
|
|
!
|
|
call Agrif_gp_delete(gridlist % first)
|
|
gridlist % first => NULL()
|
|
gridlist % last => NULL()
|
|
gridlist % nitems = 0
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gl_clear
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
subroutine Agrif_gl_delete ( gridlist )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), pointer, intent(inout) :: gridlist
|
|
!
|
|
if ( .not. associated( gridlist ) ) return
|
|
!
|
|
call Agrif_gp_delete(gridlist % first)
|
|
deallocate( gridlist )
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_gl_delete
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(in) :: gridlist
|
|
procedure(compare_grids) :: compare_func
|
|
procedure(compare_grids), optional :: compare_func_opt
|
|
!
|
|
type(Agrif_Grid_List), pointer :: gl_sorted
|
|
type(Agrif_Grid_List), pointer :: gl_left, gl_sorted_left
|
|
type(Agrif_Grid_List), pointer :: gl_right, gl_sorted_right
|
|
type(Agrif_PGrid), pointer :: grid_p
|
|
integer :: n, middle
|
|
!
|
|
! if list size is 1, consider it sorted and return it
|
|
if ( (gridlist % nitems <= 1) ) then
|
|
gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
|
|
return
|
|
endif
|
|
!
|
|
! else split the list into two sublists
|
|
n = 1
|
|
middle = gridlist % nitems / 2
|
|
grid_p => gridlist % first
|
|
!
|
|
allocate( gl_left, gl_right )
|
|
!
|
|
do while ( associated(grid_p) )
|
|
if ( n <= middle ) then
|
|
call Agrif_gl_append(gl_left, grid_p % gr)
|
|
else
|
|
call Agrif_gl_append(gl_right, grid_p % gr)
|
|
endif
|
|
grid_p => grid_p % next
|
|
n = n+1
|
|
enddo
|
|
!
|
|
! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
|
|
gl_sorted_left => Agrif_gl_merge_sort(gl_left, compare_func, compare_func_opt)
|
|
gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
|
|
!
|
|
! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
|
|
gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
|
|
!
|
|
call Agrif_gl_delete( gl_left )
|
|
call Agrif_gl_delete( gl_right )
|
|
call Agrif_gl_delete( gl_sorted_left )
|
|
call Agrif_gl_delete( gl_sorted_right )
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_gl_merge_sort
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid_List), intent(inout) :: gl_left
|
|
type(Agrif_Grid_List), intent(inout) :: gl_right
|
|
procedure(compare_grids) :: compare_func
|
|
procedure(compare_grids), optional :: compare_func_opt
|
|
!
|
|
type(Agrif_Grid_List), pointer :: gl_merged
|
|
type(Agrif_Grid), pointer :: poped_grid
|
|
integer :: comp_value
|
|
!
|
|
allocate( gl_merged )
|
|
!
|
|
do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
|
|
!
|
|
if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
|
|
!
|
|
! Let.s compare both items with the first compare function
|
|
comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
|
|
!
|
|
if ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
|
|
elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
|
|
else ! ( comp_value == 0 )
|
|
!
|
|
! Both items are equal, let.s use the second criterion if the optional
|
|
! compare function is present.
|
|
if ( present(compare_func_opt) ) then
|
|
!
|
|
comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
|
|
!
|
|
if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
|
|
else ; poped_grid => Agrif_gl_popfirst(gl_right)
|
|
endif
|
|
else
|
|
! If the second criterion is not present, let.s just pick the left item
|
|
poped_grid => Agrif_gl_popfirst(gl_left)
|
|
endif
|
|
endif
|
|
!
|
|
! If one of the lists is empty, we just have to pick in the other one.
|
|
elseif ( gl_left % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
|
|
elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
|
|
endif
|
|
!
|
|
call Agrif_gl_append( gl_merged, poped_grid )
|
|
!
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_gl_merge
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function compare_grid_degrees ( grid1, grid2 ) result( res )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid), intent(in) :: grid1
|
|
type(Agrif_Grid), intent(in) :: grid2
|
|
!
|
|
integer :: res
|
|
!
|
|
res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function compare_grid_degrees
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function compare_colors ( grid1, grid2 ) result( res )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid), intent(in) :: grid1
|
|
type(Agrif_Grid), intent(in) :: grid2
|
|
!
|
|
integer :: res
|
|
!
|
|
res = grid1 % seq_num - grid2 % seq_num
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function compare_colors
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function compare_dsat_values ( grid1, grid2 ) result( res )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid), intent(in) :: grid1
|
|
type(Agrif_Grid), intent(in) :: grid2
|
|
!
|
|
integer :: res
|
|
!
|
|
res = grid2 % dsat - grid1 % dsat
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function compare_dsat_values
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
function compare_size_values ( grid1, grid2 ) result( res )
|
|
!---------------------------------------------------------------------------------------------------
|
|
type(Agrif_Grid), intent(in) :: grid1
|
|
type(Agrif_Grid), intent(in) :: grid2
|
|
!
|
|
integer :: res
|
|
!
|
|
res = grid2 % size - grid1 % size
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function compare_size_values
|
|
!===================================================================================================
|
|
!
|
|
end module Agrif_Grids
|