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

source: trunk/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F @ 2715

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

First attempt to put dynamic allocation on the trunk

  • Property svn:keywords set to Id
File size: 20.4 KB
RevLine 
[1901]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     
[2715]126           ! pointer on the save grid
127           TYPE(Agrif_grid)                    ,Pointer :: save_grid               
[1901]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()
[2715]171           INTEGER                                 :: level
172           ! level of the grid in the hierarchy
[1901]173      End TYPE Agrif_grid
174C
175C     **************************************************************************
176CCC   TYPE Agrif_VARIABLE
177C     **************************************************************************
178C     
179CCC   Description:
180CCC   Data TYPE to CHARACTERize a grid variable.   
181C
182      TYPE Agrif_Variable 
183         CHARACTER*80 :: variablename
184C       
185         ! Pointer on the variable of the root grid
186         TYPE(Agrif_Variable), Pointer :: root_var 
187C
188         ! index of the first point in the REAL domain (x,y and z direction)
189         INTEGER     ,DIMENSION(6)          :: point
190         ! position of the variable on the cell (1 for the boarder of
191         !    the edge, 2 for the center)
192         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
193         ! Indication for the space interpolation (module Agrif_Boundary)
194         INTEGER                   ,Pointer :: interpIndex => NULL() 
195         ! number of DIMENSIONs of the grid variable
196         INTEGER                            :: nbdim = 0             
197         ! Array indicating the TYPE of DIMENSION (space or not) for
198         !    each of them
199         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
200C        Arrays containing the values of the grid variables (REAL)
201         REAL                                    :: array0 
[2715]202         REAL   , DIMENSION(:)          ,ALLOCATABLE :: array1   
203         REAL   , DIMENSION(:,:)        ,ALLOCATABLE :: array2   
204         REAL   , DIMENSION(:,:,:)      ,ALLOCATABLE :: array3   
205         REAL   , DIMENSION(:,:,:,:)    ,ALLOCATABLE :: array4   
206         REAL   , DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: array5   
207         REAL   , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6 
208         
209         REAL   , DIMENSION(:)          ,POINTER :: parray1   
210         REAL   , DIMENSION(:,:)        ,POINTER :: parray2   
211         REAL   , DIMENSION(:,:,:)      ,POINTER :: parray3   
212         REAL   , DIMENSION(:,:,:,:)    ,POINTER :: parray4   
213         REAL   , DIMENSION(:,:,:,:,:)  ,POINTER :: parray5   
214         REAL   , DIMENSION(:,:,:,:,:,:),POINTER :: parray6
215         
[1901]216C        Arrays containing the values of the grid variables (REAL*8)
217         REAL*8                                 :: darray0
[2715]218         REAL*8, DIMENSION(:)          ,ALLOCATABLE :: darray1   
219         REAL*8, DIMENSION(:,:)        ,ALLOCATABLE :: darray2   
220         REAL*8, DIMENSION(:,:,:)      ,ALLOCATABLE :: darray3   
221         REAL*8, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: darray4   
222         REAL*8, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: darray5   
223         REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6   
[1901]224C        Arrays containing the values of the grid variables (REAL*4)
225         REAL*4                                 :: sarray0
[2715]226         REAL*4, DIMENSION(:)          ,ALLOCATABLE :: sarray1   
227         REAL*4, DIMENSION(:,:)        ,ALLOCATABLE :: sarray2   
228         REAL*4, DIMENSION(:,:,:)      ,ALLOCATABLE :: sarray3   
229         REAL*4, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: sarray4   
230         REAL*4, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: sarray5   
231         REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6   
[1901]232C        Arrays containing the values of the grid variables (LOGICAL)
233         LOGICAL                                 :: larray0
[2715]234         LOGICAL, DIMENSION(:)          ,ALLOCATABLE :: larray1   
235         LOGICAL, DIMENSION(:,:)        ,ALLOCATABLE :: larray2   
236         LOGICAL, DIMENSION(:,:,:)      ,ALLOCATABLE :: larray3   
237         LOGICAL, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: larray4   
238         LOGICAL, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: larray5   
239         LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6   
[1901]240C         Arrays containing the values of the grid variables (INTEGER)   
241         INTEGER                                 :: iarray0
[2715]242         INTEGER, DIMENSION(:)          ,ALLOCATABLE :: iarray1   
243         INTEGER, DIMENSION(:,:)        ,ALLOCATABLE :: iarray2   
244         INTEGER, DIMENSION(:,:,:)      ,ALLOCATABLE :: iarray3   
245         INTEGER, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: iarray4   
246         INTEGER, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: iarray5   
247         INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6   
[1901]248C
249         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL()
250         INTEGER, DIMENSION(:,:)        ,Pointer :: restore2D => NULL()
251         INTEGER, DIMENSION(:,:,:)      ,Pointer :: restore3D => NULL()
252         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: restore4D => NULL()
253         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D => NULL()
254         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: restore6D => NULL()
255C   
256         CHARACTER(2050)                          :: carray0
[2715]257         CHARACTER(200), DIMENSION(:)    ,ALLOCATABLE :: carray1
258         CHARACTER(200), DIMENSION(:,:)  ,ALLOCATABLE :: carray2
[1901]259C
260         ! Array used for the time interpolation
261         REAL   , DIMENSION(:,:)      ,Pointer :: oldvalues2D => NULL()
262
263         ! if the variable should be restore -> =1
264         LOGICAL :: restaure = .FALSE.
265         ! the interpolation should be made in any case
266         LOGICAL :: Interpolationshouldbemade = .FALSE. 
267         INTEGER :: bcinf ! option bc
268         INTEGER :: bcsup ! option bc
269         INTEGER, DIMENSION(6) :: updateinf ! option update
270         INTEGER, DIMENSION(6) :: updatesup ! option update         
271         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp
272         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp
273         INTEGER, DIMENSION(6) :: TYPEupdate ! option update
274         
275         INTEGER, DIMENSION(6) :: lb, ub
276         
277         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL()
278         Type(Agrif_List_Interp_Loc), Pointer :: list_update => NULL()
279C
280      End TYPE Agrif_Variable 
281     
282      Type Agrif_Interp_Loc
283      integer,dimension(6) :: pttab,petab,
284     &                          pttab_Child,pttab_Parent = -99
285      integer,dimension(6) :: indmin, indmax
286      INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
287      logical :: member, memberin     
[2019]288#if !defined key_mpp_mpi     
[1901]289      integer,dimension(6) :: indminglob,indmaxglob
290#else
291      integer,dimension(6) :: indminglob2,indmaxglob2
292      INTEGER,DIMENSION(6,2,2) :: parentarray
293      INTEGER,DIMENSION(:,:,:), POINTER :: tab4t
294      LOGICAL, DIMENSION(:), POINTER :: memberinall
295      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t
296      LOGICAL, DIMENSION(:), POINTER :: memberinall2
297      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1   
298      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1     
299      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2     
300      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2     
301#endif     
302      End Type Agrif_Interp_Loc
303     
304      Type Agrif_List_Interp_Loc
305      Type(Agrif_Interp_Loc), Pointer :: interp_loc
306      Type(Agrif_List_Interp_Loc), Pointer :: suiv
307      End Type Agrif_List_Interp_Loc
308
309       TYPE Agrif_List_Variables
310         Type(Agrif_PVariable), Pointer :: pvar
311         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL()
312       END TYPE Agrif_List_Variables
313               
314       TYPE Agrif_Profile
315          character*80 :: profilename
316C
317         ! index of the first point in the REAL domain (x,y and z direction)
318         INTEGER     ,DIMENSION(6)          :: point
319         ! position of the variable on the cell (1 for the boarder of
320         !    the edge, 2 for the center)
321         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
322         ! Indication for the space interpolation (module Agrif_Boundary)
323         INTEGER                   ,Pointer :: interpIndex => NULL() 
324         ! number of DIMENSIONs of the grid variable
325         INTEGER                            :: nbdim = 0             
326         ! Array indicating the TYPE of DIMENSION (space or not) for
327         !    each of them
328         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
329         Type(Agrif_Variable), Pointer :: var
330         Type(Agrif_Profile), Pointer :: nextprofile  => NULL()
331       END TYPE Agrif_Profile
332       
333       Type(Agrif_Profile), Pointer :: Agrif_MyProfiles => NULL()
334           
335C  Boundaries Fluxes
336
337      Type Agrif_Flux
338        Character*80 fluxname
339        Type(Agrif_Variable), Pointer :: fluxtabx
340        Type(Agrif_Variable), Pointer :: fluxtaby
341        Type(Agrif_Variable), Pointer :: fluxtabz       
342        Type(Agrif_Profile), Pointer  :: profile
343        Logical :: Fluxallocated = .FALSE.
344        Type(Agrif_Flux), Pointer     :: nextflux => NULL()
345      End Type Agrif_Flux     
346C
347C     **************************************************************************
348CCC   Different PARAMETERs
349C     **************************************************************************
350      TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: Agrif_tabvars
351C
352      ! this pointer always points on the root grid of the grid hierarchy
353      TYPE(Agrif_grid)  ,Pointer :: Agrif_Mygrid     
354      ! Pointer used in the Agrif_regrid subroutine (Agrif_Util module).
355      !    It contains  the safeguard of the grid hierarchy.
356      TYPE(Agrif_pgrid) ,Pointer :: Agrif_oldmygrid   
357      ! pointer to the current grid (the link is done by using the
358      !    Agrif_Instance   procedure (module Agrif_Init))
359      TYPE(Agrif_grid)  ,Pointer :: Agrif_Curgrid
360      ! Pointer used in the Agrif_ChildGrid_to_ParentGrid and
361      !    Agrif_ParentGrid_to_ChildGrid subroutines
362      !    (Agrif_CurgridFunctions module). It contains the
363      !    safeguard of the current grid hierarchy.
364      TYPE(Agrif_grid)  ,Pointer :: Agrif_saveCURGRID
365C
366      ! Problem DIMENSION
367      INTEGER               :: Agrif_Probdim
368      ! number of variables
369      INTEGER               :: Agrif_NbVariables
370      ! number of fixed grids in the grid hierarchy
371      INTEGER               :: Agrif_nbfixedgrids           
372      ! space refinement factor
373      INTEGER ,DIMENSION(3) :: Agrif_coeffref
374      ! time refinement factor
375      INTEGER ,DIMENSION(3) :: Agrif_coeffreft
376      ! LOGICAL to use special values on the parent grid
377      LOGICAL               :: Agrif_UseSpecialValue
378      ! LOGICAL to use special values on the parent grid
379      LOGICAL               :: Agrif_UseSpecialValueInUpdate
380      ! LOGICAL to use special values on the current grid
381      LOGICAL               :: Agrif_UseSpecialValueFineGrid
382      ! Special values on the parent grid
383      REAL                  :: Agrif_SpecialValue
384      ! Special values on the current grid
385      REAL                  :: Agrif_SpecialValueFineGrid
386C   clustering PARAMETERs
[2715]387      INTEGER               :: Agrif_Regridding = 10
[1901]388      INTEGER               :: Agrif_Minwidth
389      REAL                  :: Agrif_Efficiency = 0.7
390      INTEGER               :: MaxSearch = 5
391      REAL    ,DIMENSION(3) :: Agrif_mind
392C     PARAMETERs for the interpolation of the child grids
393      ! linear interpolation
394      INTEGER ,PARAMETER    :: Agrif_linear=1
395      ! lagrange interpolation
396      INTEGER ,PARAMETER    :: Agrif_lagrange=2
397      ! spline interpolation
398      INTEGER ,PARAMETER    :: Agrif_eno=3
399      ! user s interpolation
400      INTEGER ,PARAMETER    :: Agrif_user_interp=4
401      ! constant interpolation
402      INTEGER ,PARAMETER    :: Agrif_constant=5
403      ! linear conservative interpolation
404      INTEGER ,PARAMETER    :: Agrif_linearconserv=6
405      ! linear conservative interpolation       
406      INTEGER ,PARAMETER    :: Agrif_linearconservlim=7
407      INTEGER ,PARAMETER    :: Agrif_ppm=8 
408      INTEGER ,PARAMETER    :: Agrif_weno=9         
409C     PARAMETERs for the update of the parent grids     
410      INTEGER ,PARAMETER    :: Agrif_Update_Copy=1           ! copy
411      INTEGER ,PARAMETER    :: Agrif_Update_Average=2        ! average
412      INTEGER ,PARAMETER    :: Agrif_Update_Full_Weighting=3 ! full-weighting
413C     Raffinement grid switch definition
414      ! Agrif_USE_ONLY_FIXED_GRIDS =1 if fixed grid mode
415      INTEGER               :: Agrif_USE_ONLY_FIXED_GRIDS   
416      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid
417      !    else only AMR mode
[2715]418      INTEGER               :: Agrif_USE_FIXED_GRIDS
419      INTEGER               :: Agrif_Maxlevelloc
[1901]420C
[2019]421#ifdef key_mpp_mpi
[1901]422      INTEGER :: Agrif_Nbprocs  ! Number of processors
423      INTEGER :: Agrif_ProcRank ! Rank of the current processor
[2715]424      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_WORLD
[1901]425      INTEGER :: Agrif_MPIPREC
426#endif
427C
428      contains
429C   
430      Integer Function agrif_ceiling(x)
431C             
432          Real :: x
433          Integer ::i 
434C
435          i = floor(x)
436C     
437          if( abs(x - i).le.0.0001 )then
438             agrif_ceiling = i
439          else
440             agrif_ceiling = i+1
441          endif     
442C
443      End Function
444C
445      Integer Function agrif_int(x)
446C             
447          Real :: x
448          Integer ::i 
449C
450          i = floor(x) + 1
451C     
452          if( abs(x - i).le.0.0001 )then
453             agrif_int = i
454          else
455             agrif_int = i-1
456          endif     
457C
458      End Function
459      End Module Agrif_TYPEs 
Note: See TracBrowser for help on using the repository browser.