Skip to content

Commit

Permalink
Further updates from integration with CAM and SIMA. Minor formatting …
Browse files Browse the repository at this point in the history 
…updates.
  • Loading branch information
@mwaxmonsky
mwaxmonsky committed Apr 11, 2024
1 parent d8cd203 commit a424269
Show file tree
Hide file tree
Showing 3 changed files with 42 additions and 49 deletions.
6 changes: 2 additions & 4 deletions tj2016/tj2016_precip.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ module TJ2016_precip
!! \htmlinclude tj2016_precip_run.html
subroutine tj2016_precip_run(ncol, pver, gravit, cappa, rairv, &
cpairv, latvap, rh2o, epsilo, rhoh2o, ps0, etamid, dtime, &
pmid, pdel, T, qv, relhum, precl, precc, tendency_of_air_enthalpy, scheme_name, errmsg, errflg)
pmid, pdel, T, qv, relhum, precl, tendency_of_air_enthalpy, scheme_name, errmsg, errflg)
!------------------------------------------------
! Input / output parameters
!------------------------------------------------
Expand Down Expand Up @@ -47,7 +47,6 @@ subroutine tj2016_precip_run(ncol, pver, gravit, cappa, rairv, &

real(kind_phys), intent(out) :: relhum(:,:) ! relative humidity
real(kind_phys), intent(out) :: precl(:) ! large-scale precipitation rate (m/s)
real(kind_phys), intent(out) :: precc(:) ! convective precipitation (m/s)
real(kind_phys), intent(out) :: tendency_of_air_enthalpy(:,:) !
character(len=512), intent(out):: scheme_name
character(len=512), intent(out):: errmsg
Expand Down Expand Up @@ -76,7 +75,6 @@ subroutine tj2016_precip_run(ncol, pver, gravit, cappa, rairv, &
errmsg = ' '
errflg = 0

precc = 0.0_kind_phys
precl = 0.0_kind_phys
tendency_of_air_enthalpy = 0.0_kind_phys

Expand All @@ -86,7 +84,7 @@ subroutine tj2016_precip_run(ncol, pver, gravit, cappa, rairv, &
! An example could be the simplified Betts-Miller (SBM) convection
! parameterization described in Frierson (JAS, 2007).
! The parameterization is expected to update
! the convective precipitation rate precc and the temporary state variables
! and the temporary state variables
! T and qv. T and qv will then be updated again with the
! large-scale condensation process below.

Expand Down
6 changes: 0 additions & 6 deletions tj2016/tj2016_precip.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,12 +120,6 @@
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = out
[ precc ]
standard_name = convective_precipitation_rate
units = m s-1
type = real | kind = kind_phys
dimensions = (horizontal_loop_extent)
intent = out
[ tendency_of_air_enthalpy ]
standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure
units = J kg-1 s-1
Expand Down
79 changes: 40 additions & 39 deletions tj2016/tj2016_sfc_pbl_hs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -151,30 +151,31 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
! Define simple_physics_option to either "TJ16" (moist HS) or "RJ12" (simple-physics)
character(LEN=4) :: simple_physics_option

! Initialize certain outfields
tendency_of_air_enthalpy = 0.0_kind_phys
scheme_name = "TJ2016_sfc_pbl_hs"
errmsg = ' '
errflg = 0
scheme_name = "TJ2016_sfc_pbl_hs"
errmsg = ' '
errflg = 0

! Set local copies to not modify model state directly
UCopy = U
VCopy = V
stateT = T

! Set the simple_physics_option "TJ16" (default, moist HS)
simple_physics_option = "TJ16"
simple_physics_option = "TJ16" ! Set the simple_physics_option "TJ16" (default, moist HS)
! simple_physics_option = "RJ12" ! alternative simple-physics forcing, Reed and Jablonowski (2012)

!==========================================================================
! Calculate Sea Surface Temperature and set exchange coefficient
!==========================================================================
if (simple_physics_option == "TJ16") then
C=0.0044_kind_phys ! Surface exchange coefficient for sensible and latent heat for moist HS
do i = 1, ncol ! set SST profile
C=0.0044_kind_phys ! Surface exchange coefficient for sensible and latent heat for moist HS
do i = 1, ncol ! set SST profile
Tsurf(i) = del_T*exp(-(((clat(i))**2.0_kind_phys)/(2.0_kind_phys*(T_width**2.0_kind_phys)))) + T_min
end do
else ! settings for RJ12
else ! settings for RJ12
C = 0.0011_kind_phys ! Surface exchange coefficient for sensible and latent heat for simple-physics
Tsurf = Tsurf_RJ12 ! constant SST
Tsurf = Tsurf_RJ12 ! constant SST
endif

!==========================================================================
Expand All @@ -198,7 +199,7 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
!==========================================================================
do i = 1, ncol
dlnpint = (lnpint(i,2) - lnpint(i,1))
za(i) = rairv(i,pver)/gravit*T(i,pver)*(1._kind_phys+zvirv(i,pver)*qv(i,pver))*0.5_kind_phys*dlnpint
za(i) = rairv(i,pver)/gravit*T(i,pver)*(1._kind_phys+zvirv(i,pver)*qv(i,pver))*0.5_kind_phys*dlnpint
end do

!==========================================================================
Expand Down Expand Up @@ -228,7 +229,7 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
end do
do i = 1, ncol
Ke(i,pver+1) = C*wind(i)*za(i)
if (wind(i) < v20) then ! if wind speed is less than 20 m/s
if (wind(i) < v20) then ! if wind speed is less than 20 m/s
Cd(i) = Cd0+Cd1*wind(i)
Km(i,pver+1) = Cd(i)*wind(i)*za(i)
else
Expand Down Expand Up @@ -257,19 +258,19 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
! note: this only occurs in the lowermost model level
!--------------------------------------------------------------------------
do i = 1, ncol
qsat = epsilo*e0/PS(i)*exp(-latvap/rh2o*((1._kind_phys/Tsurf(i))-1._kind_phys/T0)) ! saturation value for Q at the surface
rho(i) = pmid(i,pver)/(rairv(i,pver) * T(i,pver) *(1._kind_phys+zvirv(i,pver)*qv(i,pver))) ! air density at the lowest level rho = p/(Rd Tv)
qsat = epsilo*e0/PS(i)*exp(-latvap/rh2o*((1._kind_phys/Tsurf(i))-1._kind_phys/T0)) ! saturation value for Q at the surface
rho(i) = pmid(i,pver)/(rairv(i,pver) * T(i,pver) *(1._kind_phys+zvirv(i,pver)*qv(i,pver))) ! air density at the lowest level rho = p/(Rd Tv)

tmp = (T(i,pver)+C*wind(i)*Tsurf(i)*dtime/za(i))/(1._kind_phys+C*wind(i)*dtime/za(i)) ! new T
dtdt_vdiff(i,pver) = (tmp-T(i,pver))/dtime ! T tendency due to surface flux
shflx(i) = rho(i) * cpairv(i,pver) * C*wind(i)*(Tsurf(i)-T(i,pver)) ! sensible heat flux (W/m2)
T(i,pver) = tmp ! update T
dtdt_vdiff(i,pver) = (tmp-T(i,pver))/dtime ! T tendency due to surface flux
shflx(i) = rho(i) * cpairv(i,pver) * C*wind(i)*(Tsurf(i)-T(i,pver)) ! sensible heat flux (W/m2)
T(i,pver) = tmp ! update T

tmp = (qv(i,pver)+C*wind(i)*qsat*dtime/za(i))/(1._kind_phys+C*wind(i)*dtime/za(i)) ! new Q
dqdt_vdiff(i,pver) = (tmp-qv(i,pver))/dtime ! Q tendency due to surface flux
lhflx(i) = rho(i) * latvap * C*wind(i)*(qsat-qv(i,pver)) ! latent heat flux (W/m2)
evap(i) = rho(i) * C*wind(i)*(qsat-qv(i,pver)) ! surface water flux (kg/m2/s)
qv(i,pver) = tmp ! update Q
dqdt_vdiff(i,pver) = (tmp-qv(i,pver))/dtime ! Q tendency due to surface flux
lhflx(i) = rho(i) * latvap * C*wind(i)*(qsat-qv(i,pver)) ! latent heat flux (W/m2)
evap(i) = rho(i) * C*wind(i)*(qsat-qv(i,pver)) ! surface water flux (kg/m2/s)
qv(i,pver) = tmp ! update Q
end do

if (simple_physics_option == "RJ12") then
Expand All @@ -280,11 +281,11 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
! above is used
!--------------------------------------------------------------------------
do i = 1, ncol
tmp = Cd(i) * wind(i)
taux(i) = -rho(i) * tmp * UCopy(i,pver) ! zonal surface momentum flux (N/m2)
UCopy(i,pver) = UCopy(i,pver)/(1._kind_phys+tmp*dtime/za(i)) ! new U
tauy(i) = -rho(i) * tmp * VCopy(i,pver) ! meridional surface momentum flux (N/m2)
VCopy(i,pver) = VCopy(i,pver)/(1._kind_phys+tmp*dtime/za(i)) ! new V
tmp = Cd(i) * wind(i)
taux(i) = -rho(i) * tmp * UCopy(i,pver) ! zonal surface momentum flux (N/m2)
UCopy(i,pver) = UCopy(i,pver)/(1._kind_phys+tmp*dtime/za(i)) ! new U
tauy(i) = -rho(i) * tmp * VCopy(i,pver) ! meridional surface momentum flux (N/m2)
VCopy(i,pver) = VCopy(i,pver)/(1._kind_phys+tmp*dtime/za(i)) ! new V
enddo
endif

Expand Down Expand Up @@ -370,9 +371,9 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
do i = 1, ncol
dlnpint = (lnpint(i,2) - lnpint(i,1))
za(i) = rairv(i,pver)/gravit*T(i,pver)*(1._kind_phys+zvirv(i,pver)*qv(i,pver))*0.5_kind_phys*dlnpint ! height of lowest full model level
rho(i) = pmid(i,pver)/(rairv(i,pver) * T(i,pver) *(1._kind_phys+zvirv(i,pver)*qv(i,pver))) ! air density at the lowest level rho = p/(Rd Tv)
taux(i) = -kv * rho(i) * UCopy(i,pver) * za(i) ! U surface momentum flux in N/m2
tauy(i) = -kv * rho(i) * VCopy(i,pver) * za(i) ! V surface momentum flux in N/m2
rho(i) = pmid(i,pver)/(rairv(i,pver) * T(i,pver) *(1._kind_phys+zvirv(i,pver)*qv(i,pver))) ! air density at the lowest level rho = p/(Rd Tv)
taux(i) = -kv * rho(i) * UCopy(i,pver) * za(i) ! U surface momentum flux in N/m2
tauy(i) = -kv * rho(i) * VCopy(i,pver) * za(i) ! V surface momentum flux in N/m2
end do

!--------------------------------------------------------------------------
Expand All @@ -381,10 +382,10 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
!--------------------------------------------------------------------------
do k = 1, pver
if (etamid(k) > sigmab) then
kv = kf*(etamid(k) - sigmab)/onemsig ! RF coefficient
kv = kf*(etamid(k) - sigmab)/onemsig ! RF coefficient
do i=1,ncol
UCopy(i,k) = UCopy(i,k) -kv*UCopy(i,k)*dtime ! apply RF to U
VCopy(i,k) = VCopy(i,k) -kv*VCopy(i,k)*dtime ! apply RF to V
UCopy(i,k) = UCopy(i,k) -kv*UCopy(i,k)*dtime ! apply RF to U
VCopy(i,k) = VCopy(i,k) -kv*VCopy(i,k)*dtime ! apply RF to V
end do
end if
end do
Expand All @@ -394,7 +395,7 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
! mimics radiation
!-----------------------------------------------------------------------
do k = 1, pver
if (etamid(k) > sigmab) then ! lower atmosphere
if (etamid(k) > sigmab) then ! lower atmosphere
do i = 1, ncol
kt = ka + (ks - ka)*cossqsq(i)*(etamid(k) - sigmab)/onemsig ! relaxation coefficent varies in the vertical
trefc = T_max - delta_T*sinsq(i)
Expand Down Expand Up @@ -448,25 +449,25 @@ subroutine tj2016_sfc_pbl_hs_run(ncol, pver, gravit, cappa, rairv,
! First: calculate the PBL diffusive tendencies at the top model level
!---------------------------------------------------------------------
do i = 1, ncol
UCopy(i,1) = CFu(i,1) ! new U at the model top
VCopy(i,1) = CFv(i,1) ! new V at the model top
UCopy(i,1) = CFu(i,1) ! new U at the model top
VCopy(i,1) = CFv(i,1) ! new V at the model top
end do

!-----------------------------------------
! PBL diffusion of U and V at all other model levels
!-----------------------------------------
do i = 1, ncol
do k = 2, pver
UCopy(i,k) = CEm(i,k)*UCopy(i,k-1) + CFu(i,k) ! new U
VCopy(i,k) = CEm(i,k)*VCopy(i,k-1) + CFv(i,k) ! new V
UCopy(i,k) = CEm(i,k)*UCopy(i,k-1) + CFu(i,k) ! new U
VCopy(i,k) = CEm(i,k)*VCopy(i,k-1) + CFv(i,k) ! new V
end do
end do
endif

do i = i, ncol
do i = 1, ncol
do k = 1, pver
dudt(i, k) = UCopy(i, k) - U(i, k) / dtime
dvdt(i, k) = VCopy(i, k) - V(i, k) / dtime
dudt(i, k) = UCopy(i, k) - U(i, k) / dtime
dvdt(i, k) = VCopy(i, k) - V(i, k) / dtime
tendency_of_air_enthalpy(i,k) = (T(i,k) - stateT(i,k)) / dtime * cpairv(i,k)
end do
end do
Expand Down

0 comments on commit a424269

Please sign in to comment.