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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
modutil.F in branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES – NEMO

source: branches/UKMO/dev_r5518_bdy_sponge_temp/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F @ 5876

Last change on this file since 5876 was 5876, checked in by deazer, 8 years ago

Remove svn keywords

File size: 25.8 KB
Line 
1!
2! $Id: modutil.F 2731 2011-04-08 12:05:35Z rblod $
3!
4C     Agrif (Adaptive Grid Refinement In Fortran)
5C
6C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
7C                        Christophe Vouland (Christophe.Vouland@imag.fr)   
8C
9C     This program is free software; you can redistribute it and/or modify
10C     it under the terms of the GNU General Public License as published by
11C     the Free Software Foundation; either version 2 of the License, or
12C     (at your option) any later version.
13C
14C     This program is distributed in the hope that it will be useful,
15C     but WITHOUT ANY WARRANTY; without even the implied warranty of
16C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17C     GNU General Public License for more details.
18C
19C     You should have received a copy of the GNU General Public License
20C     along with this program; if not, write to the Free Software
21C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
22C
23C
24C
25CCC   Module Agrif_Util 
26C 
27      Module Agrif_Util 
28C
29C
30CCC   Description:   
31CCC   This module contains the two procedures called in the main program : 
32CCC   Agrif_Init_Grids allowing the initialization of the root coarse grid, and
33CCC   Agrif_Step allowing the creation of the grid hierarchy and the management
34CCC   of the time integration. 
35C
36C     Modules used:
37C
38      Use Agrif_Clustering   
39      Use Agrif_bcfunction
40C     
41      IMPLICIT NONE
42C
43      Contains
44C     Definition of procedures contained in this module.
45C
46C     **************************************************************************
47CCC   Subroutine Agrif_Step
48C     **************************************************************************
49C 
50      Subroutine Agrif_Step(procname) 
51C
52CCC   Description:
53CCC   Subroutine to create the grid hierarchy and to manage the time integration 
54CCC   procedure. It is called in the main program.
55C
56CC    Method:
57CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
58C
59C     Declarations:
60C
61      Optional :: procname
62      External :: procname
63C
64#ifdef key_mpp_mpi
65      INCLUDE 'mpif.h'
66      Integer      :: code, ierr
67      Logical      :: mpi_was_called
68C
69C
70      Call Agrif_comm_def(MPI_COMM_AGRIF)
71
72      CALL mpi_initialized ( mpi_was_called, code )
73      IF( code /= MPI_SUCCESS ) THEN
74         WRITE(*, *) ': Error in routine mpi_initialized'
75         CALL mpi_abort( mpi_comm_world, code, ierr )
76      ENDIF
77
78      IF( .NOT. mpi_was_called ) THEN
79         CALL mpi_comm_dup( mpi_comm_world, MPI_COMM_AGRIF, code)
80         IF( code /= MPI_SUCCESS ) THEN
81            WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'
82            CALL mpi_abort( mpi_comm_world, code, ierr )
83         ENDIF
84      ENDIF
85
86      If (Agrif_Mygrid % ngridstep == 0) Then
87          Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code)
88          Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code)
89          Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code)
90      endif
91#endif
92C
93C     Creation and initialization of the grid hierarchy 
94C
95C 
96C    Set the clustering variables
97C
98      Call Agrif_clustering_def()
99C     
100      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
101C     
102         If (Agrif_Mygrid % ngridstep == 0) then
103C
104            Call Agrif_Regrid
105C 
106            Call Agrif_Instance           
107     &          (Agrif_Mygrid)           
108         endif
109C
110      else
111C   
112         If (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
113C
114            Call Agrif_Regrid
115C 
116            Call Agrif_Instance           
117     &          (Agrif_Mygrid) 
118C           
119         endif
120C
121      endif
122C
123C     Time integration of the grid hierarchy
124C
125      If (present(procname)) Then
126         Call Agrif_Integrate (Agrif_Mygrid,procname)
127      Else
128         Call Agrif_Integrate (Agrif_Mygrid)     
129      endif
130C   
131      If (associated(Agrif_Mygrid%child_grids)) 
132     &   Call Agrif_Instance (Agrif_Mygrid)
133C
134      Return
135C             
136      End Subroutine Agrif_Step     
137
138C     **************************************************************************
139CCC   Subroutine Agrif_Step_Child
140C     **************************************************************************
141C
142      Subroutine Agrif_Step_Child(procname)
143C
144CCC   Description:
145CCC   Subroutine to create the grid hierarchy and to manage the time integration
146CCC   procedure. It is called in the main program.
147C
148CC    Method:
149CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
150C
151C     Declarations:
152C
153      Optional :: procname
154      External :: procname
155C
156C     Time integration of the grid hierarchy
157C
158      If (present(procname)) Then
159         Call Agrif_Integrate_Child (Agrif_Mygrid,procname)
160      Else
161         Call Agrif_Integrate_Child (Agrif_Mygrid)
162      endif
163C   
164      If (associated(Agrif_Mygrid%child_grids))
165     &   Call Agrif_Instance (Agrif_Mygrid)
166C
167      Return
168C
169      End Subroutine Agrif_Step_Child
170
171C
172C
173C
174C     **************************************************************************
175CCC   Subroutine Agrif_Regrid
176C     **************************************************************************
177C
178      Subroutine Agrif_Regrid
179C
180CCC   Description:
181CCC   Subroutine to create the grid hierarchy from fixed grids and
182CC       adaptive mesh refinement.
183C
184CC    Method:       
185C
186C     Declarations:
187C
188C     Local variables     
189      Type(Agrif_Rectangle), Pointer     :: coarsegrid_fixed
190      Type(Agrif_Rectangle), Pointer     :: coarsegrid_moving 
191      INTEGER                            :: j
192      INTEGER :: nunit
193      INTEGER                            :: iii
194      Logical :: BEXIST
195C 
196      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 )
197     &   Call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined
198C
199      Allocate(coarsegrid_fixed)
200      Allocate(coarsegrid_moving)
201C
202      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
203     &    Call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
204C
205      if ( Agrif_USE_FIXED_GRIDS .EQ. 1 .OR. 
206     &     Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
207C
208      If (Agrif_Mygrid % ngridstep == 0) Then
209          nunit = Agrif_Get_Unit()
210          open(nunit,file='AGRIF_FixedGrids.in',form='formatted',
211     &           status="old",ERR=99) ! Opening of the Agrif_FixedGrids.in file
212          j = 1
213C         Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
214            do iii = 1 , Agrif_Probdim
215               coarsegrid_fixed % imin(iii) = 1
216               coarsegrid_fixed % imax(iii) = Agrif_Mygrid % nb(iii) + 1
217            enddo
218C     
219            Call Agrif_Read_Fix_Grd (coarsegrid_fixed,j,nunit)     
220            close(nunit) ! Closing of the Agrif_FixedGrids.in file
221C
222          Nullify(Agrif_oldmygrid)
223          Nullify(Agrif_Mygrid  % child_grids)
224C       
225C         Creation of the grid hierarchy from coarsegrid_fixed
226            Call Agrif_Create_Grids (Agrif_Mygrid,coarsegrid_fixed)
227        Else       
228          Agrif_oldmygrid => Agrif_Mygrid % child_grids
229         endif
230      else
231      Agrif_oldmygrid => Agrif_Mygrid % child_grids
232      Nullify(Agrif_Mygrid  % child_grids)
233      endif
234C
235      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
236C
237      Call Agrif_Save_All(Agrif_oldmygrid)     
238C     
239      Call Agrif_Free_before_All(Agrif_oldmygrid)
240C 
241C     Creation of the grid hierarchy from coarsegrid_moving   
242      Call Agrif_Create_Grids
243     &     (Agrif_Mygrid,coarsegrid_moving)
244C
245      endif
246C
247C     Initialization of the grid hierarchy by copy or interpolation
248C
249      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
250C
251      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
252     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
253C
254      Deallocate(coarsegrid_fixed)
255      Deallocate(coarsegrid_moving)
256C     
257      Return
258C
259C     Opening error
260C
261   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
262      If (.not. BEXIST) Then
263          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
264          STOP
265        Else
266          print*,'Error opening file AGRIF_FixedGrids.in'
267          STOP         
268      endif     
269C     
270      End Subroutine Agrif_Regrid
271C
272C     **************************************************************************
273CCC   Subroutine Agrif_detect_All
274C     **************************************************************************
275C
276      Recursive Subroutine Agrif_detect_all(g)
277C
278CCC   Description:
279CCC   Subroutine to detect areas to be refined.
280C
281CC    Method:       
282C
283C     Declarations:
284C
285     
286C     
287C     Pointer argument   
288      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
289C     
290C     Local variables
291      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
292                                             ! procedure     
293      INTEGER, DIMENSION(3)      :: size
294      INTEGER                    :: iii
295      Real :: g_eps     
296C
297      parcours => g % child_grids
298C 
299C     To be positioned on the finer grids of the grid hierarchy         
300C 
301      do while (associated(parcours))       
302         Call Agrif_detect_all (parcours % gr) 
303        parcours => parcours % next             
304      enddo
305C
306      g_eps = huge(1.)
307      do iii = 1 , Agrif_Probdim
308         g_eps=min(g_eps,g%Agrif_d(iii))
309      enddo
310C
311      g_eps = g_eps/100.
312C         
313      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
314      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
315      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
316C     
317      do iii = 1 , Agrif_Probdim
318         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
319     &                     (Agrif_mind(iii)-g_eps)) Return
320      enddo
321C                                       
322      Call Agrif_instance(g)
323C 
324C     Detection (Agrif_detect is a user s routine)
325C     
326     
327      do iii = 1 , Agrif_Probdim
328         size(iii) = g%nb(iii) + 1
329      enddo
330C
331      SELECT CASE (Agrif_Probdim)
332      CASE (1) 
333         Call Agrif_detect(g%tabpoint1D,size)
334      CASE (2) 
335         Call Agrif_detect(g%tabpoint2D,size)
336      CASE (3) 
337         Call Agrif_detect(g%tabpoint3D,size)
338      END SELECT
339C
340C     Addition of the areas detected on the child grids
341C     
342      parcours => g % child_grids 
343C           
344      Do while (associated(parcours))
345        Call Agrif_Add_detected_areas (g,parcours % gr)
346        parcours => parcours % next 
347      enddo
348C     
349      Return     
350C
351      End Subroutine Agrif_detect_all
352C     
353C
354C
355C     **************************************************************************
356CCC   Subroutine Agrif_Add_detected_areas
357C     **************************************************************************
358C     
359      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
360C
361CCC   Description:
362CCC   Subroutine to add on the parent grid the areas detected 
363CC       on its child grids.
364C
365CC    Method:       
366C
367C     Declarations:
368C
369     
370C 
371      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
372C     
373      Integer :: i,j,k
374C
375      do i = 1,childgrid%nb(1)+1
376         if ( Agrif_Probdim .EQ. 1 ) then
377            If (childgrid%tabpoint1D(i).EQ.1) Then
378                parentgrid%tabpoint1D(childgrid%ix(1)+
379     &                 (i-1)/Agrif_Coeffref(1)) = 1
380            endif
381         else
382            do j=1,childgrid%nb(2)+1
383               if (Agrif_Probdim.EQ.2) then
384              If (childgrid%tabpoint2D(i,j).EQ.1) Then
385                  parentgrid%tabpoint2D(
386     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
387     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
388                  endif
389               else
390                  do k=1,childgrid%nb(3)+1
391                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
392                    parentgrid%tabpoint3D(
393     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
394     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
395     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
396                     endif
397                  enddo
398               endif
399            enddo
400         endif
401      enddo
402C     
403      Return
404C
405      End Subroutine Agrif_Add_detected_areas   
406C     
407C
408C     **************************************************************************
409CCC   Subroutine Agrif_Free_before_All
410C     **************************************************************************
411C
412      Recursive Subroutine Agrif_Free_before_All(g)
413C
414CCC   Description:
415C
416CC    Method:       
417C
418C     Declarations:
419C
420C     Pointer argument   
421      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
422C
423C     Local pointer
424      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
425                                             ! procedure     
426C
427C
428      parcours => g       
429C     
430      Do while (associated(parcours))     
431        If (.not. parcours%gr%fixed) Then
432            Call Agrif_Free_data_before(parcours%gr)
433            parcours % gr % oldgrid = .TRUE.       
434        endif
435C
436        Call Agrif_Free_before_all (parcours % gr % child_grids)
437C 
438        parcours => parcours % next             
439      enddo
440C     
441      Return     
442C
443C
444      End Subroutine Agrif_Free_before_All
445C     **************************************************************************
446CCC   Subroutine Agrif_Save_All
447C     **************************************************************************
448C
449      Recursive Subroutine Agrif_Save_All(g)
450C
451CCC   Description:
452C
453CC    Method:       
454C
455C     Declarations:
456C
457C     Pointer argument   
458      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
459C
460C     Local pointer
461      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
462                                             ! procedure     
463C
464C
465      parcours => g       
466C     
467      Do while (associated(parcours))     
468        If (.not. parcours%gr%fixed) Then
469            Call Agrif_Instance(parcours%gr)
470            Call Agrif_Before_Regridding()
471            parcours % gr % oldgrid = .TRUE.       
472        endif
473C
474        Call Agrif_Save_All (parcours % gr % child_grids)
475C 
476        parcours => parcours % next             
477      enddo
478C     
479      Return     
480C
481C
482      End Subroutine Agrif_Save_All     
483C
484C
485C
486C     **************************************************************************
487CCC   Subroutine Agrif_Free_after_All
488C     **************************************************************************
489C
490      Recursive Subroutine Agrif_Free_after_All(g)
491C
492CCC   Description:
493C
494CC    Method:       
495C
496C     Declarations:
497C
498     
499C     
500C     Pointer argument   
501      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
502C
503C     Local pointers
504      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
505      Type(Agrif_pgrid),pointer  :: preparcours   
506      Type(Agrif_pgrid),pointer  :: preparcoursini 
507C
508C
509      Allocate(preparcours)
510C 
511      preparcoursini => preparcours
512C 
513      Nullify(preparcours % gr)
514C 
515      preparcours % next => g
516C
517      parcours => g
518C     
519      Do while (associated(parcours))
520C
521         if ( (.NOT. parcours% gr% fixed) .AND.
522     &        (parcours% gr% oldgrid    ) ) then
523          Call Agrif_Free_data_after(parcours%gr)
524         endif
525C
526         Call Agrif_Free_after_all (parcours % gr % child_grids)
527C
528      If (parcours % gr % oldgrid) Then
529          Deallocate(parcours % gr)
530          preparcours % next => parcours % next
531          Deallocate(parcours)
532          parcours => preparcours % next
533        Else
534          preparcours => preparcours % next
535          parcours => parcours % next 
536         endif       
537      enddo
538C
539      Deallocate(preparcoursini)
540C     
541      Return     
542C
543      End Subroutine Agrif_Free_after_All
544C
545C
546C     **************************************************************************
547CCC   Subroutine Agrif_Integrate
548C     **************************************************************************
549C
550      Recursive Subroutine Agrif_Integrate(g, procname)         
551C
552CCC   Description:
553CCC   Subroutine to manage the time integration of the grid hierarchy.
554C
555CC    Method:
556CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
557C
558C     Declarations:
559C
560     
561C     
562C     Pointer argument   
563      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
564C
565C     main procedure name
566      Optional :: procname
567      External :: procname     
568C     
569C     Local pointer
570      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
571                                             ! procedure
572C
573C     Local scalars
574      INTEGER                    :: nbt      ! Number of time steps
575                                             ! of the current grid
576      INTEGER                    :: k       
577      INTEGER                    :: iii
578C 
579C     Instanciation of the variables of the current grid
580      If (g%fixedrank .NE.0) Then     
581      Call Agrif_Instance
582     &     (g)
583      End If
584C       
585C     One step on the current grid     
586C
587      If (present(procname)) Then
588         Call procname ()     
589      Else
590        write(*,*) 'The name of the step subroutine has not '
591        write(*,*) 'been given in the subroutine Agrif_Integrate'
592        stop
593      endif
594C
595C     Number of time steps on the current grid     
596C
597      g%ngridstep = g % ngridstep + 1
598C     
599      parcours => g % child_grids
600C   
601C     Recursive procedure for the time integration of the grid hierarchy     
602      Do while (associated(parcours))
603C
604C       Instanciation of the variables of the current grid           
605        Call Agrif_Instance
606     &           (parcours % gr)
607C       
608C       Number of time steps
609        nbt = 1
610        do iii = 1 , Agrif_Probdim
611           nbt = max(nbt, parcours % gr % timeref(iii))
612        enddo
613C       
614        Do k = 1,nbt
615C       
616           If (present(procname)) Then
617                 Call Agrif_Integrate (parcours % gr, procname)
618           Else
619                 Call Agrif_Integrate (parcours % gr)     
620           endif
621C       
622        enddo     
623C 
624        parcours => parcours % next
625C     
626      enddo
627C
628C     
629      End Subroutine Agrif_Integrate 
630
631C     **************************************************************************
632CCC   Subroutine Agrif_Integrate_Child
633C     **************************************************************************
634C
635      Recursive Subroutine Agrif_Integrate_Child(g,procname)
636C
637CCC   Description:
638CCC   Subroutine to manage the time integration of the grid hierarchy.
639C
640CC    Method:
641CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
642C
643C     Declarations:
644C
645
646C
647C     Pointer argument
648      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
649C
650C     main procedure name
651      Optional :: procname
652      External :: procname
653C
654C     Local pointer
655      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
656                                             ! procedure
657C
658C     One step on the current grid
659C
660      If (present(procname)) Then
661         Call procname ()     
662      Else
663        write(*,*) 'The name of the step subroutine has not '
664        write(*,*) 'been given in the subroutine Agrif_Integrate'
665        stop
666      endif
667C
668C     Number of time steps on the current grid
669C
670C
671      parcours => g % child_grids
672C
673C     Recursive procedure for the time integration of the grid hierarchy     
674      Do while (associated(parcours))
675C
676C       Instanciation of the variables of the current grid
677        Call Agrif_Instance
678     &           (parcours % gr)
679
680C       
681           If (present(procname)) Then
682                 Call Agrif_Integrate_Child (parcours % gr, procname)
683           Else
684                 Call Agrif_Integrate_Child (parcours % gr)
685           endif
686C 
687        parcours => parcours % next
688C     
689      enddo
690C
691C
692      End Subroutine Agrif_Integrate_Child
693
694C
695C
696C     **************************************************************************
697CCC   Subroutine Agrif_Init_Grids
698C     **************************************************************************
699C     
700      Subroutine Agrif_Init_Grids
701C
702CCC   Description:
703CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
704CCC   It is called in the main program.
705C
706C     Declarations:
707C
708C
709      INTEGER :: iii
710C
711C             definition of the probdim and modtypes variables
712C
713#ifdef key_mpp_mpi
714      INCLUDE 'mpif.h'
715      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
716#endif
717      Call Agrif_probdim_modtype_def()
718C     
719      Agrif_UseSpecialValue = .FALSE.
720      Agrif_UseSpecialValueFineGrid = .FALSE.
721      Agrif_SpecialValue = 0.
722      Agrif_SpecialValueFineGrid = 0.
723C     
724C     Allocation of Agrif_Mygrid
725      allocate(Agrif_Mygrid)
726C     
727C     Space and time refinement factors are set to 1 on the root grid
728C
729      do iii = 1 , Agrif_Probdim
730         Agrif_Mygrid % spaceref(iii) = 1
731         Agrif_Mygrid % timeref(iii) = 1
732      enddo
733C     
734C     Initialization of the number of time steps   
735      Agrif_Mygrid % ngridstep = 0
736      Agrif_Mygrid % grid_id = 0
737C
738C     No parent grid for the root coarse grid
739      Nullify(Agrif_Mygrid % parent)
740C     
741C     Initialization of the minimum positions, global abscissa and space steps 
742      do iii= 1 ,  Agrif_Probdim
743         Agrif_Mygrid % ix(iii) = 1           
744         Agrif_Mygrid % Agrif_x(iii) = 0.
745         Agrif_Mygrid % Agrif_d(iii) = 1. 
746C     Borders of the root coarse grid 
747         Agrif_Mygrid % NearRootBorder(iii) = .true. 
748         Agrif_Mygrid % DistantRootBorder(iii) = .true.     
749      enddo
750C 
751C     The root coarse grid is a fixed grid
752      Agrif_Mygrid % fixed = .TRUE.
753C     Level of the root grid
754      Agrif_Mygrid % level = 0
755C     Maximum level in the hierarchy
756      Agrif_MaxLevelLoc = 0
757     
758C     
759C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
760      Agrif_Mygrid % rank = 1     
761C 
762C     Number of the root grid as a fixed grid   
763      Agrif_Mygrid % fixedrank = 0 
764C 
765C     Initialization of some fields of the root grid variables     
766      Call Agrif_Create_Var (Agrif_Mygrid)
767C     
768C     Initialization of the other fields of the root grid variables (number of 
769C     cells, positions, number and type of its dimensions, ...) 
770      Call Agrif_Set_numberofcells(Agrif_Mygrid)
771C     
772      Call Agrif_Instance (Agrif_Mygrid)       
773C
774      Call Agrif_Set_numberofcells(Agrif_Mygrid)         
775C             
776C     Allocation of the array containing the values of the grid variables
777      Call Agrif_Allocation (Agrif_Mygrid)
778C       
779      Call Agrif_initialisations(Agrif_Mygrid)   
780C     
781      nullify(Agrif_Mygrid % child_grids)
782C 
783C     Total number of fixed grids   
784      Agrif_nbfixedgrids = 0         
785C     
786      Call Agrif_Instance (Agrif_Mygrid)
787C       
788      End Subroutine Agrif_Init_Grids 
789C
790C
791C     **************************************************************************
792CCC   Subroutine Agrif_Deallocation
793C     **************************************************************************
794C     
795      Subroutine Agrif_Deallocation
796C
797CCC   Description:
798CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
799CCC   It is called in the main program.
800C
801C     Declarations:
802C
803C
804      INTEGER :: nb
805C
806C             definition of the probdim and modtypes variables
807C
808      do nb = 1, Agrif_NbVariables
809          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
810     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
811          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
812     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
813          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
814     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
815          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
816     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
817          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
818     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
819          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
820     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
821C
822          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
823     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
824          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
825     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
826          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
827     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
828          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
829     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
830          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
831     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
832          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
833     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
834C
835          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
836     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
837          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
838     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
839          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
840     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
841          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
842     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
843          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
844     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
845          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
846     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
847C
848          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
849     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
850          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
851     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
852      enddo
853C
854      do nb = 1, Agrif_NbVariables
855        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
856      enddo
857C
858      Deallocate(Agrif_Mygrid % tabvars)
859C
860      Deallocate(Agrif_Mygrid)
861C
862      End Subroutine  Agrif_Deallocation 
863C
864      End module Agrif_Util 
Note: See TracBrowser for help on using the repository browser.