Skip to content

Commit

Permalink
Merge pull request #8 from adcroft/user/aja/obc_split_kind_and_direction
Browse files Browse the repository at this point in the history 
User/aja/obc split kind and direction
  • Loading branch information
@kshedstrom
kshedstrom authored Jun 19, 2016
2 parents 983ce84 + f182829 commit 8e10ec5
Show file tree
Hide file tree
Showing 10 changed files with 382 additions and 270 deletions.
180 changes: 96 additions & 84 deletions src/core/MOM_barotropic.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,9 +105,9 @@ module MOM_barotropic
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
use MOM_io, only : vardesc, var_desc
use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE
use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W
use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S
use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_FLATHER
use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W
use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S
use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS
use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS
use MOM_time_manager, only : time_type, set_time, operator(+), operator(-)
Expand Down Expand Up @@ -362,6 +362,8 @@ module MOM_barotropic
OBC_mask_u => NULL(), &
OBC_mask_v => NULL()
integer, dimension(:,:), pointer :: &
OBC_direction_u => NULL(), &
OBC_direction_v => NULL(), &
OBC_kind_u => NULL(), &
OBC_kind_v => NULL()
real, dimension(:,:), pointer :: &
Expand Down Expand Up @@ -2378,44 +2380,46 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
uhbt(I,j) = BT_OBC%uhbt(I,j)
ubt(I,j) = BT_OBC%ubt_outer(I,j)
vel_trans = ubt(I,j)
elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external
h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal

H_u = BT_OBC%H_u(I,j)
vel_prev = ubt(I,j)
ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
(BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j)))

vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external
h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal

H_u = BT_OBC%H_u(I,j)
vel_prev = ubt(I,j)
ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + &
(BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in))

vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_N) then
if ((vbt(i,J-1)+vbt(i+1,J-1)) > 0.0) then
ubt(I,j) = 2.0*ubt(I,j-1)-ubt(I,j-2)
else
ubt(I,j) = BT_OBC%ubt_outer(I,j)
endif
vel_trans = ubt(I,j)
elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_S) then
if ((vbt(i,J)+vbt(i+1,J)) > 0.0) then
ubt(I,j) = 2.0*ubt(I,j+1)-ubt(I,j+2)
else
ubt(I,j) = BT_OBC%ubt_outer(I,j)
elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER) then
if (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external
h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal

H_u = BT_OBC%H_u(I,j)
vel_prev = ubt(I,j)
ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + &
(BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j)))

vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1
! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external
h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal

H_u = BT_OBC%H_u(I,j)
vel_prev = ubt(I,j)
ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + &
(BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in))

vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j)
elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N) then
if ((vbt(i,J-1)+vbt(i+1,J-1)) > 0.0) then
ubt(I,j) = 2.0*ubt(I,j-1)-ubt(I,j-2)
else
ubt(I,j) = BT_OBC%ubt_outer(I,j)
endif
vel_trans = ubt(I,j)
elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S) then
if ((vbt(i,J)+vbt(i+1,J)) > 0.0) then
ubt(I,j) = 2.0*ubt(I,j+1)-ubt(I,j+2)
else
ubt(I,j) = BT_OBC%ubt_outer(I,j)
endif
vel_trans = ubt(I,j)
endif
vel_trans = ubt(I,j)
endif

if (BT_OBC%OBC_kind_u(I,j) /= OBC_SIMPLE) then
Expand All @@ -2436,52 +2440,54 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans,
vhbt(i,J) = BT_OBC%vhbt(i,J)
vbt(i,J) = BT_OBC%vbt_outer(i,J)
vel_trans = vbt(i,J)
elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1
! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external
h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal

H_v = BT_OBC%H_v(i,J)
vel_prev = vbt(i,J)
vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + &
(BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J)))

vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1
! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external
h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal

H_v = BT_OBC%H_v(i,J)
vel_prev = vbt(i,J)
vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + &
(BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in))

vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_E) then
if ((ubt(I-1,j)+ubt(I-1,j+1)) > 0.0) then
vbt(i,J) = 2.0*vbt(i-1,J)-vbt(i-2,J)
else
vbt(i,J) = BT_OBC%vbt_outer(i,J)
endif
vel_trans = vbt(i,J)
elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER) then
if (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1
! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external
h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal

H_v = BT_OBC%H_v(i,J)
vel_prev = vbt(i,J)
vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + &
(BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J)))

vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then
cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL
v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1
! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external
h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal

H_v = BT_OBC%H_v(i,J)
vel_prev = vbt(i,J)
vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + &
(BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in))

vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J)
elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E) then
if ((ubt(I-1,j)+ubt(I-1,j+1)) > 0.0) then
vbt(i,J) = 2.0*vbt(i-1,J)-vbt(i-2,J)
else
vbt(i,J) = BT_OBC%vbt_outer(i,J)
endif
vel_trans = vbt(i,J)
!!!!!!!!!!!!!!!!!!! CLAMPED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) !
! vbt(i,J) = (vbt(i-1,J) + CFL*vbt(i,J)) / (1.0 + CFL) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_W) then
if ((ubt(I,j)+ubt(I,j+1)) < 0.0) then
vbt(i,J) = 2.0*vbt(i+1,J)-vbt(i+2,J)
else
vbt(i,J) = BT_OBC%vbt_outer(i,J)
endif
vel_trans = vbt(i,J)
elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W) then
if ((ubt(I,j)+ubt(I,j+1)) < 0.0) then
vbt(i,J) = 2.0*vbt(i+1,J)-vbt(i+2,J)
else
vbt(i,J) = BT_OBC%vbt_outer(i,J)
endif
vel_trans = vbt(i,J)
!!!!!!!!!!!!!!!!!! CLAMPED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) !
! vbt(i,J) = (vbt(i-1,J) + CFL*vbt(i,J)) / (1.0 + CFL) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
endif
endif

if (BT_OBC%OBC_kind_v(i,J) /= OBC_SIMPLE) then
Expand Down Expand Up @@ -2532,8 +2538,8 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt)

