BOUNDARIES: Rewrite initialize_boundaries().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
b1343baa30
commit
c9c76c93e1
@ -57,7 +57,7 @@ module boundaries
|
||||
! supported boundary types
|
||||
!
|
||||
enum, bind(c)
|
||||
enumerator bnd_user
|
||||
enumerator bnd_custom
|
||||
enumerator bnd_periodic
|
||||
enumerator bnd_open
|
||||
enumerator bnd_outflow
|
||||
@ -98,163 +98,98 @@ module boundaries
|
||||
! subroutine INITIALIZE_BOUNDARIES:
|
||||
! --------------------------------
|
||||
!
|
||||
! Subroutine initializes the module BOUNDARIES by setting its parameters.
|
||||
! Subroutine initializes the module BOUNDARIES.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! status - return flag of the procedure execution status;
|
||||
! status - the subroutine call status;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine initialize_boundaries(status)
|
||||
|
||||
! import external procedures and variables
|
||||
!
|
||||
use coordinates, only : periodic
|
||||
use helpers , only : print_message
|
||||
#ifdef MPI
|
||||
use mpitools , only : npmax
|
||||
#endif /* MPI */
|
||||
use parameters , only : get_parameter
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
!
|
||||
integer, intent(out) :: status
|
||||
|
||||
! module parameters for the boundary update order and boundary type
|
||||
!
|
||||
character(len = 32) :: xlbndry = "periodic"
|
||||
character(len = 32) :: xubndry = "periodic"
|
||||
character(len = 32) :: ylbndry = "periodic"
|
||||
character(len = 32) :: yubndry = "periodic"
|
||||
character(len = 32) :: zlbndry = "periodic"
|
||||
character(len = 32) :: zubndry = "periodic"
|
||||
character(len=64) :: str, bnd
|
||||
|
||||
integer :: n, s
|
||||
|
||||
character(len=*), parameter :: loc = 'BOUNDARIES::initialize_boundaries()'
|
||||
|
||||
! local variables
|
||||
!
|
||||
integer :: n
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
status = 0
|
||||
|
||||
! get runtime values for the boundary types
|
||||
!
|
||||
call get_parameter("xlbndry", xlbndry)
|
||||
call get_parameter("xubndry", xubndry)
|
||||
call get_parameter("ylbndry", ylbndry)
|
||||
call get_parameter("yubndry", yubndry)
|
||||
call get_parameter("zlbndry", zlbndry)
|
||||
call get_parameter("zubndry", zubndry)
|
||||
|
||||
! fill the boundary type flags
|
||||
!
|
||||
select case(xlbndry)
|
||||
case("open")
|
||||
bnd_type(1,1) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(1,1) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(1,1) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(1,1) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(1,1) = bnd_user
|
||||
case default
|
||||
bnd_type(1,1) = bnd_periodic
|
||||
end select
|
||||
|
||||
select case(xubndry)
|
||||
case("open")
|
||||
bnd_type(1,2) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(1,2) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(1,2) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(1,2) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(1,2) = bnd_user
|
||||
case default
|
||||
bnd_type(1,2) = bnd_periodic
|
||||
end select
|
||||
|
||||
select case(ylbndry)
|
||||
case("open")
|
||||
bnd_type(2,1) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(2,1) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(2,1) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(2,1) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(2,1) = bnd_user
|
||||
case default
|
||||
bnd_type(2,1) = bnd_periodic
|
||||
end select
|
||||
|
||||
select case(yubndry)
|
||||
case("open")
|
||||
bnd_type(2,2) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(2,2) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(2,2) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(2,2) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(2,2) = bnd_user
|
||||
case default
|
||||
bnd_type(2,2) = bnd_periodic
|
||||
end select
|
||||
|
||||
select case(zlbndry)
|
||||
case("open")
|
||||
bnd_type(3,1) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(3,1) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(3,1) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(3,1) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(3,1) = bnd_user
|
||||
case default
|
||||
bnd_type(3,1) = bnd_periodic
|
||||
end select
|
||||
|
||||
select case(zubndry)
|
||||
case("open")
|
||||
bnd_type(3,2) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(3,2) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(3,2) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(3,2) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(3,2) = bnd_user
|
||||
case default
|
||||
bnd_type(3,2) = bnd_periodic
|
||||
end select
|
||||
|
||||
! set domain periodicity
|
||||
!
|
||||
do n = 1, NDIMS
|
||||
periodic(n) = (bnd_type(n,1) == bnd_periodic) .and. &
|
||||
do s = 1, 2
|
||||
|
||||
bnd = "periodic"
|
||||
|
||||
if (s == 1) then
|
||||
str = char(119+n) // "lbndry"
|
||||
else
|
||||
str = char(119+n) // "ubndry"
|
||||
end if
|
||||
call get_parameter(str, bnd)
|
||||
|
||||
if (s == 1) then
|
||||
str = char(119+n) // "_lower_boundary"
|
||||
else
|
||||
str = char(119+n) // "_upper_boundary"
|
||||
end if
|
||||
call get_parameter(str, bnd)
|
||||
|
||||
select case(bnd)
|
||||
case("open")
|
||||
bnd_type(n,s) = bnd_open
|
||||
case("outflow", "out")
|
||||
bnd_type(n,s) = bnd_outflow
|
||||
case("reflective", "reflecting", "reflect")
|
||||
bnd_type(n,s) = bnd_reflective
|
||||
case("hydrostatic", "gravity")
|
||||
bnd_type(n,s) = bnd_gravity
|
||||
case("user", "custom")
|
||||
bnd_type(n,s) = bnd_custom
|
||||
case default
|
||||
bnd_type(n,s) = bnd_periodic
|
||||
end select
|
||||
|
||||
end do
|
||||
|
||||
if ((bnd_type(n,1) == bnd_periodic .and. &
|
||||
bnd_type(n,2) /= bnd_periodic) .or. &
|
||||
(bnd_type(n,2) == bnd_periodic .and. &
|
||||
bnd_type(n,1) /= bnd_periodic)) then
|
||||
|
||||
call print_message(loc, char(87+n) // &
|
||||
"-boundary cannot be periodic on one " // &
|
||||
"side and non-periodic on another!")
|
||||
status = 1
|
||||
return
|
||||
end if
|
||||
|
||||
periodic(n) = (bnd_type(n,1) == bnd_periodic) .and. &
|
||||
(bnd_type(n,2) == bnd_periodic)
|
||||
|
||||
end do
|
||||
|
||||
#ifdef MPI
|
||||
! allocate the exchange arrays
|
||||
!
|
||||
allocate(barray(0:npmax,0:npmax), bcount(0:npmax,0:npmax), stat = status)
|
||||
|
||||
! prepare the exchange arrays
|
||||
#ifdef MPI
|
||||
! allocate the arrays for the list of data blocks at different processes which
|
||||
! need to exchange boundaries, and for the count of the blocks in each list
|
||||
!
|
||||
allocate(barray(0:npmax,0:npmax), bcount(0:npmax,0:npmax), stat=status)
|
||||
|
||||
! generate the list of blocks on different processes
|
||||
!
|
||||
if (status == 0) call prepare_exchange_array()
|
||||
#endif /* MPI */
|
||||
@ -5377,7 +5312,7 @@ module boundaries
|
||||
|
||||
! user specific boundary conditions
|
||||
!
|
||||
case(bnd_user)
|
||||
case(bnd_custom)
|
||||
|
||||
if (associated(custom_boundary_x)) then
|
||||
call custom_boundary_x(side(1), jl, ju, kl, ku, &
|
||||
@ -5560,7 +5495,7 @@ module boundaries
|
||||
|
||||
! user specific boundary conditions
|
||||
!
|
||||
case(bnd_user)
|
||||
case(bnd_custom)
|
||||
|
||||
if (associated(custom_boundary_y)) then
|
||||
call custom_boundary_y(side(2), il, iu, kl, ku, &
|
||||
@ -5739,7 +5674,7 @@ module boundaries
|
||||
|
||||
! user specific boundary conditions
|
||||
!
|
||||
case(bnd_user)
|
||||
case(bnd_custom)
|
||||
|
||||
if (associated(custom_boundary_z)) then
|
||||
call custom_boundary_z(side(3), il, iu, jl, ju, &
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user