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

!
! $Id$
!
!     AGRIF (Adaptive Grid Refinement In Fortran)
!
!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
!                        Christophe Vouland (Christophe.Vouland@imag.fr)
!
!     This program is free software; you can redistribute it and/or modify
!     it under the terms of the GNU General Public License as published by
!     the Free Software Foundation; either version 2 of the License, or
!     (at your option) any later version.
!
!     This program is distributed in the hope that it will be useful,
!     but WITHOUT ANY WARRANTY; without even the implied warranty of
!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!     GNU General Public License for more details.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!
!---------------------------------------------------------------------------------------------------
!> Module Agrif_BcFunction.
!!
!---------------------------------------------------------------------------------------------------
module Agrif_BcFunction
!
!     Modules used:
!
   use Agrif_User_Variables

!
    implicit none
!
    interface Agrif_Save_Forrestore
        module procedure Agrif_Save_Forrestore0d,   &
                         Agrif_Save_Forrestore2d,   &
                         Agrif_Save_Forrestore3d,   &
                         Agrif_Save_Forrestore4d
    end interface
!
contains

!===================================================================================================
!  subroutine Agrif_Set_restore
!> This subroutine is used to set the index of the current grid variable we want to restore.
!---------------------------------------------------------------------------------------------------
subroutine Agrif_Set_restore ( tabvarsindic )
!---------------------------------------------------------------------------------------------------
    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
!
    INTEGER :: indic  !  indice of the variable in tabvars
!
print *,'CURRENTLY BROKEN'
STOP

    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
!
    Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
!---------------------------------------------------------------------------------------------------
end subroutine Agrif_Set_restore
!===================================================================================================
!
!===================================================================================================
!  subroutine Agrif_Save_ForRestore0D
!---------------------------------------------------------------------------------------------------
subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
!---------------------------------------------------------------------------------------------------
    integer, intent(in) :: tabvarsindic0 !< index of the current grid variable 
    integer, intent(in) :: tabvarsindic  !< index of the varible which should be restored
    
!
    type(Agrif_Variable), pointer   :: root_var, save_var
    integer :: nbdim
!
print *,'CURRENTLY BROKEN'
STOP
    root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
    save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
    nbdim =  root_var % nbdim
!
    select case(nbdim)
        case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic)
        case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic)
        case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic)
    end select
!---------------------------------------------------------------------------------------------------
end subroutine Agrif_Save_ForRestore0D
!===================================================================================================
!
!===================================================================================================
!  subroutine Agrif_Save_ForRestore2D
!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 2D-variable.
!---------------------------------------------------------------------------------------------------
subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
!---------------------------------------------------------------------------------------------------
!
real, dimension(:,:), intent(in) :: q            !< input 2D-variable which should be saved
integer,            intent(in) :: tabvarsindic !< index of the current grid variable we want to restore
!
    type(Agrif_Variable),  pointer  :: root_var, save_var
    integer                         :: indic
!
print *,'CURRENTLY BROKEN'
STOP
    indic = tabvarsindic
    if (tabvarsindic >= 0) then
        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
        endif
    endif
!
    if (indic <= 0) then
        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
    else
        save_var => Agrif_Curgrid % tabvars(indic)
        root_var => Agrif_Mygrid % tabvars(indic)
    endif
!
    if ( .not.allocated(save_var%array2) ) then
        allocate(save_var%array2(save_var%lb(1):save_var%ub(1),  &
                                 save_var%lb(2):save_var%ub(2)))
    endif
!
    save_var % array2  = q
    root_var % restore = .true.
!---------------------------------------------------------------------------------------------------
end subroutine Agrif_Save_ForRestore2D
!===================================================================================================
!
!===================================================================================================
!  subroutine Agrif_Save_ForRestore3D
!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 3D-variable.
!---------------------------------------------------------------------------------------------------
subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
!---------------------------------------------------------------------------------------------------
!
real, dimension(:,:,:), intent(in) :: q !< input 3D-variable which should be saved
integer, intent(in) :: tabvarsindic    !< index of the current grid variable we want to restore
!
    type(Agrif_Variable),  pointer  :: root_var, save_var
    integer                         :: indic
!
print *,'CURRENTLY BROKEN'
STOP

    indic = tabvarsindic
    if (tabvarsindic >= 0) then
        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
        endif
    endif
!
    if (indic <= 0) then
        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
    else
        save_var => Agrif_Curgrid % tabvars(indic)
        root_var => Agrif_Mygrid % tabvars(indic)
    endif
!
    if ( .not.allocated(save_var%array3) ) then
        allocate(save_var%array3(save_var%lb(1):save_var%ub(1), &
                                 save_var%lb(2):save_var%ub(2), &
                                 save_var%lb(3):save_var%ub(3)))
    endif
!
    save_var % array3  = q
    root_var % restore = .true.
!---------------------------------------------------------------------------------------------------
end subroutine Agrif_Save_ForRestore3D
!===================================================================================================
!
!===================================================================================================
!  subroutine Agrif_Save_ForRestore4D
!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 4D-variable.
!---------------------------------------------------------------------------------------------------
subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
!---------------------------------------------------------------------------------------------------
!
real, dimension(:,:,:,:), intent(in) :: q !< input 4D-variable which should be saved
integer, intent(in) :: tabvarsindic      !< index of the current grid variable we want to restore
!
!
    type(Agrif_Variable),  pointer  :: root_var, save_var
    integer                         :: indic
!
print *,'CURRENTLY BROKEN'
STOP
    indic = tabvarsindic
    if (tabvarsindic >= 0) then
        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
        endif
    endif
!
    if (indic <= 0) then
        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
    else
        save_var => Agrif_Curgrid % tabvars(indic)
        root_var => Agrif_Mygrid % tabvars(indic)
    endif
!
    if (.not.allocated(save_var%array4)) then
        allocate(save_var%array4(save_var%lb(1):save_var%ub(1),&
                                 save_var%lb(2):save_var%ub(2),&
                                 save_var%lb(3):save_var%ub(3),&
                                 save_var%lb(4):save_var%ub(4)))
    endif
!
    save_var % array4  = q
    root_var % restore = .true.
!---------------------------------------------------------------------------------------------------
end subroutine Agrif_Save_ForRestore4D
!===================================================================================================
!
end module Agrif_BcFunction