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

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

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

update AGRIF library

File size: 6.5 KB
Line 
1!
2! $Id: modupdate.F 779 2007-12-22 17:04:17Z rblod $
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_User_Update
25!!
26!! This module contains the main procedures used to update a variable.
27!---------------------------------------------------------------------------------------------------
28!
29module Agrif_User_Update
30!
31    use Agrif_Update
32    use Agrif_Save
33!
34    implicit none
35!
36contains
37!
38!
39!===================================================================================================
40!  subroutine Agrif_Set_UpdateType
41!> This subroutine is used to specify the type of update we want to do. The index of the variable we want
42!! to interpolate is a profile defined with the subroutine Agrif_Declare_Variable.
43!---------------------------------------------------------------------------------------------------
44subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, &
45                                                update3, update4, update5 )
46!---------------------------------------------------------------------------------------------------
47    INTEGER,           intent(in) :: tabvarsindic     !< index of the variable in tabvars
48    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5 !< type of update
49!
50    INTEGER                         :: indic ! indice of the variable in tabvars
51    type(Agrif_Variable),  pointer  :: root_var
52!
53
54        root_var => Agrif_Search_Variable(Agrif_Mygrid,tabvarsindic)
55
56!
57    root_var % type_update = Agrif_Update_Copy
58    if (present(update))    root_var % type_update    = update
59    if (present(update1))   root_var % type_update(1) = update1
60    if (present(update2))   root_var % type_update(2) = update2
61    if (present(update3))   root_var % type_update(3) = update3
62    if (present(update4))   root_var % type_update(4) = update4
63    if (present(update5))   root_var % type_update(5) = update5
64!---------------------------------------------------------------------------------------------------
65end subroutine Agrif_Set_UpdateType
66!===================================================================================================
67!
68!
69!===================================================================================================
70!  subroutine Agrif_Update_Variable
71!> This subroutine is used to update variables. When the location is not specify, the update is made
72!! within the domain of the reference grid (not at boundary). The index of the variable we want to
73!! interpolate is a profile defined with the subroutine Agrif_Declare_Variable.
74!>locupdate1 : specifies the location for the first dimension.
75!---------------------------------------------------------------------------------------------------
76subroutine Agrif_Update_Variable ( tabvarsindic, procname, &
77                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 )
78!---------------------------------------------------------------------------------------------------
79    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars
80    procedure()                                 :: procname         !< Data recovery procedure written by users
81    integer, dimension(2), intent(in), optional :: locupdate      !< location to update
82    integer, dimension(2), intent(in), optional :: locupdate1
83    integer, dimension(2), intent(in), optional :: locupdate2
84    integer, dimension(2), intent(in), optional :: locupdate3
85    integer, dimension(2), intent(in), optional :: locupdate4
86!---------------------------------------------------------------------------------------------------
87    integer :: indic
88    integer :: nbdim
89    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated
90    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated
91    type(Agrif_Variable), pointer   :: root_var
92    type(Agrif_Variable), pointer   :: parent_var
93    type(Agrif_Variable), pointer   :: child_var
94!
95    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return
96    if (agrif_curgrid%grand_mother_grid) return
97!
98
99        child_var  => Agrif_Search_Variable(Agrif_Curgrid, tabvarsindic)
100        parent_var => child_var % parent_var
101
102        if (.not.associated(parent_var)) then
103          ! can occur during the first update of Agrif_Coarsegrid (if any)
104          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, tabvarsindic)
105          child_var % parent_var => parent_var
106        endif
107
108        root_var   => child_var % root_var
109
110!
111    nbdim = root_var % nbdim
112!
113    updateinf = -99
114    updatesup = -99
115!
116    if ( present(locupdate) ) then
117        updateinf(1:nbdim) = locupdate(1)
118        updatesup(1:nbdim) = locupdate(2)
119    endif
120!
121    if ( present(locupdate1) ) then
122        updateinf(1) = locupdate1(1)
123        updatesup(1) = locupdate1(2)
124    endif
125!
126    if ( present(locupdate2) ) then
127        updateinf(2) = locupdate2(1)
128        updatesup(2) = locupdate2(2)
129    endif
130
131    if ( present(locupdate3) ) then
132        updateinf(3) = locupdate3(1)
133        updatesup(3) = locupdate3(2)
134    endif
135
136    if ( present(locupdate4) ) then
137        updateinf(4) = locupdate4(1)
138        updatesup(4) = locupdate4(2)
139    endif
140!
141    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname )
142!---------------------------------------------------------------------------------------------------
143end subroutine Agrif_Update_Variable
144!===================================================================================================
145!
146
147end module Agrif_User_Update
Note: See TracBrowser for help on using the repository browser.