source: vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90 @ 10725

Last change on this file since 10725 was 10725, checked in by rblod, 21 months ago

Update agrif library and conv see ticket #2129

  • Property svn:keywords set to Id
File size: 43.5 KB
Line 
1!
2! $Id$
3!
4!     Agrif (Adaptive Grid Refinement In Fortran)
5!
6!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
7!                        Christophe Vouland (Christophe.Vouland@imag.fr)
8!
9!     This program is free software; you can redistribute it and/or modify
10!     it under the terms of the GNU General Public License as published by
11!     the Free Software Foundation; either version 2 of the License, or
12!     (at your option) any later version.
13!
14!     This program is distributed in the hope that it will be useful,
15!     but WITHOUT ANY WARRANTY; without even the implied warranty of
16!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17!     GNU General Public License for more details.
18!
19!     You should have received a copy of the GNU General Public License
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.
22!
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.
28!
29module Agrif_Util
30!
31    use Agrif_Clustering
32    use Agrif_BcFunction
33    use Agrif_seq
34!
35    implicit none
36!
37    abstract interface
38        subroutine step_proc()
39        end subroutine step_proc
40    end interface
41!
42contains
43!
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!---------------------------------------------------------------------------------------------------
51subroutine 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!---------------------------------------------------------------------------------------------------
89end subroutine Agrif_Step
90!===================================================================================================
91!
92!===================================================================================================
93!  subroutine Agrif_Step_Child
94!
95!> Apply 'procname' to each grid of the hierarchy
96!---------------------------------------------------------------------------------------------------
97subroutine 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!---------------------------------------------------------------------------------------------------
109end 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!---------------------------------------------------------------------------------------------------
159subroutine 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!
25399  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!---------------------------------------------------------------------------------------------------
262end subroutine Agrif_Regrid
263!===================================================================================================
264!
265!===================================================================================================
266!  subroutine Agrif_detect_All
267!
268!> Detects areas to be refined.
269!---------------------------------------------------------------------------------------------------
270recursive 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!---------------------------------------------------------------------------------------------------
329end 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!---------------------------------------------------------------------------------------------------
337subroutine 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!---------------------------------------------------------------------------------------------------
371end subroutine Agrif_Add_detected_areas
372!===================================================================================================
373!
374!===================================================================================================
375!  subroutine Agrif_Free_before_All
376!---------------------------------------------------------------------------------------------------
377recursive 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!---------------------------------------------------------------------------------------------------
398end subroutine Agrif_Free_before_All
399!===================================================================================================
400!
401!===================================================================================================
402!  subroutine Agrif_Save_All
403!---------------------------------------------------------------------------------------------------
404recursive 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!---------------------------------------------------------------------------------------------------
426end subroutine Agrif_Save_All
427!===================================================================================================
428!
429!===================================================================================================
430!  subroutine Agrif_Free_after_All
431!---------------------------------------------------------------------------------------------------
432recursive 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!---------------------------------------------------------------------------------------------------
471end 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!---------------------------------------------------------------------------------------------------
480recursive 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!---------------------------------------------------------------------------------------------------
523end 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!---------------------------------------------------------------------------------------------------
532recursive 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!---------------------------------------------------------------------------------------------------
579end 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!---------------------------------------------------------------------------------------------------
591recursive 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!---------------------------------------------------------------------------------------------------
661end 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!---------------------------------------------------------------------------------------------------
669recursive 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!---------------------------------------------------------------------------------------------------
694end 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!---------------------------------------------------------------------------------------------------
703recursive 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!---------------------------------------------------------------------------------------------------
734end 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!---------------------------------------------------------------------------------------------------
742subroutine 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
90498  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!---------------------------------------------------------------------------------------------------
914end subroutine Agrif_Init_Grids
915!===================================================================================================
916!
917!===================================================================================================
918!  subroutine Agrif_Deallocation
919!
920!> Deallocates all data arrays.
921!---------------------------------------------------------------------------------------------------
922subroutine 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!---------------------------------------------------------------------------------------------------
999end 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!---------------------------------------------------------------------------------------------------
1009subroutine 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!---------------------------------------------------------------------------------------------------
1043end 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!---------------------------------------------------------------------------------------------------
1052recursive 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!
1096end 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!---------------------------------------------------------------------------------------------------
1104subroutine 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!
1112end 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!---------------------------------------------------------------------------------------------------
1121recursive 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!---------------------------------------------------------------------------------------------------
1145end subroutine Agrif_Integrate_Child_adj
1146!===================================================================================================
1147!
1148!===================================================================================================
1149
1150end module Agrif_Util
Note: See TracBrowser for help on using the repository browser.