[4777] | 1 | module Agrif_Grids |
---|
| 2 | |
---|
| 3 | use Agrif_Types |
---|
| 4 | ! |
---|
| 5 | implicit none |
---|
| 6 | ! |
---|
| 7 | !=================================================================================================== |
---|
| 8 | type 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 16 | end type Agrif_Grid_List |
---|
| 17 | !=================================================================================================== |
---|
| 18 | ! |
---|
| 19 | !=================================================================================================== |
---|
| 20 | type 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 29 | end type Agrif_PGrid |
---|
| 30 | !=================================================================================================== |
---|
| 31 | ! |
---|
| 32 | !=================================================================================================== |
---|
| 33 | type 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 , dimension(3) :: Agrif_x !< global x, y and z position |
---|
| 47 | real , 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 91 | end type Agrif_Grid |
---|
| 92 | !=================================================================================================== |
---|
| 93 | ! |
---|
| 94 | !> this pointer always points on the root grid of the grid hierarchy |
---|
| 95 | type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL() |
---|
| 96 | |
---|
| 97 | !> this pointer always points on the grand mother grid of the grid hierarchy (if any) |
---|
| 98 | type(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. |
---|
| 102 | type(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)) |
---|
| 105 | type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL() |
---|
| 106 | ! |
---|
| 107 | !=================================================================================================== |
---|
| 108 | type Agrif_Sequence |
---|
| 109 | !--------------------------------------------------------------------------------------------------- |
---|
| 110 | type(Agrif_Grid_List) :: gridlist |
---|
| 111 | type(Agrif_Proc_List) :: proclist |
---|
| 112 | !--------------------------------------------------------------------------------------------------- |
---|
| 113 | end type Agrif_Sequence |
---|
| 114 | !=================================================================================================== |
---|
| 115 | ! |
---|
| 116 | !=================================================================================================== |
---|
| 117 | type Agrif_Sequence_List |
---|
| 118 | !--------------------------------------------------------------------------------------------------- |
---|
| 119 | integer :: nb_seqs |
---|
| 120 | type(Agrif_Sequence), dimension(:), allocatable :: sequences |
---|
| 121 | !--------------------------------------------------------------------------------------------------- |
---|
| 122 | end type Agrif_Sequence_List |
---|
| 123 | !=================================================================================================== |
---|
| 124 | ! |
---|
| 125 | interface |
---|
| 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 |
---|
| 135 | end interface |
---|
| 136 | ! |
---|
| 137 | contains |
---|
| 138 | ! |
---|
| 139 | !=================================================================================================== |
---|
| 140 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 157 | end subroutine Agrif_gl_print |
---|
| 158 | !=================================================================================================== |
---|
| 159 | ! |
---|
| 160 | !=================================================================================================== |
---|
| 161 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 180 | end subroutine Agrif_gl_print_debug |
---|
| 181 | !=================================================================================================== |
---|
| 182 | ! |
---|
| 183 | !=================================================================================================== |
---|
| 184 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 207 | end subroutine Agrif_gl_append |
---|
| 208 | !=================================================================================================== |
---|
| 209 | ! |
---|
| 210 | !=================================================================================================== |
---|
| 211 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 235 | end function Agrif_gl_popfirst |
---|
| 236 | !=================================================================================================== |
---|
| 237 | ! |
---|
| 238 | !=================================================================================================== |
---|
| 239 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 254 | end subroutine Agrif_gl_copy |
---|
| 255 | !=================================================================================================== |
---|
| 256 | ! |
---|
| 257 | !=================================================================================================== |
---|
| 258 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 274 | end function Agrif_gl_build_from_gp |
---|
| 275 | !=================================================================================================== |
---|
| 276 | ! |
---|
| 277 | !=================================================================================================== |
---|
| 278 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 294 | end subroutine Agrif_gp_delete |
---|
| 295 | !=================================================================================================== |
---|
| 296 | ! |
---|
| 297 | !=================================================================================================== |
---|
| 298 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 307 | end subroutine Agrif_gl_clear |
---|
| 308 | !=================================================================================================== |
---|
| 309 | ! |
---|
| 310 | !=================================================================================================== |
---|
| 311 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 320 | end subroutine Agrif_gl_delete |
---|
| 321 | !=================================================================================================== |
---|
| 322 | ! |
---|
| 323 | !=================================================================================================== |
---|
| 324 | recursive 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 371 | end function Agrif_gl_merge_sort |
---|
| 372 | !=================================================================================================== |
---|
| 373 | ! |
---|
| 374 | !=================================================================================================== |
---|
| 375 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 423 | end function Agrif_gl_merge |
---|
| 424 | !=================================================================================================== |
---|
| 425 | ! |
---|
| 426 | !=================================================================================================== |
---|
| 427 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 436 | end function compare_grid_degrees |
---|
| 437 | !=================================================================================================== |
---|
| 438 | ! |
---|
| 439 | !=================================================================================================== |
---|
| 440 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 449 | end function compare_colors |
---|
| 450 | !=================================================================================================== |
---|
| 451 | ! |
---|
| 452 | !=================================================================================================== |
---|
| 453 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 462 | end function compare_dsat_values |
---|
| 463 | !=================================================================================================== |
---|
| 464 | ! |
---|
| 465 | !=================================================================================================== |
---|
| 466 | function 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 | !--------------------------------------------------------------------------------------------------- |
---|
| 475 | end function compare_size_values |
---|
| 476 | !=================================================================================================== |
---|
| 477 | ! |
---|
| 478 | end module Agrif_Grids |
---|