diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index af2beca1fb..b843dd44fb 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -742,6 +742,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB integer :: ioff, joff integer :: l_seg + logical :: do_i(SZI_(G),SZJ_(G)) ! If true, work on given points. if (.not.CS%module_is_initialized) call MOM_error(FATAL, & "btstep: Module MOM_barotropic must be initialized before it is used.") @@ -2457,19 +2458,58 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, haloshift=iev-ie, unscale=US%L_to_m**2*GV%H_to_m) endif + do j=jsv,jev + do i=isv,iev + do_i(i,j) = .true. + enddo + enddo + + ! Update do_i so that nothing changes outside of the OBC (problem for interior OBCs only) + if (associated(OBC)) then ; if (OBC%OBC_pe) then + do j=jsv,jev + if (OBC%specified_u_BCs_exist_globally .or. OBC%open_u_BCs_exist_globally) then + do i=isv,iev-1 ; if (OBC%segnum_u(I,j) /= OBC_NONE) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + do_i(i+1,j) = .false. + elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then + do_i(i,j) = .false. + endif + endif ; enddo + endif + if (OBC%specified_v_BCs_exist_globally .or. OBC%open_v_BCs_exist_globally) then + do i=isv,iev + if (OBC%segnum_v(i,J-1) /= OBC_NONE) then + if (OBC%segment(OBC%segnum_v(i,J-1))%direction == OBC_DIRECTION_N) then + do_i(i,j) = .false. + endif + endif + if (OBC%segnum_v(i,J) /= OBC_NONE) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then + do_i(i,j) = .false. + endif + endif + enddo + endif + enddo + endif ; endif + if (integral_BT_cont) then !$OMP do do j=jsv,jev ; do i=isv,iev - eta(i,j) = (eta_IC(i,j) + n*eta_src(i,j)) + CS%IareaT(i,j) * & - ((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J))) - eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n) + if (do_i(i,j)) then + eta(i,j) = (eta_IC(i,j) + n*eta_src(i,j)) + CS%IareaT(i,j) * & + ((uhbt_int(I-1,j) - uhbt_int(I,j)) + (vhbt_int(i,J-1) - vhbt_int(i,J))) + eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n) + endif enddo ; enddo else !$OMP do do j=jsv,jev ; do i=isv,iev - eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & - ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) - eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n) + if (do_i(i,j)) then + eta(i,j) = (eta(i,j) + eta_src(i,j)) + (dtbt * CS%IareaT(i,j)) * & + ((uhbt(I-1,j) - uhbt(I,j)) + (vhbt(i,J-1) - vhbt(i,J))) + eta_wtd(i,j) = eta_wtd(i,j) + eta(i,j) * wt_eta(n) + endif enddo ; enddo endif !$OMP end parallel