source: vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modgrids.F90 @ 10087

Last change on this file since 10087 was 10087, checked in by rblod, 2 years ago

update AGRIF library

  • Property svn:keywords set to Id
File size: 22.7 KB
Line 
1module Agrif_Grids
2
3    use Agrif_Types
4!
5    implicit none
6!
7!===================================================================================================
8type Agrif_Grid_List
9!---------------------------------------------------------------------------------------------------
10!<  List of grids.
11!
12    integer                     :: nitems = 0      !< Number of elements in the list
13    type(Agrif_PGrid), pointer  :: first => NULL() !< Pointer to the first grid in the list
14    type(Agrif_PGrid), pointer  :: last  => NULL() !< Pointer to the last  grid inserted in the list
15!---------------------------------------------------------------------------------------------------
16end type Agrif_Grid_List
17!===================================================================================================
18!
19!===================================================================================================
20type Agrif_PGrid
21!---------------------------------------------------------------------------------------------------
22!<  Data type to go over the grid hierarchy (used for the creation of this grid hierarchy
23!<  and during the time integration).
24!
25    type(Agrif_Grid) , pointer :: gr   => NULL()  !< Pointer to the actual grid data structure
26    type(Agrif_PGrid), pointer :: next => NULL()  !< Next grid in the list
27!
28!---------------------------------------------------------------------------------------------------
29end type Agrif_PGrid
30!===================================================================================================
31!
32!===================================================================================================
33type Agrif_Grid
34!---------------------------------------------------------------------------------------------------
35!<  Data type to define a grid (position, space and time refinement factors).
36!
37    type(Agrif_Grid)                    , pointer :: parent      => NULL() !< pointer on the parent grid
38    type(Agrif_Grid)                    , pointer :: save_grid   => NULL() !< pointer on the save grid
39    type(Agrif_Grid_List)                         :: child_list            !< List of child grids
40    type(Agrif_Variable),   dimension(:), allocatable :: tabvars    !< List of grid variables
41    type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c  !< List of character grid variables
42    type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r  !< List of real      grid variables
43    type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l  !< List of logical   grid variables
44    type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables
45!
46    real(kind=8), dimension(3)         :: Agrif_x   !< global x, y and z position
47    real(kind=8)   , dimension(3)      :: Agrif_dx  !< global space step in the x, y and z direction
48    real, dimension(3)                 :: Agrif_dt  !< global time  step in the x, y and z direction
49    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction
50    integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction
51    integer, dimension(3)              :: spaceref  !< space refinement factor in the x, y and z direction
52    integer, dimension(3)              :: timeref   !< Time refinement factor in the x, y and z direction
53    integer                            :: ngridstep !< number of time steps
54    integer                            :: rank
55    integer                            :: grid_id   !< moving grid id
56    integer                            :: fixedrank !< number of the grid
57    logical                            :: fixed     !< fixed or moving grid ?
58    logical                            :: oldgrid
59!> \name Logicals indicating if the current grid has a common border with the root coarse grid
60!> @{
61    logical, dimension(3)              :: NearRootBorder
62    logical, dimension(3)              :: DistantRootBorder
63!> @}
64!> \name Arrays for adaptive grid refinement
65!> @{
66    integer, dimension(:)    ,   allocatable :: tabpoint1D
67    integer, dimension(:,:)  ,   allocatable :: tabpoint2D
68    integer, dimension(:,:,:),   allocatable :: tabpoint3D
69!> @}
70!> \name Members for parallel integration
71!> @{
72    type(Agrif_Rectangle),  pointer    :: rect_in_parent => NULL()
73    type(Agrif_Grid_List)              :: neigh_list                !< List of neighboring grids (ie. connected through a common proc)
74    type(Agrif_Proc_List)              :: proc_def_list             !< List of procs that will integrate this grid
75    type(Agrif_Proc_List)              :: proc_def_in_parent_list   !< List of procs that will integrate this grid (defined as in the parent grid)
76    type(Agrif_Proc_List)              :: required_proc_list        !< List of procs that are required for this grid
77    type(Agrif_Sequence_List), pointer :: child_seq => NULL()       !< Sequence for childs
78    integer                            :: seq_num = 0
79    integer                            :: size = 0
80    integer                            :: dsat = 0
81#if defined AGRIF_MPI
82    integer                            :: communicator = -1
83#endif
84!> @}
85    type(Agrif_Variables_List), pointer :: variables => NULL()
86    integer                             :: NbVariables = 0
87    integer                             :: level    !< level of the grid in the hierarchy
88    logical                             :: allocation_is_done = .false.
89    logical                             :: grand_mother_grid = .false.
90!---------------------------------------------------------------------------------------------------
91end type Agrif_Grid
92!===================================================================================================
93!
94!> this pointer always points on the root grid of the grid hierarchy
95type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
96
97!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
98type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
99
100!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
101!> It contains  the safeguard of the grid hierarchy.
102type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
103
104!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
105type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
106!
107!===================================================================================================
108type Agrif_Sequence
109!---------------------------------------------------------------------------------------------------
110    type(Agrif_Grid_List) :: gridlist
111    type(Agrif_Proc_List) :: proclist
112!---------------------------------------------------------------------------------------------------
113end type Agrif_Sequence
114!===================================================================================================
115!
116!===================================================================================================
117type Agrif_Sequence_List
118!---------------------------------------------------------------------------------------------------
119    integer :: nb_seqs
120    type(Agrif_Sequence), dimension(:), allocatable :: sequences
121!---------------------------------------------------------------------------------------------------
122end type Agrif_Sequence_List
123!===================================================================================================
124!
125interface
126    function compare_grids ( grid1, grid2 ) result( res )
127        import Agrif_Grid
128        type(Agrif_Grid), intent(in)    :: grid1
129        type(Agrif_Grid), intent(in)    :: grid2
130        integer                         :: res  !< Result of the comparison :
131                                                !!  - res  < 0   if grid1 <  grid2
132                                                !!  - res == 0   if grid1 == grid2
133                                                !!  - res  > 0   if grid1 >  grid2
134    end function compare_grids
135end interface
136!
137contains
138!
139!===================================================================================================
140subroutine Agrif_gl_print ( gridlist )
141!
142!< DEBUG : a virer à terme.
143!---------------------------------------------------------------------------------------------------
144    type(Agrif_Grid_List), intent(in)   :: gridlist
145!
146    type(Agrif_PGrid), pointer  :: gridp
147    type(Agrif_Grid),  pointer  :: grid
148!
149    gridp => gridlist % first
150    do while ( associated(gridp) )
151        grid => gridp % gr
152        write(*,'("G",i0,", ")', advance='no') grid % fixedrank
153        gridp => gridp % next
154    enddo
155    write(*,*)
156!---------------------------------------------------------------------------------------------------
157end subroutine Agrif_gl_print
158!===================================================================================================
159!
160!===================================================================================================
161subroutine Agrif_gl_print_debug ( gridlist )
162!
163!< DEBUG : a virer à terme.
164!---------------------------------------------------------------------------------------------------
165    type(Agrif_Grid_List), intent(in)   :: gridlist
166!
167    type(Agrif_PGrid), pointer  :: gridp
168    type(Agrif_Grid),  pointer  :: grid
169!
170    write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
171    gridp => gridlist % first
172    do while ( associated(gridp) )
173        grid => gridp % gr
174        write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
175            grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
176        gridp => gridp % next
177    enddo
178    write(*,*)
179!---------------------------------------------------------------------------------------------------
180end subroutine Agrif_gl_print_debug
181!===================================================================================================
182!
183!===================================================================================================
184subroutine Agrif_gl_append ( gridlist, grid )
185!---------------------------------------------------------------------------------------------------
186    type(Agrif_Grid_List),     intent(inout)  :: gridlist
187    type(Agrif_Grid), pointer, intent(in)     :: grid
188!
189    type(Agrif_PGrid), pointer   :: new_gp
190!
191    allocate( new_gp )
192!
193    new_gp % gr   => grid
194    new_gp % next => NULL()
195!
196    if ( associated(gridlist % last) ) then
197    ! the list is not empty, append the new pointer at the end
198        gridlist % last % next => new_gp
199    else
200    ! the list is empty, the new pointer is the first one
201        gridlist % first => new_gp
202    endif
203    ! anyway, for next time 'grid' will be the last one.
204    gridlist % last => new_gp
205    gridlist % nitems = gridlist % nitems + 1
206!---------------------------------------------------------------------------------------------------
207end subroutine Agrif_gl_append
208!===================================================================================================
209!
210!===================================================================================================
211function Agrif_gl_popfirst ( gridlist ) result ( grid )
212!
213!<  Removes the first item of the list and returns it.
214!---------------------------------------------------------------------------------------------------
215    type(Agrif_Grid_List), intent(inout)    :: gridlist
216!
217    type(Agrif_PGrid), pointer :: grid_p
218    type(Agrif_Grid),  pointer :: grid
219!
220    grid_p => gridlist % first
221!
222    if ( .not. associated( grid_p ) ) then
223        grid => NULL()
224        return
225    endif
226!
227    grid              => grid_p % gr
228    gridlist % first  => grid_p % next
229    gridlist % nitems =  gridlist % nitems - 1
230    if ( .not. associated(gridlist % first) ) then
231       nullify(gridlist % last)
232    endif
233    deallocate(grid_p)
234!---------------------------------------------------------------------------------------------------
235end function Agrif_gl_popfirst
236!===================================================================================================
237!
238!===================================================================================================
239subroutine Agrif_gl_copy ( new_gl, model )
240!---------------------------------------------------------------------------------------------------
241    type(Agrif_Grid_List), intent(out)  :: new_gl
242    type(Agrif_Grid_List), intent(in)   :: model
243!
244    type(Agrif_PGrid), pointer :: gp
245!
246    call Agrif_gl_clear(new_gl)
247    gp => model % first
248!
249    do while( associated(gp) )
250        call Agrif_gl_append( new_gl, gp % gr )
251        gp => gp % next
252    enddo
253!---------------------------------------------------------------------------------------------------
254end subroutine Agrif_gl_copy
255!===================================================================================================
256!
257!===================================================================================================
258function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
259!---------------------------------------------------------------------------------------------------
260    type(Agrif_PGrid), pointer, intent(in)   :: gridp
261!
262    type(Agrif_Grid_List), pointer  :: gridlist
263    type(Agrif_PGrid),     pointer  :: gp
264!
265    allocate(gridlist)
266!
267    gp => gridp
268!
269    do while ( associated( gp ) )
270        call Agrif_gl_append( gridlist, gp % gr )
271        gp => gp % next
272    enddo
273!---------------------------------------------------------------------------------------------------
274end function Agrif_gl_build_from_gp
275!===================================================================================================
276!
277!===================================================================================================
278subroutine Agrif_gp_delete ( gridp )
279!---------------------------------------------------------------------------------------------------
280    type(Agrif_PGrid), pointer, intent(inout)  :: gridp
281!
282    type(Agrif_PGrid), pointer   :: gp, gpd
283!
284    if ( .not. associated( gridp ) ) return
285!
286    gp => gridp
287!
288    do while( associated(gp) )
289        gpd => gp
290        gp  => gp % next
291        deallocate(gpd)
292    enddo
293!---------------------------------------------------------------------------------------------------
294end subroutine Agrif_gp_delete
295!===================================================================================================
296!
297!===================================================================================================
298subroutine Agrif_gl_clear ( gridlist )
299!---------------------------------------------------------------------------------------------------
300    type(Agrif_Grid_List), intent(inout)  :: gridlist
301!
302    call Agrif_gp_delete(gridlist % first)
303    gridlist % first => NULL()
304    gridlist % last  => NULL()
305    gridlist % nitems = 0
306!---------------------------------------------------------------------------------------------------
307end subroutine Agrif_gl_clear
308!===================================================================================================
309!
310!===================================================================================================
311subroutine Agrif_gl_delete ( gridlist )
312!---------------------------------------------------------------------------------------------------
313    type(Agrif_Grid_List), pointer, intent(inout)  :: gridlist
314!
315    if ( .not. associated( gridlist ) ) return
316!
317    call Agrif_gp_delete(gridlist % first)
318    deallocate( gridlist )
319!---------------------------------------------------------------------------------------------------
320end subroutine Agrif_gl_delete
321!===================================================================================================
322!
323!===================================================================================================
324recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
325!---------------------------------------------------------------------------------------------------
326    type(Agrif_Grid_List), intent(in)    :: gridlist
327    procedure(compare_grids)             :: compare_func
328    procedure(compare_grids), optional   :: compare_func_opt
329!
330    type(Agrif_Grid_List), pointer  :: gl_sorted
331    type(Agrif_Grid_List), pointer  :: gl_left,  gl_sorted_left
332    type(Agrif_Grid_List), pointer  :: gl_right, gl_sorted_right
333    type(Agrif_PGrid),     pointer  :: grid_p
334    integer                         :: n, middle
335!
336! if list size is 1, consider it sorted and return it
337    if  ( (gridlist % nitems <= 1) ) then
338        gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
339        return
340    endif
341!
342! else split the list into two sublists
343    n = 1
344    middle    =  gridlist % nitems / 2
345    grid_p    => gridlist % first
346!
347    allocate( gl_left, gl_right )
348!
349    do while ( associated(grid_p) )
350        if ( n <= middle ) then
351            call Agrif_gl_append(gl_left,  grid_p % gr)
352        else
353            call Agrif_gl_append(gl_right, grid_p % gr)
354        endif
355        grid_p => grid_p % next
356        n = n+1
357    enddo
358!
359! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
360    gl_sorted_left  => Agrif_gl_merge_sort(gl_left,  compare_func, compare_func_opt)
361    gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
362!
363! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
364    gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
365!
366    call Agrif_gl_delete( gl_left )
367    call Agrif_gl_delete( gl_right )
368    call Agrif_gl_delete( gl_sorted_left )
369    call Agrif_gl_delete( gl_sorted_right )
370!---------------------------------------------------------------------------------------------------
371end function Agrif_gl_merge_sort
372!===================================================================================================
373!
374!===================================================================================================
375function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
376!---------------------------------------------------------------------------------------------------
377    type(Agrif_Grid_List), intent(inout)    :: gl_left
378    type(Agrif_Grid_List), intent(inout)    :: gl_right
379    procedure(compare_grids)                :: compare_func
380    procedure(compare_grids), optional      :: compare_func_opt
381!
382    type(Agrif_Grid_List), pointer  :: gl_merged
383    type(Agrif_Grid),      pointer  :: poped_grid
384    integer                         :: comp_value
385!
386    allocate( gl_merged )
387!
388    do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
389!
390        if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
391!
392!         Let.s compare both items with the first compare function
393            comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
394!
395            if     ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
396            elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
397            else ! ( comp_value == 0 )
398!
399!             Both items are equal, let.s use the second criterion if the optional
400!             compare function is present.
401                if ( present(compare_func_opt) ) then
402!
403                    comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
404!
405                    if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
406                    else                        ; poped_grid => Agrif_gl_popfirst(gl_right)
407                    endif
408                else
409!                 If the second criterion is not present, let.s just pick the left item
410                    poped_grid => Agrif_gl_popfirst(gl_left)
411                endif
412            endif
413!
414!     If one of the lists is empty, we just have to pick in the other one.
415        elseif ( gl_left  % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
416        elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
417        endif
418!
419        call Agrif_gl_append( gl_merged, poped_grid )
420!
421    enddo
422!---------------------------------------------------------------------------------------------------
423end function Agrif_gl_merge
424!===================================================================================================
425!
426!===================================================================================================
427function compare_grid_degrees ( grid1, grid2 ) result( res )
428!---------------------------------------------------------------------------------------------------
429    type(Agrif_Grid), intent(in)    :: grid1
430    type(Agrif_Grid), intent(in)    :: grid2
431!
432    integer     :: res
433!
434    res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
435!---------------------------------------------------------------------------------------------------
436end function compare_grid_degrees
437!===================================================================================================
438!
439!===================================================================================================
440function compare_colors ( grid1, grid2 ) result( res )
441!---------------------------------------------------------------------------------------------------
442    type(Agrif_Grid), intent(in)    :: grid1
443    type(Agrif_Grid), intent(in)    :: grid2
444!
445    integer     :: res
446!
447    res = grid1 % seq_num - grid2 % seq_num
448!---------------------------------------------------------------------------------------------------
449end function compare_colors
450!===================================================================================================
451!
452!===================================================================================================
453function compare_dsat_values ( grid1, grid2 ) result( res )
454!---------------------------------------------------------------------------------------------------
455    type(Agrif_Grid), intent(in)    :: grid1
456    type(Agrif_Grid), intent(in)    :: grid2
457!
458    integer     :: res
459!
460    res = grid2 % dsat - grid1 % dsat
461!---------------------------------------------------------------------------------------------------
462end function compare_dsat_values
463!===================================================================================================
464!
465!===================================================================================================
466function compare_size_values ( grid1, grid2 ) result( res )
467!---------------------------------------------------------------------------------------------------
468    type(Agrif_Grid), intent(in)    :: grid1
469    type(Agrif_Grid), intent(in)    :: grid2
470!
471    integer     :: res
472!
473    res = grid2 % size - grid1 % size
474!---------------------------------------------------------------------------------------------------
475end function compare_size_values
476!===================================================================================================
477!
478end module Agrif_Grids
Note: See TracBrowser for help on using the repository browser.