[10087] | 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 |
---|