source: vendors/AGRIF/current/AGRIF_FILES/modutil.F @ 2671

Last change on this file since 2671 was 2671, checked in by rblod, 10 years ago

Load working_directory into vendors/AGRIF/current.

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