In pre_step3d, there is a computation of
Code: Select all
FC(i,k)=FC(i,k)-dt(ng)*Akt(i,j,k,ltrc)*ghats(i,j,k,ltrc)
Code: Select all
FC(i,k)=FC(i,k)-dt(ng)*Akt(i,j,k,ltrc)*ghats(i,j,k,ltrc)
kate wrote:Hmm, this might explain a problem I was having where non-NAT tracers got outrageous values from the vertical mixing. I "solved" it by limiting Akt for non-NAT tracers, but there might be a better fix.
OK, so this is a real problem and I've submitted a bug report. Now I'm wondering if the portion of the surface flux that's added via LMD_NONLOCAL is added twice - once at the surface and once in the mixed layer.
Code: Select all
FC(i,k)=FC(i,k)-dt(ng)*Akt(i,j,k,ltrc)*ghats(i,j,k,ltrc)
Code: Select all
TracerFlux = - hbl * wscale(sigma) * G(sigma) * d_z TracerConcentration + NonLocalFlux
Code: Select all
NonLocalFlux = C * G(sigma) * SurfaceForcingFlux
Code: Select all
G(sigma) = sigma*(1-sigma)^2
Code: Select all
do j=jstr,jend ! <-- a very long j-loop starts at the beginning "lmd_kpp.F"
....
....
do i=istr,iend
do k=N-1,kbl(i),-1
sigma=(z_w(i,j,N)-z_w(i,j,k))/max(hbl(i,j),eps)
....
.... !<-- many other things are computed here as well.
# ifdef LMD_NONLOCAL
if (Bfsfc .lt. 0.) then
ghat(i,j,k)=Cg * sigma*(1.-sigma)**2
else
ghat(i,j,k)=0.
endif
# endif
enddo
do k=kbl(i)-1,1,-1
# ifdef LMD_NONLOCAL
ghat(i,j,k)=0.
# endif
....
....
enddo
enddo
....
....
enddo !<-- j
Code: Select all
do j=jstr,jend ! <-- a very long j-loop starts at the beginning
...
...
# ifdef LMD_KPP
! Add the solar radiation flux in temperature equation. Also compute
! the nonlocal transport flux for unstable (convective) forcing
! conditions into matrix DC when using the Large et al. 1994 KPP
! scheme.
if (itrc.eq.itemp) then
do k=N-1,1,-1
do i=istr,iend
cff=srflx(i,j)*swr_frac(i,j,k)
# ifdef LMD_NONLOCAL
& -ghat(i,j,k)*(stflx(i,j,itemp)-srflx(i,j))
# endif
t(i,j,k+1,nnew,itemp)=t(i,j,k+1,nnew,itemp) -dt*cff
t(i,j,k ,nnew,itemp)=t(i,j,k ,nnew,itemp) +dt*cff
enddo
enddo
# if defined LMD_NONLOCAL && defined SALINITY
elseif (itrc.eq.isalt) then
do k=N-1,1,-1
do i=istr,iend
cff=-dt*ghat(i,j,k)*stflx(i,j,isalt)
t(i,j,k+1,nnew,isalt)=t(i,j,k+1,nnew,isalt) -cff
t(i,j,k ,nnew,isalt)=t(i,j,k ,nnew,isalt) +cff
enddo
enddo
# endif
endif
# endif
...
...
enddo !<-- j
Code: Select all
# ifdef LMD_NONLOCAL
cff=1.0_r8-(0.5_r8+SIGN(0.5_r8,Bflux(i,j,k)))
ghats(i,j,k,itemp)=-cff*(stflx(i,j,itemp)-srflx(i,j)+ &
& srflx(i,j)*(1.0_r8-swdk(i,j)))
# ifdef SALINITY
ghats(i,j,k,isalt)=cff*stflx(i,j,isalt)
# endif
# endif
Code: Select all
# ifdef LMD_NONLOCAL
! Compute boundary layer nonlocal transport (m/s2).
cff=lmd_Cg*(1.0_r8-(0.5_r8+SIGN(0.5_r8,Bflux(i,j,k))))/ &
& (zbl*ws(i,j)+eps)
ghats(i,j,k,itemp)=cff*ghats(i,j,k,itemp)
# ifdef SALINITY
ghats(i,j,k,isalt)=cff*ghats(i,j,k,isalt)
# endif
# endif
Code: Select all
....(stflx(i,j,itemp)-srflx(i,j)+ &
& srflx(i,j)*(1.0_r8-swdk(i,j)))
Code: Select all
stflx(i,j,itemp) - srflx(i,j)*swdk(i,j)
Code: Select all
# ifdef SALINITY
Bo(i,j)=g*(alpha(i,j)*(stflx(i,j,itemp)-srflx(i,j))- &
& beta (i,j)*stflx(i,j,isalt))
# else
Bo(i,j)=g*alpha(i,j)*(stflx(i,j,itemp)-srflx(i,j))
# endif
Bosol(i,j)=g*alpha(i,j)*srflx(i,j)
Code: Select all
CALL lmd_swfrac_tile (ng, tile, &
& LBi, UBi, LBj, UBj, &
& IminS, ImaxS, JminS, JmaxS, &
& -1.0_r8, zgrid, swdk)
DO j=Jstr,Jend
DO i=Istr,Iend
Bflux(i,j,k)=(Bo(i,j)+Bosol(i,j)*(1.0_r8-swdk(i,j)))
Code: Select all
do j=1,ny_block
do i=1,nx_block
if (RHO1(i,j) /= c0) then
BO (i,j) = grav*(-TALPHA(i,j)*STF(i,j,1) - &
SBETA (i,j)*STF(i,j,2))/RHO1(i,j)
BOSOL(i,j) = -grav*TALPHA(i,j)*SHF_QSW(i,j)/RHO1(i,j)
else
BO (i,j) = c0
BOSOL(i,j) = c0
endif
end do
end do
Code: Select all
CCSM STF(:,:,1) is the same as ROMS (stflx(:,:,itemp)-srflx(:,:))
Code: Select all
if (lshort_wave) then
select case (sw_absorption_type)
case ('top-layer')
BFSFC = BO + BOSOL
! QSW_HBL = SHF_QSW
if (tavg_requested(tavg_QSW_HBL)) then
WORK = SHF_QSW/hflux_factor
call accumulate_tavg_field(WORK,tavg_QSW_HBL,bid,1)
endif
case ('jerlov')
do j = 1,ny_block
do i = 1,nx_block
call sw_absorb_frac(HBLT(i,j),absorb_frac)
BFSFC(i,j) = BO(i,j) + BOSOL(i,j)*(c1 - absorb_frac)
enddo
enddo
if (tavg_requested(tavg_QSW_HBL)) then
!QSW_HBL(i,j) = SHF_QSW(i,j)*(c1-absorb_frac) ! boundary layer sw
WORK = SHF_QSW*(c1-absorb_frac)/hflux_factor
call accumulate_tavg_field(WORK,tavg_QSW_HBL,bid,1)
endif
case ('chlorophyll')
ZTRANS(:,:,bid) = HBLT(:,:)
call sw_trans_chl(0,this_block)
BFSFC = BO + BOSOL*(c1-TRANS(:,:,bid))
if (tavg_requested(tavg_QSW_HBL)) then
!QSW_HBL = SHF_QSW *(c1-TRANS(:,:,bid)) ! boundary layer sw heating
WORK = SHF_QSW*(c1-TRANS(:,:,bid))/hflux_factor
call accumulate_tavg_field(WORK,tavg_QSW_HBL,bid,1)
endif
end select
endif
STABLE = MERGE(c1, c0, BFSFC >= c0)
BFSFC = BFSFC + STABLE * eps ! ensures bfsfc never=0
Code: Select all
do k = 1,km
if (partial_bottom_cells) then
if (k > 1) then
SIGMA = (-zgrid(k-1) + p5*DZT(:,:,k-1,bid) + &
DZT(:,:,k,bid)) / HBLT
else
SIGMA = (-zgrid(k) + p5*hwide(k)) / HBLT
end if
else
SIGMA = (-zgrid(k) + p5*hwide(k)) / HBLT
endif
F1 = min(SIGMA,epssfc)
call wscale(F1, HBLT, USTAR, BFSFC, 3, WM, WS)
!DIR$ COLLAPSE
do j=1,ny_block
do i=1,nx_block
BLMC(i,j,k,1) = HBLT(i,j)*WM(i,j)*SIGMA(i,j)* &
(c1 + SIGMA(i,j)*((SIGMA(i,j)-c2) + &
(c3-c2*SIGMA(i,j))*GAT1(i,j,1) + &
(SIGMA(i,j)-c1)*DAT1(i,j,1)))
BLMC(i,j,k,2) = HBLT(i,j)*WS(i,j)*SIGMA(i,j)* &
(c1 + SIGMA(i,j)*((SIGMA(i,j)-c2) + &
(c3-c2*SIGMA(i,j))*GAT1(i,j,2) + &
(SIGMA(i,j)-c1)*DAT1(i,j,2)))
BLMC(i,j,k,3) = HBLT(i,j)*WS(i,j)*SIGMA(i,j)* &
(c1 + SIGMA(i,j)*((SIGMA(i,j)-c2) + &
(c3-c2*SIGMA(i,j))*GAT1(i,j,3) + &
(SIGMA(i,j)-c1)*DAT1(i,j,3)))
GHAT(i,j,k) = (c1-STABLE(i,j))* cg/(WS(i,j)*HBLT(i,j) +eps)
end do
end do
end do
Code: Select all
GHAT(:,:,k) = (c1-CASEA) * GHAT(:,:,k)
Code: Select all
do n=1,nt
mt2=min(n,2)
KPP_SRC(:,:,1,n,bid) = STF(:,:,n)/dz(1) &
*(-VDC(:,:,1,mt2)*GHAT(:,:,1))
if (partial_bottom_cells) then
do k=2,km
KPP_SRC(:,:,k,n,bid) = STF(:,:,n)/DZT(:,:,k,bid) &
*( VDC(:,:,k-1,mt2)*GHAT(:,:,k-1) &
-VDC(:,:,k ,mt2)*GHAT(:,:,k ))
enddo
else
do k=2,km
KPP_SRC(:,:,k,n,bid) = STF(:,:,n)/dz(k) &
*( VDC(:,:,k-1,mt2)*GHAT(:,:,k-1) &
-VDC(:,:,k ,mt2)*GHAT(:,:,k ))
enddo
endif
enddo
Code: Select all
BO = grav*(-TALPHA*STF(:,:,1) - SBETA*STF(:,:,2))/RHO1
BOSOL = -grav*TALPHA*SHF_QSW/RHO1
BFSFC(i,j) = BO(i,j) + BOSOL(i,j)*(c1 - absorb_frac)
Code: Select all
# ifdef LMD_NONLOCAL
!
! Compute boundary layer nonlocal transport [m/s^2]
!
if (Bflux(i,j).le.0.) then
ghats(i,j,k)=lmd_Cg/(ws(i,j)*hbl(i,j)+eps)
else
ghats(i,j,k)=0.
endif
# endif
Code: Select all
! Add top and bottom fluxes
!
do i=Istr,Iend
FC(i,N)=dt*stflx(i,j,itrc)
FC(i,0)=-dt*btflx(i,j,itrc)
enddo
!
! Add solar radiation flux in temperature equation
! Also compute the nonlocal transport flux for unstable
! (convective) forcing conditions into matrix DC when using
! the Large et al. 1994 KPP scheme.
!
if (itrc.eq.itemp) then
do k=1,N-1
do i=Istr,Iend
FC(i,k)=0.
# if defined LMD_SKPP || defined LMD_BKPP
& +dt*srflx(i,j)*swdk(i,j,k)
# ifdef LMD_NONLOCAL
& -dt*Akt(i,j,k,itemp)*ghats(i,j,k)
# endif
# endif
enddo
enddo
# ifdef SALINITY
elseif (itrc.eq.isalt) then
do k=1,N-1
do i=Istr,Iend
FC(i,k)=0.
# if defined LMD_SKPP || defined LMD_BKPP
# ifdef LMD_NONLOCAL
& -dt*Akt(i,j,k,isalt)*ghats(i,j,k)
# endif
# endif
enddo
enddo
# endif
endif
# ifdef SALINITY
if (itrc.eq.itemp .or. itrc.eq.isalt) then
# else
if (itrc.eq.itemp) then
# endif
do k=1,N
do i=Istr,Iend
t(i,j,k,nnew,itrc)=t(i,j,k,nnew,itrc)+FC(i,k )
& -FC(i,k-1)
enddo
enddo
endif
Code: Select all
FC(i,k) = ... -dt*Akt(i,j,k,itemp)*ghats(i,j,k)
Code: Select all
FC(i,k) = ... -dt*Akt(i,j,k,isalt)*ghats(i,j,k)
Code: Select all
....
....
FC(i,k)=0.
# if defined LMD_SKPP || defined LMD_BKPP
& +dt*srflx(i,j)*swdk(i,j,k)
# ifdef LMD_NONLOCAL
& -dt*Akt(i,j,k,itemp)*ghats(i,j,k)*(stflx(i,j,itemp)-srflx(i,j))
# endif
# endif
....
....
Code: Select all
....
FC(i,k)=0.
# if defined LMD_SKPP || defined LMD_BKPP
# ifdef LMD_NONLOCAL
& -dt*Akt(i,j,k,isalt)*ghats(i,j,k)*stflx(i,j,isalt)
# endif
# endif
....
Code: Select all
Akt = wscale * hbl * sigma * (1-sigma)^2
Code: Select all
Akt = wscale * hbl * G(sigma)
Code: Select all
ghats = C_g / (wscale * hbl)