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

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

update AGRIF library

  • Property svn:keywords set to Id
File size: 9.4 KB
Line 
1!
2! $Id$
3!
4!     AGRIF (Adaptive Grid Refinement In Fortran)
5!
6!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
7!                        Christophe Vouland (Christophe.Vouland@imag.fr)
8!
9!     This program is free software; you can redistribute it and/or modify
10!     it under the terms of the GNU General Public License as published by
11!     the Free Software Foundation; either version 2 of the License, or
12!     (at your option) any later version.
13!
14!     This program is distributed in the hope that it will be useful,
15!     but WITHOUT ANY WARRANTY; without even the implied warranty of
16!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17!     GNU General Public License for more details.
18!
19!     You should have received a copy of the GNU General Public License
20!     along with this program; if not, write to the Free Software
21!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22!
23!---------------------------------------------------------------------------------------------------
24!> Module Agrif_BcFunction.
25!!
26!---------------------------------------------------------------------------------------------------
27module Agrif_BcFunction
28!
29!     Modules used:
30!
31   use Agrif_User_Variables
32
33!
34    implicit none
35!
36    interface Agrif_Save_Forrestore
37        module procedure Agrif_Save_Forrestore0d,   &
38                         Agrif_Save_Forrestore2d,   &
39                         Agrif_Save_Forrestore3d,   &
40                         Agrif_Save_Forrestore4d
41    end interface
42!
43contains
44
45!===================================================================================================
46!  subroutine Agrif_Set_restore
47!> This subroutine is used to set the index of the current grid variable we want to restore.
48!---------------------------------------------------------------------------------------------------
49subroutine Agrif_Set_restore ( tabvarsindic )
50!---------------------------------------------------------------------------------------------------
51    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
52!
53    INTEGER :: indic  !  indice of the variable in tabvars
54!
55print *,'CURRENTLY BROKEN'
56STOP
57
58    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
59!
60    Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
61!---------------------------------------------------------------------------------------------------
62end subroutine Agrif_Set_restore
63!===================================================================================================
64!
65!===================================================================================================
66!  subroutine Agrif_Save_ForRestore0D
67!---------------------------------------------------------------------------------------------------
68subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
69!---------------------------------------------------------------------------------------------------
70    integer, intent(in) :: tabvarsindic0 !< index of the current grid variable
71    integer, intent(in) :: tabvarsindic  !< index of the varible which should be restored
72   
73!
74    type(Agrif_Variable), pointer   :: root_var, save_var
75    integer :: nbdim
76!
77print *,'CURRENTLY BROKEN'
78STOP
79    root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
80    save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
81    nbdim =  root_var % nbdim
82!
83    select case(nbdim)
84        case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic)
85        case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic)
86        case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic)
87    end select
88!---------------------------------------------------------------------------------------------------
89end subroutine Agrif_Save_ForRestore0D
90!===================================================================================================
91!
92!===================================================================================================
93!  subroutine Agrif_Save_ForRestore2D
94!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 2D-variable.
95!---------------------------------------------------------------------------------------------------
96subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
97!---------------------------------------------------------------------------------------------------
98!
99real, dimension(:,:), intent(in) :: q            !< input 2D-variable which should be saved
100integer,            intent(in) :: tabvarsindic !< index of the current grid variable we want to restore
101!
102    type(Agrif_Variable),  pointer  :: root_var, save_var
103    integer                         :: indic
104!
105print *,'CURRENTLY BROKEN'
106STOP
107    indic = tabvarsindic
108    if (tabvarsindic >= 0) then
109        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
110            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
111        endif
112    endif
113!
114    if (indic <= 0) then
115        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
116        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
117    else
118        save_var => Agrif_Curgrid % tabvars(indic)
119        root_var => Agrif_Mygrid % tabvars(indic)
120    endif
121!
122    if ( .not.allocated(save_var%array2) ) then
123        allocate(save_var%array2(save_var%lb(1):save_var%ub(1),  &
124                                 save_var%lb(2):save_var%ub(2)))
125    endif
126!
127    save_var % array2  = q
128    root_var % restore = .true.
129!---------------------------------------------------------------------------------------------------
130end subroutine Agrif_Save_ForRestore2D
131!===================================================================================================
132!
133!===================================================================================================
134!  subroutine Agrif_Save_ForRestore3D
135!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 3D-variable.
136!---------------------------------------------------------------------------------------------------
137subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
138!---------------------------------------------------------------------------------------------------
139!
140real, dimension(:,:,:), intent(in) :: q !< input 3D-variable which should be saved
141integer, intent(in) :: tabvarsindic    !< index of the current grid variable we want to restore
142!
143    type(Agrif_Variable),  pointer  :: root_var, save_var
144    integer                         :: indic
145!
146print *,'CURRENTLY BROKEN'
147STOP
148
149    indic = tabvarsindic
150    if (tabvarsindic >= 0) then
151        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
152            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
153        endif
154    endif
155!
156    if (indic <= 0) then
157        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
158        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
159    else
160        save_var => Agrif_Curgrid % tabvars(indic)
161        root_var => Agrif_Mygrid % tabvars(indic)
162    endif
163!
164    if ( .not.allocated(save_var%array3) ) then
165        allocate(save_var%array3(save_var%lb(1):save_var%ub(1), &
166                                 save_var%lb(2):save_var%ub(2), &
167                                 save_var%lb(3):save_var%ub(3)))
168    endif
169!
170    save_var % array3  = q
171    root_var % restore = .true.
172!---------------------------------------------------------------------------------------------------
173end subroutine Agrif_Save_ForRestore3D
174!===================================================================================================
175!
176!===================================================================================================
177!  subroutine Agrif_Save_ForRestore4D
178!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 4D-variable.
179!---------------------------------------------------------------------------------------------------
180subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
181!---------------------------------------------------------------------------------------------------
182!
183real, dimension(:,:,:,:), intent(in) :: q !< input 4D-variable which should be saved
184integer, intent(in) :: tabvarsindic      !< index of the current grid variable we want to restore
185!
186!
187    type(Agrif_Variable),  pointer  :: root_var, save_var
188    integer                         :: indic
189!
190print *,'CURRENTLY BROKEN'
191STOP
192    indic = tabvarsindic
193    if (tabvarsindic >= 0) then
194        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
195            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
196        endif
197    endif
198!
199    if (indic <= 0) then
200        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
201        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
202    else
203        save_var => Agrif_Curgrid % tabvars(indic)
204        root_var => Agrif_Mygrid % tabvars(indic)
205    endif
206!
207    if (.not.allocated(save_var%array4)) then
208        allocate(save_var%array4(save_var%lb(1):save_var%ub(1),&
209                                 save_var%lb(2):save_var%ub(2),&
210                                 save_var%lb(3):save_var%ub(3),&
211                                 save_var%lb(4):save_var%ub(4)))
212    endif
213!
214    save_var % array4  = q
215    root_var % restore = .true.
216!---------------------------------------------------------------------------------------------------
217end subroutine Agrif_Save_ForRestore4D
218!===================================================================================================
219!
220end module Agrif_BcFunction
Note: See TracBrowser for help on using the repository browser.