#include "cppdefs.h" MODULE curr_inw_mod #if defined INWAVE_MODEL # if defined DOPPLER ! !svn $Id: celer_inw.F 732 2008-09-07 01:55:51Z jcwarner $ !======================================================================! ! ! ! This routine computes the currents affecting the wave field ! ! Needed to solve the action density equations considering ! ! wave-current interaction effects ! ! ! !======================================================================! ! implicit none PRIVATE PUBLIC :: curr_inw CONTAINS ! !*********************************************************************** SUBROUTINE curr_inw (ng, tile) !*********************************************************************** ! USE mod_param USE mod_ocean USE mod_stepping USE mod_inwave_vars USE mod_inwave_params # ifdef UV_KIRBY USE mod_grid # endif ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile ! ! Local variable declarations. ! # include "tile.h" ! !# ifdef PROFILE ! CALL wclock_on (ng, iNLM, 35) !# endif CALL curr_inw_tile(ng, tile, & & LBi, UBi, LBj, UBj, & & nrhs(ng), nstp(ng), nnew(ng), & # ifdef SOLVE3D # ifdef UV_KIRBY & GRID(ng) % Hz, & & GRID(ng) % z_r, & & OCEAN(ng) % uwave, & & OCEAN(ng) % vwave, & # endif & OCEAN(ng) % u, & & OCEAN(ng) % v, & # else & OCEAN(ng) % ubar, & & OCEAN(ng) % vbar, & # endif & WAVEP(ng) % kwc, & & WAVEP(ng) % h_tot, & & WAVEP(ng) % u_rho, & & WAVEP(ng) % v_rho) !# ifdef PROFILE ! CALL wclock_off (ng, iNLM, 35) !# endif RETURN END SUBROUTINE curr_inw ! !*********************************************************************** SUBROUTINE curr_inw_tile(ng, tile, & & LBi, UBi, LBj, UBj, & & nrhs, nstp, nnew, & # ifdef SOLVE3D # ifdef UV_KIRBY & Hz, z_r, & & uwave, vwave, & # endif & u, v, & # else & ubar, vbar, & # endif & kwc, h_tot, u_rho, v_rho) !*********************************************************************** ! USE mod_param USE mod_scalars USE mod_inwave_params USE bc_2d_mod # ifdef DISTRIBUTE USE mp_exchange_mod, ONLY : mp_exchange2d # endif USE exchange_2d_mod ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj integer, intent(in) :: nrhs, nstp, nnew # ifdef ASSUMED_SHAPE # ifdef SOLVE3D # ifdef UV_KIRBY real(r8), intent(in) :: Hz(LBi:,LBj:,:) real(r8), intent(in) :: z_r(LBi:,LBj:,:) real(r8), intent(out) :: uwave(LBi:,LBj:) real(r8), intent(out) :: vwave(LBi:,LBj:) # endif real(r8), intent(in) :: u(LBi:,LBj:,:,:) real(r8), intent(in) :: v(LBi:,LBj:,:,:) # else real(r8), intent(in) :: ubar(LBi:,LBj:,:) real(r8), intent(in) :: vbar(LBi:,LBj:,:) # endif real(r8), intent(in) :: kwc(LBi:,LBj:,:) real(r8), intent(in) :: h_tot(LBi:,LBj:) real(r8), intent(inout) :: u_rho(LBi:,LBj:) real(r8), intent(inout) :: v_rho(LBi:,LBj:) # else # ifdef SOLVE3D # ifdef UV_KIRBY real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng)) real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng)) real(r8), intent(out) :: uwave(LBi:UBi,LBj:UBj) real(r8), intent(out) :: vwave(LBi:UBi,LBj:UBj) # endif real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2) real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2) # else real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,2) real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,2) # endif real(r8), intent(in) :: kwc(LBi:UBi,LBj:UBj,ND) real(r8), intent(in) :: h_tot(LBi:UBi,LBj:UBj,ND) real(r8), intent(inout) :: u_rho(LBi:UBi,LBj:UBj,ND) real(r8), intent(inout) :: v_rho(LBi:UBi,LBj:UBj,ND) # endif ! ! Local variable declarations. ! integer :: i, j, k, d real(r8) :: twopi, otwopi real(r8) :: cff1, cff2 real(r8) :: cff1_u, cff2_u, cff3_u real(r8) :: cff1_v, cff2_v, cff3_v real(r8) :: kwc_mean ! # include "set_bounds.h" ! twopi=2.0_r8*pi otwopi=1.0_r8/twopi DO j=Jstr,Jend DO i=Istr,Iend ! For the different directional components when there are currents the Tr ! is different and therefore also the kwc and the currents affecting the ! waves. Here I am assuming that this difference is very small. ! We can change this is the future. kwc_mean=0.0_r8 DO d=1,ND kwc_mean=kwc_mean+kwc(i,j,d) END DO kwc_mean=kwc_mean/ND ! !======================================================================! ! Compute u and v currents affecting the wave field at rho points ! ! these can be computed using Kirby and Chen (1989) or assume that ! ! the currents are the superficial currents; in the 2D case those ! ! computed with the vertically averaged currents ! !======================================================================! ! # ifdef SOLVE3D # ifdef UV_KIRBY cff1=2.0_r8*kwc_mean*h_tot(i,j) IF (cff1.lt.700.0_r8) THEN cff1=2.0_r8*kwc_mean ELSE cff1=700.0_r8/h_tot(i,j) ENDIF ! cff2=0.0_r8 ! cff1_u=0.0_r8 cff2_u=0.0_r8 cff3_u=0.0_r8 ! cff1_v=0.0_r8 cff2_v=0.0_r8 cff3_v=0.0_r8 DO k=1,N(ng) cff2=COSH(cff1*(h_tot(i,j)+z_r(i,j,k)))*Hz(i,j,k) cff1_u=0.5_r8*(u(i,j,k,nnew)+u(i+1,j,k,nnew)) cff2_u=cff2_u+cff2*cff1_u cff3_u=cff3_u+cff2 cff1_v=0.5_r8*(v(i,j,k,nnew)+v(i,j+1,k,nnew)) cff2_v=cff2_v+cff2*cff1_v cff3_v=cff3_v+cff2 END DO u_rho(i,j)=cff2_u/cff3_u v_rho(i,j)=cff2_v/cff3_v uwave(i,j)=u_rho(i,j) vwave(i,j)=v_rho(i,j) # else u_rho(i,j)=0.5_r8*(u(i,j,N(ng),nnew)+u(i+1,j,N(ng),nnew)) v_rho(i,j)=0.5_r8*(v(i,j,N(ng),nnew)+v(i,j+1,N(ng),nnew)) # endif # else u_rho(i,j)=0.5_r8*(ubar(i,j,nnew)+ubar(i+1,j,nnew)) v_rho(i,j)=0.5_r8*(vbar(i,j,nnew)+vbar(i,j+1,nnew)) # endif END DO END DO ! ! Apply nonperiodic boundary conditions in xi and eta space. ! CALL bc_r2d_tile (ng, tile, & & LBi, UBi, LBj, UBj, u_rho) CALL bc_r2d_tile (ng, tile, & & LBi, UBi, LBj, UBj, v_rho) ! ! Apply periodic boundary conditions. ! IF (EWperiodic(ng).or.NSperiodic(ng)) THEN CALL exchange_r2d_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & u_rho) CALL exchange_r2d_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & v_rho) END IF # ifdef DISTRIBUTE ! ! Exchange boundary data. ! CALL mp_exchange2d (ng, tile, iNLM, 2, & & LBi, UBi, LBj, UBj, & & NghostPoints, & & EWperiodic(ng), NSperiodic(ng), & & u_rho, v_rho) ! # endif RETURN END SUBROUTINE curr_inw_tile # endif #endif END MODULE curr_inw_mod