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.
modtypes.F in trunk/AGRIF/AGRIF_FILES – NEMO

source: trunk/AGRIF/AGRIF_FILES/modtypes.F @ 1200

Last change on this file since 1200 was 1200, checked in by rblod, 16 years ago

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.9 KB
Line 
1C     Agrif (Adaptive Grid Refinement In Fortran)
2C
3C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
4C                        Christophe Vouland (Christophe.Vouland@imag.fr)   
5C
6C     This program is free software; you can redistribute it and/or modify
7C     it under the terms of the GNU General Public License as published by
8C     the Free Software Foundation; either version 2 of the License, or
9C     (at your option) any later version.
10C
11C     This program is distributed in the hope that it will be useful,
12C     but WITHOUT ANY WARRANTY; without even the implied warranty of
13C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14C     GNU General Public License for more details.
15C
16C     You should have received a copy of the GNU General Public License
17C     along with this program; if not, write to the Free Software
18C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
19C
20C
21C
22CCC   Module Agrif_types 
23C
24      Module Agrif_types 
25C
26CCC   Description:
27CCC   Definition of data types used in Agrif, of several variables and
28C        PARAMETERs.     
29C
30      IMPLICIT NONE
31     
32C     Maximum refinement ratio
33
34      INTEGER, PARAMETER :: Agrif_MaxRaff = 7
35     
36C     Maximum number of grids of the hierarchy
37      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10
38                 
39C
40C     **************************************************************************
41CCC   TYPE Agrif_LRECTANGLE
42C     **************************************************************************
43C
44CCC   Description:
45CCC   Data TYPE allowing a grid to reach a grid on the same level or its child
46CCC   grids.
47C
48      TYPE Agrif_lrectangle 
49           TYPE(Agrif_rectangle) , Pointer :: r    ! to reach a child grid
50           TYPE(Agrif_lrectangle), Pointer :: next ! to reach a grid on the
51                                                   !    same level
52      End TYPE Agrif_lrectangle 
53C
54C     **************************************************************************
55CCC   TYPE Agrif_RECTANGLE: 
56C     **************************************************************************
57C
58CCC   Description:
59CCC   Data TYPE to define several CHARACTERistics of a grid (number,position,
60CCC   time and space refinement factors,...). 
61C
62      TYPE Agrif_rectangle
63           INTEGER                         :: number      ! Number of the grid
64           ! Number of child grids
65           INTEGER                         :: nbgridchild 
66           ! Minimal position in the x,y and z direction
67           INTEGER, DIMENSION(3)           :: imin       
68           ! Maximal position in the x,y and z direction
69           INTEGER, DIMENSION(3)           :: imax 
70           ! Space refinement factor in the x,y and z direction 
71           INTEGER, DIMENSION(3)           :: spaceref   
72           ! Time refinement factor in the x,y and z direction
73           INTEGER, DIMENSION(3)           :: timeref     
74           ! Pointer to reach a grid on  the same level or a child grid
75           TYPE(Agrif_lrectangle), Pointer :: childgrids 
76      End TYPE Agrif_rectangle 
77C
78C
79C
80C     **************************************************************************
81CCC   TYPE Agrif_PGrid
82C     **************************************************************************
83C
84CCC   Description:
85CCC   Data TYPE to go over the grid hierarchy (used for the creation of this 
86CCC   grid hierarchy and during the time integration).
87C 
88      TYPE Agrif_pgrid 
89           ! allows to reach a child grid 
90           TYPE(Agrif_grid) , Pointer :: gr
91           ! allows to reach the grids of the same level
92           TYPE(Agrif_pgrid), Pointer :: next 
93      End TYPE Agrif_pgrid 
94C
95C
96C
97C     **************************************************************************
98CCC   TYPE Agrif_PVariable
99C     **************************************************************************
100C
101CCC   Description:
102CCC   Data TYPE to define a grid variable.
103C
104      TYPE Agrif_PVariable 
105           ! This field allows to get the various CHARACTERistics
106           !   of the variable (defined by the Agrif_Variable data TYPE)
107           TYPE(Agrif_Variable) , Pointer :: var 
108           ! Pointer on the parent grid
109           TYPE(Agrif_PVariable), Pointer :: parent_var 
110      End TYPE Agrif_PVariable 
111C
112C     **************************************************************************
113CCC   TYPE Agrif_Grid
114C     **************************************************************************
115C
116CCC   Description:
117CCC   Data TYPE to define a grid (position, space and time refinement factors).
118C
119      TYPE Agrif_grid 
120           ! pointer on the parent grid
121           TYPE(Agrif_grid)                    ,Pointer :: parent     
122           ! pointer on the child grids
123           TYPE(Agrif_pgrid)                   ,Pointer :: child_grids 
124           ! List of the grid variables   
125           TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars     
126C
127           ! Global x,y and z position
128           REAL    ,DIMENSION(3)                   :: Agrif_x   
129           ! Global space step in the x,y and z direction
130           REAL    ,DIMENSION(3)                   :: Agrif_d
131           ! number of cells in the x,y and z direction
132           INTEGER ,DIMENSION(3)                   :: nb       
133           ! minimal position in the x,y and z direction
134           INTEGER ,DIMENSION(3)                   :: ix       
135           ! Space refinement factor in the x,y and z direction
136           INTEGER ,DIMENSION(3)                   :: spaceref 
137           ! Time refinement factor in the x,y and z direction
138           INTEGER ,DIMENSION(3)                   :: timeref   
139           INTEGER ,DIMENSION(:)          ,Pointer :: restore1D   
140           INTEGER ,DIMENSION(:,:)        ,Pointer :: restore2D   
141           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: restore3D 
142           INTEGER ,DIMENSION(:,:,:,:)    ,Pointer :: restore4D
143           INTEGER ,DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D
144           INTEGER ,DIMENSION(:,:,:,:,:,:),Pointer :: restore6D
145           ! number of time step 
146           INTEGER                                 :: ngridstep 
147           INTEGER                                 :: rank 
148           !moving grid id
149           INTEGER                                 :: grid_id
150           ! number of the grid
151           INTEGER                                 :: fixedrank 
152           ! fixed or moving grid ? 
153           LOGICAL                                 :: fixed     
154           LOGICAL                                 :: oldgrid   
155C          LOGICALs indicating if the current grid has a common border 
156C             with the root coarse grid
157           LOGICAL ,DIMENSION(3)                   :: NearRootBorder
158           LOGICAL ,DIMENSION(3)                   :: DistantRootBorder
159C          Arrays for adaptive grid refinement
160           REAL    ,DIMENSION(:)          ,Pointer :: valtabpoint1D
161           REAL    ,DIMENSION(:,:)        ,Pointer :: valtabpoint2D
162           REAL    ,DIMENSION(:,:,:)      ,Pointer :: valtabpoint3D
163           INTEGER ,DIMENSION(:)          ,Pointer :: tabpoint1D
164           INTEGER ,DIMENSION(:,:)        ,Pointer :: tabpoint2D
165           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: tabpoint3D
166           Type(Agrif_List_Variables), Pointer     :: variables=>NULL()
167           INTEGER                                 :: NbVariables = 0
168           Type(Agrif_Flux), Pointer               :: fluxes => NULL()
169      End TYPE Agrif_grid
170C
171C     **************************************************************************
172CCC   TYPE Agrif_VARIABLE
173C     **************************************************************************
174C     
175CCC   Description:
176CCC   Data TYPE to CHARACTERize a grid variable.   
177C
178      TYPE Agrif_Variable 
179         CHARACTER*80 :: variablename
180C       
181         ! Pointer on the variable of the root grid
182         TYPE(Agrif_Variable), Pointer :: root_var 
183C
184         ! index of the first point in the REAL domain (x,y and z direction)
185         INTEGER     ,DIMENSION(6)          :: point
186         ! position of the variable on the cell (1 for the boarder of
187         !    the edge, 2 for the center)
188         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
189         ! Indication for the space interpolation (module Agrif_Boundary)
190         INTEGER                   ,Pointer :: interpIndex => NULL() 
191         ! number of DIMENSIONs of the grid variable
192         INTEGER                            :: nbdim = 0             
193         ! Array indicating the TYPE of DIMENSION (space or not) for
194         !    each of them
195         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
196C        Arrays containing the values of the grid variables (REAL)
197         REAL                                    :: array0 
198         REAL   , DIMENSION(:)          ,Pointer :: array1    => NULL()
199         REAL   , DIMENSION(:,:)        ,Pointer :: array2    => NULL()
200         REAL   , DIMENSION(:,:,:)      ,Pointer :: array3    => NULL()
201         REAL   , DIMENSION(:,:,:,:)    ,Pointer :: array4    => NULL()
202         REAL   , DIMENSION(:,:,:,:,:)  ,Pointer :: array5    => NULL()
203         REAL   , DIMENSION(:,:,:,:,:,:),Pointer :: array6    => NULL()
204C        Arrays containing the values of the grid variables (REAL*8)
205         REAL*8                                 :: darray0
206         REAL*8, DIMENSION(:)          ,Pointer :: darray1   => NULL()
207         REAL*8, DIMENSION(:,:)        ,Pointer :: darray2   => NULL()
208         REAL*8, DIMENSION(:,:,:)      ,Pointer :: darray3   => NULL()
209         REAL*8, DIMENSION(:,:,:,:)    ,Pointer :: darray4   => NULL()
210         REAL*8, DIMENSION(:,:,:,:,:)  ,Pointer :: darray5   => NULL()
211         REAL*8, DIMENSION(:,:,:,:,:,:),Pointer :: darray6   => NULL()
212C        Arrays containing the values of the grid variables (REAL*4)
213         REAL*4                                 :: sarray0
214         REAL*4, DIMENSION(:)          ,Pointer :: sarray1   => NULL()
215         REAL*4, DIMENSION(:,:)        ,Pointer :: sarray2   => NULL()
216         REAL*4, DIMENSION(:,:,:)      ,Pointer :: sarray3   => NULL()
217         REAL*4, DIMENSION(:,:,:,:)    ,Pointer :: sarray4   => NULL()
218         REAL*4, DIMENSION(:,:,:,:,:)  ,Pointer :: sarray5   => NULL()
219         REAL*4, DIMENSION(:,:,:,:,:,:),Pointer :: sarray6   => NULL()
220C        Arrays containing the values of the grid variables (LOGICAL)
221         LOGICAL                                 :: larray0
222         LOGICAL, DIMENSION(:)          ,Pointer :: larray1   => NULL()
223         LOGICAL, DIMENSION(:,:)        ,Pointer :: larray2   => NULL()
224         LOGICAL, DIMENSION(:,:,:)      ,Pointer :: larray3   => NULL()
225         LOGICAL, DIMENSION(:,:,:,:)    ,Pointer :: larray4   => NULL()
226         LOGICAL, DIMENSION(:,:,:,:,:)  ,Pointer :: larray5   => NULL()
227         LOGICAL, DIMENSION(:,:,:,:,:,:),Pointer :: larray6   => NULL()
228C         Arrays containing the values of the grid variables (INTEGER)   
229         INTEGER                                 :: iarray0
230         INTEGER, DIMENSION(:)          ,Pointer :: iarray1   => NULL()
231         INTEGER, DIMENSION(:,:)        ,Pointer :: iarray2   => NULL()
232         INTEGER, DIMENSION(:,:,:)      ,Pointer :: iarray3   => NULL()
233         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: iarray4   => NULL()
234         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: iarray5   => NULL()
235         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: iarray6   => NULL()
236C
237         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL()
238         INTEGER, DIMENSION(:,:)        ,Pointer :: restore2D => NULL()
239         INTEGER, DIMENSION(:,:,:)      ,Pointer :: restore3D => NULL()
240         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: restore4D => NULL()
241         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D => NULL()
242         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: restore6D => NULL()
243C   
244         CHARACTER(2050)                          :: carray0
245         CHARACTER(200), DIMENSION(:)    ,Pointer :: carray1   => NULL()
246         CHARACTER(200), DIMENSION(:,:)  ,Pointer :: carray2   => NULL()
247C
248         ! Array used for the time interpolation
249         REAL   , DIMENSION(:,:)      ,Pointer :: oldvalues2D => NULL()
250
251         ! if the variable should be restore -> =1
252         LOGICAL :: restaure = .FALSE.
253         ! the interpolation should be made in any case
254         LOGICAL :: Interpolationshouldbemade = .FALSE. 
255         INTEGER :: bcinf ! option bc
256         INTEGER :: bcsup ! option bc
257         INTEGER, DIMENSION(6) :: updateinf ! option update
258         INTEGER, DIMENSION(6) :: updatesup ! option update         
259         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp
260         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp
261         INTEGER, DIMENSION(6) :: TYPEupdate ! option update
262         
263         INTEGER, DIMENSION(6) :: lb, ub
264         
265         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL()
266         Type(Agrif_List_Interp_Loc), Pointer :: list_update => NULL()
267C
268      End TYPE Agrif_Variable 
269     
270      Type Agrif_Interp_Loc
271      integer,dimension(6) :: pttab,petab,
272     &                          pttab_Child,pttab_Parent = -99
273      integer,dimension(6) :: indmin, indmax
274      INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
275      logical :: member, memberin     
276#if !defined AGRIF_MPI     
277      integer,dimension(6) :: indminglob,indmaxglob
278#else
279      integer,dimension(6) :: indminglob2,indmaxglob2
280      INTEGER,DIMENSION(6,2,2) :: parentarray
281      INTEGER,DIMENSION(:,:,:), POINTER :: tab4t
282      LOGICAL, DIMENSION(:), POINTER :: memberinall
283      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t
284      LOGICAL, DIMENSION(:), POINTER :: memberinall2
285      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1   
286      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1     
287      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2     
288      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2     
289#endif     
290      End Type Agrif_Interp_Loc
291     
292      Type Agrif_List_Interp_Loc
293      Type(Agrif_Interp_Loc), Pointer :: interp_loc
294      Type(Agrif_List_Interp_Loc), Pointer :: suiv
295      End Type Agrif_List_Interp_Loc
296
297       TYPE Agrif_List_Variables
298         Type(Agrif_PVariable), Pointer :: pvar
299         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL()
300       END TYPE Agrif_List_Variables
301               
302       TYPE Agrif_Profile
303          character*80 :: profilename
304C
305         ! index of the first point in the REAL domain (x,y and z direction)
306         INTEGER     ,DIMENSION(6)          :: point
307         ! position of the variable on the cell (1 for the boarder of
308         !    the edge, 2 for the center)
309         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
310         ! Indication for the space interpolation (module Agrif_Boundary)
311         INTEGER                   ,Pointer :: interpIndex => NULL() 
312         ! number of DIMENSIONs of the grid variable
313         INTEGER                            :: nbdim = 0             
314         ! Array indicating the TYPE of DIMENSION (space or not) for
315         !    each of them
316         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
317         Type(Agrif_Variable), Pointer :: var
318         Type(Agrif_Profile), Pointer :: nextprofile  => NULL()
319       END TYPE Agrif_Profile
320       
321       Type(Agrif_Profile), Pointer :: Agrif_MyProfiles => NULL()
322           
323C  Boundaries Fluxes
324
325      Type Agrif_Flux
326        Character*80 fluxname
327        Type(Agrif_Variable), Pointer :: fluxtabx
328        Type(Agrif_Variable), Pointer :: fluxtaby
329        Type(Agrif_Variable), Pointer :: fluxtabz       
330        Type(Agrif_Profile), Pointer  :: profile
331        Logical :: Fluxallocated = .FALSE.
332        Type(Agrif_Flux), Pointer     :: nextflux => NULL()
333      End Type Agrif_Flux     
334C
335C     **************************************************************************
336CCC   Different PARAMETERs
337C     **************************************************************************
338      TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: Agrif_tabvars
339C
340      ! this pointer always points on the root grid of the grid hierarchy
341      TYPE(Agrif_grid)  ,Pointer :: Agrif_Mygrid     
342      ! Pointer used in the Agrif_regrid subroutine (Agrif_Util module).
343      !    It contains  the safeguard of the grid hierarchy.
344      TYPE(Agrif_pgrid) ,Pointer :: Agrif_oldmygrid   
345      ! pointer to the current grid (the link is done by using the
346      !    Agrif_Instance   procedure (module Agrif_Init))
347      TYPE(Agrif_grid)  ,Pointer :: Agrif_Curgrid
348      ! Pointer used in the Agrif_ChildGrid_to_ParentGrid and
349      !    Agrif_ParentGrid_to_ChildGrid subroutines
350      !    (Agrif_CurgridFunctions module). It contains the
351      !    safeguard of the current grid hierarchy.
352      TYPE(Agrif_grid)  ,Pointer :: Agrif_saveCURGRID
353C
354      ! Problem DIMENSION
355      INTEGER               :: Agrif_Probdim
356      ! number of variables
357      INTEGER               :: Agrif_NbVariables
358      ! number of fixed grids in the grid hierarchy
359      INTEGER               :: Agrif_nbfixedgrids           
360      ! space refinement factor
361      INTEGER ,DIMENSION(3) :: Agrif_coeffref
362      ! time refinement factor
363      INTEGER ,DIMENSION(3) :: Agrif_coeffreft
364      ! LOGICAL to use special values on the parent grid
365      LOGICAL               :: Agrif_UseSpecialValue
366      ! LOGICAL to use special values on the parent grid
367      LOGICAL               :: Agrif_UseSpecialValueInUpdate
368      ! LOGICAL to use special values on the current grid
369      LOGICAL               :: Agrif_UseSpecialValueFineGrid
370      ! Special values on the parent grid
371      REAL                  :: Agrif_SpecialValue
372      ! Special values on the current grid
373      REAL                  :: Agrif_SpecialValueFineGrid
374C   clustering PARAMETERs
375      INTEGER               :: Agrif_Regridding
376      INTEGER               :: Agrif_Minwidth
377      REAL                  :: Agrif_Efficiency = 0.7
378      INTEGER               :: MaxSearch = 5
379      REAL    ,DIMENSION(3) :: Agrif_mind
380C     PARAMETERs for the interpolation of the child grids
381      ! linear interpolation
382      INTEGER ,PARAMETER    :: Agrif_linear=1
383      ! lagrange interpolation
384      INTEGER ,PARAMETER    :: Agrif_lagrange=2
385      ! spline interpolation
386      INTEGER ,PARAMETER    :: Agrif_eno=3
387      ! user s interpolation
388      INTEGER ,PARAMETER    :: Agrif_user_interp=4
389      ! constant interpolation
390      INTEGER ,PARAMETER    :: Agrif_constant=5
391      ! linear conservative interpolation
392      INTEGER ,PARAMETER    :: Agrif_linearconserv=6
393      ! linear conservative interpolation       
394      INTEGER ,PARAMETER    :: Agrif_linearconservlim=7
395      INTEGER ,PARAMETER    :: Agrif_ppm=8 
396      INTEGER ,PARAMETER    :: Agrif_weno=9         
397C     PARAMETERs for the update of the parent grids     
398      INTEGER ,PARAMETER    :: Agrif_Update_Copy=1           ! copy
399      INTEGER ,PARAMETER    :: Agrif_Update_Average=2        ! average
400      INTEGER ,PARAMETER    :: Agrif_Update_Full_Weighting=3 ! full-weighting
401C     Raffinement grid switch definition
402      ! Agrif_USE_ONLY_FIXED_GRIDS =1 if fixed grid mode
403      INTEGER               :: Agrif_USE_ONLY_FIXED_GRIDS   
404      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid
405      !    else only AMR mode
406      INTEGER               :: Agrif_USE_FIXED_GRIDS         
407C
408#ifdef AGRIF_MPI
409      INTEGER :: Agrif_Nbprocs  ! Number of processors
410      INTEGER :: Agrif_ProcRank ! Rank of the current processor
411      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_WORLD
412      INTEGER :: Agrif_MPIPREC
413#endif
414C
415      contains
416C   
417      Integer Function agrif_ceiling(x)
418C             
419          Real :: x
420          Integer ::i 
421C
422          i = floor(x)
423C     
424          if( abs(x - i).le.0.0001 )then
425             agrif_ceiling = i
426          else
427             agrif_ceiling = i+1
428          endif     
429C
430      End Function
431C
432      Integer Function agrif_int(x)
433C             
434          Real :: x
435          Integer ::i 
436C
437          i = floor(x) + 1
438C     
439          if( abs(x - i).le.0.0001 )then
440             agrif_int = i
441          else
442             agrif_int = i-1
443          endif     
444C
445      End Function
446      End Module Agrif_TYPEs 
Note: See TracBrowser for help on using the repository browser.