subroutine closurebc use modsubgriddata, only : ekm, ekh use modglobal, only : ib, ie, jb, je, kb, ke, ih, jh, kh, numol, prandtlmoli, & ibrank, ierank, jbrank, jerank, BCtopm, BCxm, BCym, & BCtopm_freeslip, BCtopm_noslip, BCtopm_pressure, & BCxm_periodic, BCym_periodic use decomp_2d, only : exchange_halo_z integer i, j call exchange_halo_z(ekm) call exchange_halo_z(ekh) ! Top and bottom if ((BCtopm .eq. BCtopm_freeslip) .or. (BCtopm .eq. BCtopm_pressure)) then do j = jb - 1, je + 1 do i = ib - 1, ie + 1 ekm(i, j, ke + 1) = ekm(i, j, ke) ! zero-gradient top wall ekh(i, j, ke + 1) = ekh(i, j, ke) ! zero-gradient top wall ekm(i, j, kb - 1) = 2.*numol - ekm(i, j, kb) ! no-slip lower wall ekh(i, j, kb - 1) = (2.*numol*prandtlmoli) - ekh(i, j, kb) ! no-slip lower wall end do end do else if (BCtopm .eq. BCtopm_noslip) then do j = jb - 1, je + 1 do i = ib - 1, ie + 1 ekm(i, j, ke + 1) = 2.*numol - ekm(i, j, ke) ! no-slip top wall ekh(i, j, ke + 1) = (2.*numol*prandtlmoli) - ekh(i, j, ke) ! no-slip top wall ekm(i, j, kb - 1) = 2.*numol - ekm(i, j, kb) ! no-slip lower wall ekh(i, j, kb - 1) = (2.*numol*prandtlmoli) - ekh(i, j, kb) ! no-slip lower wall end do end do end if if (BCxm .ne. BCxm_periodic) then ! inflow/outflow if (ibrank) then ekm(ib - 1, :, :) = ekm(ib, :, :) ekh(ib - 1, :, :) = ekh(ib, :, :) end if if (ierank) then ekm(ie + 1, :, :) = ekm(ie, :, :) ekh(ie + 1, :, :) = ekh(ie, :, :) end if else ! periodic if (ibrank .and. ierank) then ekm(ib - 1, :, :) = ekm(ie, :, :) ekm(ie + 1, :, :) = ekm(ib, :, :) ekh(ib - 1, :, :) = ekh(ie, :, :) ekh(ie + 1, :, :) = ekh(ib, :, :) end if end if if (BCym .ne. BCym_periodic) then ! inflow/outflow if (jbrank) then ekm(:,jb-1,:) = ekm(:,jb,:) ekh(:,jb-1,:) = ekh(:,jb,:) end if if (jerank) then ekm(:,je+1,:) = ekm(:,je,:) ekh(:,je+1,:) = ekh(:,je,:) end if else ! periodic if (jbrank .and. jerank) then ekm(:, jb - 1, :) = ekm(:, je, :) ekm(:, je + 1, :) = ekm(:, jb, :) ekh(:, jb - 1, :) = ekh(:, je, :) ekh(:, je + 1, :) = ekh(:, jb, :) end if end if end subroutine closurebc