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 trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES – NEMO

source: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

Update NEMOGCM from branch nemo_v3_3_beta
  • Property svn:keywords set to Id
File size: 24.5 KB
Line 
1!
2! $Id$
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      Logical      :: mpi_was_called
66      Integer      :: code, ierr
67      INCLUDE 'mpif.h'
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_Free_before_All(Agrif_oldmygrid)
238C 
239C     Creation of the grid hierarchy from coarsegrid_moving   
240      Call Agrif_Create_Grids
241     &     (Agrif_Mygrid,coarsegrid_moving)
242C
243      endif
244C
245C     Initialization of the grid hierarchy by copy or interpolation
246C
247      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
248C
249      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
250     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
251C
252      Deallocate(coarsegrid_fixed)
253      Deallocate(coarsegrid_moving)
254C     
255      Return
256C
257C     Opening error
258C
259   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
260      If (.not. BEXIST) Then
261          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
262          STOP
263        Else
264          print*,'Error opening file AGRIF_FixedGrids.in'
265          STOP         
266      endif     
267C     
268      End Subroutine Agrif_Regrid
269C
270C     **************************************************************************
271CCC   Subroutine Agrif_detect_All
272C     **************************************************************************
273C
274      Recursive Subroutine Agrif_detect_all(g)
275C
276CCC   Description:
277CCC   Subroutine to detect areas to be refined.
278C
279CC    Method:       
280C
281C     Declarations:
282C
283     
284C     
285C     Pointer argument   
286      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
287C     
288C     Local variables
289      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
290                                             ! procedure     
291      INTEGER, DIMENSION(3)      :: size
292      INTEGER                    :: iii
293      Real :: g_eps     
294C
295      parcours => g % child_grids
296C 
297C     To be positioned on the finer grids of the grid hierarchy         
298C 
299      do while (associated(parcours))       
300         Call Agrif_detect_all (parcours % gr) 
301        parcours => parcours % next             
302      enddo
303C
304      g_eps = huge(1.)
305      do iii = 1 , Agrif_Probdim
306         g_eps=min(g_eps,g%Agrif_d(iii))
307      enddo
308C
309      g_eps = g_eps/100.
310C         
311      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
312      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
313      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
314C     
315      do iii = 1 , Agrif_Probdim
316         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
317     &                     (Agrif_mind(iii)-g_eps)) Return
318      enddo
319C                                       
320      Call Agrif_instance(g)
321C 
322C     Detection (Agrif_detect is a user s routine)
323C     
324      do iii = 1 , Agrif_Probdim
325         size(iii) = g%nb(iii) + 1
326      enddo
327C
328      SELECT CASE (Agrif_Probdim)
329      CASE (1) 
330         Call Agrif_detect(g%tabpoint1D,size)
331      CASE (2) 
332         Call Agrif_detect(g%tabpoint2D,size)
333      CASE (3) 
334         Call Agrif_detect(g%tabpoint3D,size)
335      END SELECT
336C
337C     Addition of the areas detected on the child grids
338C     
339      parcours => g % child_grids 
340C           
341      Do while (associated(parcours))
342        Call Agrif_Add_detected_areas (g,parcours % gr)
343        parcours => parcours % next 
344      enddo
345C     
346      Return     
347C
348      End Subroutine Agrif_detect_all
349C     
350C
351C
352C     **************************************************************************
353CCC   Subroutine Agrif_Add_detected_areas
354C     **************************************************************************
355C     
356      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
357C
358CCC   Description:
359CCC   Subroutine to add on the parent grid the areas detected 
360CC       on its child grids.
361C
362CC    Method:       
363C
364C     Declarations:
365C
366     
367C 
368      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
369C     
370      Integer :: i,j,k
371C
372      do i = 1,childgrid%nb(1)+1
373         if ( Agrif_Probdim .EQ. 1 ) then
374            If (childgrid%tabpoint1D(i).EQ.1) Then
375                parentgrid%tabpoint1D(childgrid%ix(1)+
376     &                 (i-1)/Agrif_Coeffref(1)) = 1
377            endif
378         else
379            do j=1,childgrid%nb(2)+1
380               if (Agrif_Probdim.EQ.2) then
381              If (childgrid%tabpoint2D(i,j).EQ.1) Then
382                  parentgrid%tabpoint2D(
383     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
384     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
385                  endif
386               else
387                  do k=1,childgrid%nb(3)+1
388                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
389                    parentgrid%tabpoint3D(
390     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
391     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
392     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
393                     endif
394                  enddo
395               endif
396            enddo
397         endif
398      enddo
399C     
400      Return
401C
402      End Subroutine Agrif_Add_detected_areas   
403C     
404C
405C     **************************************************************************
406CCC   Subroutine Agrif_Free_before_All
407C     **************************************************************************
408C
409      Recursive Subroutine Agrif_Free_before_All(g)
410C
411CCC   Description:
412C
413CC    Method:       
414C
415C     Declarations:
416C
417C     Pointer argument   
418      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
419C
420C     Local pointer
421      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
422                                             ! procedure     
423C
424C
425      parcours => g       
426C     
427      Do while (associated(parcours))     
428        If (.not. parcours%gr%fixed) Then
429            Call Agrif_Free_data_before(parcours%gr)
430            parcours % gr % oldgrid = .TRUE.       
431        endif
432C
433        Call Agrif_Free_before_all (parcours % gr % child_grids)
434C 
435        parcours => parcours % next             
436      enddo
437C     
438      Return     
439C
440C
441      End Subroutine Agrif_Free_before_All
442C
443C
444C
445C     **************************************************************************
446CCC   Subroutine Agrif_Free_after_All
447C     **************************************************************************
448C
449      Recursive Subroutine Agrif_Free_after_All(g)
450C
451CCC   Description:
452C
453CC    Method:       
454C
455C     Declarations:
456C
457     
458C     
459C     Pointer argument   
460      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
461C
462C     Local pointers
463      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
464      Type(Agrif_pgrid),pointer  :: preparcours   
465      Type(Agrif_pgrid),pointer  :: preparcoursini 
466C
467C
468      Allocate(preparcours)
469C 
470      preparcoursini => preparcours
471C 
472      Nullify(preparcours % gr)
473C 
474      preparcours % next => g
475C
476      parcours => g
477C     
478      Do while (associated(parcours))
479C
480         if ( (.NOT. parcours% gr% fixed) .AND.
481     &        (parcours% gr% oldgrid    ) ) then
482          Call Agrif_Free_data_after(parcours%gr)
483         endif
484C
485         Call Agrif_Free_after_all (parcours % gr % child_grids)
486C
487      If (parcours % gr % oldgrid) Then
488          Deallocate(parcours % gr)
489          preparcours % next => parcours % next
490          Deallocate(parcours)
491          parcours => preparcours % next
492        Else
493          preparcours => preparcours % next
494          parcours => parcours % next 
495         endif       
496      enddo
497C
498      Deallocate(preparcoursini)
499C     
500      Return     
501C
502      End Subroutine Agrif_Free_after_All
503C
504C
505C     **************************************************************************
506CCC   Subroutine Agrif_Integrate
507C     **************************************************************************
508C
509      Recursive Subroutine Agrif_Integrate(g, procname)         
510C
511CCC   Description:
512CCC   Subroutine to manage the time integration of the grid hierarchy.
513C
514CC    Method:
515CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
516C
517C     Declarations:
518C
519     
520C     
521C     Pointer argument   
522      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
523C
524C     main procedure name
525      Optional :: procname
526      External :: procname     
527C     
528C     Local pointer
529      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
530                                             ! procedure
531C
532C     Local scalars
533      INTEGER                    :: nbt      ! Number of time steps
534                                             ! of the current grid
535      INTEGER                    :: k       
536      INTEGER                    :: iii
537C 
538C     Instanciation of the variables of the current grid
539      If (g%fixedrank .NE.0) Then     
540      Call Agrif_Instance
541     &     (g)
542      End If
543C       
544C     One step on the current grid     
545C
546      If (present(procname)) Then
547         Call procname ()     
548      Else
549        write(*,*) 'The name of the step subroutine has not '
550        write(*,*) 'been given in the subroutine Agrif_Integrate'
551        stop
552      endif
553C
554C     Number of time steps on the current grid     
555C
556      g%ngridstep = g % ngridstep + 1
557C     
558      parcours => g % child_grids
559C   
560C     Recursive procedure for the time integration of the grid hierarchy     
561      Do while (associated(parcours))
562C
563C       Instanciation of the variables of the current grid           
564        Call Agrif_Instance
565     &           (parcours % gr)
566C       
567C       Number of time steps
568        nbt = 1
569        do iii = 1 , Agrif_Probdim
570           nbt = max(nbt, parcours % gr % timeref(iii))
571        enddo
572C       
573        Do k = 1,nbt
574C       
575           If (present(procname)) Then
576                 Call Agrif_Integrate (parcours % gr, procname)
577           Else
578                 Call Agrif_Integrate (parcours % gr)     
579           endif
580C       
581        enddo     
582C 
583        parcours => parcours % next
584C     
585      enddo
586C
587C     
588      End Subroutine Agrif_Integrate 
589
590C     **************************************************************************
591CCC   Subroutine Agrif_Integrate_Child
592C     **************************************************************************
593C
594      Recursive Subroutine Agrif_Integrate_Child(g,procname)
595C
596CCC   Description:
597CCC   Subroutine to manage the time integration of the grid hierarchy.
598C
599CC    Method:
600CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
601C
602C     Declarations:
603C
604
605C
606C     Pointer argument
607      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
608C
609C     main procedure name
610      Optional :: procname
611      External :: procname
612C
613C     Local pointer
614      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
615                                             ! procedure
616C
617C     One step on the current grid
618C
619      If (present(procname)) Then
620         Call procname ()     
621      Else
622        write(*,*) 'The name of the step subroutine has not '
623        write(*,*) 'been given in the subroutine Agrif_Integrate'
624        stop
625      endif
626C
627C     Number of time steps on the current grid
628C
629C
630      parcours => g % child_grids
631C
632C     Recursive procedure for the time integration of the grid hierarchy     
633      Do while (associated(parcours))
634C
635C       Instanciation of the variables of the current grid
636        Call Agrif_Instance
637     &           (parcours % gr)
638
639C       
640           If (present(procname)) Then
641                 Call Agrif_Integrate_Child (parcours % gr, procname)
642           Else
643                 Call Agrif_Integrate_Child (parcours % gr)
644           endif
645C 
646        parcours => parcours % next
647C     
648      enddo
649C
650C
651      End Subroutine Agrif_Integrate_Child
652
653C
654C
655C     **************************************************************************
656CCC   Subroutine Agrif_Init_Grids
657C     **************************************************************************
658C     
659      Subroutine Agrif_Init_Grids
660C
661CCC   Description:
662CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
663CCC   It is called in the main program.
664C
665C     Declarations:
666C
667C
668      INTEGER :: iii
669C
670C             definition of the probdim and modtypes variables
671C
672#ifdef key_mpp_mpi
673      INCLUDE 'mpif.h'
674      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
675#endif
676      Call Agrif_probdim_modtype_def()
677C     
678      Agrif_UseSpecialValue = .FALSE.
679      Agrif_UseSpecialValueFineGrid = .FALSE.
680      Agrif_SpecialValue = 0.
681      Agrif_SpecialValueFineGrid = 0.
682C     
683C     Allocation of Agrif_Mygrid
684      allocate(Agrif_Mygrid)
685C     
686C     Space and time refinement factors are set to 1 on the root grid
687C
688      do iii = 1 , Agrif_Probdim
689         Agrif_Mygrid % spaceref(iii) = 1
690         Agrif_Mygrid % timeref(iii) = 1
691      enddo
692C     
693C     Initialization of the number of time steps   
694      Agrif_Mygrid % ngridstep = 0
695      Agrif_Mygrid % grid_id = 0
696C
697C     No parent grid for the root coarse grid
698      Nullify(Agrif_Mygrid % parent)
699C     
700C     Initialization of the minimum positions, global abscissa and space steps 
701      do iii= 1 ,  Agrif_Probdim
702         Agrif_Mygrid % ix(iii) = 1           
703         Agrif_Mygrid % Agrif_x(iii) = 0.
704         Agrif_Mygrid % Agrif_d(iii) = 1. 
705C     Borders of the root coarse grid 
706         Agrif_Mygrid % NearRootBorder(iii) = .true. 
707         Agrif_Mygrid % DistantRootBorder(iii) = .true.     
708      enddo
709C 
710C     The root coarse grid is a fixed grid
711      Agrif_Mygrid % fixed = .TRUE.
712C     
713C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
714      Agrif_Mygrid % rank = 1     
715C 
716C     Number of the root grid as a fixed grid   
717      Agrif_Mygrid % fixedrank = 0 
718C 
719C     Initialization of some fields of the root grid variables     
720      Call Agrif_Create_Var (Agrif_Mygrid)
721C     
722C     Initialization of the other fields of the root grid variables (number of 
723C     cells, positions, number and type of its dimensions, ...) 
724      Call Agrif_Set_numberofcells(Agrif_Mygrid)
725C     
726      Call Agrif_Instance (Agrif_Mygrid)       
727C             
728C     Allocation of the array containing the values of the grid variables
729      Call Agrif_Allocation (Agrif_Mygrid)
730C       
731      Call Agrif_initialisations(Agrif_Mygrid)
732C     
733      nullify(Agrif_Mygrid % child_grids)
734C 
735C     Total number of fixed grids   
736      Agrif_nbfixedgrids = 0         
737C     
738      Call Agrif_Instance (Agrif_Mygrid)
739C       
740      End Subroutine Agrif_Init_Grids 
741C
742C
743C     **************************************************************************
744CCC   Subroutine Agrif_Deallocation
745C     **************************************************************************
746C     
747      Subroutine Agrif_Deallocation
748C
749CCC   Description:
750CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
751CCC   It is called in the main program.
752C
753C     Declarations:
754C
755C
756      INTEGER :: nb
757C
758C             definition of the probdim and modtypes variables
759C
760      do nb = 1, Agrif_NbVariables
761          if ( associated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
762     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
763          if ( associated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
764     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
765          if ( associated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
766     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
767          if ( associated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
768     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
769          if ( associated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
770     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
771          if ( associated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
772     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
773C
774          if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
775     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
776          if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
777     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
778          if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
779     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
780          if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
781     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
782          if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
783     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
784          if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
785     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
786C
787          if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
788     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
789          if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
790     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
791          if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
792     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
793          if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
794     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
795          if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
796     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
797          if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
798     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
799C
800          if ( associated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
801     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
802          if ( associated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
803     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
804      enddo
805C
806      do nb = 1, Agrif_NbVariables
807        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
808      enddo
809C
810      Deallocate(Agrif_Mygrid % tabvars)
811C
812      Deallocate(Agrif_Mygrid)
813C
814      End Subroutine  Agrif_Deallocation 
815C
816      End module Agrif_Util 
Note: See TracBrowser for help on using the repository browser.