1154 lines
47 KiB
Fortran
Executable File
1154 lines
47 KiB
Fortran
Executable File
!
|
|
! $Id: modcurgridfunctions.F90 14431 2021-02-11 07:57:24Z smasson $
|
|
!
|
|
! 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 to define some procedures concerning the current grid
|
|
!
|
|
module Agrif_CurgridFunctions
|
|
!
|
|
use Agrif_Init
|
|
!
|
|
implicit none
|
|
!
|
|
|
|
interface Agrif_Parent
|
|
module procedure Agrif_Parent_Real_4, &
|
|
Agrif_Parent_Real_8, &
|
|
Agrif_Parent_Array2_Real_8, &
|
|
Agrif_Parent_Integer, &
|
|
Agrif_Parent_Character, &
|
|
Agrif_Parent_Logical
|
|
end interface
|
|
interface Agrif_Child
|
|
module procedure Agrif_Child_Logical
|
|
end interface
|
|
|
|
contains
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_rel_dt
|
|
!
|
|
!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.).
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_rel_dt ( ) result( rel_dt )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: i
|
|
real :: rel_dt
|
|
!
|
|
rel_dt = 1.
|
|
!
|
|
do i = 1,Agrif_Probdim
|
|
rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i))
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_rel_dt
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_rel_idt
|
|
!
|
|
!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1).
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_rel_idt ( ) result( rel_idt )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: rel_idt
|
|
!
|
|
rel_idt = nint(1./Agrif_rel_dt())
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_rel_idt
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_IRhot
|
|
!
|
|
!> Returns the time refinement factor of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_IRhot ( ) result( irhot )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: i, irhot
|
|
!
|
|
irhot = 1
|
|
!
|
|
do i = 1,Agrif_Probdim
|
|
irhot = max(irhot, Agrif_Curgrid % timeref(i))
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_IRhot
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Rhot
|
|
!
|
|
!> Returns the time refinement factor of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Rhot ( ) result( rhot )
|
|
!---------------------------------------------------------------------------------------------------
|
|
real :: rhot
|
|
!
|
|
rhot = float(Agrif_IRhot())
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Rhot
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_IRhot
|
|
!
|
|
!> Returns the time refinement factor of the parent of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_IRhot ( ) result( irhot )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: i, irhot
|
|
!
|
|
irhot = 1
|
|
!
|
|
do i = 1,Agrif_Probdim
|
|
irhot = max(irhot, Agrif_Curgrid % parent % timeref(i))
|
|
enddo
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_IRhot
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_Rhot
|
|
!
|
|
!> Returns the time refinement factor of the parent of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_Rhot ( ) result( rhot )
|
|
!---------------------------------------------------------------------------------------------------
|
|
real :: rhot
|
|
!
|
|
rhot = float(Agrif_Parent_IRhot())
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_Rhot
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Nbstepint
|
|
!
|
|
!> function for the calculation of the coefficients used for the time interpolation
|
|
!! (module #Agrif_Boundary).
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Nbstepint ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_nbstepint ! result
|
|
!
|
|
Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot())
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Nbstepint
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_Nbstepint
|
|
!
|
|
!> function for the calculation of the coefficients used for the time interpolation
|
|
!! (module #Agrif_Boundary).
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_Nbstepint ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_Parent_Nbstepint ! result
|
|
!
|
|
Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot()))
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_Nbstepint
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_InterpNearBorderX
|
|
!
|
|
!> Allows to interpolate (in the x direction) on a near border of the current grid if this one
|
|
!! has a common border with the root coarse grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_InterpNearBorderX ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % NearRootBorder(1) = .FALSE.
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_InterpNearBorderX
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_InterpDistantBorderX
|
|
!
|
|
!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one
|
|
!! has a common border with the root coarse grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_InterpDistantBorderX ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % DistantRootBorder(1) = .FALSE.
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_InterpDistantBorderX
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_InterpNearBorderY
|
|
!
|
|
!> Allows to interpolate (in the y direction) on a near border of the current grid if this one
|
|
!! has a common border with the root coarse grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_InterpNearBorderY ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % NearRootBorder(2) = .FALSE.
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_InterpNearBorderY
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_InterpDistantBorderY
|
|
!
|
|
!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one
|
|
!! has a common border with the root coarse grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_InterpDistantBorderY ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % DistantRootBorder(2) = .FALSE.
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_InterpDistantBorderY
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_InterpNearBorderZ
|
|
!
|
|
!> Allows to interpolate (in the z direction) on a near border of the current grid if this one
|
|
!! has a common border with the root coarse grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_InterpNearBorderZ ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % NearRootBorder(3) = .FALSE.
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_InterpNearBorderZ
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_InterpDistantBorderZ
|
|
!
|
|
!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one
|
|
!! has a common border with the root coarse grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_InterpDistantBorderZ()
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % DistantRootBorder(3) = .FALSE.
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_InterpDistantBorderZ
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_Nb_Step
|
|
!
|
|
!> Returns the number of time steps of the parent of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_Nb_Step ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_Parent_Nb_Step ! Result
|
|
!
|
|
if (Agrif_Root()) then
|
|
Agrif_Parent_Nb_Step = -1
|
|
else
|
|
Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_Nb_Step
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Root
|
|
!
|
|
!> Indicates if the current grid is or not the root grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Root ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
logical :: Agrif_Root ! Result
|
|
!
|
|
Agrif_Root = (Agrif_Curgrid % fixedrank == 0)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Root
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_GrandMother
|
|
!
|
|
!> Indicates if the current grid is or not the root grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_GrandMother ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
logical :: Agrif_GrandMother ! Result
|
|
!
|
|
Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_GrandMother
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_Root
|
|
!
|
|
!> Indicates if the parent of the current grid is or not the root grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_Root ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
logical :: Agrif_Parent_Root ! Result
|
|
!
|
|
Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_Root
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Fixed
|
|
!
|
|
!> Returns the number of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Fixed ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_Fixed ! Result
|
|
!
|
|
if (Agrif_Curgrid % fixed) then
|
|
Agrif_Fixed = Agrif_Curgrid % fixedrank
|
|
else
|
|
Agrif_Fixed = -1
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Fixed
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_Fixed
|
|
!
|
|
!> Returns the number of the parent of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_Fixed ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_Parent_Fixed ! Result
|
|
!
|
|
if (Agrif_Curgrid % parent % fixed) then
|
|
Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank
|
|
else
|
|
Agrif_Parent_Fixed = 0
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_Fixed
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Is_Fixed
|
|
!
|
|
!> Returns .TRUE. if the current grid is fixed.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Is_Fixed ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
logical :: Agrif_Is_Fixed ! Result
|
|
!
|
|
Agrif_Is_Fixed = Agrif_Curgrid % fixed
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Is_Fixed
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Parent_Is_Fixed
|
|
!
|
|
!> Returns .TRUE. if the parent of the current grid is fixed.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Parent_Is_Fixed ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
logical :: Agrif_Parent_Is_Fixed ! Result
|
|
!
|
|
Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Parent_Is_Fixed
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_CFixed
|
|
!
|
|
!> Returns the number of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_CFixed ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
character(3) :: Agrif_CFixed ! Result
|
|
!
|
|
character(3) :: cfixed
|
|
integer :: fixed
|
|
!
|
|
fixed = Agrif_Fixed()
|
|
!
|
|
if (fixed /= -1) then
|
|
!
|
|
if (fixed <= 9) then
|
|
write(cfixed,'(i1)') fixed
|
|
else
|
|
write(cfixed,'(i2)') fixed
|
|
endif
|
|
!
|
|
Agrif_CFixed = cfixed
|
|
|
|
if (associated(agrif_curgrid,agrif_coarsegrid)) then
|
|
Agrif_CFixed = 'gm'
|
|
endif
|
|
!
|
|
else
|
|
print*,'Call to Agrif_CFixed() on a moving grid'
|
|
stop
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_CFixed
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrid_Parent_CFixed
|
|
!
|
|
!> Returns the number of the parent of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrid_Parent_CFixed ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
character(3) :: Agrid_Parent_CFixed ! Result
|
|
!
|
|
character(3) :: cfixed
|
|
integer :: fixed
|
|
!
|
|
fixed = Agrif_Parent_Fixed()
|
|
!
|
|
if(fixed /= -1) then
|
|
!
|
|
if (fixed <= 9) then
|
|
write(cfixed,'(i1)')fixed
|
|
else
|
|
write(cfixed,'(i2)')fixed
|
|
endif
|
|
!
|
|
Agrid_Parent_CFixed=cfixed
|
|
!
|
|
else
|
|
print*,'Illegal call to Agrid_Parent_CFixed()'
|
|
stop
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrid_Parent_CFixed
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_ChildGrid_to_ParentGrid
|
|
!
|
|
!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_ChildGrid_to_ParentGrid ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
Agrif_Curgrid % parent % save_grid => Agrif_Curgrid
|
|
call Agrif_Instance(Agrif_Curgrid%parent)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_ChildGrid_to_ParentGrid
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_ParentGrid_to_ChildGrid
|
|
!
|
|
!> Make the pointer #Agrif_Curgrid point on the child grid after having called the
|
|
!! #Agrif_ChildGrid_to_ParentGrid subroutine.
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_ParentGrid_to_ChildGrid ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
call Agrif_Instance(Agrif_Curgrid%save_grid)
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_ParentGrid_to_ChildGrid
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Get_Unit
|
|
!
|
|
!> Returns a unit not connected to any file.
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Get_Unit ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_Get_Unit ! Result
|
|
!
|
|
integer :: n
|
|
logical :: op
|
|
!
|
|
integer :: nunit
|
|
integer :: iii, out, iiimax
|
|
logical :: bexist
|
|
integer,dimension(1:1000) :: forbiddenunit
|
|
!
|
|
! Load forbidden Unit if the file Agrif_forbidenUnit exist
|
|
!
|
|
INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist)
|
|
!
|
|
if (.not. bexist) then
|
|
! File Agrif_forbiddenUnit.txt not found
|
|
else
|
|
nunit = 777
|
|
OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old")
|
|
iii = 1
|
|
do while ( .TRUE. )
|
|
READ(nunit,*, end=99) forbiddenunit(iii)
|
|
iii = iii + 1
|
|
enddo
|
|
99 continue
|
|
iiimax = iii
|
|
close(nunit)
|
|
endif
|
|
!
|
|
do n = 7,1000
|
|
!
|
|
INQUIRE(Unit=n,Opened=op)
|
|
!
|
|
out = 0
|
|
if ( bexist .AND. (.NOT.op) ) then
|
|
do iii = 1,iiimax
|
|
if ( n == forbiddenunit(iii) ) out = 1
|
|
enddo
|
|
endif
|
|
!
|
|
if ( (.NOT.op) .AND. (out == 0) ) exit
|
|
!
|
|
enddo
|
|
!
|
|
Agrif_Get_Unit = n
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Get_Unit
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_Extra_Boundary_Cells
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: nb_extra_cells
|
|
!
|
|
Agrif_Extra_Boundary_Cells = nb_extra_cells
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_Extra_Boundary_Cells
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_Efficiency
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_Efficiency ( eff )
|
|
!---------------------------------------------------------------------------------------------------
|
|
real, intent(in) :: eff
|
|
!
|
|
if ( (eff < 0.) .OR. (eff > 1) ) then
|
|
write(*,*) 'Error Efficiency should be between 0 and 1'
|
|
stop
|
|
else
|
|
Agrif_Efficiency = eff
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_Efficiency
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_Regridding
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_Regridding ( regfreq )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: regfreq
|
|
!
|
|
if (regfreq < 0) then
|
|
write(*,*) 'Regridding frequency should be positive'
|
|
stop
|
|
else
|
|
Agrif_Regridding = regfreq
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_Regridding
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffref_x
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffref_x ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
|
|
if (coeffref < 0) then
|
|
write(*,*) 'Coefficient of raffinement should be positive'
|
|
stop
|
|
else
|
|
Agrif_coeffref(1) = coeffref
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffref_x
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffref_y
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffref_y ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
|
|
if (coeffref < 0) then
|
|
write(*,*) 'Coefficient of raffinement should be positive'
|
|
stop
|
|
else
|
|
Agrif_coeffref(2) = coeffref
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffref_y
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffref_z
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffref_z ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
!
|
|
if (coeffref < 0) then
|
|
write(*,*) 'Coefficient of raffinement should be positive'
|
|
stop
|
|
else
|
|
Agrif_coeffref(3) = coeffref
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffref_z
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffreft_x
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffreft_x ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
|
|
if (coeffref < 0) then
|
|
write(*,*) 'Coefficient of time raffinement should be positive'
|
|
stop
|
|
else
|
|
Agrif_coeffreft(1) = coeffref
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffreft_x
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffreft_y
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffreft_y ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
!
|
|
if (coeffref < 0) then
|
|
write(*,*) 'Coefficient of time raffinement should be positive'
|
|
stop
|
|
else
|
|
Agrif_coeffreft(2) = coeffref
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffreft_y
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffreft_z
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffreft_z ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
|
|
if (coeffref < 0) then
|
|
write(*,*)'Coefficient of time raffinement should be positive'
|
|
stop
|
|
else
|
|
Agrif_coeffreft(3) = coeffref
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffreft_z
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_coeffreft
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_coeffreft ( coeffref )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coeffref
|
|
integer :: i
|
|
|
|
if (coeffref < 0) then
|
|
write(*,*)'Coefficient of time raffinement should be positive'
|
|
stop
|
|
else
|
|
do i=1,Agrif_Probdim
|
|
Agrif_coeffreft(i) = coeffref
|
|
Agrif_Curgrid % timeref(i) = coeffref
|
|
enddo
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_coeffreft
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_Minwidth
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_Minwidth ( coefminwidth )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coefminwidth
|
|
!
|
|
if (coefminwidth < 0) then
|
|
write(*,*)'Coefficient of Minwidth should be positive'
|
|
stop
|
|
else
|
|
Agrif_Minwidth = coefminwidth
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_Minwidth
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_Rafmax
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_Rafmax ( coefrafmax )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: coefrafmax
|
|
!
|
|
integer :: i
|
|
real :: res
|
|
!
|
|
if (coefrafmax < 0) then
|
|
write(*,*)'Coefficient of should be positive'
|
|
stop
|
|
else
|
|
res = 1.
|
|
do i = 1,coefrafmax-1
|
|
res = res * FLOAT(Agrif_coeffref(1))
|
|
enddo
|
|
if ( res == 0 ) res = 1
|
|
Agrif_Mind(1) = 1. / res
|
|
!
|
|
res = 1.
|
|
do i = 1,coefrafmax-1
|
|
res = res * FLOAT(Agrif_coeffref(2))
|
|
enddo
|
|
if ( res == 0 ) res = 1
|
|
Agrif_Mind(2) = 1. / res
|
|
!
|
|
res = 1.
|
|
do i = 1,coefrafmax-1
|
|
res = res * FLOAT(Agrif_coeffref(3))
|
|
enddo
|
|
if ( res == 0 ) res = 1
|
|
Agrif_Mind(3) = 1. / res
|
|
!
|
|
endif
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_Rafmax
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! subroutine Agrif_Set_MaskMaxSearch
|
|
!---------------------------------------------------------------------------------------------------
|
|
subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer, intent(in) :: mymaxsearch
|
|
!
|
|
MaxSearch = mymaxsearch
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_Set_MaskMaxSearch
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_Level
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_Level ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_Level ! Result
|
|
!
|
|
Agrif_Level = Agrif_Curgrid % level
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_Level
|
|
!===================================================================================================
|
|
!===================================================================================================
|
|
! subroutine Agrif_set_periodicity
|
|
!---------------------------------------------------------------------------------------------------
|
|
|
|
subroutine Agrif_set_periodicity(i,decal)
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: i, decal
|
|
|
|
Agrif_curgrid%periodicity(i)=.TRUE.
|
|
Agrif_curgrid%periodicity_decal(i)=decal
|
|
|
|
!---------------------------------------------------------------------------------------------------
|
|
end subroutine Agrif_set_periodicity
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_MaxLevel
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_MaxLevel ( )
|
|
!---------------------------------------------------------------------------------------------------
|
|
integer :: Agrif_MaxLevel ! Result
|
|
!
|
|
Agrif_MaxLevel = Agrif_MaxLevelLoc
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_MaxLevel
|
|
!===================================================================================================
|
|
!
|
|
!===================================================================================================
|
|
! function Agrif_GridAllocation_is_done
|
|
!---------------------------------------------------------------------------------------------------
|
|
function Agrif_GridAllocation_is_done ( ) result(isdone)
|
|
!---------------------------------------------------------------------------------------------------
|
|
logical :: isdone
|
|
!
|
|
isdone = Agrif_Curgrid % allocation_is_done
|
|
!---------------------------------------------------------------------------------------------------
|
|
end function Agrif_GridAllocation_is_done
|
|
!===================================================================================================
|
|
!
|
|
|
|
function Agrif_Parent_Real_4(real_variable) result(real_variable_parent)
|
|
real(KIND=4) :: real_variable
|
|
real(KIND=4) :: real_variable_parent
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(2)
|
|
if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
|
|
real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
IF (.NOT.i_found) THEN
|
|
do i=1,Agrif_NbVariables(2)
|
|
if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then
|
|
real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%sarray0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
ENDIF
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found'
|
|
|
|
end function Agrif_Parent_Real_4
|
|
|
|
function Agrif_Parent_Real_8(real_variable) result(real_variable_parent)
|
|
real(KIND=8) :: real_variable
|
|
real(KIND=8) :: real_variable_parent
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(2)
|
|
if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
|
|
real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
IF (.NOT.i_found) THEN
|
|
do i=1,Agrif_NbVariables(2)
|
|
if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then
|
|
real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%darray0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
ENDIF
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found'
|
|
|
|
end function Agrif_Parent_Real_8
|
|
|
|
function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent)
|
|
real(KIND=8), DIMENSION(:,:) :: real_variable
|
|
real(KIND=8) :: real_variable_parent
|
|
integer :: ji,jj
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(0)
|
|
if (LOC(real_variable) == LOC(agrif_curgrid%tabvars(i)%array2)) then
|
|
real_variable_parent = agrif_curgrid%tabvars(i)%parent_var%array2(ji,jj)
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found'
|
|
|
|
end function Agrif_Parent_Array2_Real_8
|
|
|
|
|
|
function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent)
|
|
integer :: integer_variable
|
|
integer :: integer_variable_parent
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(4)
|
|
if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then
|
|
integer_variable_parent = agrif_curgrid%tabvars_i(i)%parent_var%iarray0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
|
|
|
|
end function Agrif_Parent_Integer
|
|
|
|
function Agrif_Parent_Character(character_variable) result(character_variable_parent)
|
|
character(*) :: character_variable
|
|
character(len(character_variable)) :: character_variable_parent
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(1)
|
|
if (LOC(character_variable) == LOC(agrif_curgrid%tabvars_c(i)%carray0)) then
|
|
character_variable_parent = agrif_curgrid%tabvars_c(i)%parent_var%carray0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
|
|
|
|
end function Agrif_Parent_Character
|
|
|
|
function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent)
|
|
logical :: logical_variable
|
|
logical :: logical_variable_parent
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(3)
|
|
if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then
|
|
logical_variable_parent = agrif_curgrid%tabvars_l(i)%parent_var%larray0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
|
|
|
|
end function Agrif_Parent_Logical
|
|
|
|
function Agrif_Child_Logical(logical_variable) result(logical_variable_child)
|
|
logical :: logical_variable
|
|
logical :: logical_variable_child
|
|
|
|
integer :: i
|
|
logical :: i_found
|
|
|
|
i_found = .FALSE.
|
|
|
|
do i=1,Agrif_NbVariables(3)
|
|
if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then
|
|
logical_variable_child = Agrif_CurChildgrid%tabvars_l(i)%larray0
|
|
i_found = .TRUE.
|
|
EXIT
|
|
endif
|
|
enddo
|
|
|
|
if (.NOT.i_found) STOP 'Agrif_Child : Variable not found'
|
|
|
|
end function Agrif_Child_Logical
|
|
|
|
function Agrif_Irhox() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%spaceref(1)
|
|
end function Agrif_Irhox
|
|
|
|
function Agrif_Irhoy() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%spaceref(2)
|
|
end function Agrif_Irhoy
|
|
|
|
function Agrif_Irhoz() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%spaceref(3)
|
|
end function Agrif_Irhoz
|
|
|
|
function Agrif_NearCommonBorderX() result(l_val)
|
|
logical :: l_val
|
|
l_val = agrif_curgrid%nearRootBorder(1)
|
|
end function Agrif_NearCommonBorderX
|
|
|
|
subroutine Agrif_Set_NearCommonBorderX(l_val)
|
|
logical,intent(in) :: l_val
|
|
agrif_curgrid%nearRootBorder(1)=l_val
|
|
end subroutine Agrif_Set_NearCommonBorderX
|
|
|
|
function Agrif_NearCommonBorderY() result(l_val)
|
|
logical :: l_val
|
|
l_val = agrif_curgrid%nearRootBorder(2)
|
|
end function Agrif_NearCommonBorderY
|
|
|
|
subroutine Agrif_Set_NearCommonBorderY(l_val)
|
|
logical,intent(in) :: l_val
|
|
agrif_curgrid%nearRootBorder(2)=l_val
|
|
end subroutine Agrif_Set_NearCommonBorderY
|
|
|
|
function Agrif_NearCommonBorderZ() result(l_val)
|
|
logical :: l_val
|
|
l_val = agrif_curgrid%nearRootBorder(3)
|
|
end function Agrif_NearCommonBorderZ
|
|
|
|
subroutine Agrif_Set_NearCommonBorderZ(l_val)
|
|
logical,intent(in) :: l_val
|
|
agrif_curgrid%nearRootBorder(3)=l_val
|
|
end subroutine Agrif_Set_NearCommonBorderZ
|
|
|
|
function Agrif_DistantCommonBorderX() result(l_val)
|
|
logical :: l_val
|
|
l_val = agrif_curgrid%DistantRootBorder(1)
|
|
end function Agrif_DistantCommonBorderX
|
|
|
|
subroutine Agrif_Set_DistantCommonBorderX(l_val)
|
|
logical,intent(in) :: l_val
|
|
agrif_curgrid%DistantRootBorder(1)=l_val
|
|
end subroutine Agrif_Set_DistantCommonBorderX
|
|
|
|
function Agrif_DistantCommonBorderY() result(l_val)
|
|
logical :: l_val
|
|
l_val = agrif_curgrid%DistantRootBorder(2)
|
|
end function Agrif_DistantCommonBorderY
|
|
|
|
subroutine Agrif_Set_DistantCommonBorderY(l_val)
|
|
logical,intent(in) :: l_val
|
|
agrif_curgrid%DistantRootBorder(2)=l_val
|
|
end subroutine Agrif_Set_DistantCommonBorderY
|
|
|
|
function Agrif_DistantCommonBorderZ() result(l_val)
|
|
logical :: l_val
|
|
l_val = agrif_curgrid%DistantRootBorder(3)
|
|
end function Agrif_DistantCommonBorderZ
|
|
|
|
subroutine Agrif_Set_DistantCommonBorderZ(l_val)
|
|
logical,intent(in) :: l_val
|
|
agrif_curgrid%DistantRootBorder(3)=l_val
|
|
end subroutine Agrif_Set_DistantCommonBorderZ
|
|
|
|
function Agrif_Ix() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%ix(1)
|
|
end function Agrif_Ix
|
|
|
|
function Agrif_Iy() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%ix(2)
|
|
end function Agrif_Iy
|
|
|
|
function Agrif_Iz() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%ix(3)
|
|
end function Agrif_Iz
|
|
|
|
function Agrif_Get_grid_id() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid % grid_id
|
|
end function Agrif_Get_grid_id
|
|
|
|
function Agrif_Get_parent_id() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid % parent % grid_id
|
|
end function Agrif_Get_parent_id
|
|
|
|
function Agrif_rhox() result(r_val)
|
|
real :: r_val
|
|
r_val = real(agrif_curgrid%spaceref(1))
|
|
end function Agrif_rhox
|
|
|
|
function Agrif_rhoy() result(r_val)
|
|
real :: r_val
|
|
r_val = real(agrif_curgrid%spaceref(2))
|
|
end function Agrif_rhoy
|
|
|
|
function Agrif_rhoz() result(r_val)
|
|
real :: r_val
|
|
r_val = real(agrif_curgrid%spaceref(3))
|
|
end function Agrif_rhoz
|
|
|
|
function Agrif_Nb_Step() result(i_val)
|
|
integer :: i_val
|
|
i_val = agrif_curgrid%ngridstep
|
|
end function Agrif_Nb_Step
|
|
|
|
function Agrif_Nb_Fine_Grids() result(i_val)
|
|
integer :: i_val
|
|
i_val = Agrif_nbfixedgrids
|
|
end function Agrif_Nb_Fine_Grids
|
|
|
|
! Set the name of the External mapping subroutine (if needed)
|
|
subroutine Agrif_Set_ExternalMapping(external_mapping)
|
|
Procedure(mapping) :: external_mapping
|
|
|
|
agrif_external_mapping => external_mapping
|
|
|
|
end subroutine Agrif_Set_ExternalMapping
|
|
|
|
! Set the name of the user linear interp function (if needed)
|
|
subroutine Agrif_Set_external_linear_interp(external_linear_interp)
|
|
Procedure(linear_interp) :: external_linear_interp
|
|
|
|
agrif_external_linear_interp => external_linear_interp
|
|
|
|
end subroutine Agrif_Set_external_linear_interp
|
|
|
|
subroutine Agrif_UnSet_external_linear_interp()
|
|
|
|
nullify(agrif_external_linear_interp)
|
|
|
|
end subroutine Agrif_UnSet_external_linear_interp
|
|
|
|
! test if there is at least a child grid in the early stage of the initialisation
|
|
! (when Agrif_Nb_Fine_Grids is not yet defined)
|
|
LOGICAL FUNCTION Agrif_Root_Only()
|
|
INTEGER :: nb_rootschildgrids
|
|
INTEGER :: nunit, iost
|
|
LOGICAL :: Bexist
|
|
|
|
nunit = Agrif_Get_Unit()
|
|
OPEN(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", action ="read", IOSTAT=iost)
|
|
IF( iost == 0 ) THEN
|
|
READ(nunit,*) nb_rootschildgrids
|
|
CLOSE(nunit)
|
|
Agrif_Root_Only = (nb_rootschildgrids <= 0)
|
|
ELSE
|
|
INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
|
|
IF (.NOT. BEXIST) THEN
|
|
PRINT*,'ERROR : File AGRIF_FixedGrids.in not found.'
|
|
STOP
|
|
ELSE
|
|
PRINT*,'Error opening file AGRIF_FixedGrids.in'
|
|
STOP
|
|
ENDIF
|
|
ENDIF
|
|
|
|
END FUNCTION Agrif_Root_Only
|
|
|
|
end module Agrif_CurgridFunctions
|