MODULE sed_surface_mod ! !svn $Id: sed_surface.F 396 2009-09-11 18:53:38Z arango $ !==================================================== John C. Warner === ! Copyright (c) 2002-2009 The ROMS/TOMS Group Hernan G. Arango ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This routine computed sediment surface layer (sediment-water ! ! interface) properties. ! ! ! ! References: ! ! ! ! Warner, J.C., C.R. Sherwood, R.P. Signell, C.K. Harris, and H.G. ! ! Arango, 2008: Development of a three-dimensional, regional, ! ! coupled wave, current, and sediment-transport model, Computers ! ! & Geosciences, 34, 1284-1306. ! ! ! !======================================================================= ! implicit none PRIVATE PUBLIC :: sed_surface CONTAINS ! !*********************************************************************** SUBROUTINE sed_surface (ng, tile) !*********************************************************************** ! USE mod_param USE mod_ocean 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, 16) CALL sed_surface_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & IminS, ImaxS, JminS, JmaxS, & & nstp(ng), nnew(ng), & & OCEAN(ng) % bed_frac, & & OCEAN(ng) % bottom) CALL wclock_off (ng, iNLM, 16) RETURN END SUBROUTINE sed_surface ! !*********************************************************************** SUBROUTINE sed_surface_tile (ng, tile, & & LBi, UBi, LBj, UBj, & & IminS, ImaxS, JminS, JmaxS, & & nstp, nnew, & & bed_frac, bottom) !*********************************************************************** ! USE mod_param USE mod_scalars USE mod_sediment ! USE bc_3d_mod, ONLY : bc_r3d_tile USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj integer, intent(in) :: IminS, ImaxS, JminS, JmaxS integer, intent(in) :: nstp, nnew ! real(r8), intent(inout) :: bed_frac(LBi:,LBj:,:,:) real(r8), intent(inout) :: bottom(LBi:,LBj:,:) ! ! Local variable declarations. ! logical :: EWperiodic=.FALSE. logical :: NSperiodic=.FALSE. integer :: i, ised, j real(r8) :: cff1, cff2, cff3, cff4 real(r8), parameter :: eps = 1.0E-14_r8 ! !----------------------------------------------------------------------- ! 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) ! ! Update mean surface properties. ! Sd50 must be positive definite, due to BBL routines. ! Srho must be >1000, due to (s-1) in BBL routines ! J_LOOP : DO j=Jstr,Jend DO i=Istr,Iend cff1=1.0_r8 cff2=1.0_r8 cff3=1.0_r8 cff4=1.0_r8 DO ised=1,NST cff1=cff1*tau_ce(ised,ng)**bed_frac(i,j,1,ised) cff2=cff2*Sd50(ised,ng)**bed_frac(i,j,1,ised) cff3=cff3*(wsed(ised,ng)+eps)**bed_frac(i,j,1,ised) cff4=cff4*Srho(ised,ng)**bed_frac(i,j,1,ised) END DO bottom(i,j,itauc)=cff1 bottom(i,j,isd50)=MIN(cff2,Zob(ng)) bottom(i,j,iwsed)=cff3 bottom(i,j,idens)=MAX(cff4,1050.0_r8) END DO END DO J_LOOP ! !----------------------------------------------------------------------- ! Apply periodic or gradient boundary conditions to property arrays. !----------------------------------------------------------------------- ! CALL bc_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, 1, MBOTP, & & bottom) CALL mp_exchange3d (ng, tile, iNLM, 1, & & LBi, UBi, LBj, UBj, 1, MBOTP, & & NghostPoints, EWperiodic, NSperiodic, & & bottom) RETURN END SUBROUTINE sed_surface_tile END MODULE sed_surface_mod