Changeset 10087 for vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90
- Timestamp:
- 2018-09-05T15:33:44+02:00 (6 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
r10084 r10087 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- 21 ! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. 22 22 ! 23 23 !> Module Agrif_Util 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. 24 !> 25 !> 26 ! 28 27 ! 29 28 module Agrif_Util 30 29 ! 31 use Agrif_Clustering 32 use Agrif_BcFunction 33 use Agrif_seq 34 use Agrif_Link 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 35 36 ! 36 37 implicit none 37 38 ! 38 abstract interface39 subroutine step_proc()40 end subroutine step_proc41 end interface42 !43 39 contains 44 40 ! 45 !===================================================================================================46 ! subroutine Agrif_Step47 !48 !> Creates the grid hierarchy and manages the time integration procedure.49 !> It is called in the main program.50 !> Calls subroutines #Agrif_Regrid and #Agrif_Integrate.51 !---------------------------------------------------------------------------------------------------52 subroutine Agrif_Step ( procname )53 !---------------------------------------------------------------------------------------------------54 procedure(step_proc) :: procname !< subroutine to call on each grid55 type(agrif_grid), pointer :: ref_grid56 !57 ! Set the clustering variables58 call Agrif_clustering_def()59 !60 ! Creation and initialization of the grid hierarchy61 if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then62 !63 if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then64 call Agrif_Regrid()65 Agrif_regrid_has_been_done = .TRUE.66 endif67 !68 else69 !70 if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then71 call Agrif_Regrid()72 endif73 !74 endif75 !76 ! Time integration of the grid hierarchy77 if (agrif_coarse) then78 ref_grid => agrif_coarsegrid79 else80 ref_grid => agrif_mygrid81 endif82 if ( Agrif_Parallel_sisters ) then83 call Agrif_Integrate_Parallel(ref_grid,procname)84 else85 call Agrif_Integrate(ref_grid,procname)86 endif87 !88 if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid)89 !---------------------------------------------------------------------------------------------------90 end subroutine Agrif_Step91 !===================================================================================================92 !93 !===================================================================================================94 ! subroutine Agrif_Step_Child95 !96 !> Apply 'procname' to each grid of the hierarchy97 !---------------------------------------------------------------------------------------------------98 subroutine Agrif_Step_Child ( procname )99 !---------------------------------------------------------------------------------------------------100 procedure(step_proc) :: procname !< subroutine to call on each grid101 !102 if ( Agrif_Parallel_sisters ) then103 call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname)104 else105 call Agrif_Integrate_Child(Agrif_Mygrid,procname)106 endif107 !108 if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)109 !---------------------------------------------------------------------------------------------------110 end subroutine Agrif_Step_Child111 !===================================================================================================112 !113 !===================================================================================================114 ! subroutine Agrif_Regrid115 !116 !> Creates the grid hierarchy from fixed grids and adaptive mesh refinement.117 !---------------------------------------------------------------------------------------------------118 subroutine Agrif_Regrid ( procname )119 !---------------------------------------------------------------------------------------------------120 procedure(init_proc), optional :: procname !< Initialisation subroutine (Default: Agrif_InitValues)121 !122 type(Agrif_Rectangle), pointer :: coarsegrid_fixed123 type(Agrif_Rectangle), pointer :: coarsegrid_moving124 integer :: i, j125 integer :: nunit126 logical :: BEXIST127 TYPE(Agrif_Rectangle) :: newrect ! Pointer on a new grid128 integer :: is_coarse, rhox, rhoy, rhoz, rhot129 !130 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &131 call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined132 !133 allocate(coarsegrid_fixed)134 allocate(coarsegrid_moving)135 !136 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &137 call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering138 !139 if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then140 !141 if (Agrif_Mygrid % ngridstep == 0) then142 !143 nunit = Agrif_Get_Unit()144 open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99)145 if (agrif_coarse) then ! SKIP the coarse grid declaration146 if (Agrif_Probdim == 3) then147 read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot148 elseif (Agrif_Probdim == 2) then149 read(nunit,*) is_coarse, rhox, rhoy, rhot150 elseif (Agrif_Probdim == 2) then151 read(nunit,*) is_coarse, rhox, rhot152 endif153 endif154 ! Creation of the grid hierarchy from the Agrif_FixedGrids.in file155 do i = 1,Agrif_Probdim156 coarsegrid_fixed % imin(i) = 1157 coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1158 enddo159 j = 1160 call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit)161 close(nunit)162 !163 call Agrif_gl_clear(Agrif_oldmygrid)164 !165 ! Creation of the grid hierarchy from coarsegrid_fixed166 call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed)167 168 else169 call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)170 endif171 else172 call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)173 call Agrif_gl_clear(Agrif_Mygrid % child_list)174 endif175 !176 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then177 !178 call Agrif_Save_All(Agrif_oldmygrid)179 call Agrif_Free_before_All(Agrif_oldmygrid)180 !181 ! Creation of the grid hierarchy from coarsegrid_moving182 call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving)183 !184 endif185 !186 ! Initialization of the grid hierarchy by copy or interpolation187 !188 #if defined AGRIF_MPI189 if ( Agrif_Parallel_sisters ) then190 call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid)191 call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname)192 else193 call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)194 endif195 #else196 call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)197 #endif198 !199 if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid)200 !201 Agrif_regrid_has_been_done = .TRUE.202 !203 call Agrif_Instance( Agrif_Mygrid )204 !205 deallocate(coarsegrid_fixed)206 deallocate(coarsegrid_moving)207 !208 return209 !210 ! Opening error211 !212 99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)213 if (.not. BEXIST) then214 print*,'ERROR : File AGRIF_FixedGrids.in not found.'215 STOP216 else217 print*,'Error opening file AGRIF_FixedGrids.in'218 STOP219 endif220 !---------------------------------------------------------------------------------------------------221 end subroutine Agrif_Regrid222 !===================================================================================================223 !224 !===================================================================================================225 ! subroutine Agrif_detect_All226 !227 !> Detects areas to be refined.228 !---------------------------------------------------------------------------------------------------229 recursive subroutine Agrif_detect_all ( g )230 !---------------------------------------------------------------------------------------------------231 TYPE(Agrif_Grid), pointer :: g !< Pointer on the current grid232 !233 Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure234 integer, DIMENSION(3) :: size235 integer :: i236 real :: g_eps237 !238 parcours => g % child_list % first239 !240 ! To be positioned on the finer grids of the grid hierarchy241 !242 do while (associated(parcours))243 call Agrif_detect_all(parcours % gr)244 parcours => parcours % next245 enddo246 !247 g_eps = huge(1.)248 do i = 1,Agrif_Probdim249 g_eps = min(g_eps, g % Agrif_dx(i))250 enddo251 !252 g_eps = g_eps / 100.253 !254 if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0255 if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0256 if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0257 !258 do i = 1,Agrif_Probdim259 if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return260 enddo261 !262 call Agrif_instance(g)263 !264 ! Detection (Agrif_detect is a users routine)265 !266 do i = 1,Agrif_Probdim267 size(i) = g % nb(i) + 1268 enddo269 !270 SELECT CASE (Agrif_Probdim)271 CASE (1)272 call Agrif_detect(g%tabpoint1D,size)273 CASE (2)274 call Agrif_detect(g%tabpoint2D,size)275 CASE (3)276 call Agrif_detect(g%tabpoint3D,size)277 END SELECT278 !279 ! Addition of the areas detected on the child grids280 !281 parcours => g % child_list % first282 !283 do while (associated(parcours))284 call Agrif_Add_detected_areas(g,parcours % gr)285 parcours => parcours % next286 enddo287 !---------------------------------------------------------------------------------------------------288 end subroutine Agrif_detect_all289 !===================================================================================================290 !291 !===================================================================================================292 ! subroutine Agrif_Add_detected_areas293 !294 !> Adds on the parent grid the areas detected on its child grids295 !---------------------------------------------------------------------------------------------------296 subroutine Agrif_Add_detected_areas ( parentgrid, childgrid )297 !---------------------------------------------------------------------------------------------------298 Type(Agrif_Grid), pointer :: parentgrid299 Type(Agrif_Grid), pointer :: childgrid300 !301 integer :: i,j,k302 !303 do i = 1,childgrid%nb(1)+1304 if ( Agrif_Probdim == 1 ) then305 if (childgrid%tabpoint1D(i)==1) then306 parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1307 endif308 else309 do j=1,childgrid%nb(2)+1310 if (Agrif_Probdim==2) then311 if (childgrid%tabpoint2D(i,j)==1) then312 parentgrid%tabpoint2D( &313 childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &314 childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1315 endif316 else317 do k=1,childgrid%nb(3)+1318 if (childgrid%tabpoint3D(i,j,k)==1) then319 parentgrid%tabpoint3D( &320 childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &321 childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), &322 childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1323 endif324 enddo325 endif326 enddo327 endif328 enddo329 !---------------------------------------------------------------------------------------------------330 end subroutine Agrif_Add_detected_areas331 !===================================================================================================332 !333 !===================================================================================================334 ! subroutine Agrif_Free_before_All335 !---------------------------------------------------------------------------------------------------336 recursive subroutine Agrif_Free_before_All ( gridlist )337 !---------------------------------------------------------------------------------------------------338 Type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list339 !340 Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure341 !342 parcours => gridlist % first343 !344 do while (associated(parcours))345 !346 if (.not. parcours%gr%fixed) then347 call Agrif_Free_data_before(parcours%gr)348 parcours % gr % oldgrid = .TRUE.349 endif350 !351 call Agrif_Free_before_all (parcours % gr % child_list)352 !353 parcours => parcours % next354 !355 enddo356 !---------------------------------------------------------------------------------------------------357 end subroutine Agrif_Free_before_All358 !===================================================================================================359 !360 !===================================================================================================361 ! subroutine Agrif_Save_All362 !---------------------------------------------------------------------------------------------------363 recursive subroutine Agrif_Save_All ( gridlist )364 !---------------------------------------------------------------------------------------------------365 type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list366 !367 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure368 !369 parcours => gridlist % first370 !371 do while (associated(parcours))372 !373 if (.not. parcours%gr%fixed) then374 call Agrif_Instance(parcours%gr)375 call Agrif_Before_Regridding()376 parcours % gr % oldgrid = .TRUE.377 endif378 !379 call Agrif_Save_All(parcours % gr % child_list)380 !381 parcours => parcours % next382 !383 enddo384 !---------------------------------------------------------------------------------------------------385 end subroutine Agrif_Save_All386 !===================================================================================================387 !388 !===================================================================================================389 ! subroutine Agrif_Free_after_All390 !---------------------------------------------------------------------------------------------------391 recursive subroutine Agrif_Free_after_All ( gridlist )392 !---------------------------------------------------------------------------------------------------393 Type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list to free394 !395 Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive proced396 Type(Agrif_PGrid), pointer :: preparcours397 Type(Agrif_PGrid), pointer :: preparcoursini398 !399 allocate(preparcours)400 !401 preparcoursini => preparcours402 !403 nullify(preparcours % gr)404 !405 preparcours % next => gridlist % first406 parcours => gridlist % first407 !408 do while (associated(parcours))409 !410 if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then411 call Agrif_Free_data_after(parcours%gr)412 endif413 !414 call Agrif_Free_after_all( parcours%gr % child_list )415 !416 if (parcours % gr % oldgrid) then417 deallocate(parcours % gr)418 preparcours % next => parcours % next419 deallocate(parcours)420 parcours => preparcours % next421 else422 preparcours => preparcours % next423 parcours => parcours % next424 endif425 !426 enddo427 !428 deallocate(preparcoursini)429 !---------------------------------------------------------------------------------------------------430 end subroutine Agrif_Free_after_All431 !===================================================================================================432 !433 !===================================================================================================434 ! subroutine Agrif_Integrate435 !436 !> Manages the time integration of the grid hierarchy.437 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step438 !---------------------------------------------------------------------------------------------------439 recursive subroutine Agrif_Integrate ( g, procname )440 !---------------------------------------------------------------------------------------------------441 type(Agrif_Grid), pointer :: g !< Pointer on the current grid442 procedure(step_proc) :: procname !< Subroutine to call on each grid443 !444 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure445 integer :: nbt ! Number of time steps of the current grid446 integer :: i, k447 !448 ! Instanciation of the variables of the current grid449 ! if ( g % fixedrank /= 0 ) then450 call Agrif_Instance(g)451 ! endif452 !453 ! One step on the current grid454 !455 call procname ()456 !457 ! Number of time steps on the current grid458 !459 g%ngridstep = g % ngridstep + 1460 parcours => g % child_list % first461 !462 ! Recursive procedure for the time integration of the grid hierarchy463 do while (associated(parcours))464 !465 ! Instanciation of the variables of the current grid466 call Agrif_Instance(parcours % gr)467 !468 ! Number of time steps469 nbt = 1470 do i = 1,Agrif_Probdim471 nbt = max(nbt, parcours % gr % timeref(i))472 enddo473 !474 do k = 1,nbt475 call Agrif_Integrate(parcours % gr, procname)476 enddo477 !478 parcours => parcours % next479 !480 enddo481 !---------------------------------------------------------------------------------------------------482 end subroutine Agrif_Integrate483 !===================================================================================================484 !485 !===================================================================================================486 ! subroutine Agrif_Integrate_Parallel487 !488 !> Manages the time integration of the grid hierarchy in parallel489 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step490 !---------------------------------------------------------------------------------------------------491 recursive subroutine Agrif_Integrate_Parallel ( g, procname )492 !---------------------------------------------------------------------------------------------------493 type(Agrif_Grid), pointer :: g !< Pointer on the current grid494 procedure(step_proc) :: procname !< Subroutine to call on each grid495 !496 #if defined AGRIF_MPI497 type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure498 integer :: nbt ! Number of time steps of the current grid499 integer :: i, k, is500 !501 ! Instanciation of the variables of the current grid502 if ( g % fixedrank /= 0 ) then503 call Agrif_Instance(g)504 endif505 !506 ! One step on the current grid507 call procname ()508 !509 ! Number of time steps on the current grid510 g % ngridstep = g % ngridstep + 1511 !512 ! Continue only if the grid has defined sequences of child integrations.513 if ( .not. associated(g % child_seq) ) return514 !515 do is = 1, g % child_seq % nb_seqs516 !517 ! For each sequence, a given processor does integrate only on grid.518 gridp => Agrif_seq_select_child(g,is)519 !520 ! Instanciation of the variables of the current grid521 call Agrif_Instance(gridp % gr)522 !523 ! Number of time steps524 nbt = 1525 do i = 1,Agrif_Probdim526 nbt = max(nbt, gridp % gr % timeref(i))527 enddo528 !529 do k = 1,nbt530 call Agrif_Integrate_Parallel(gridp % gr, procname)531 enddo532 !533 enddo534 #else535 call Agrif_Integrate( g, procname )536 #endif537 !---------------------------------------------------------------------------------------------------538 end subroutine Agrif_Integrate_Parallel539 !===================================================================================================540 !541 !542 !===================================================================================================543 ! subroutine Agrif_Integrate_ChildGrids544 !545 !> Manages the time integration of the grid hierarchy.546 !! Call the subroutine procname on each child grid of the current grid547 !---------------------------------------------------------------------------------------------------548 recursive subroutine Agrif_Integrate_ChildGrids ( procname )549 !---------------------------------------------------------------------------------------------------550 procedure(step_proc) :: procname !< Subroutine to call on each grid551 !552 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure553 integer :: nbt ! Number of time steps of the current grid554 integer :: i, k, is555 type(Agrif_Grid) , pointer :: save_grid556 type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure557 558 save_grid => Agrif_Curgrid559 41 560 ! Number of time steps on the current grid561 save_grid % ngridstep = save_grid % ngridstep + 1562 563 #ifdef AGRIF_MPI564 if ( .not. Agrif_Parallel_sisters ) then565 #endif566 parcours => save_grid % child_list % first567 !568 ! Recursive procedure for the time integration of the grid hierarchy569 do while (associated(parcours))570 !571 ! Instanciation of the variables of the current grid572 call Agrif_Instance(parcours % gr)573 !574 ! Number of time steps575 nbt = 1576 do i = 1,Agrif_Probdim577 nbt = max(nbt, parcours % gr % timeref(i))578 enddo579 !580 do k = 1,nbt581 call procname()582 enddo583 !584 parcours => parcours % next585 !586 enddo587 588 #ifdef AGRIF_MPI589 else590 ! Continue only if the grid has defined sequences of child integrations.591 if ( .not. associated(save_grid % child_seq) ) return592 !593 do is = 1, save_grid % child_seq % nb_seqs594 !595 ! For each sequence, a given processor does integrate only on grid.596 gridp => Agrif_seq_select_child(save_grid,is)597 !598 ! Instanciation of the variables of the current grid599 call Agrif_Instance(gridp % gr)600 !601 ! Number of time steps602 nbt = 1603 do i = 1,Agrif_Probdim604 nbt = max(nbt, gridp % gr % timeref(i))605 enddo606 !607 do k = 1,nbt608 call procname()609 enddo610 !611 enddo612 endif613 #endif614 615 call Agrif_Instance(save_grid)616 617 !---------------------------------------------------------------------------------------------------618 end subroutine Agrif_Integrate_ChildGrids619 !===================================================================================================620 !===================================================================================================621 ! subroutine Agrif_Integrate_Child622 !623 !> Manages the time integration of the grid hierarchy.624 !! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.625 !---------------------------------------------------------------------------------------------------626 recursive subroutine Agrif_Integrate_Child ( g, procname )627 !---------------------------------------------------------------------------------------------------628 type(Agrif_Grid), pointer :: g !< Pointer on the current grid629 procedure(step_proc) :: procname !< Subroutine to call on each grid630 !631 type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure632 !633 ! One step on the current grid634 !635 call procname ()636 !637 ! Number of time steps on the current grid638 !639 parcours => g % child_list % first640 !641 ! Recursive procedure for the time integration of the grid hierarchy642 do while (associated(parcours))643 !644 ! Instanciation of the variables of the current grid645 call Agrif_Instance(parcours % gr)646 call Agrif_Integrate_Child (parcours % gr, procname)647 parcours => parcours % next648 !649 enddo650 !---------------------------------------------------------------------------------------------------651 end subroutine Agrif_Integrate_Child652 !===================================================================================================653 !654 !===================================================================================================655 ! subroutine Agrif_Integrate_Child_Parallel656 !657 !> Manages the time integration of the grid hierarchy.658 !! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.659 !---------------------------------------------------------------------------------------------------660 recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname )661 !---------------------------------------------------------------------------------------------------662 type(Agrif_Grid), pointer :: g !< Pointer on the current grid663 procedure(step_proc) :: procname !< Subroutine to call on each grid664 !665 #if defined AGRIF_MPI666 type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure667 integer :: is668 !669 ! Instanciation of the variables of the current grid670 call Agrif_Instance(g)671 !672 ! One step on the current grid673 call procname ()674 !675 ! Continue only if the grid has defined sequences of child integrations.676 if ( .not. associated(g % child_seq) ) return677 !678 do is = 1, g % child_seq % nb_seqs679 !680 ! For each sequence, a given processor does integrate only on grid.681 gridp => Agrif_seq_select_child(g,is)682 call Agrif_Integrate_Child_Parallel(gridp % gr, procname)683 !684 enddo685 !686 call Agrif_Instance(g)687 #else688 call Agrif_Integrate_Child( g, procname )689 #endif690 !---------------------------------------------------------------------------------------------------691 end subroutine Agrif_Integrate_Child_Parallel692 !===================================================================================================693 !694 !===================================================================================================695 ! subroutine Agrif_Init_Grids696 !697 !> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program.698 !---------------------------------------------------------------------------------------------------699 subroutine Agrif_Init_Grids ( procname1, procname2 )700 !---------------------------------------------------------------------------------------------------701 procedure(typedef_proc), optional :: procname1 !< (Default: Agrif_probdim_modtype_def)702 procedure(alloc_proc), optional :: procname2 !< (Default: Agrif_Allocationcalls)703 !704 integer :: i, ierr_allocate, nunit705 integer :: is_coarse, rhox,rhoy,rhoz,rhot706 logical :: BEXIST707 !708 if (present(procname1)) Then709 call procname1()710 else711 call Agrif_probdim_modtype_def()712 endif713 !714 715 ! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in716 nunit = Agrif_Get_Unit()717 open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98)718 if (Agrif_Probdim == 3) then719 read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot720 elseif (Agrif_Probdim == 2) then721 read(nunit,*) is_coarse, rhox, rhoy, rhot722 elseif (Agrif_Probdim == 2) then723 read(nunit,*) is_coarse, rhox, rhot724 endif725 if (is_coarse == -1) then726 agrif_coarse = .TRUE.727 if (Agrif_Probdim == 3) then728 coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)729 elseif (Agrif_Probdim == 2) then730 coarse_spaceref(1:2)=(/rhox,rhoy/)731 elseif (Agrif_Probdim == 2) then732 coarse_spaceref(1:1)=(/rhox/)733 endif734 coarse_timeref(1:Agrif_Probdim) = rhot735 endif736 close(nunit)737 738 Agrif_UseSpecialValue = .FALSE.739 Agrif_UseSpecialValueFineGrid = .FALSE.740 Agrif_SpecialValue = 0.741 Agrif_SpecialValueFineGrid = 0.742 !743 allocate(Agrif_Mygrid)744 allocate(Agrif_OldMygrid)745 !746 ! Space and time refinement factors are set to 1 on the root grid747 !748 do i = 1,Agrif_Probdim749 Agrif_Mygrid % spaceref(i) = coarse_spaceref(i)750 Agrif_Mygrid % timeref(i) = coarse_timeref(i)751 enddo752 !753 ! Initialization of the number of time steps754 Agrif_Mygrid % ngridstep = 0755 Agrif_Mygrid % grid_id = 0756 !757 ! No parent grid for the root coarse grid758 nullify(Agrif_Mygrid % parent)759 !760 ! Initialization of the minimum positions, global abscissa and space steps761 do i = 1, Agrif_Probdim762 Agrif_Mygrid % ix(i) = 1763 Agrif_Mygrid % Agrif_x(i) = 0.764 Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i)765 Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i)766 ! Borders of the root coarse grid767 Agrif_Mygrid % NearRootBorder(i) = .true.768 Agrif_Mygrid % DistantRootBorder(i) = .true.769 enddo770 !771 ! The root coarse grid is a fixed grid772 Agrif_Mygrid % fixed = .TRUE.773 ! Level of the root grid774 Agrif_Mygrid % level = 0775 ! Maximum level in the hierarchy776 Agrif_MaxLevelLoc = 0777 !778 ! Number of the grid pointed by Agrif_Mygrid (root coarse grid)779 Agrif_Mygrid % rank = 1780 !781 ! Number of the root grid as a fixed grid782 Agrif_Mygrid % fixedrank = 0783 !784 ! Initialization of some fields of the root grid variables785 ierr_allocate = 0786 if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate)787 if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate)788 if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate)789 if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate)790 if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate)791 if (ierr_allocate /= 0) THEN792 STOP "*** ERROR WHEN ALLOCATING TABVARS ***"793 endif794 !795 ! Initialization of the other fields of the root grid variables (number of796 ! cells, positions, number and type of its dimensions, ...)797 call Agrif_Instance(Agrif_Mygrid)798 call Agrif_Set_numberofcells(Agrif_Mygrid)799 !800 ! Allocation of the array containing the values of the grid variables801 call Agrif_Allocation(Agrif_Mygrid, procname2)802 call Agrif_initialisations(Agrif_Mygrid)803 !804 ! Total number of fixed grids805 Agrif_nbfixedgrids = 0806 807 ! If a grand mother grid is declared808 809 if (agrif_coarse) then810 allocate(Agrif_Coarsegrid)811 812 Agrif_Coarsegrid % ngridstep = 0813 Agrif_Coarsegrid % grid_id = -9999814 815 do i = 1, Agrif_Probdim816 Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i)817 Agrif_Coarsegrid%timeref(i) = coarse_timeref(i)818 Agrif_Coarsegrid % ix(i) = 1819 Agrif_Coarsegrid % Agrif_x(i) = 0.820 Agrif_Coarsegrid % Agrif_dx(i) = 1.821 Agrif_Coarsegrid % Agrif_dt(i) = 1.822 ! Borders of the root coarse grid823 Agrif_Coarsegrid % NearRootBorder(i) = .true.824 Agrif_Coarsegrid % DistantRootBorder(i) = .true.825 Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i)826 enddo827 828 ! The root coarse grid is a fixed grid829 Agrif_Coarsegrid % fixed = .TRUE.830 ! Level of the root grid831 Agrif_Coarsegrid % level = -1832 833 Agrif_Coarsegrid % grand_mother_grid = .true.834 835 ! Number of the grid pointed by Agrif_Mygrid (root coarse grid)836 Agrif_Coarsegrid % rank = -9999837 !838 ! Number of the root grid as a fixed grid839 Agrif_Coarsegrid % fixedrank = -9999840 841 Agrif_Mygrid%parent => Agrif_Coarsegrid842 843 ! Not used but required to prevent seg fault844 Agrif_Coarsegrid%parent => Agrif_Mygrid845 846 call Agrif_Create_Var(Agrif_Coarsegrid)847 848 ! Reset to null849 Nullify(Agrif_Coarsegrid%parent)850 851 Agrif_Coarsegrid%child_list%nitems = 1852 allocate(Agrif_Coarsegrid%child_list%first)853 allocate(Agrif_Coarsegrid%child_list%last)854 Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid855 Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid856 857 endif858 859 return860 861 98 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)862 if (.not. BEXIST) then863 print*,'ERROR : File AGRIF_FixedGrids.in not found.'864 STOP865 else866 print*,'Error opening file AGRIF_FixedGrids.in'867 STOP868 endif869 870 !---------------------------------------------------------------------------------------------------871 end subroutine Agrif_Init_Grids872 !===================================================================================================873 !874 !===================================================================================================875 ! subroutine Agrif_Deallocation876 !877 !> Deallocates all data arrays.878 !---------------------------------------------------------------------------------------------------879 subroutine Agrif_Deallocation880 !---------------------------------------------------------------------------------------------------881 integer :: nb882 type(Agrif_Variable), pointer :: var883 type(Agrif_Variable_c), pointer :: var_c884 type(Agrif_Variable_l), pointer :: var_l885 type(Agrif_Variable_i), pointer :: var_i886 !887 do nb = 1,Agrif_NbVariables(0)888 !889 var => Agrif_Mygrid % tabvars(nb)890 !891 if ( allocated(var % array1) ) deallocate(var % array1)892 if ( allocated(var % array2) ) deallocate(var % array2)893 if ( allocated(var % array3) ) deallocate(var % array3)894 if ( allocated(var % array4) ) deallocate(var % array4)895 if ( allocated(var % array5) ) deallocate(var % array5)896 if ( allocated(var % array6) ) deallocate(var % array6)897 !898 if ( allocated(var % sarray1) ) deallocate(var % sarray1)899 if ( allocated(var % sarray2) ) deallocate(var % sarray2)900 if ( allocated(var % sarray3) ) deallocate(var % sarray3)901 if ( allocated(var % sarray4) ) deallocate(var % sarray4)902 if ( allocated(var % sarray5) ) deallocate(var % sarray5)903 if ( allocated(var % sarray6) ) deallocate(var % sarray6)904 !905 if ( allocated(var % darray1) ) deallocate(var % darray1)906 if ( allocated(var % darray2) ) deallocate(var % darray2)907 if ( allocated(var % darray3) ) deallocate(var % darray3)908 if ( allocated(var % darray4) ) deallocate(var % darray4)909 if ( allocated(var % darray5) ) deallocate(var % darray5)910 if ( allocated(var % darray6) ) deallocate(var % darray6)911 !912 enddo913 !914 do nb = 1,Agrif_NbVariables(1)915 !916 var_c => Agrif_Mygrid % tabvars_c(nb)917 !918 if ( allocated(var_c % carray1) ) deallocate(var_c % carray1)919 if ( allocated(var_c % carray2) ) deallocate(var_c % carray2)920 !921 enddo922 923 do nb = 1,Agrif_NbVariables(3)924 !925 var_l => Agrif_Mygrid % tabvars_l(nb)926 !927 if ( allocated(var_l % larray1) ) deallocate(var_l % larray1)928 if ( allocated(var_l % larray2) ) deallocate(var_l % larray2)929 if ( allocated(var_l % larray3) ) deallocate(var_l % larray3)930 if ( allocated(var_l % larray4) ) deallocate(var_l % larray4)931 if ( allocated(var_l % larray5) ) deallocate(var_l % larray5)932 if ( allocated(var_l % larray6) ) deallocate(var_l % larray6)933 !934 enddo935 !936 do nb = 1,Agrif_NbVariables(4)937 !938 var_i => Agrif_Mygrid % tabvars_i(nb)939 !940 if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1)941 if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2)942 if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3)943 if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4)944 if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5)945 if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)946 !947 enddo948 !949 if ( allocated(Agrif_Mygrid % tabvars) ) deallocate(Agrif_Mygrid % tabvars)950 if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c)951 if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r)952 if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l)953 if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i)954 deallocate(Agrif_Mygrid)955 !---------------------------------------------------------------------------------------------------956 end subroutine Agrif_Deallocation957 !===================================================================================================958 !959 !===================================================================================================960 ! subroutine Agrif_Step_adj961 !962 !> creates the grid hierarchy and manages the backward time integration procedure.963 !> It is called in the main program.964 !> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj.965 !---------------------------------------------------------------------------------------------------966 subroutine Agrif_Step_adj ( procname )967 !---------------------------------------------------------------------------------------------------968 procedure(step_proc) :: procname !< Subroutine to call on each grid969 !970 ! Creation and initialization of the grid hierarchy971 !972 ! Set the clustering variables973 call Agrif_clustering_def()974 !975 if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then976 !977 if (Agrif_Mygrid % ngridstep == 0) then978 if (.not.Agrif_regrid_has_been_done ) then979 call Agrif_Regrid()980 endif981 call Agrif_Instance(Agrif_Mygrid)982 endif983 !984 else985 !986 if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then987 call Agrif_Regrid()988 call Agrif_Instance(Agrif_Mygrid)989 endif990 !991 endif992 !993 ! Time integration of the grid hierarchy994 !995 call Agrif_Integrate_adj (Agrif_Mygrid,procname)996 !997 if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)998 !999 !---------------------------------------------------------------------------------------------------1000 end subroutine Agrif_Step_adj1001 !===================================================================================================1002 !1003 !===================================================================================================1004 ! subroutine Agrif_Integrate_adj1005 !1006 !> Manages the backward time integration of the grid hierarchy.1007 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj1008 !---------------------------------------------------------------------------------------------------1009 recursive subroutine Agrif_Integrate_adj ( g, procname )1010 !---------------------------------------------------------------------------------------------------1011 type(Agrif_Grid), pointer :: g !< Pointer on the current grid1012 procedure(step_proc) :: procname !< Subroutine to call on each grid1013 !1014 type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure1015 integer :: nbt ! Number of time steps of the current grid1016 integer :: k1017 !1018 ! Instanciation of the variables of the current grid1019 if ( g%fixedrank /= 0 ) then1020 call Agrif_Instance(g)1021 endif1022 !1023 ! Number of time steps on the current grid1024 !1025 g%ngridstep = g % ngridstep + 11026 parcours => g % child_list % first1027 !1028 ! Recursive procedure for the time integration of the grid hierarchy1029 do while (associated(parcours))1030 !1031 ! Instanciation of the variables of the current grid1032 call Agrif_Instance(parcours % gr)1033 !1034 ! Number of time steps1035 nbt = 11036 do k = 1,Agrif_Probdim1037 nbt = max(nbt, parcours % gr % timeref(k))1038 enddo1039 !1040 do k = nbt,1,-11041 call Agrif_Integrate_adj(parcours % gr, procname)1042 enddo1043 !1044 parcours => parcours % next1045 !1046 enddo1047 !1048 if ( g % child_list % nitems > 0 ) call Agrif_Instance(g)1049 !1050 ! One step on the current grid1051 call procname ()1052 !1053 end subroutine Agrif_Integrate_adj1054 !===================================================================================================1055 !1056 !===================================================================================================1057 ! subroutine Agrif_Step_Child_adj1058 !1059 !> Apply 'procname' to each grid of the hierarchy from Child to Parent1060 !---------------------------------------------------------------------------------------------------1061 subroutine Agrif_Step_Child_adj ( procname )1062 !---------------------------------------------------------------------------------------------------1063 procedure(step_proc) :: procname !< Subroutine to call on each grid1064 !1065 call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname)1066 !1067 if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)1068 !1069 end subroutine Agrif_Step_Child_adj1070 !===================================================================================================1071 !1072 !===================================================================================================1073 ! subroutine Agrif_Integrate_Child_adj1074 !1075 !> Manages the backward time integration of the grid hierarchy.1076 !! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj.1077 !---------------------------------------------------------------------------------------------------1078 recursive subroutine Agrif_Integrate_Child_adj ( g, procname )1079 !---------------------------------------------------------------------------------------------------1080 type(Agrif_Grid),pointer :: g !< Pointer on the current grid1081 procedure(step_proc) :: procname !< Subroutine to call on each grid1082 !1083 type(Agrif_PGrid),pointer :: parcours !< Pointer for the recursive procedure1084 !1085 parcours => g % child_list % first1086 !1087 ! Recursive procedure for the time integration of the grid hierarchy1088 do while (associated(parcours))1089 !1090 ! Instanciation of the variables of the current grid1091 call Agrif_Instance(parcours % gr)1092 call Agrif_Integrate_Child_adj(parcours % gr, procname)1093 !1094 parcours => parcours % next1095 !1096 enddo1097 if ( g % child_list % nitems > 0 ) call Agrif_Instance(g)1098 !1099 ! One step on the current grid1100 call procname()1101 !---------------------------------------------------------------------------------------------------1102 end subroutine Agrif_Integrate_Child_adj1103 !===================================================================================================1104 !1105 !===================================================================================================1106 42 1107 43 end module Agrif_Util
Note: See TracChangeset
for help on using the changeset viewer.
