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 @ 898

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

Correct some bugs in agrif optimization and add MPP optimization, see #42

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