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 | ! |
---|
29 | module Agrif_User_Update |
---|
30 | ! |
---|
31 | use Agrif_Update |
---|
32 | use Agrif_Save |
---|
33 | ! |
---|
34 | implicit none |
---|
35 | ! |
---|
36 | contains |
---|
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 | !--------------------------------------------------------------------------------------------------- |
---|
44 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
65 | end 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 | !--------------------------------------------------------------------------------------------------- |
---|
76 | subroutine 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 | !--------------------------------------------------------------------------------------------------- |
---|
143 | end subroutine Agrif_Update_Variable |
---|
144 | !=================================================================================================== |
---|
145 | ! |
---|
146 | |
---|
147 | end module Agrif_User_Update |
---|