MODULE set_tides_mod ! !svn $Id: set_tides.F 297 2009-01-13 01:10:23Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2009 The ROMS/TOMS Group Robert Hetland ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This routine adds tidal elevation (m) and tidal currents (m/s) to ! ! sea surface height and 2D momentum climatologies, respectively. ! ! ! !======================================================================= ! implicit none PRIVATE PUBLIC :: set_tides CONTAINS ! !*********************************************************************** SUBROUTINE set_tides (ng, tile) !*********************************************************************** ! USE mod_param USE mod_boundary USE mod_grid USE mod_tides USE mod_stepping ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile ! ! Local variable declarations. ! integer :: IminS, ImaxS, JminS, JmaxS integer :: LBi, UBi, LBj, UBj, LBij, UBij ! ! Set horizontal starting and ending indices for automatic private storage ! arrays. ! IminS=BOUNDS(ng)%Istr(tile)-3 ImaxS=BOUNDS(ng)%Iend(tile)+3 JminS=BOUNDS(ng)%Jstr(tile)-3 JmaxS=BOUNDS(ng)%Jend(tile)+3 ! ! Determine array lower and upper bounds in the I- and J-directions. ! LBi=BOUNDS(ng)%LBi(tile) UBi=BOUNDS(ng)%UBi(tile) LBj=BOUNDS(ng)%LBj(tile) UBj=BOUNDS(ng)%UBj(tile) ! ! Set array lower and upper bounds for MIN(I,J)- and MAX(I,J)-directions. ! LBij=BOUNDS(ng)%LBij UBij=BOUNDS(ng)%UBij ! CALL wclock_on (ng, iNLM, 11) CALL set_tides_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & IminS, ImaxS, JminS, JmaxS, & & NTC(ng), & & GRID(ng) % angler, & & GRID(ng) % rmask, & & GRID(ng) % umask, & & GRID(ng) % vmask, & & TIDES(ng) % SSH_Tamp, & & TIDES(ng) % SSH_Tphase, & & TIDES(ng) % UV_Tangle, & & TIDES(ng) % UV_Tphase, & & TIDES(ng) % UV_Tmajor, & & TIDES(ng) % UV_Tminor, & & BOUNDARY(ng) % zeta_east, & & BOUNDARY(ng) % zeta_west, & & BOUNDARY(ng) % zeta_south, & & BOUNDARY(ng) % ubar_east, & & BOUNDARY(ng) % vbar_east, & & BOUNDARY(ng) % ubar_west, & & BOUNDARY(ng) % vbar_west, & & BOUNDARY(ng) % ubar_south, & & BOUNDARY(ng) % vbar_south, & & TIDES(ng) % Tperiod) CALL wclock_off (ng, iNLM, 11) RETURN END SUBROUTINE set_tides ! !*********************************************************************** SUBROUTINE set_tides_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & IminS, ImaxS, JminS, JmaxS, & & NTC, & & angler, & & rmask, umask, vmask, & & SSH_Tamp, SSH_Tphase, & & UV_Tangle, UV_Tphase, & & UV_Tmajor, UV_Tminor, & & zeta_east, & & zeta_west, & & zeta_south, & & ubar_east, vbar_east, & & ubar_west, vbar_west, & & ubar_south, vbar_south, & & Tperiod) !*********************************************************************** ! USE mod_param USE mod_scalars ! USE distribute_mod, ONLY : mp_boundary USE mp_exchange_mod, ONLY : mp_exchange2d ! ! Imported variables declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj integer, intent(in) :: IminS, ImaxS, JminS, JmaxS integer, intent(in) :: NTC ! real(r8), intent(in) :: angler(LBi:,LBj:) real(r8), intent(in) :: rmask(LBi:,LBj:) real(r8), intent(in) :: umask(LBi:,LBj:) real(r8), intent(in) :: vmask(LBi:,LBj:) real(r8), intent(in) :: Tperiod(MTC) real(r8), intent(in) :: SSH_Tamp(LBi:,LBj:,:) real(r8), intent(in) :: SSH_Tphase(LBi:,LBj:,:) real(r8), intent(in) :: UV_Tangle(LBi:,LBj:,:) real(r8), intent(in) :: UV_Tmajor(LBi:,LBj:,:) real(r8), intent(in) :: UV_Tminor(LBi:,LBj:,:) real(r8), intent(in) :: UV_Tphase(LBi:,LBj:,:) real(r8), intent(inout) :: zeta_east(0:) real(r8), intent(inout) :: zeta_west(0:) real(r8), intent(inout) :: zeta_south(0:) real(r8), intent(inout) :: ubar_east(0:) real(r8), intent(inout) :: vbar_east(0:) real(r8), intent(inout) :: ubar_west(0:) real(r8), intent(inout) :: vbar_west(0:) real(r8), intent(inout) :: ubar_south(0:) real(r8), intent(inout) :: vbar_south(0:) ! ! Local variables declarations. ! logical :: EWperiodic=.FALSE. logical :: NSperiodic=.FALSE. logical :: update integer :: ILB, IUB, JLB, JUB integer :: i, itide, j real(r8) :: Cangle, Cphase, Sangle, Sphase real(r8) :: angle, cff, phase, omega, ramp real(r8) :: bry_cor, bry_pgr, bry_str, bry_val real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Etide real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Utide real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Uwrk real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Vtide real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: Vwrk ! !----------------------------------------------------------------------- ! Set lower and upper tile bounds and staggered variables bounds for ! this horizontal domain partition. Notice that if tile=-1, it will ! set the values for the global grid. !----------------------------------------------------------------------- ! integer :: Istr, IstrR, IstrT, IstrU, Iend, IendR, IendT integer :: Jstr, JstrR, JstrT, JstrV, Jend, JendR, JendT ! Istr =BOUNDS(ng)%Istr (tile) IstrR=BOUNDS(ng)%IstrR(tile) IstrT=BOUNDS(ng)%IstrT(tile) IstrU=BOUNDS(ng)%IstrU(tile) Iend =BOUNDS(ng)%Iend (tile) IendR=BOUNDS(ng)%IendR(tile) IendT=BOUNDS(ng)%IendT(tile) Jstr =BOUNDS(ng)%Jstr (tile) JstrR=BOUNDS(ng)%JstrR(tile) JstrT=BOUNDS(ng)%JstrT(tile) JstrV=BOUNDS(ng)%JstrV(tile) Jend =BOUNDS(ng)%Jend (tile) JendR=BOUNDS(ng)%JendR(tile) JendT=BOUNDS(ng)%JendT(tile) ! ! Lower and upper bounds for nontiled boundary arrays. ! ILB=0 IUB=Im(ng)+1 JLB=0 JUB=Jm(ng)+1 ! ! Set time-ramping parameter. ! ramp=1.0_r8 ! !----------------------------------------------------------------------- ! Add tidal elevation (m) to sea surface height climatology. !----------------------------------------------------------------------- ! Etide(:,:)=0.0_r8 cff=2.0_r8*pi*(time(ng)-tide_start*day2sec) DO itide=1,NTC IF (Tperiod(itide).gt.0.0_r8) THEN omega=cff/Tperiod(itide) DO j=JstrR,JendR DO i=IstrR,IendR Etide(i,j)=Etide(i,j)+ & & ramp*SSH_Tamp(i,j,itide)* & & COS(omega-SSH_Tphase(i,j,itide)) Etide(i,j)=Etide(i,j)*rmask(i,j) END DO END DO END IF END DO ! ! If appropriate, load tidal forcing into boundary arrays. The "zeta" ! boundary arrays are important for the Flather or reduced physics ! boundary conditions for 2D momentum. To avoid having two boundary ! points for these arrays, the values of "zeta_west" and "zeta_east" ! are averaged at u-points. Similarly, the values of "zeta_south" ! and "zeta_north" is averaged at v-points. Noticed that these ! arrays are also used for the clamped conditions for free-surface. ! This averaging is less important for that type ob boundary ! conditions. ! update=.FALSE. IF (Istr.eq.1) THEN DO j=JstrR,JendR zeta_west(j)=0.5_r8*(Etide(Istr-1,j)+Etide(Istr,j)) END DO update=.TRUE. END IF CALL mp_boundary (ng, iNLM, JstrR, JendR, JLB, JUB, 1, 1, update, & & zeta_west) update=.FALSE. IF (Iend.eq.Lm(ng)) THEN DO j=JstrR,JendR zeta_east(j)=0.5_r8*(Etide(Iend,j)+Etide(Iend+1,j)) END DO update=.TRUE. END IF CALL mp_boundary (ng, iNLM, JstrR, JendR, JLB, JUB, 1, 1, update, & & zeta_east) update=.FALSE. IF (Jstr.eq.1) THEN DO i=IstrR,IendR zeta_south(i)=0.5_r8*(Etide(i,Jstr-1)+Etide(i,Jstr)) END DO update=.TRUE. END IF CALL mp_boundary (ng, iNLM, IstrR, IendR, ILB, IUB, 1, 1, update, & & zeta_south) ! !----------------------------------------------------------------------- ! Add tidal currents (m/s) to 2D momentum climatologies. !----------------------------------------------------------------------- ! Utide(:,:)=0.0_r8 Vtide(:,:)=0.0_r8 cff=2.0_r8*pi*(time(ng)-tide_start*day2sec) DO itide=1,NTC IF (Tperiod(itide).gt.0.0_r8) THEN omega=cff/Tperiod(itide) DO j=MIN(JstrR,Jstr-1),JendR DO i=MIN(IstrR,Istr-1),IendR angle=UV_Tangle(i,j,itide)-angler(i,j) Cangle=COS(angle) Sangle=SIN(angle) phase=omega-UV_Tphase(i,j,itide) Cphase=COS(phase) Sphase=SIN(phase) Uwrk(i,j)=UV_Tmajor(i,j,itide)*Cangle*Cphase- & & UV_Tminor(i,j,itide)*Sangle*Sphase Vwrk(i,j)=UV_Tmajor(i,j,itide)*Sangle*Cphase+ & & UV_Tminor(i,j,itide)*Cangle*Sphase END DO END DO DO j=JstrR,JendR DO i=Istr,IendR Utide(i,j)=Utide(i,j)+ & & ramp*0.5_r8*(Uwrk(i-1,j)+Uwrk(i,j)) Utide(i,j)=Utide(i,j)*umask(i,j) END DO END DO DO j=Jstr,JendR DO i=IstrR,IendR Vtide(i,j)=(Vtide(i,j)+ & & ramp*0.5_r8*(Vwrk(i,j-1)+Vwrk(i,j))) Vtide(i,j)=Vtide(i,j)*vmask(i,j) END DO END DO END IF END DO ! ! If appropriate, load tidal forcing into boundary arrays. ! update=.FALSE. IF (Istr.eq.1) THEN DO j=JstrR,JendR ubar_west(j)=Utide(Istr,j) END DO DO j=Jstr,JendR vbar_west(j)=Vtide(Istr-1,j) END DO update=.TRUE. END IF CALL mp_boundary (ng, iNLM, JstrR, JendR, JLB, JUB, 1, 1, update, & & ubar_west) CALL mp_boundary (ng, iNLM, Jstr, JendR, JLB, JUB, 1, 1, update, & & vbar_west) update=.FALSE. IF (Iend.eq.Lm(ng)) THEN DO j=JstrR,JendR ubar_east(j)=Utide(Iend+1,j) END DO DO j=Jstr,JendR vbar_east(j)=Vtide(Iend+1,j) END DO update=.TRUE. END IF CALL mp_boundary (ng, iNLM, JstrR, JendR, JLB, JUB, 1, 1, update, & & ubar_east) CALL mp_boundary (ng, iNLM, Jstr, JendR, JLB, JUB, 1, 1, update, & & vbar_east) update=.FALSE. IF (Jstr.eq.1) THEN DO i=Istr,IendR ubar_south(i)=Utide(i,Jstr-1) END DO DO i=IstrR,IendR vbar_south(i)=Vtide(i,Jstr) END DO update=.TRUE. END IF CALL mp_boundary (ng, iNLM, Istr, IendR, ILB, IUB, 1, 1, update, & & ubar_south) CALL mp_boundary (ng, iNLM, IstrR, IendR, ILB, IUB, 1, 1, update, & & vbar_south) RETURN END SUBROUTINE set_tides_tile END MODULE set_tides_mod