New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
modgrids.F90 in vendors/AGRIF/dev/AGRIF_FILES – NEMO

source: vendors/AGRIF/dev/AGRIF_FILES/modgrids.F90

Last change on this file was 14975, checked in by jchanut, 3 years ago

#2638, merge new AGRIF library into trunk

  • Property svn:keywords set to Id
File size: 22.9 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 = 1    !< 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    logical,dimension(4)                :: periodicity = .false.
91    integer,dimension(4)                :: periodicity_decal = 0
92!---------------------------------------------------------------------------------------------------
93end type Agrif_Grid
94!===================================================================================================
95!
96!> this pointer always points on the root grid of the grid hierarchy
97type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
98
99!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
100type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
101
102!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
103!> It contains  the safeguard of the grid hierarchy.
104type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
105
106!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
107type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
108
109!> Pointer to the current child grid (the link is done before calls to procname)
110type(Agrif_Grid) , pointer :: Agrif_CurChildgrid => NULL()
111!
112!===================================================================================================
113type Agrif_Sequence
114!---------------------------------------------------------------------------------------------------
115    type(Agrif_Grid_List) :: gridlist
116    type(Agrif_Proc_List) :: proclist
117!---------------------------------------------------------------------------------------------------
118end type Agrif_Sequence
119!===================================================================================================
120!
121!===================================================================================================
122type Agrif_Sequence_List
123!---------------------------------------------------------------------------------------------------
124    integer :: nb_seqs
125    type(Agrif_Sequence), dimension(:), allocatable :: sequences
126!---------------------------------------------------------------------------------------------------
127end type Agrif_Sequence_List
128!===================================================================================================
129!
130interface
131    function compare_grids ( grid1, grid2 ) result( res )
132        import Agrif_Grid
133        type(Agrif_Grid), intent(in)    :: grid1
134        type(Agrif_Grid), intent(in)    :: grid2
135        integer                         :: res  !< Result of the comparison :
136                                                !!  - res  < 0   if grid1 <  grid2
137                                                !!  - res == 0   if grid1 == grid2
138                                                !!  - res  > 0   if grid1 >  grid2
139    end function compare_grids
140end interface
141!
142contains
143!
144!===================================================================================================
145subroutine Agrif_gl_print ( gridlist )
146!
147!< DEBUG : a virer à terme.
148!---------------------------------------------------------------------------------------------------
149    type(Agrif_Grid_List), intent(in)   :: gridlist
150!
151    type(Agrif_PGrid), pointer  :: gridp
152    type(Agrif_Grid),  pointer  :: grid
153!
154    gridp => gridlist % first
155    do while ( associated(gridp) )
156        grid => gridp % gr
157        write(*,'("G",i0,", ")', advance='no') grid % fixedrank
158        gridp => gridp % next
159    enddo
160    write(*,*)
161!---------------------------------------------------------------------------------------------------
162end subroutine Agrif_gl_print
163!===================================================================================================
164!
165!===================================================================================================
166subroutine Agrif_gl_print_debug ( gridlist )
167!
168!< DEBUG : a virer à terme.
169!---------------------------------------------------------------------------------------------------
170    type(Agrif_Grid_List), intent(in)   :: gridlist
171!
172    type(Agrif_PGrid), pointer  :: gridp
173    type(Agrif_Grid),  pointer  :: grid
174!
175    write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
176    gridp => gridlist % first
177    do while ( associated(gridp) )
178        grid => gridp % gr
179        write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
180            grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
181        gridp => gridp % next
182    enddo
183    write(*,*)
184!---------------------------------------------------------------------------------------------------
185end subroutine Agrif_gl_print_debug
186!===================================================================================================
187!
188!===================================================================================================
189subroutine Agrif_gl_append ( gridlist, grid )
190!---------------------------------------------------------------------------------------------------
191    type(Agrif_Grid_List),     intent(inout)  :: gridlist
192    type(Agrif_Grid), pointer, intent(in)     :: grid
193!
194    type(Agrif_PGrid), pointer   :: new_gp
195!
196    allocate( new_gp )
197!
198    new_gp % gr   => grid
199    new_gp % next => NULL()
200!
201    if ( associated(gridlist % last) ) then
202    ! the list is not empty, append the new pointer at the end
203        gridlist % last % next => new_gp
204    else
205    ! the list is empty, the new pointer is the first one
206        gridlist % first => new_gp
207    endif
208    ! anyway, for next time 'grid' will be the last one.
209    gridlist % last => new_gp
210    gridlist % nitems = gridlist % nitems + 1
211!---------------------------------------------------------------------------------------------------
212end subroutine Agrif_gl_append
213!===================================================================================================
214!
215!===================================================================================================
216function Agrif_gl_popfirst ( gridlist ) result ( grid )
217!
218!<  Removes the first item of the list and returns it.
219!---------------------------------------------------------------------------------------------------
220    type(Agrif_Grid_List), intent(inout)    :: gridlist
221!
222    type(Agrif_PGrid), pointer :: grid_p
223    type(Agrif_Grid),  pointer :: grid
224!
225    grid_p => gridlist % first
226!
227    if ( .not. associated( grid_p ) ) then
228        grid => NULL()
229        return
230    endif
231!
232    grid              => grid_p % gr
233    gridlist % first  => grid_p % next
234    gridlist % nitems =  gridlist % nitems - 1
235    if ( .not. associated(gridlist % first) ) then
236       nullify(gridlist % last)
237    endif
238    deallocate(grid_p)
239!---------------------------------------------------------------------------------------------------
240end function Agrif_gl_popfirst
241!===================================================================================================
242!
243!===================================================================================================
244subroutine Agrif_gl_copy ( new_gl, model )
245!---------------------------------------------------------------------------------------------------
246    type(Agrif_Grid_List), intent(out)  :: new_gl
247    type(Agrif_Grid_List), intent(in)   :: model
248!
249    type(Agrif_PGrid), pointer :: gp
250!
251    call Agrif_gl_clear(new_gl)
252    gp => model % first
253!
254    do while( associated(gp) )
255        call Agrif_gl_append( new_gl, gp % gr )
256        gp => gp % next
257    enddo
258!---------------------------------------------------------------------------------------------------
259end subroutine Agrif_gl_copy
260!===================================================================================================
261!
262!===================================================================================================
263function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
264!---------------------------------------------------------------------------------------------------
265    type(Agrif_PGrid), pointer, intent(in)   :: gridp
266!
267    type(Agrif_Grid_List), pointer  :: gridlist
268    type(Agrif_PGrid),     pointer  :: gp
269!
270    allocate(gridlist)
271!
272    gp => gridp
273!
274    do while ( associated( gp ) )
275        call Agrif_gl_append( gridlist, gp % gr )
276        gp => gp % next
277    enddo
278!---------------------------------------------------------------------------------------------------
279end function Agrif_gl_build_from_gp
280!===================================================================================================
281!
282!===================================================================================================
283subroutine Agrif_gp_delete ( gridp )
284!---------------------------------------------------------------------------------------------------
285    type(Agrif_PGrid), pointer, intent(inout)  :: gridp
286!
287    type(Agrif_PGrid), pointer   :: gp, gpd
288!
289    if ( .not. associated( gridp ) ) return
290!
291    gp => gridp
292!
293    do while( associated(gp) )
294        gpd => gp
295        gp  => gp % next
296        deallocate(gpd)
297    enddo
298!---------------------------------------------------------------------------------------------------
299end subroutine Agrif_gp_delete
300!===================================================================================================
301!
302!===================================================================================================
303subroutine Agrif_gl_clear ( gridlist )
304!---------------------------------------------------------------------------------------------------
305    type(Agrif_Grid_List), intent(inout)  :: gridlist
306!
307    call Agrif_gp_delete(gridlist % first)
308    gridlist % first => NULL()
309    gridlist % last  => NULL()
310    gridlist % nitems = 0
311!---------------------------------------------------------------------------------------------------
312end subroutine Agrif_gl_clear
313!===================================================================================================
314!
315!===================================================================================================
316subroutine Agrif_gl_delete ( gridlist )
317!---------------------------------------------------------------------------------------------------
318    type(Agrif_Grid_List), pointer, intent(inout)  :: gridlist
319!
320    if ( .not. associated( gridlist ) ) return
321!
322    call Agrif_gp_delete(gridlist % first)
323    deallocate( gridlist )
324!---------------------------------------------------------------------------------------------------
325end subroutine Agrif_gl_delete
326!===================================================================================================
327!
328!===================================================================================================
329recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
330!---------------------------------------------------------------------------------------------------
331    type(Agrif_Grid_List), intent(in)    :: gridlist
332    procedure(compare_grids)             :: compare_func
333    procedure(compare_grids), optional   :: compare_func_opt
334!
335    type(Agrif_Grid_List), pointer  :: gl_sorted
336    type(Agrif_Grid_List), pointer  :: gl_left,  gl_sorted_left
337    type(Agrif_Grid_List), pointer  :: gl_right, gl_sorted_right
338    type(Agrif_PGrid),     pointer  :: grid_p
339    integer                         :: n, middle
340!
341! if list size is 1, consider it sorted and return it
342    if  ( (gridlist % nitems <= 1) ) then
343        gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
344        return
345    endif
346!
347! else split the list into two sublists
348    n = 1
349    middle    =  gridlist % nitems / 2
350    grid_p    => gridlist % first
351!
352    allocate( gl_left, gl_right )
353!
354    do while ( associated(grid_p) )
355        if ( n <= middle ) then
356            call Agrif_gl_append(gl_left,  grid_p % gr)
357        else
358            call Agrif_gl_append(gl_right, grid_p % gr)
359        endif
360        grid_p => grid_p % next
361        n = n+1
362    enddo
363!
364! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
365    gl_sorted_left  => Agrif_gl_merge_sort(gl_left,  compare_func, compare_func_opt)
366    gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
367!
368! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
369    gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
370!
371    call Agrif_gl_delete( gl_left )
372    call Agrif_gl_delete( gl_right )
373    call Agrif_gl_delete( gl_sorted_left )
374    call Agrif_gl_delete( gl_sorted_right )
375!---------------------------------------------------------------------------------------------------
376end function Agrif_gl_merge_sort
377!===================================================================================================
378!
379!===================================================================================================
380function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
381!---------------------------------------------------------------------------------------------------
382    type(Agrif_Grid_List), intent(inout)    :: gl_left
383    type(Agrif_Grid_List), intent(inout)    :: gl_right
384    procedure(compare_grids)                :: compare_func
385    procedure(compare_grids), optional      :: compare_func_opt
386!
387    type(Agrif_Grid_List), pointer  :: gl_merged
388    type(Agrif_Grid),      pointer  :: poped_grid
389    integer                         :: comp_value
390!
391    allocate( gl_merged )
392!
393    do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
394!
395        if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
396!
397!         Let.s compare both items with the first compare function
398            comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
399!
400            if     ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
401            elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
402            else ! ( comp_value == 0 )
403!
404!             Both items are equal, let.s use the second criterion if the optional
405!             compare function is present.
406                if ( present(compare_func_opt) ) then
407!
408                    comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
409!
410                    if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
411                    else                        ; poped_grid => Agrif_gl_popfirst(gl_right)
412                    endif
413                else
414!                 If the second criterion is not present, let.s just pick the left item
415                    poped_grid => Agrif_gl_popfirst(gl_left)
416                endif
417            endif
418!
419!     If one of the lists is empty, we just have to pick in the other one.
420        elseif ( gl_left  % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
421        elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
422        endif
423!
424        call Agrif_gl_append( gl_merged, poped_grid )
425!
426    enddo
427!---------------------------------------------------------------------------------------------------
428end function Agrif_gl_merge
429!===================================================================================================
430!
431!===================================================================================================
432function compare_grid_degrees ( grid1, grid2 ) result( res )
433!---------------------------------------------------------------------------------------------------
434    type(Agrif_Grid), intent(in)    :: grid1
435    type(Agrif_Grid), intent(in)    :: grid2
436!
437    integer     :: res
438!
439    res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
440!---------------------------------------------------------------------------------------------------
441end function compare_grid_degrees
442!===================================================================================================
443!
444!===================================================================================================
445function compare_colors ( grid1, grid2 ) result( res )
446!---------------------------------------------------------------------------------------------------
447    type(Agrif_Grid), intent(in)    :: grid1
448    type(Agrif_Grid), intent(in)    :: grid2
449!
450    integer     :: res
451!
452    res = grid1 % seq_num - grid2 % seq_num
453!---------------------------------------------------------------------------------------------------
454end function compare_colors
455!===================================================================================================
456!
457!===================================================================================================
458function compare_dsat_values ( grid1, grid2 ) result( res )
459!---------------------------------------------------------------------------------------------------
460    type(Agrif_Grid), intent(in)    :: grid1
461    type(Agrif_Grid), intent(in)    :: grid2
462!
463    integer     :: res
464!
465    res = grid2 % dsat - grid1 % dsat
466!---------------------------------------------------------------------------------------------------
467end function compare_dsat_values
468!===================================================================================================
469!
470!===================================================================================================
471function compare_size_values ( grid1, grid2 ) result( res )
472!---------------------------------------------------------------------------------------------------
473    type(Agrif_Grid), intent(in)    :: grid1
474    type(Agrif_Grid), intent(in)    :: grid2
475!
476    integer     :: res
477!
478    res = grid2 % size - grid1 % size
479!---------------------------------------------------------------------------------------------------
480end function compare_size_values
481!===================================================================================================
482!
483end module Agrif_Grids
Note: See TracBrowser for help on using the repository browser.