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 branches/UKMO/dev_r5518_v3.6_asm_nemovar_community_ersem_hem08/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES – NEMO

source: branches/UKMO/dev_r5518_v3.6_asm_nemovar_community_ersem_hem08/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F @ 9319

Last change on this file since 9319 was 7730, checked in by dford, 7 years ago

Clear svn keywords.

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