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

source: vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinit.F90 @ 10087

Last change on this file since 10087 was 10087, checked in by rblod, 6 years ago

update AGRIF library

  • Property svn:keywords set to Id
File size: 8.5 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!> Module Agrif_Init.
22!>
23!> Several operations on the variables of the current grid (creation, instanciation, ...)
24!! used during the creation of the grid hierarchy and during the time integration.
25!
26module Agrif_Init
27!
28    use Agrif_Grids
29    use Agrif_Link
30    use Agrif_Mpp
31!
32    implicit none
33
34    abstract interface
35        subroutine step_proc()
36        end subroutine step_proc
37    end interface
38   
39!
40contains
41!
42
43
44subroutine Agrif_call_procname ( procname )
45    procedure(step_proc)  :: procname
46    call procname()
47end subroutine  Agrif_call_procname
48!===================================================================================================
49
50subroutine Agrif_call_procname1 ( procname1 )
51    procedure(typedef_proc) :: procname1 
52    call procname1()
53end subroutine  Agrif_call_procname1
54
55!===================================================================================================
56!  subroutine Agrif_Allocation
57!
58!> Allocates the arrays containing the values of the variables of the current grd.
59!---------------------------------------------------------------------------------------------------
60subroutine Agrif_Allocation ( Agrif_Gr, procname )
61!---------------------------------------------------------------------------------------------------
62    type(Agrif_Grid),       pointer   :: Agrif_Gr   !< Pointer on the current grid
63    procedure(alloc_proc),  optional  :: procname   !< Allocation procedure (Default: Agrif_Allocationcalls)
64!
65    if ( present(procname) ) then
66        call procname(Agrif_Gr)
67    else
68        call Agrif_Allocationcalls(Agrif_Gr)
69    endif
70    Agrif_Gr % allocation_is_done = .true.
71!
72    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
73!
74        if ( Agrif_Probdim == 1 ) allocate( Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1) )
75        if ( Agrif_Probdim == 2 ) allocate( Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1, &
76                                                                Agrif_Gr%nb(2)+1) )
77        if ( Agrif_Probdim == 3 ) allocate( Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1, &
78                                                                Agrif_Gr%nb(2)+1, &
79                                                                Agrif_Gr%nb(3)+1) )
80    endif
81!---------------------------------------------------------------------------------------------------
82end subroutine Agrif_Allocation
83!===================================================================================================
84!
85!===================================================================================================
86!  subroutine Agrif_Instance
87!
88!> Make the pointer Agrif_Types::Agrif_Curgrid point to Agrif_Gr
89!---------------------------------------------------------------------------------------------------
90subroutine Agrif_Instance ( Agrif_Gr )
91!---------------------------------------------------------------------------------------------------
92    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
93!
94    Agrif_Curgrid => Agrif_Gr
95    Agrif_tabvars => Agrif_Curgrid % tabvars
96    Agrif_tabvars_c => Agrif_Curgrid % tabvars_c
97    Agrif_tabvars_r => Agrif_Curgrid % tabvars_r
98    Agrif_tabvars_l => Agrif_Curgrid % tabvars_l
99    Agrif_tabvars_i => Agrif_Curgrid % tabvars_i
100!
101#if defined AGRIF_MPI
102    if ( Agrif_Gr % communicator /= -1 ) then
103        call Agrif_MPI_switch_comm( Agrif_Gr % communicator )
104    endif
105#endif
106!
107    call Agrif_Get_numberofcells(Agrif_Gr)
108    call Agrif_InitWorkSpace()
109!---------------------------------------------------------------------------------------------------
110end subroutine Agrif_Instance
111!===================================================================================================
112!
113!===================================================================================================
114!  subroutine Agrif_initialisations
115!---------------------------------------------------------------------------------------------------
116subroutine Agrif_initialisations ( Agrif_Gr )
117!---------------------------------------------------------------------------------------------------
118    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
119!
120    integer                         :: i
121    type(Agrif_Variable),   pointer :: var => NULL()
122    type(Agrif_Variable_c), pointer :: var_c => NULL()
123    type(Agrif_Variable_r), pointer :: var_r => NULL()
124    type(Agrif_Variable_l), pointer :: var_l => NULL()
125    type(Agrif_Variable_i), pointer :: var_i => NULL()
126!
127    do i = 1,Agrif_NbVariables(0)
128!
129        var => Agrif_Gr % tabvars(i)
130        var % nbdim = 0
131!
132        if (allocated(var%array1)) then
133            var % nbdim = 1
134            var % lb(1:1) = lbound(var%array1)
135            var % ub(1:1) = ubound(var%array1)
136        endif
137        if (allocated(var%array2)) then
138            var % nbdim = 2
139            var % lb(1:2) = lbound(var%array2)
140            var % ub(1:2) = ubound(var%array2)
141        endif
142        if (allocated(var%array3)) then
143            var % nbdim = 3
144            var % lb(1:3) = lbound(var%array3)
145            var % ub(1:3) = ubound(var%array3)
146        endif
147        if (allocated(var%array4)) then
148            var % nbdim = 4
149            var % lb(1:4) = lbound(var%array4)
150            var % ub(1:4) = ubound(var%array4)
151        endif
152        if (allocated(var%array5)) then
153            var % nbdim = 5
154            var % lb(1:5) = lbound(var%array5)
155            var % ub(1:5) = ubound(var%array5)
156        endif
157        if (allocated(var%array6)) then
158            var % nbdim = 6
159            var % lb(1:6) = lbound(var%array6)
160            var % ub(1:6) = ubound(var%array6)
161        endif
162!
163        if (allocated(var%darray1)) var % nbdim = 1
164        if (allocated(var%darray2)) var % nbdim = 2
165        if (allocated(var%darray3)) var % nbdim = 3
166        if (allocated(var%darray4)) var % nbdim = 4
167        if (allocated(var%darray5)) var % nbdim = 5
168        if (allocated(var%darray6)) var % nbdim = 6
169!
170        if (allocated(var%sarray1)) var % nbdim = 1
171        if (allocated(var%sarray2)) var % nbdim = 2
172        if (allocated(var%sarray3)) var % nbdim = 3
173        if (allocated(var%sarray4)) var % nbdim = 4
174        if (allocated(var%sarray5)) var % nbdim = 5
175        if (allocated(var%sarray6)) var % nbdim = 6
176!
177    enddo
178
179    do i = 1,Agrif_NbVariables(1)
180!
181        var_c => Agrif_Gr % tabvars_c(i)
182        var_c % nbdim = 0
183!
184        if (allocated(var_c%carray1)) var_c % nbdim = 1
185        if (allocated(var_c%carray2)) var_c % nbdim = 2
186!
187    enddo
188
189    do i = 1,Agrif_NbVariables(2)
190!
191        var_r => Agrif_Gr % tabvars_r(i)
192        var_r % nbdim = 0
193!
194    enddo
195
196    do i = 1,Agrif_NbVariables(3)
197!
198        var_l => Agrif_Gr % tabvars_l(i)
199        var_l % nbdim = 0
200!
201        if (allocated(var_l%larray1)) var_l % nbdim = 1
202        if (allocated(var_l%larray2)) var_l % nbdim = 2
203        if (allocated(var_l%larray3)) var_l % nbdim = 3
204        if (allocated(var_l%larray4)) var_l % nbdim = 4
205        if (allocated(var_l%larray5)) var_l % nbdim = 5
206        if (allocated(var_l%larray6)) var_l % nbdim = 6
207!
208    enddo
209
210    do i = 1,Agrif_NbVariables(4)
211!
212        var_i => Agrif_Gr % tabvars_i(i)
213        var_i % nbdim = 0
214!
215        if (allocated(var_i%iarray1)) var_i % nbdim = 1
216        if (allocated(var_i%iarray2)) var_i % nbdim = 2
217        if (allocated(var_i%iarray3)) var_i % nbdim = 3
218        if (allocated(var_i%iarray4)) var_i % nbdim = 4
219        if (allocated(var_i%iarray5)) var_i % nbdim = 5
220        if (allocated(var_i%iarray6)) var_i % nbdim = 6
221!
222    enddo
223
224!---------------------------------------------------------------------------------------------------
225end subroutine Agrif_initialisations
226!===================================================================================================
227!
228end module Agrif_Init
Note: See TracBrowser for help on using the repository browser.