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.F90 in vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES – NEMO

source: vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modtypes.F90 @ 13370

Last change on this file since 13370 was 13027, checked in by rblod, 4 years ago

New AGRIF library, see ticket #2129

  • Property svn:keywords set to Id
File size: 25.7 KB
Line 
1!     Agrif (Adaptive Grid Refinement In Fortran)
2!
3!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
4!                        Christophe Vouland (Christophe.Vouland@imag.fr)
5!
6!     This program is free software; you can redistribute it and/or modify
7!     it under the terms of the GNU General Public License as published by
8!     the Free Software Foundation; either version 2 of the License, or
9!     (at your option) any later version.
10!
11!     This program is distributed in the hope that it will be useful,
12!     but WITHOUT ANY WARRANTY; without even the implied warranty of
13!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14!     GNU General Public License for more details.
15!
16!     You should have received a copy of the GNU General Public License
17!     along with this program; if not, write to the Free Software
18!     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
19!
20!
21!
22!
23!> Definition of data types used in AGRIF, of several variables and parameters
24!
25module Agrif_Types
26!
27use Agrif_Procs
28!
29implicit none
30!
31integer, parameter :: Agrif_MaxRaff = 7       !< Maximum refinement ratio
32integer, parameter :: Agrif_NbMaxGrids = 10   !< Maximum number of grids of the hierarchy
33!
34!===================================================================================================
35type Agrif_LRectangle
36!---------------------------------------------------------------------------------------------------
37!<  Data type allowing a grid to reach a grid on the same level or its child grids
38!
39    type(Agrif_Rectangle) , pointer :: r    => NULL()   !< to reach a child grid
40    type(Agrif_LRectangle), pointer :: next => NULL()   !< to reach a grid on the same level
41!
42!---------------------------------------------------------------------------------------------------
43end type Agrif_LRectangle
44!===================================================================================================
45!
46!===================================================================================================
47type Agrif_Rectangle
48!---------------------------------------------------------------------------------------------------
49!<  Data type to define several characteristics of a grid (number, position, time and space
50!<  refinement factors, etc).
51!
52    integer                         :: number       !< Number of the grid
53    integer, dimension(3)           :: imin         !< Minimal position in the x,y and z direction
54    integer, dimension(3)           :: imax         !< Maximal position in the x,y and z direction
55    integer, dimension(3)           :: spaceref     !< Space refinement factor in the x,y and z direction
56    integer, dimension(3)           :: timeref      !< Time refinement factor in the x,y and z direction
57    type(Agrif_LRectangle), pointer :: childgrids => NULL()   !< Pointer to reach a grid on the same level or a child grid
58!
59!---------------------------------------------------------------------------------------------------
60end type Agrif_Rectangle
61!===================================================================================================
62!
63!===================================================================================================
64type Agrif_Variable
65!---------------------------------------------------------------------------------------------------
66!<  Data type to characterize a grid variable.
67!
68    type(Agrif_Variable), pointer  :: root_var   => NULL()  !< pointer on the variable of the root grid
69    type(Agrif_Variable), pointer  :: parent_var => NULL()  !< pointer on the parent variable
70!
71    integer,   dimension(6)              :: point           !< index of the first point in the
72                                                            !<    real domain (x,y and z direction)
73    integer,   dimension(:), allocatable :: posvar          !< position of the variable on the cell
74                                                            !<   (1 for the boarder of the edge, 2 for the center)
75    integer                            :: interpIndex = -1  !< Indication for the space interpolation (module Agrif_Boundary)
76    integer                            :: nbdim = 0         !< number of dimensions of the grid variable
77    character(1), dimension(:), allocatable :: interptab    !< Array indicating the type of dimension (space or not)
78                                                            !!   for each of them
79    integer,   dimension(:), allocatable :: coords          !< Array indicating the coordinate for each dimension
80                                                            !!   of the array that is refined :
81                                                            !!  'x' -> 1 ; 'y' -> 2 ; 'z' -> 3 ; 'N' -> 0
82
83!> @}
84!> \name Arrays containing the values of the grid variables (real)
85!> @{
86    real,    dimension(:)          , allocatable :: array1
87    real,    dimension(:,:)        , allocatable :: array2
88    real,    dimension(:,:,:)      , allocatable :: array3
89    real,    dimension(:,:,:,:)    , allocatable :: array4
90    real,    dimension(:,:,:,:,:)  , allocatable :: array5
91    real,    dimension(:,:,:,:,:,:), allocatable :: array6
92!> @}
93!> \name Arrays containing the values of the grid variables (real*8)
94!> @{
95    real(8), dimension(:)          , allocatable :: darray1
96    real(8), dimension(:,:)        , allocatable :: darray2
97    real(8), dimension(:,:,:)      , allocatable :: darray3
98    real(8), dimension(:,:,:,:)    , allocatable :: darray4
99    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
100    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
101!> @}
102!> \name Arrays containing the values of the grid variables (real*4)
103!> @{
104    real(4), dimension(:)          , allocatable :: sarray1
105    real(4), dimension(:,:)        , allocatable :: sarray2
106    real(4), dimension(:,:,:)      , allocatable :: sarray3
107    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
108    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
109    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
110!> @}
111!> \name Arrays containing the values of the grid variables (real)
112!> @{
113    real,    dimension(:)          , pointer :: parray1
114    real,    dimension(:,:)        , pointer :: parray2
115    real,    dimension(:,:,:)      , pointer :: parray3
116    real,    dimension(:,:,:,:)    , pointer :: parray4
117    real,    dimension(:,:,:,:,:)  , pointer :: parray5
118    real,    dimension(:,:,:,:,:,:), pointer :: parray6
119!> @}
120!> \name Arrays containing the values of the grid variables (real*8)
121!> @{
122    real(8), dimension(:)          , pointer :: pdarray1
123    real(8), dimension(:,:)        , pointer :: pdarray2
124    real(8), dimension(:,:,:)      , pointer :: pdarray3
125    real(8), dimension(:,:,:,:)    , pointer :: pdarray4
126    real(8), dimension(:,:,:,:,:)  , pointer :: pdarray5
127    real(8), dimension(:,:,:,:,:,:), pointer :: pdarray6
128!> @}
129!> \name Arrays containing the values of the grid variables (real*4)
130!> @{
131    real(4), dimension(:)          , pointer :: psarray1
132    real(4), dimension(:,:)        , pointer :: psarray2
133    real(4), dimension(:,:,:)      , pointer :: psarray3
134    real(4), dimension(:,:,:,:)    , pointer :: psarray4
135    real(4), dimension(:,:,:,:,:)  , pointer :: psarray5
136    real(4), dimension(:,:,:,:,:,:), pointer :: psarray6
137!> @}
138!> \name Arrays used to restore the values
139!> @{
140    integer, dimension(:)          , pointer :: restore1D => NULL()
141    integer, dimension(:,:)        , pointer :: restore2D => NULL()
142    integer, dimension(:,:,:)      , pointer :: restore3D => NULL()
143    integer, dimension(:,:,:,:)    , pointer :: restore4D => NULL()
144    integer, dimension(:,:,:,:,:)  , pointer :: restore5D => NULL()
145    integer, dimension(:,:,:,:,:,:), pointer :: restore6D => NULL()
146!> @}
147
148    real, dimension(:,:), pointer :: oldvalues2D => NULL() !< Array used for the time interpolation
149
150    logical :: restore = .FALSE. !< =1 if the variable should be restored
151    logical :: Interpolationshouldbemade = .FALSE. !< TRUE if the interpolation should be made in any case
152    integer                 :: bcinf !< option bc
153    integer                 :: bcsup !< option bc
154    integer, dimension(6)   :: type_interp    !< option interp
155    integer, dimension(6,6) :: type_interp_bc !< option bcinterp
156    integer, dimension(6)   :: type_update    !< option update
157
158    integer, dimension(6)   :: lb
159    integer, dimension(6)   :: ub
160
161    logical,dimension(6,2) :: memberin
162    integer,dimension(6,2,2,6,2) :: childarray
163
164    type(Agrif_List_Interp_Loc), pointer :: list_interp => NULL()
165    type(Agrif_List_Interp_Loc), pointer :: list_update => NULL()
166!---------------------------------------------------------------------------------------------------
167end type Agrif_Variable
168!===================================================================================================
169!
170!===================================================================================================
171type Agrif_Variable_c
172!---------------------------------------------------------------------------------------------------
173!<  Data type to characterize a grid variable.
174!
175    type(Agrif_Variable_c), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
176    type(Agrif_Variable_c), pointer  :: parent_var => NULL()      !< pointer on the parent variable
177!
178    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
179!
180!> \name Arrays containing the values of the grid variables (character)
181!> @{
182    character(4000)                             :: carray0
183    character(:)  ,                 allocatable :: carrayu
184    character(400), dimension(:)  , allocatable :: carray1
185    character(400), dimension(:,:), allocatable :: carray2
186!> @}
187!---------------------------------------------------------------------------------------------------
188end type Agrif_Variable_c
189!===================================================================================================
190!
191!===================================================================================================
192type Agrif_Variable_r
193!---------------------------------------------------------------------------------------------------
194!<  Data type to characterize a grid variable.
195!
196    type(Agrif_Variable_r), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
197    type(Agrif_Variable_r), pointer  :: parent_var => NULL()      !< pointer on the parent variable
198!
199    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
200!
201!> \name Arrays containing the values of the grid variables (real)
202!> @{
203    real                                         :: array0
204    real,    dimension(:)          , allocatable :: array1
205    real,    dimension(:,:)        , allocatable :: array2
206    real,    dimension(:,:,:)      , allocatable :: array3
207    real,    dimension(:,:,:,:)    , allocatable :: array4
208    real,    dimension(:,:,:,:,:)  , allocatable :: array5
209    real,    dimension(:,:,:,:,:,:), allocatable :: array6
210!> @}
211!> \name Arrays containing the values of the grid variables (real*8)
212!> @{
213    real(8)                                      :: darray0
214    real(8), dimension(:)          , allocatable :: darray1
215    real(8), dimension(:,:)        , allocatable :: darray2
216    real(8), dimension(:,:,:)      , allocatable :: darray3
217    real(8), dimension(:,:,:,:)    , allocatable :: darray4
218    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
219    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
220!> @}
221!> \name Arrays containing the values of the grid variables (real*4)
222!> @{
223    real(4)                                      :: sarray0
224    real(4), dimension(:)          , allocatable :: sarray1
225    real(4), dimension(:,:)        , allocatable :: sarray2
226    real(4), dimension(:,:,:)      , allocatable :: sarray3
227    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
228    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
229    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
230!> @}
231!---------------------------------------------------------------------------------------------------
232end type Agrif_Variable_r
233!===================================================================================================
234!===================================================================================================
235!
236!===================================================================================================
237type Agrif_Variable_l
238!---------------------------------------------------------------------------------------------------
239!<  Data type to characterize a grid variable.
240!
241    type(Agrif_Variable_l), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
242    type(Agrif_Variable_l), pointer  :: parent_var => NULL()      !< pointer on the parent variable
243!
244    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
245!
246!> \name Arrays containing the values of the grid variables (logical)
247!> @{
248    logical                                      :: larray0 = .FALSE.
249    logical, dimension(:)          , allocatable :: larray1
250    logical, dimension(:,:)        , allocatable :: larray2
251    logical, dimension(:,:,:)      , allocatable :: larray3
252    logical, dimension(:,:,:,:)    , allocatable :: larray4
253    logical, dimension(:,:,:,:,:)  , allocatable :: larray5
254    logical, dimension(:,:,:,:,:,:), allocatable :: larray6
255
256!> @}
257!> \name Arrays containing the values of the grid variables (logical pointers)
258!> @{
259    logical, dimension(:)          , pointer :: plarray1
260    logical, dimension(:,:)        , pointer :: plarray2
261    logical, dimension(:,:,:)      , pointer :: plarray3
262    logical, dimension(:,:,:,:)    , pointer :: plarray4
263    logical, dimension(:,:,:,:,:)  , pointer :: plarray5
264    logical, dimension(:,:,:,:,:,:), pointer :: plarray6
265!> @}
266
267!---------------------------------------------------------------------------------------------------
268end type Agrif_Variable_l
269!===================================================================================================
270!
271!===================================================================================================
272type Agrif_Variable_i
273!---------------------------------------------------------------------------------------------------
274!<  Data type to characterize a grid variable.
275!
276    type(Agrif_Variable_i), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
277    type(Agrif_Variable_i), pointer  :: parent_var => NULL()      !< pointer on the parent variable
278!
279    integer                          :: nbdim = 0             !< number of dimensions of the grid variable
280!
281!> \name Arrays containing the values of the grid variables (integer)
282!> @{
283    integer                                      :: iarray0 = 0
284    integer, dimension(:)          , allocatable :: iarray1
285    integer, dimension(:,:)        , allocatable :: iarray2
286    integer, dimension(:,:,:)      , allocatable :: iarray3
287    integer, dimension(:,:,:,:)    , allocatable :: iarray4
288    integer, dimension(:,:,:,:,:)  , allocatable :: iarray5
289    integer, dimension(:,:,:,:,:,:), allocatable :: iarray6
290
291!> @}
292!
293!> \name Arrays containing the values of the grid variables (integer pointers)
294!> @{
295    integer, dimension(:)          , pointer :: piarray1
296    integer, dimension(:,:)        , pointer :: piarray2
297    integer, dimension(:,:,:)      , pointer :: piarray3
298    integer, dimension(:,:,:,:)    , pointer :: piarray4
299    integer, dimension(:,:,:,:,:)  , pointer :: piarray5
300    integer, dimension(:,:,:,:,:,:), pointer :: piarray6
301!> @}
302!---------------------------------------------------------------------------------------------------
303end type Agrif_Variable_i
304!===================================================================================================
305!
306!===================================================================================================
307type Agrif_Interp_Loc
308!---------------------------------------------------------------------------------------------------
309    integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99
310    integer,dimension(6)              :: indmin, indmax
311    integer,dimension(6)              :: pttruetab,cetruetab
312    logical :: member, memberin
313#if !defined AGRIF_MPI
314    integer,dimension(6)              :: indminglob,indmaxglob
315#else
316    integer,dimension(6)              :: indminglob2,indmaxglob2
317    integer,dimension(6,2,2)          :: parentarray
318    integer,dimension(:,:,:), pointer :: tab4t          => NULL()
319    integer,dimension(:,:,:), pointer :: tab5t          => NULL()
320    logical, dimension(:),    pointer :: memberinall    => NULL()
321    logical, dimension(:),    pointer :: memberinall2   => NULL()
322    logical, dimension(:),    pointer :: sendtoproc1    => NULL()
323    logical, dimension(:),    pointer :: sendtoproc2    => NULL()
324    logical, dimension(:),    pointer :: recvfromproc1  => NULL()
325    logical, dimension(:),    pointer :: recvfromproc2  => NULL() 
326#endif
327    integer                           :: nb_chunks
328    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk
329    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk_decal
330    integer, dimension(:,:),allocatable :: decal_chunks
331    logical, dimension(:),allocatable :: correction_required
332    logical, dimension(:),allocatable :: member_chuncks 
333!---------------------------------------------------------------------------------------------------
334end type Agrif_Interp_Loc
335!===================================================================================================
336
337!===================================================================================================
338type Agrif_List_Interp_Loc
339!---------------------------------------------------------------------------------------------------
340    type(Agrif_Interp_Loc),      pointer :: interp_loc => NULL()
341    type(Agrif_List_Interp_Loc), pointer :: suiv       => NULL()
342!---------------------------------------------------------------------------------------------------
343end type Agrif_List_Interp_Loc
344!===================================================================================================
345
346!===================================================================================================
347type Agrif_Variables_List
348!---------------------------------------------------------------------------------------------------
349    type(Agrif_Variable),       pointer :: var  => NULL()
350    type(Agrif_Variables_List), pointer :: next => NULL()
351!---------------------------------------------------------------------------------------------------
352end type Agrif_Variables_List
353!===================================================================================================
354!
355!===================================================================================================
356!> Different parameters
357!
358    type(Agrif_Variable),   dimension(:), pointer :: Agrif_tabvars => NULL()
359    type(Agrif_Variable_c), dimension(:), pointer :: Agrif_tabvars_c => NULL()
360    type(Agrif_Variable_r), dimension(:), pointer :: Agrif_tabvars_r => NULL()
361    type(Agrif_Variable_l), dimension(:), pointer :: Agrif_tabvars_l => NULL()
362    type(Agrif_Variable_i), dimension(:), pointer :: Agrif_tabvars_i => NULL()
363!
364    integer               :: Agrif_Probdim          !< Problem dimension
365    integer,dimension(0:4):: Agrif_NbVariables      !< Number of variables
366    integer               :: Agrif_nbfixedgrids     !< Number of fixed grids in the grid hierarchy
367    integer, dimension(3) :: Agrif_coeffref         !< Space refinement factor
368    integer, dimension(3) :: Agrif_coeffreft        !< Time refinement factor
369    logical               :: Agrif_UseSpecialValue          !< T if use special values on the parent grid
370    logical               :: Agrif_UseSpecialValueInUpdate  !< T if use special values on the parent grid
371    logical               :: Agrif_Update_Weights = .FALSE.
372    logical               :: Agrif_UseSpecialValueFineGrid  !< T if use special values on the current grid
373    real                  :: Agrif_SpecialValue             !< Special value on the parent grid
374    real                  :: Agrif_SpecialValueFineGrid     !< Special value on the current grid
375!>
376!> \name Clustering parameters
377!> @{
378    integer               :: Agrif_Regridding = 10
379    integer               :: Agrif_Minwidth
380    real                  :: Agrif_Efficiency = 0.7
381    integer               :: MaxSearch = 5
382    real, dimension(3)    :: Agrif_mind
383!> @}
384!> \name parameters for the interpolation of the child grids
385!> @{
386    integer, parameter    :: Agrif_linear = 1           !< linear interpolation
387    integer, parameter    :: Agrif_lagrange = 2         !< lagrange interpolation
388    integer, parameter    :: Agrif_eno = 3              !< spline interpolation
389    integer, parameter    :: Agrif_user_interp = 4      !< user defined interpolation
390    integer, parameter    :: Agrif_constant = 5         !< constant interpolation
391    integer, parameter    :: Agrif_linearconserv = 6    !< linear conservative interpolation
392    integer, parameter    :: Agrif_linearconservlim = 7 !< linear conservative interpolation
393    integer, parameter    :: Agrif_ppm = 8              !< PPM interpolation
394    integer, parameter    :: Agrif_weno = 9             !< WENO5 interpolation
395    integer, parameter    :: Agrif_ppm_lim = 10         !< PPM interpolation with monotonicity
396!> @}
397!> \name parameters for the update of the parent grids
398!> @{
399    integer, parameter    :: Agrif_Update_Copy = 1              !< copy
400    integer, parameter    :: Agrif_Update_Average = 2           !< average
401    integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting
402    integer, parameter    :: Agrif_Update_Max = 4               !< Max
403!> @}
404!> \name Raffinement grid switches
405!> @{
406    integer               :: Agrif_USE_ONLY_FIXED_GRIDS   !< = 1 if fixed grid mode
407    integer               :: Agrif_USE_FIXED_GRIDS        !< = 1 if AMR mode + fixed grid else only AMR mode
408!> @}
409    integer               :: Agrif_Maxlevelloc
410!
411#if defined AGRIF_MPI
412    integer :: Agrif_Nbprocs  !< Number of processors
413    integer :: Agrif_ProcRank !< Rank of the current processor
414    integer :: Agrif_Group    !< Group associated to Agrif_mpi_comm
415    integer :: Agrif_mpi_comm
416#else
417    integer :: Agrif_ProcRank = 0
418#endif
419!
420    integer :: Agrif_Extra_Boundary_Cells = 3       !< When computing integration sequences, the grid rects
421                                                    !! are expanded to this number of cells.
422    logical :: Agrif_Parallel_sisters = .FALSE.     !< When TRUE, try to compute sister grids (which have the same parent)
423                                                    !! in parallel rather than sequentially.
424    logical :: agrif_regrid_has_been_done = .FALSE. !< switch to skip Agrif_Regrid call
425!
426    real, dimension(:)          , allocatable :: parray1
427    real, dimension(:,:)        , allocatable :: parray2
428    real, dimension(:,:,:)      , allocatable :: parray3
429    real, dimension(:,:,:,:)    , allocatable :: parray4
430    real, dimension(:,:,:,:,:)  , allocatable :: parray5
431    real, dimension(:,:,:,:,:,:), allocatable :: parray6
432!
433    logical :: agrif_debug = .false.        ! may be activaded in users subroutine for debugging purposes
434    logical :: agrif_debug_interp = .false. ! may be activaded in users subroutine for debugging interpolations
435    logical :: agrif_debug_update = .false. ! may be activaded in users subroutine for debugging updates
436
437! If a grand mother grid is present
438    logical :: agrif_coarse = .false.
439    integer, dimension(3) :: coarse_spaceref = (/1,1,1/)
440    integer, dimension(3) :: coarse_timeref  = (/1,1,1/)
441   
442   
443! External mapping procedure
444    Procedure(mapping), pointer :: agrif_external_mapping => NULL()
445    abstract interface
446     subroutine mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
447     integer :: ndim, ptx, pty
448     integer,dimension(ndim,2,2) :: bounds
449     integer,dimension(:,:,:,:),allocatable :: bounds_chunks
450     logical,dimension(:),allocatable :: correction_required
451     integer :: nb_chunks
452     end subroutine mapping
453    end interface
454
455    Procedure(linear_interp), pointer :: agrif_external_linear_interp => NULL()
456    abstract interface
457     real function linear_interp(x1,x2,coeff)
458     real :: x1, x2, coeff
459     end function linear_interp
460    end interface
461!
462contains
463!
464!===================================================================================================
465!  function Agrif_Ceiling
466!---------------------------------------------------------------------------------------------------
467integer function Agrif_Ceiling ( x )
468!---------------------------------------------------------------------------------------------------
469    real,   intent(in) :: x
470!
471    integer   :: i
472!
473    i = FLOOR(x)
474!
475    if( ABS(x - i) <= 0.0001 )then
476        Agrif_Ceiling = i
477    else
478        Agrif_Ceiling = i+1
479    endif
480!---------------------------------------------------------------------------------------------------
481end function Agrif_Ceiling
482!===================================================================================================
483!
484!===================================================================================================
485!  function Agrif_Int
486!---------------------------------------------------------------------------------------------------
487    integer function Agrif_Int(x)
488!---------------------------------------------------------------------------------------------------
489    real,   intent(in) :: x
490!
491    integer :: i
492!
493    i = FLOOR(x) + 1
494!
495    if( ABS(x - i) <= 0.0001 )then
496        Agrif_Int = i
497    else
498        Agrif_Int = i-1
499    endif
500!---------------------------------------------------------------------------------------------------
501end function Agrif_Int
502!===================================================================================================
503!
504end module Agrif_Types
Note: See TracBrowser for help on using the repository browser.