if ((OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west) .and. &
associated(BT_OBC%OBC_mask_u)) then
do j=js,je ; do I=is-1,ie ; if (BT_OBC%OBC_mask_u(I,j)) then
if (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then
do j=js,je ; do I=is-1,ie ; if (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER) then
if (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then
cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt(I-1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1
! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external
Expand All @@ -2542,7 +2548,7 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt)
H_u = BT_OBC%H_u(I,j)
eta(i+1,j) = 2.0 * 0.5*((BT_OBC%eta_outer_u(I,j)+h_in) + &
(H_u/BT_OBC%Cg_u(I,j))*(u_inlet-BT_OBC%ubt_outer(I,j))) - eta(i,j)
elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then
elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then
cfl = dtbt*BT_OBC%Cg_u(I,j)*G%IdxCu(I,j) ! CFL
u_inlet = cfl*ubt(I+1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1
! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external
Expand All @@ -2557,8 +2563,8 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt)

if ((OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south) .and. &
associated(BT_OBC%OBC_mask_v)) then
do J=js-1,je ; do i=is,ie ; if (BT_OBC%OBC_mask_v(i,J)) then
if (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then
do J=js-1,je ; do i=is,ie ; if (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER) then
if (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then
cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL
v_inlet = cfl*vbt(i,J-1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1
! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external
Expand All @@ -2567,7 +2573,7 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt)
H_v = BT_OBC%H_v(i,J)
eta(i,j+1) = 2.0 * 0.5*((BT_OBC%eta_outer_v(i,J)+h_in) + &
(H_v/BT_OBC%Cg_v(i,J))*(v_inlet-BT_OBC%vbt_outer(i,J))) - eta(i,j)
elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then
elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then
cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL
v_inlet = cfl*vbt(i,J+1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1
! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external
Expand Down Expand Up @@ -2635,6 +2641,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D
allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%eta_outer_u(:,:) = 0.0
allocate(BT_OBC%OBC_mask_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_mask_u(:,:)=.false.
allocate(BT_OBC%OBC_kind_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_kind_u(:,:)=OBC_NONE
allocate(BT_OBC%OBC_direction_u(isdw-1:iedw,jsdw:jedw)); BT_OBC%OBC_direction_u(:,:)=OBC_NONE

allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%Cg_v(:,:) = 0.0
allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%H_v(:,:) = 0.0
Expand All @@ -2643,11 +2650,13 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D
allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%eta_outer_v(:,:)=0.0
allocate(BT_OBC%OBC_mask_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%OBC_mask_v(:,:)=.false.
allocate(BT_OBC%OBC_kind_v(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_kind_v(:,:)=OBC_NONE
allocate(BT_OBC%OBC_direction_v(isdw-1:iedw,jsdw:jedw)); BT_OBC%OBC_direction_v(:,:)=OBC_NONE

if (associated(OBC%OBC_mask_u)) then
do j=js-1,je+1 ; do I=is-1,ie
BT_OBC%OBC_mask_u(I,j) = OBC%OBC_mask_u(I,j)
BT_OBC%OBC_kind_u(I,j) = OBC%OBC_kind_u(I,j)
BT_OBC%OBC_direction_u(I,j) = OBC%OBC_direction_u(I,j)
enddo ; enddo
if (OBC%apply_OBC_u) then
do k=1,nz ; do j=js,je ; do I=is-1,ie
Expand Down Expand Up @@ -2683,6 +2692,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D
do J=js-1,je ; do i=is-1,ie+1
BT_OBC%OBC_mask_v(i,J) = OBC%OBC_mask_v(i,J)
BT_OBC%OBC_kind_v(i,J) = OBC%OBC_kind_v(i,J)
BT_OBC%OBC_direction_v(i,J) = OBC%OBC_direction_v(i,J)
enddo ; enddo
if (OBC%apply_OBC_v) then
do k=1,nz ; do J=js-1,je ; do i=is,ie
Expand Down Expand Up @@ -2732,6 +2742,7 @@ subroutine destroy_BT_OBC(BT_OBC)

if (associated(BT_OBC%OBC_mask_u)) deallocate(BT_OBC%OBC_mask_u)
if (associated(BT_OBC%OBC_kind_u)) deallocate(BT_OBC%OBC_kind_u)
if (associated(BT_OBC%OBC_direction_u)) deallocate(BT_OBC%OBC_direction_u)
deallocate(BT_OBC%Cg_u)
deallocate(BT_OBC%H_u)
deallocate(BT_OBC%uhbt)
Expand All @@ -2740,6 +2751,7 @@ subroutine destroy_BT_OBC(BT_OBC)

if (associated(BT_OBC%OBC_mask_v)) deallocate(BT_OBC%OBC_mask_v)
if (associated(BT_OBC%OBC_kind_v)) deallocate(BT_OBC%OBC_kind_v)
if (associated(BT_OBC%OBC_direction_v)) deallocate(BT_OBC%OBC_direction_v)
deallocate(BT_OBC%Cg_v)
deallocate(BT_OBC%H_v)
deallocate(BT_OBC%vhbt)
Expand Down
20 changes: 10 additions & 10 deletions src/core/MOM_continuity_PPM.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,8 +48,8 @@ module MOM_continuity_PPM
use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_grid, only : ocean_grid_type
use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE
use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S
use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_FLATHER
use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S
use MOM_variables, only : BT_cont_type
use MOM_verticalGrid, only : verticalGrid_type

Expand Down Expand Up @@ -229,11 +229,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west) then
do k=1,nz ; do j=LB%jsh,LB%jeh
do I=LB%ish,LB%ieh+1
if (OBC%OBC_mask_u(I-1,j) .and. (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER_E)) &
if (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I-1,j) == OBC_DIRECTION_E)) &
h(i,j,k) = h_input(i-1,j,k)
enddo
do i=LB%ish-1,LB%ieh
if (OBC%OBC_mask_u(I,j) .and. (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W)) &
if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W)) &
h(i,j,k) = h_input(i+1,j,k)
enddo
enddo ; enddo
Expand All @@ -257,11 +257,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
if (apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) then
do k=1,nz
do J=LB%jsh,LB%jeh+1 ; do i=LB%ish-1,LB%ieh+1
if (OBC%OBC_mask_v(i,J-1) .and. (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER_N)) &
if (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J-1) == OBC_DIRECTION_N)) &
h(i,j,k) = h_input(i,j-1,k)
enddo ; enddo
do J=LB%jsh-1,LB%jeh ; do i=LB%ish-1,LB%ieh+1
if (OBC%OBC_mask_v(i,J) .and. (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S)) &
if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) &
h(i,j,k) = h_input(i,j+1,k)
enddo ; enddo
enddo
Expand All @@ -284,11 +284,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
if (apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) then
do k=1,nz
do J=LB%jsh,LB%jeh+1 ; do i=LB%ish-1,LB%ieh+1
if (OBC%OBC_mask_v(i,J-1) .and. (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER_N)) &
if (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J-1) == OBC_DIRECTION_N)) &
h(i,j,k) = h_input(i,j-1,k)
enddo ; enddo
do J=LB%jsh-1,LB%jeh ; do i=LB%ish-1,LB%ieh+1
if (OBC%OBC_mask_v(i,J) .and. (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S)) &
if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) &
h(i,j,k) = h_input(i,j+1,k)
enddo ; enddo
enddo
Expand All @@ -312,11 +312,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC,
if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west) then
do k=1,nz ; do j=LB%jsh,LB%jeh
do I=LB%ish,LB%ieh+1
if (OBC%OBC_mask_u(I-1,j) .and. (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER_E)) &
if (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I-1,j) == OBC_DIRECTION_E)) &
h(i,j,k) = h_input(i-1,j,k)
enddo
do i=LB%ish-1,LB%ieh
if (OBC%OBC_mask_u(I,j) .and. (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W)) &
if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W)) &
h(i,j,k) = h_input(i+1,j,k)
enddo
enddo ; enddo
Expand Down
Loading

0 comments on commit 8e10ec5

Please sign in to comment.