Changeset 10725 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90
- Timestamp:
- 2019-02-27T14:55:54+01:00 (5 years ago)
- File:
-
- 1 edited
-
vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90
r10087 r10725 2 2 ! $Id$ 3 3 ! 4 ! A GRIF(Adaptive Grid Refinement In Fortran)4 ! Agrif (Adaptive Grid Refinement In Fortran) 5 5 ! 6 6 ! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) … … 19 19 ! You should have received a copy of the GNU General Public License 20 20 ! along with this program; if not, write to the Free Software 21 ! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.21 ! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. 22 22 ! 23 23 !> Module Agrif_Util 24 !> 25 !> 26 ! 24 !! 25 !! This module contains the two procedures called in the main program : 26 !! - #Agrif_Init_Grids allows the initialization of the root coarse grid 27 !! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration. 27 28 ! 28 29 module Agrif_Util 29 30 ! 30 use Agrif_User_Hierarchy 31 use Agrif_User_Variables 32 use Agrif_user_Functions 33 use Agrif_user_Interpolation 34 use Agrif_user_Update 35 31 use Agrif_Clustering 32 use Agrif_BcFunction 33 use Agrif_seq 36 34 ! 37 35 implicit none 38 36 ! 37 abstract interface 38 subroutine step_proc() 39 end subroutine step_proc 40 end interface 41 ! 39 42 contains 40 43 ! 41 44 !=================================================================================================== 45 ! subroutine Agrif_Step 46 ! 47 !> Creates the grid hierarchy and manages the time integration procedure. 48 !> It is called in the main program. 49 !> Calls subroutines #Agrif_Regrid and #Agrif_Integrate. 50 !--------------------------------------------------------------------------------------------------- 51 subroutine Agrif_Step ( procname ) 52 !--------------------------------------------------------------------------------------------------- 53 procedure(step_proc) :: procname !< subroutine to call on each grid 54 type(agrif_grid), pointer :: ref_grid 55 ! 56 ! Set the clustering variables 57 call Agrif_clustering_def() 58 ! 59 ! Creation and initialization of the grid hierarchy 60 if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then 61 ! 62 if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then 63 call Agrif_Regrid() 64 Agrif_regrid_has_been_done = .TRUE. 65 endif 66 ! 67 else 68 ! 69 if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then 70 call Agrif_Regrid() 71 endif 72 ! 73 endif 74 ! 75 ! Time integration of the grid hierarchy 76 if (agrif_coarse) then 77 ref_grid => agrif_coarsegrid 78 else 79 ref_grid => agrif_mygrid 80 endif 81 if ( Agrif_Parallel_sisters ) then 82 call Agrif_Integrate_Parallel(ref_grid,procname) 83 else 84 call Agrif_Integrate(ref_grid,procname) 85 endif 86 ! 87 if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid) 88 !--------------------------------------------------------------------------------------------------- 89 end subroutine Agrif_Step 90 !=================================================================================================== 91 ! 92 !=================================================================================================== 93 ! subroutine Agrif_Step_Child 94 ! 95 !> Apply 'procname' to each grid of the hierarchy 96 !--------------------------------------------------------------------------------------------------- 97 subroutine Agrif_Step_Child ( procname ) 98 !--------------------------------------------------------------------------------------------------- 99 procedure(step_proc) :: procname !< subroutine to call on each grid 100 ! 101 if ( Agrif_Parallel_sisters ) then 102 call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname) 103 else 104 call Agrif_Integrate_Child(Agrif_Mygrid,procname) 105 endif 106 ! 107 if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) 108 !--------------------------------------------------------------------------------------------------- 109 end subroutine Agrif_Step_Child 110 !=================================================================================================== 111 ! 112 !=================================================================================================== 113 ! subroutine Agrif_Step_Childs 114 ! 115 !> Apply 'procname' to each child grids of the current grid 116 !--------------------------------------------------------------------------------------------------- 117 ! ************************************************************************** 118 !!! Subroutine Agrif_Step_Childs 119 ! ************************************************************************** 120 ! 121 Subroutine Agrif_Step_Childs(procname) 122 ! 123 procedure(step_proc) :: procname !< subroutine to call on each grid 124 ! Pointer argument 125 Type(Agrif_Grid),pointer :: g ! Pointer on the current grid 126 ! 127 128 ! 129 ! Local pointer 130 Type(Agrif_pgrid),pointer :: parcours ! Pointer for the recursive 131 ! procedure 132 ! 133 g => Agrif_Curgrid 134 135 parcours => g % child_list % first 136 ! 137 ! Recursive procedure for the time integration of the grid hierarchy 138 Do while (associated(parcours)) 139 ! 140 ! Instanciation of the variables of the current grid 141 Call Agrif_Instance(parcours % gr) 142 143 ! One step on the current grid 144 145 Call procname () 146 parcours => parcours % next 147 enddo 148 149 If (associated(g % child_list % first)) Call Agrif_Instance (g) 150 Return 151 End Subroutine Agrif_Step_Childs 152 !=================================================================================================== 153 ! 154 !=================================================================================================== 155 ! subroutine Agrif_Regrid 156 ! 157 !> Creates the grid hierarchy from fixed grids and adaptive mesh refinement. 158 !--------------------------------------------------------------------------------------------------- 159 subroutine Agrif_Regrid ( procname ) 160 !--------------------------------------------------------------------------------------------------- 161 procedure(init_proc), optional :: procname !< Initialisation subroutine (Default: Agrif_InitValues) 162 ! 163 type(Agrif_Rectangle), pointer :: coarsegrid_fixed 164 type(Agrif_Rectangle), pointer :: coarsegrid_moving 165 integer :: i, j 166 integer :: nunit 167 logical :: BEXIST 168 TYPE(Agrif_Rectangle) :: newrect ! Pointer on a new grid 169 integer :: is_coarse, rhox, rhoy, rhoz, rhot 170 ! 171 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) & 172 call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined 173 ! 174 allocate(coarsegrid_fixed) 175 allocate(coarsegrid_moving) 176 ! 177 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) & 178 call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering 179 ! 180 if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then 181 ! 182 if (Agrif_Mygrid % ngridstep == 0) then 183 ! 184 nunit = Agrif_Get_Unit() 185 open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99) 186 if (agrif_coarse) then ! SKIP the coarse grid declaration 187 if (Agrif_Probdim == 3) then 188 read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot 189 elseif (Agrif_Probdim == 2) then 190 read(nunit,*) is_coarse, rhox, rhoy, rhot 191 elseif (Agrif_Probdim == 2) then 192 read(nunit,*) is_coarse, rhox, rhot 193 endif 194 endif 195 ! Creation of the grid hierarchy from the Agrif_FixedGrids.in file 196 do i = 1,Agrif_Probdim 197 coarsegrid_fixed % imin(i) = 1 198 coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1 199 enddo 200 j = 1 201 call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit) 202 close(nunit) 203 ! 204 call Agrif_gl_clear(Agrif_oldmygrid) 205 ! 206 ! Creation of the grid hierarchy from coarsegrid_fixed 207 call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed) 208 209 else 210 call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list) 211 endif 212 else 213 call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list) 214 call Agrif_gl_clear(Agrif_Mygrid % child_list) 215 endif 216 ! 217 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then 218 ! 219 call Agrif_Save_All(Agrif_oldmygrid) 220 call Agrif_Free_before_All(Agrif_oldmygrid) 221 ! 222 ! Creation of the grid hierarchy from coarsegrid_moving 223 call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving) 224 ! 225 endif 226 ! 227 ! Initialization of the grid hierarchy by copy or interpolation 228 ! 229 #if defined AGRIF_MPI 230 if ( Agrif_Parallel_sisters ) then 231 call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid) 232 call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname) 233 else 234 call Agrif_Init_Hierarchy(Agrif_Mygrid,procname) 235 endif 236 #else 237 call Agrif_Init_Hierarchy(Agrif_Mygrid,procname) 238 #endif 239 ! 240 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid) 241 ! 242 Agrif_regrid_has_been_done = .TRUE. 243 ! 244 call Agrif_Instance( Agrif_Mygrid ) 245 ! 246 deallocate(coarsegrid_fixed) 247 deallocate(coarsegrid_moving) 248 ! 249 return 250 ! 251 ! Opening error 252 ! 253 99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST) 254 if (.not. BEXIST) then 255 print*,'ERROR : File AGRIF_FixedGrids.in not found.' 256 STOP 257 else 258 print*,'Error opening file AGRIF_FixedGrids.in' 259 STOP 260 endif 261 !--------------------------------------------------------------------------------------------------- 262 end subroutine Agrif_Regrid 263 !=================================================================================================== 264 ! 265 !=================================================================================================== 266 ! subroutine Agrif_detect_All 267 ! 268 !> Detects areas to be refined. 269 !--------------------------------------------------------------------------------------------------- 270 recursive subroutine Agrif_detect_all ( g ) 271 !--------------------------------------------------------------------------------------------------- 272 TYPE(Agrif_Grid), pointer :: g !< Pointer on the current grid 273 ! 274 Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure 275 integer, DIMENSION(3) :: size 276 integer :: i 277 real :: g_eps 278 ! 279 parcours => g % child_list % first 280 ! 281 ! To be positioned on the finer grids of the grid hierarchy 282 ! 283 do while (associated(parcours)) 284 call Agrif_detect_all(parcours % gr) 285 parcours => parcours % next 286 enddo 287 ! 288 g_eps = huge(1.) 289 do i = 1,Agrif_Probdim 290 g_eps = min(g_eps, g % Agrif_dx(i)) 291 enddo 292 ! 293 g_eps = g_eps / 100. 294 ! 295 if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0 296 if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0 297 if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0 298 ! 299 do i = 1,Agrif_Probdim 300 if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return 301 enddo 302 ! 303 call Agrif_instance(g) 304 ! 305 ! Detection (Agrif_detect is a users routine) 306 ! 307 do i = 1,Agrif_Probdim 308 size(i) = g % nb(i) + 1 309 enddo 310 ! 311 SELECT CASE (Agrif_Probdim) 312 CASE (1) 313 call Agrif_detect(g%tabpoint1D,size) 314 CASE (2) 315 call Agrif_detect(g%tabpoint2D,size) 316 CASE (3) 317 call Agrif_detect(g%tabpoint3D,size) 318 END SELECT 319 ! 320 ! Addition of the areas detected on the child grids 321 ! 322 parcours => g % child_list % first 323 ! 324 do while (associated(parcours)) 325 call Agrif_Add_detected_areas(g,parcours % gr) 326 parcours => parcours % next 327 enddo 328 !--------------------------------------------------------------------------------------------------- 329 end subroutine Agrif_detect_all 330 !=================================================================================================== 331 ! 332 !=================================================================================================== 333 ! subroutine Agrif_Add_detected_areas 334 ! 335 !> Adds on the parent grid the areas detected on its child grids 336 !--------------------------------------------------------------------------------------------------- 337 subroutine Agrif_Add_detected_areas ( parentgrid, childgrid ) 338 !--------------------------------------------------------------------------------------------------- 339 Type(Agrif_Grid), pointer :: parentgrid 340 Type(Agrif_Grid), pointer :: childgrid 341 ! 342 integer :: i,j,k 343 ! 344 do i = 1,childgrid%nb(1)+1 345 if ( Agrif_Probdim == 1 ) then 346 if (childgrid%tabpoint1D(i)==1) then 347 parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1 348 endif 349 else 350 do j=1,childgrid%nb(2)+1 351 if (Agrif_Probdim==2) then 352 if (childgrid%tabpoint2D(i,j)==1) then 353 parentgrid%tabpoint2D( & 354 childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), & 355 childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1 356 endif 357 else 358 do k=1,childgrid%nb(3)+1 359 if (childgrid%tabpoint3D(i,j,k)==1) then 360 parentgrid%tabpoint3D( & 361 childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), & 362 childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), & 363 childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1 364 endif 365 enddo 366 endif 367 enddo 368 endif 369 enddo 370 !--------------------------------------------------------------------------------------------------- 371 end subroutine Agrif_Add_detected_areas 372 !=================================================================================================== 373 ! 374 !=================================================================================================== 375 ! subroutine Agrif_Free_before_All 376 !--------------------------------------------------------------------------------------------------- 377 recursive subroutine Agrif_Free_before_All ( gridlist ) 378 !--------------------------------------------------------------------------------------------------- 379 Type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list 380 ! 381 Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure 382 ! 383 parcours => gridlist % first 384 ! 385 do while (associated(parcours)) 386 ! 387 if (.not. parcours%gr%fixed) then 388 call Agrif_Free_data_before(parcours%gr) 389 parcours % gr % oldgrid = .TRUE. 390 endif 391 ! 392 call Agrif_Free_before_all (parcours % gr % child_list) 393 ! 394 parcours => parcours % next 395 ! 396 enddo 397 !--------------------------------------------------------------------------------------------------- 398 end subroutine Agrif_Free_before_All 399 !=================================================================================================== 400 ! 401 !=================================================================================================== 402 ! subroutine Agrif_Save_All 403 !--------------------------------------------------------------------------------------------------- 404 recursive subroutine Agrif_Save_All ( gridlist ) 405 !--------------------------------------------------------------------------------------------------- 406 type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list 407 ! 408 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure 409 ! 410 parcours => gridlist % first 411 ! 412 do while (associated(parcours)) 413 ! 414 if (.not. parcours%gr%fixed) then 415 call Agrif_Instance(parcours%gr) 416 call Agrif_Before_Regridding() 417 parcours % gr % oldgrid = .TRUE. 418 endif 419 ! 420 call Agrif_Save_All(parcours % gr % child_list) 421 ! 422 parcours => parcours % next 423 ! 424 enddo 425 !--------------------------------------------------------------------------------------------------- 426 end subroutine Agrif_Save_All 427 !=================================================================================================== 428 ! 429 !=================================================================================================== 430 ! subroutine Agrif_Free_after_All 431 !--------------------------------------------------------------------------------------------------- 432 recursive subroutine Agrif_Free_after_All ( gridlist ) 433 !--------------------------------------------------------------------------------------------------- 434 Type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list to free 435 ! 436 Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive proced 437 Type(Agrif_PGrid), pointer :: preparcours 438 Type(Agrif_PGrid), pointer :: preparcoursini 439 ! 440 allocate(preparcours) 441 ! 442 preparcoursini => preparcours 443 ! 444 nullify(preparcours % gr) 445 ! 446 preparcours % next => gridlist % first 447 parcours => gridlist % first 448 ! 449 do while (associated(parcours)) 450 ! 451 if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then 452 call Agrif_Free_data_after(parcours%gr) 453 endif 454 ! 455 call Agrif_Free_after_all( parcours%gr % child_list ) 456 ! 457 if (parcours % gr % oldgrid) then 458 deallocate(parcours % gr) 459 preparcours % next => parcours % next 460 deallocate(parcours) 461 parcours => preparcours % next 462 else 463 preparcours => preparcours % next 464 parcours => parcours % next 465 endif 466 ! 467 enddo 468 ! 469 deallocate(preparcoursini) 470 !--------------------------------------------------------------------------------------------------- 471 end subroutine Agrif_Free_after_All 472 !=================================================================================================== 473 ! 474 !=================================================================================================== 475 ! subroutine Agrif_Integrate 476 ! 477 !> Manages the time integration of the grid hierarchy. 478 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step 479 !--------------------------------------------------------------------------------------------------- 480 recursive subroutine Agrif_Integrate ( g, procname ) 481 !--------------------------------------------------------------------------------------------------- 482 type(Agrif_Grid), pointer :: g !< Pointer on the current grid 483 procedure(step_proc) :: procname !< Subroutine to call on each grid 484 ! 485 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure 486 integer :: nbt ! Number of time steps of the current grid 487 integer :: i, k 488 ! 489 ! Instanciation of the variables of the current grid 490 ! if ( g % fixedrank /= 0 ) then 491 call Agrif_Instance(g) 492 ! endif 493 ! 494 ! One step on the current grid 495 ! 496 call procname () 497 ! 498 ! Number of time steps on the current grid 499 ! 500 g%ngridstep = g % ngridstep + 1 501 parcours => g % child_list % first 502 ! 503 ! Recursive procedure for the time integration of the grid hierarchy 504 do while (associated(parcours)) 505 ! 506 ! Instanciation of the variables of the current grid 507 call Agrif_Instance(parcours % gr) 508 ! 509 ! Number of time steps 510 nbt = 1 511 do i = 1,Agrif_Probdim 512 nbt = max(nbt, parcours % gr % timeref(i)) 513 enddo 514 ! 515 do k = 1,nbt 516 call Agrif_Integrate(parcours % gr, procname) 517 enddo 518 ! 519 parcours => parcours % next 520 ! 521 enddo 522 !--------------------------------------------------------------------------------------------------- 523 end subroutine Agrif_Integrate 524 !=================================================================================================== 525 ! 526 !=================================================================================================== 527 ! subroutine Agrif_Integrate_Parallel 528 ! 529 !> Manages the time integration of the grid hierarchy in parallel 530 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step 531 !--------------------------------------------------------------------------------------------------- 532 recursive subroutine Agrif_Integrate_Parallel ( g, procname ) 533 !--------------------------------------------------------------------------------------------------- 534 type(Agrif_Grid), pointer :: g !< Pointer on the current grid 535 procedure(step_proc) :: procname !< Subroutine to call on each grid 536 ! 537 #if defined AGRIF_MPI 538 type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure 539 integer :: nbt ! Number of time steps of the current grid 540 integer :: i, k, is 541 ! 542 ! Instanciation of the variables of the current grid 543 if ( g % fixedrank /= 0 ) then 544 call Agrif_Instance(g) 545 endif 546 ! 547 ! One step on the current grid 548 call procname () 549 ! 550 ! Number of time steps on the current grid 551 g % ngridstep = g % ngridstep + 1 552 ! 553 ! Continue only if the grid has defined sequences of child integrations. 554 if ( .not. associated(g % child_seq) ) return 555 ! 556 do is = 1, g % child_seq % nb_seqs 557 ! 558 ! For each sequence, a given processor does integrate only on grid. 559 gridp => Agrif_seq_select_child(g,is) 560 ! 561 ! Instanciation of the variables of the current grid 562 call Agrif_Instance(gridp % gr) 563 ! 564 ! Number of time steps 565 nbt = 1 566 do i = 1,Agrif_Probdim 567 nbt = max(nbt, gridp % gr % timeref(i)) 568 enddo 569 ! 570 do k = 1,nbt 571 call Agrif_Integrate_Parallel(gridp % gr, procname) 572 enddo 573 ! 574 enddo 575 #else 576 call Agrif_Integrate( g, procname ) 577 #endif 578 !--------------------------------------------------------------------------------------------------- 579 end subroutine Agrif_Integrate_Parallel 580 !=================================================================================================== 581 ! 582 !=================================================================================================== 583 ! 584 ! 585 !=================================================================================================== 586 ! subroutine Agrif_Integrate_ChildGrids 587 ! 588 !> Manages the time integration of the grid hierarchy. 589 !! Call the subroutine procname on each child grid of the current grid 590 !--------------------------------------------------------------------------------------------------- 591 recursive subroutine Agrif_Integrate_ChildGrids ( procname ) 592 !--------------------------------------------------------------------------------------------------- 593 procedure(step_proc) :: procname !< Subroutine to call on each grid 594 ! 595 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure 596 integer :: nbt ! Number of time steps of the current grid 597 integer :: i, k, is 598 type(Agrif_Grid) , pointer :: save_grid 599 type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure 600 601 save_grid => Agrif_Curgrid 602 603 ! Number of time steps on the current grid 604 save_grid % ngridstep = save_grid % ngridstep + 1 605 606 #ifdef AGRIF_MPI 607 if ( .not. Agrif_Parallel_sisters ) then 608 #endif 609 parcours => save_grid % child_list % first 610 ! 611 ! Recursive procedure for the time integration of the grid hierarchy 612 do while (associated(parcours)) 613 ! 614 ! Instanciation of the variables of the current grid 615 call Agrif_Instance(parcours % gr) 616 ! 617 ! Number of time steps 618 nbt = 1 619 do i = 1,Agrif_Probdim 620 nbt = max(nbt, parcours % gr % timeref(i)) 621 enddo 622 ! 623 do k = 1,nbt 624 call procname() 625 enddo 626 ! 627 parcours => parcours % next 628 ! 629 enddo 630 631 #ifdef AGRIF_MPI 632 else 633 ! Continue only if the grid has defined sequences of child integrations. 634 if ( .not. associated(save_grid % child_seq) ) return 635 ! 636 do is = 1, save_grid % child_seq % nb_seqs 637 ! 638 ! For each sequence, a given processor does integrate only on grid. 639 gridp => Agrif_seq_select_child(save_grid,is) 640 ! 641 ! Instanciation of the variables of the current grid 642 call Agrif_Instance(gridp % gr) 643 ! 644 ! Number of time steps 645 nbt = 1 646 do i = 1,Agrif_Probdim 647 nbt = max(nbt, gridp % gr % timeref(i)) 648 enddo 649 ! 650 do k = 1,nbt 651 call procname() 652 enddo 653 ! 654 enddo 655 endif 656 #endif 657 658 call Agrif_Instance(save_grid) 659 660 !--------------------------------------------------------------------------------------------------- 661 end subroutine Agrif_Integrate_ChildGrids 662 !=================================================================================================== 663 !=================================================================================================== 664 ! subroutine Agrif_Integrate_Child 665 ! 666 !> Manages the time integration of the grid hierarchy. 667 !! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step. 668 !--------------------------------------------------------------------------------------------------- 669 recursive subroutine Agrif_Integrate_Child ( g, procname ) 670 !--------------------------------------------------------------------------------------------------- 671 type(Agrif_Grid), pointer :: g !< Pointer on the current grid 672 procedure(step_proc) :: procname !< Subroutine to call on each grid 673 ! 674 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure 675 ! 676 ! One step on the current grid 677 ! 678 call procname () 679 ! 680 ! Number of time steps on the current grid 681 ! 682 parcours => g % child_list % first 683 ! 684 ! Recursive procedure for the time integration of the grid hierarchy 685 do while (associated(parcours)) 686 ! 687 ! Instanciation of the variables of the current grid 688 call Agrif_Instance(parcours % gr) 689 call Agrif_Integrate_Child (parcours % gr, procname) 690 parcours => parcours % next 691 ! 692 enddo 693 !--------------------------------------------------------------------------------------------------- 694 end subroutine Agrif_Integrate_Child 695 !=================================================================================================== 696 ! 697 !=================================================================================================== 698 ! subroutine Agrif_Integrate_Child_Parallel 699 ! 700 !> Manages the time integration of the grid hierarchy. 701 !! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step. 702 !--------------------------------------------------------------------------------------------------- 703 recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname ) 704 !--------------------------------------------------------------------------------------------------- 705 type(Agrif_Grid), pointer :: g !< Pointer on the current grid 706 procedure(step_proc) :: procname !< Subroutine to call on each grid 707 ! 708 #if defined AGRIF_MPI 709 type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure 710 integer :: is 711 ! 712 ! Instanciation of the variables of the current grid 713 call Agrif_Instance(g) 714 ! 715 ! One step on the current grid 716 call procname () 717 ! 718 ! Continue only if the grid has defined sequences of child integrations. 719 if ( .not. associated(g % child_seq) ) return 720 ! 721 do is = 1, g % child_seq % nb_seqs 722 ! 723 ! For each sequence, a given processor does integrate only on grid. 724 gridp => Agrif_seq_select_child(g,is) 725 call Agrif_Integrate_Child_Parallel(gridp % gr, procname) 726 ! 727 enddo 728 ! 729 call Agrif_Instance(g) 730 #else 731 call Agrif_Integrate_Child( g, procname ) 732 #endif 733 !--------------------------------------------------------------------------------------------------- 734 end subroutine Agrif_Integrate_Child_Parallel 735 !=================================================================================================== 736 ! 737 !=================================================================================================== 738 ! subroutine Agrif_Init_Grids 739 ! 740 !> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program. 741 !--------------------------------------------------------------------------------------------------- 742 subroutine Agrif_Init_Grids ( procname1, procname2 ) 743 !--------------------------------------------------------------------------------------------------- 744 procedure(typedef_proc), optional :: procname1 !< (Default: Agrif_probdim_modtype_def) 745 procedure(alloc_proc), optional :: procname2 !< (Default: Agrif_Allocationcalls) 746 ! 747 integer :: i, ierr_allocate, nunit 748 integer :: is_coarse, rhox,rhoy,rhoz,rhot 749 logical :: BEXIST 750 ! 751 if (present(procname1)) Then 752 call procname1() 753 else 754 call Agrif_probdim_modtype_def() 755 endif 756 ! 757 758 ! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in 759 nunit = Agrif_Get_Unit() 760 open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98) 761 if (Agrif_Probdim == 3) then 762 read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot 763 elseif (Agrif_Probdim == 2) then 764 read(nunit,*) is_coarse, rhox, rhoy, rhot 765 elseif (Agrif_Probdim == 2) then 766 read(nunit,*) is_coarse, rhox, rhot 767 endif 768 if (is_coarse == -1) then 769 agrif_coarse = .TRUE. 770 if (Agrif_Probdim == 3) then 771 coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/) 772 elseif (Agrif_Probdim == 2) then 773 coarse_spaceref(1:2)=(/rhox,rhoy/) 774 elseif (Agrif_Probdim == 2) then 775 coarse_spaceref(1:1)=(/rhox/) 776 endif 777 coarse_timeref(1:Agrif_Probdim) = rhot 778 endif 779 close(nunit) 780 781 Agrif_UseSpecialValue = .FALSE. 782 Agrif_UseSpecialValueFineGrid = .FALSE. 783 Agrif_SpecialValue = 0. 784 Agrif_SpecialValueFineGrid = 0. 785 ! 786 allocate(Agrif_Mygrid) 787 allocate(Agrif_OldMygrid) 788 ! 789 ! Space and time refinement factors are set to 1 on the root grid 790 ! 791 do i = 1,Agrif_Probdim 792 Agrif_Mygrid % spaceref(i) = coarse_spaceref(i) 793 Agrif_Mygrid % timeref(i) = coarse_timeref(i) 794 enddo 795 ! 796 ! Initialization of the number of time steps 797 Agrif_Mygrid % ngridstep = 0 798 Agrif_Mygrid % grid_id = 0 799 ! 800 ! No parent grid for the root coarse grid 801 nullify(Agrif_Mygrid % parent) 802 ! 803 ! Initialization of the minimum positions, global abscissa and space steps 804 do i = 1, Agrif_Probdim 805 Agrif_Mygrid % ix(i) = 1 806 Agrif_Mygrid % Agrif_x(i) = 0. 807 Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i) 808 Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i) 809 ! Borders of the root coarse grid 810 Agrif_Mygrid % NearRootBorder(i) = .true. 811 Agrif_Mygrid % DistantRootBorder(i) = .true. 812 enddo 813 ! 814 ! The root coarse grid is a fixed grid 815 Agrif_Mygrid % fixed = .TRUE. 816 ! Level of the root grid 817 Agrif_Mygrid % level = 0 818 ! Maximum level in the hierarchy 819 Agrif_MaxLevelLoc = 0 820 ! 821 ! Number of the grid pointed by Agrif_Mygrid (root coarse grid) 822 Agrif_Mygrid % rank = 1 823 ! 824 ! Number of the root grid as a fixed grid 825 Agrif_Mygrid % fixedrank = 0 826 ! 827 ! Initialization of some fields of the root grid variables 828 ierr_allocate = 0 829 if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate) 830 if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate) 831 if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate) 832 if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate) 833 if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate) 834 if (ierr_allocate /= 0) THEN 835 STOP "*** ERROR WHEN ALLOCATING TABVARS ***" 836 endif 837 ! 838 ! Initialization of the other fields of the root grid variables (number of 839 ! cells, positions, number and type of its dimensions, ...) 840 call Agrif_Instance(Agrif_Mygrid) 841 call Agrif_Set_numberofcells(Agrif_Mygrid) 842 ! 843 ! Allocation of the array containing the values of the grid variables 844 call Agrif_Allocation(Agrif_Mygrid, procname2) 845 call Agrif_initialisations(Agrif_Mygrid) 846 ! 847 ! Total number of fixed grids 848 Agrif_nbfixedgrids = 0 849 850 ! If a grand mother grid is declared 851 852 if (agrif_coarse) then 853 allocate(Agrif_Coarsegrid) 854 855 Agrif_Coarsegrid % ngridstep = 0 856 Agrif_Coarsegrid % grid_id = -9999 857 858 do i = 1, Agrif_Probdim 859 Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i) 860 Agrif_Coarsegrid%timeref(i) = coarse_timeref(i) 861 Agrif_Coarsegrid % ix(i) = 1 862 Agrif_Coarsegrid % Agrif_x(i) = 0. 863 Agrif_Coarsegrid % Agrif_dx(i) = 1. 864 Agrif_Coarsegrid % Agrif_dt(i) = 1. 865 ! Borders of the root coarse grid 866 Agrif_Coarsegrid % NearRootBorder(i) = .true. 867 Agrif_Coarsegrid % DistantRootBorder(i) = .true. 868 Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i) 869 enddo 870 871 ! The root coarse grid is a fixed grid 872 Agrif_Coarsegrid % fixed = .TRUE. 873 ! Level of the root grid 874 Agrif_Coarsegrid % level = -1 875 876 Agrif_Coarsegrid % grand_mother_grid = .true. 877 878 ! Number of the grid pointed by Agrif_Mygrid (root coarse grid) 879 Agrif_Coarsegrid % rank = -9999 880 ! 881 ! Number of the root grid as a fixed grid 882 Agrif_Coarsegrid % fixedrank = -9999 883 884 Agrif_Mygrid%parent => Agrif_Coarsegrid 885 886 ! Not used but required to prevent seg fault 887 Agrif_Coarsegrid%parent => Agrif_Mygrid 888 889 call Agrif_Create_Var(Agrif_Coarsegrid) 890 891 ! Reset to null 892 Nullify(Agrif_Coarsegrid%parent) 893 894 Agrif_Coarsegrid%child_list%nitems = 1 895 allocate(Agrif_Coarsegrid%child_list%first) 896 allocate(Agrif_Coarsegrid%child_list%last) 897 Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid 898 Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid 899 900 endif 901 902 return 903 904 98 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST) 905 if (.not. BEXIST) then 906 print*,'ERROR : File AGRIF_FixedGrids.in not found.' 907 STOP 908 else 909 print*,'Error opening file AGRIF_FixedGrids.in' 910 STOP 911 endif 912 913 !--------------------------------------------------------------------------------------------------- 914 end subroutine Agrif_Init_Grids 915 !=================================================================================================== 916 ! 917 !=================================================================================================== 918 ! subroutine Agrif_Deallocation 919 ! 920 !> Deallocates all data arrays. 921 !--------------------------------------------------------------------------------------------------- 922 subroutine Agrif_Deallocation 923 !--------------------------------------------------------------------------------------------------- 924 integer :: nb 925 type(Agrif_Variable), pointer :: var 926 type(Agrif_Variable_c), pointer :: var_c 927 type(Agrif_Variable_l), pointer :: var_l 928 type(Agrif_Variable_i), pointer :: var_i 929 ! 930 do nb = 1,Agrif_NbVariables(0) 931 ! 932 var => Agrif_Mygrid % tabvars(nb) 933 ! 934 if ( allocated(var % array1) ) deallocate(var % array1) 935 if ( allocated(var % array2) ) deallocate(var % array2) 936 if ( allocated(var % array3) ) deallocate(var % array3) 937 if ( allocated(var % array4) ) deallocate(var % array4) 938 if ( allocated(var % array5) ) deallocate(var % array5) 939 if ( allocated(var % array6) ) deallocate(var % array6) 940 ! 941 if ( allocated(var % sarray1) ) deallocate(var % sarray1) 942 if ( allocated(var % sarray2) ) deallocate(var % sarray2) 943 if ( allocated(var % sarray3) ) deallocate(var % sarray3) 944 if ( allocated(var % sarray4) ) deallocate(var % sarray4) 945 if ( allocated(var % sarray5) ) deallocate(var % sarray5) 946 if ( allocated(var % sarray6) ) deallocate(var % sarray6) 947 ! 948 if ( allocated(var % darray1) ) deallocate(var % darray1) 949 if ( allocated(var % darray2) ) deallocate(var % darray2) 950 if ( allocated(var % darray3) ) deallocate(var % darray3) 951 if ( allocated(var % darray4) ) deallocate(var % darray4) 952 if ( allocated(var % darray5) ) deallocate(var % darray5) 953 if ( allocated(var % darray6) ) deallocate(var % darray6) 954 ! 955 enddo 956 ! 957 do nb = 1,Agrif_NbVariables(1) 958 ! 959 var_c => Agrif_Mygrid % tabvars_c(nb) 960 ! 961 if ( allocated(var_c % carray1) ) deallocate(var_c % carray1) 962 if ( allocated(var_c % carray2) ) deallocate(var_c % carray2) 963 ! 964 enddo 965 966 do nb = 1,Agrif_NbVariables(3) 967 ! 968 var_l => Agrif_Mygrid % tabvars_l(nb) 969 ! 970 if ( allocated(var_l % larray1) ) deallocate(var_l % larray1) 971 if ( allocated(var_l % larray2) ) deallocate(var_l % larray2) 972 if ( allocated(var_l % larray3) ) deallocate(var_l % larray3) 973 if ( allocated(var_l % larray4) ) deallocate(var_l % larray4) 974 if ( allocated(var_l % larray5) ) deallocate(var_l % larray5) 975 if ( allocated(var_l % larray6) ) deallocate(var_l % larray6) 976 ! 977 enddo 978 ! 979 do nb = 1,Agrif_NbVariables(4) 980 ! 981 var_i => Agrif_Mygrid % tabvars_i(nb) 982 ! 983 if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1) 984 if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2) 985 if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3) 986 if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4) 987 if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5) 988 if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6) 989 ! 990 enddo 991 ! 992 if ( allocated(Agrif_Mygrid % tabvars) ) deallocate(Agrif_Mygrid % tabvars) 993 if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c) 994 if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r) 995 if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l) 996 if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i) 997 deallocate(Agrif_Mygrid) 998 !--------------------------------------------------------------------------------------------------- 999 end subroutine Agrif_Deallocation 1000 !=================================================================================================== 1001 ! 1002 !=================================================================================================== 1003 ! subroutine Agrif_Step_adj 1004 ! 1005 !> creates the grid hierarchy and manages the backward time integration procedure. 1006 !> It is called in the main program. 1007 !> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj. 1008 !--------------------------------------------------------------------------------------------------- 1009 subroutine Agrif_Step_adj ( procname ) 1010 !--------------------------------------------------------------------------------------------------- 1011 procedure(step_proc) :: procname !< Subroutine to call on each grid 1012 ! 1013 ! Creation and initialization of the grid hierarchy 1014 ! 1015 ! Set the clustering variables 1016 call Agrif_clustering_def() 1017 ! 1018 if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then 1019 ! 1020 if (Agrif_Mygrid % ngridstep == 0) then 1021 if (.not.Agrif_regrid_has_been_done ) then 1022 call Agrif_Regrid() 1023 endif 1024 call Agrif_Instance(Agrif_Mygrid) 1025 endif 1026 ! 1027 else 1028 ! 1029 if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then 1030 call Agrif_Regrid() 1031 call Agrif_Instance(Agrif_Mygrid) 1032 endif 1033 ! 1034 endif 1035 ! 1036 ! Time integration of the grid hierarchy 1037 ! 1038 call Agrif_Integrate_adj (Agrif_Mygrid,procname) 1039 ! 1040 if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) 1041 ! 1042 !--------------------------------------------------------------------------------------------------- 1043 end subroutine Agrif_Step_adj 1044 !=================================================================================================== 1045 ! 1046 !=================================================================================================== 1047 ! subroutine Agrif_Integrate_adj 1048 ! 1049 !> Manages the backward time integration of the grid hierarchy. 1050 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj 1051 !--------------------------------------------------------------------------------------------------- 1052 recursive subroutine Agrif_Integrate_adj ( g, procname ) 1053 !--------------------------------------------------------------------------------------------------- 1054 type(Agrif_Grid), pointer :: g !< Pointer on the current grid 1055 procedure(step_proc) :: procname !< Subroutine to call on each grid 1056 ! 1057 type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure 1058 integer :: nbt ! Number of time steps of the current grid 1059 integer :: k 1060 ! 1061 ! Instanciation of the variables of the current grid 1062 if ( g%fixedrank /= 0 ) then 1063 call Agrif_Instance(g) 1064 endif 1065 ! 1066 ! Number of time steps on the current grid 1067 ! 1068 g%ngridstep = g % ngridstep + 1 1069 parcours => g % child_list % first 1070 ! 1071 ! Recursive procedure for the time integration of the grid hierarchy 1072 do while (associated(parcours)) 1073 ! 1074 ! Instanciation of the variables of the current grid 1075 call Agrif_Instance(parcours % gr) 1076 ! 1077 ! Number of time steps 1078 nbt = 1 1079 do k = 1,Agrif_Probdim 1080 nbt = max(nbt, parcours % gr % timeref(k)) 1081 enddo 1082 ! 1083 do k = nbt,1,-1 1084 call Agrif_Integrate_adj(parcours % gr, procname) 1085 enddo 1086 ! 1087 parcours => parcours % next 1088 ! 1089 enddo 1090 ! 1091 if ( g % child_list % nitems > 0 ) call Agrif_Instance(g) 1092 ! 1093 ! One step on the current grid 1094 call procname () 1095 ! 1096 end subroutine Agrif_Integrate_adj 1097 !=================================================================================================== 1098 ! 1099 !=================================================================================================== 1100 ! subroutine Agrif_Step_Child_adj 1101 ! 1102 !> Apply 'procname' to each grid of the hierarchy from Child to Parent 1103 !--------------------------------------------------------------------------------------------------- 1104 subroutine Agrif_Step_Child_adj ( procname ) 1105 !--------------------------------------------------------------------------------------------------- 1106 procedure(step_proc) :: procname !< Subroutine to call on each grid 1107 ! 1108 call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname) 1109 ! 1110 if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) 1111 ! 1112 end subroutine Agrif_Step_Child_adj 1113 !=================================================================================================== 1114 ! 1115 !=================================================================================================== 1116 ! subroutine Agrif_Integrate_Child_adj 1117 ! 1118 !> Manages the backward time integration of the grid hierarchy. 1119 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj. 1120 !--------------------------------------------------------------------------------------------------- 1121 recursive subroutine Agrif_Integrate_Child_adj ( g, procname ) 1122 !--------------------------------------------------------------------------------------------------- 1123 type(Agrif_Grid),pointer :: g !< Pointer on the current grid 1124 procedure(step_proc) :: procname !< Subroutine to call on each grid 1125 ! 1126 type(Agrif_PGrid),pointer :: parcours !< Pointer for the recursive procedure 1127 ! 1128 parcours => g % child_list % first 1129 ! 1130 ! Recursive procedure for the time integration of the grid hierarchy 1131 do while (associated(parcours)) 1132 ! 1133 ! Instanciation of the variables of the current grid 1134 call Agrif_Instance(parcours % gr) 1135 call Agrif_Integrate_Child_adj(parcours % gr, procname) 1136 ! 1137 parcours => parcours % next 1138 ! 1139 enddo 1140 if ( g % child_list % nitems > 0 ) call Agrif_Instance(g) 1141 ! 1142 ! One step on the current grid 1143 call procname() 1144 !--------------------------------------------------------------------------------------------------- 1145 end subroutine Agrif_Integrate_Child_adj 1146 !=================================================================================================== 1147 ! 1148 !=================================================================================================== 42 1149 43 1150 end module Agrif_Util
Note: See TracChangeset
for help on using the changeset viewer.
