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/dev_005_AWL/AGRIF/AGRIF_FILES – NEMO

source: branches/dev_005_AWL/AGRIF/AGRIF_FILES/modtypes.F @ 1804

Last change on this file since 1804 was 1804, checked in by sga, 14 years ago

merge of trunk changes from r1782 to r1802 into NEMO branch dev_005_AWL

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