Skip to content

Commit

Permalink
Couple TEMPO to radiation
Browse files Browse the repository at this point in the history
  • Loading branch information
@AndersJensen-NOAA
AndersJensen-NOAA committed Feb 3, 2025
1 parent dcda3f9 commit a2fc440
Show file tree
Hide file tree
Showing 5 changed files with 131 additions and 31 deletions.
107 changes: 83 additions & 24 deletions physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
ntdu1, ntdu2, ntdu3, ntdu4, ntdu5, ntss1, ntss2, &
ntss3, ntss4, ntss5, ntsu, ntbcb, ntbcl, ntocb, ntocl, ntchm, &
imp_physics,imp_physics_nssl, nssl_ccn_on, nssl_invertccn, &
imp_physics_thompson, imp_physics_gfdl, imp_physics_zhao_carr, &
imp_physics_thompson, imp_physics_tempo, imp_physics_gfdl, &
imp_physics_zhao_carr, &
imp_physics_zhao_carr_pdf, imp_physics_mg, imp_physics_wsm6, &
imp_physics_fer_hires, iovr, iovr_rand, iovr_maxrand, iovr_max, &
iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, idcor_hogan, &
Expand All @@ -45,7 +46,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
gasvmr_ccl4, gasvmr_cfc113, aerodp,ext550, clouds6, clouds7, clouds8, &
clouds9, cldsa, cldfra, cldfra2d, lwp_ex,iwp_ex, lwp_fc,iwp_fc, &
faersw1, faersw2, faersw3, faerlw1, faerlw2, faerlw3, alpha, rrfs_sd, &
aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, ozphys, &
aero_dir_fdb, fdb_coef, spp_wts_rad, spp_rad, ico2, ozphys, tempo_cfg, &
errmsg, errflg)

use machine, only: kind_phys
Expand Down Expand Up @@ -81,6 +82,24 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
make_IceNumber, &
make_DropletNumber, &
make_RainNumber

use module_mp_tempo_params, only: &
ty_tempo_cfg, &
Nt_c_l_tempo => Nt_c_l, &
Nt_c_o_tempo => Nt_c_o, &
re_qc_min_tempo => re_qc_min, &
re_qc_max_tempo => re_qc_max, &
re_qi_min_tempo => re_qi_min, &
re_qi_max_tempo => re_qi_max, &
re_qs_min_tempo => re_qs_min, &
re_qs_max_tempo => re_qs_max

use module_mp_tempo_utils, only: &
calc_effectRad_tempo => calc_effectRad, &
make_IceNumber_tempo => make_IceNumber, &
make_DropletNumber_tempo => make_DropletNumber, &
make_RainNumber_tempo => make_RainNumber

! For NRL Ozone
use module_ozphys, only: ty_ozphys
implicit none
Expand All @@ -98,6 +117,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
lndp_type, &
kdt, imp_physics, &
imp_physics_thompson, &
imp_physics_tempo, &
imp_physics_gfdl, &
imp_physics_zhao_carr, &
imp_physics_zhao_carr_pdf, &
Expand Down Expand Up @@ -235,6 +255,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
real (kind=kind_phys), dimension(lm) :: cldfra1d, qv1d, &
& qc1d, qi1d, qs1d, dz1d, p1d, t1d

! For TEMPO MP
type(ty_tempo_cfg), intent(in) :: tempo_cfg

! for F-A MP
real(kind=kind_phys), dimension(im,lm+LTP+1) :: tem2db, hz

Expand Down Expand Up @@ -276,7 +299,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&

LP1 = LM + 1 ! num of in/out levels

if (imp_physics == imp_physics_thompson) then
if (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then
max_relh = 1.5
else
max_relh = 1.1
Expand Down Expand Up @@ -737,7 +760,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
enddo
enddo
! for Thompson MP - prepare variables for calc_effr
if_thompson: if (imp_physics == imp_physics_thompson .and. (ltaerosol .or. mraerosol)) then
if_thompson: if ((imp_physics == imp_physics_thompson .or. &
imp_physics == imp_physics_tempo) .and. (ltaerosol .or. mraerosol)) then
do k=1,LMK
do i=1,IM
qvs = qlyr(i,k)
Expand All @@ -752,7 +776,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
nwfa (i,k) = tracer1(i,k,ntwa)
enddo
enddo
elseif (imp_physics == imp_physics_thompson) then
elseif (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then
do k=1,LMK
do i=1,IM
qvs = qlyr(i,k)
Expand All @@ -763,9 +787,17 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs)
qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs)
if(nint(slmsk(i)) == 1) then
nc_mp (i,k) = Nt_c_l*orho(i,k)
if (imp_physics == imp_physics_thompson) then
nc_mp (i,k) = Nt_c_l*orho(i,k)
else
nc_mp (i,k) = Nt_c_l_tempo*orho(i,k)
endif
else
nc_mp (i,k) = Nt_c_o*orho(i,k)
if (imp_physics == imp_physics_thompson) then
nc_mp (i,k) = Nt_c_o*orho(i,k)
else
nc_mp (i,k) = Nt_c_o_tempo*orho(i,k)
endif
endif
ni_mp (i,k) = tracer1(i,k,ntinc)/(1.-qvs)
enddo
Expand Down Expand Up @@ -878,18 +910,26 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
! not used yet -- effr_in should always be true for now
endif

elseif (imp_physics == imp_physics_thompson) then ! Thompson MP
elseif (imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) then ! Thompson MP
!
! Compute effective radii for QC, QI, QS with (GF, MYNN) or without (all others) sub-grid clouds
!
! Update number concentration, consistent with sub-grid clouds (GF, MYNN) or without (all others)
do k=1,lm
do i=1,im
if ((ltaerosol .or. mraerosol) .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then
nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k)
if ((ltaerosol .or. mraerosol) .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then
if (imp_physics == imp_physics_thompson) then
nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k)
else
nc_mp(i,k) = make_DropletNumber_tempo(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k)
endif
endif
if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then
ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k)
if (imp_physics == imp_physics_thompson) then
ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k)
else
ni_mp(i,k) = make_IceNumber_tempo(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k)
endif
endif
end do
end do
Expand All @@ -900,18 +940,36 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
!tgs: progclduni has different limits for ice radii (10.0-150.0) than
! calc_effectRad (4.99-125.0 for WRFv3.8.1; 2.49-125.0 for WRFv4+)
! it will raise the low limit from 5 to 10, but the high limit will remain 125.
call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), &
nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), &
effrl(i,:), effri(i,:), effrs(i,:), islmsk, 1, lm )
! Scale Thompson's effective radii from meter to micron
do k=1,lm
effrl(i,k) = MAX(re_qc_min, MIN(effrl(i,k), re_qc_max))*1.e6
effri(i,k) = MAX(re_qi_min, MIN(effri(i,k), re_qi_max))*1.e6
effrs(i,k) = MAX(re_qs_min, MIN(effrs(i,k), re_qs_max))*1.e6
end do
effrl(i,lmk) = re_qc_min*1.e6
effri(i,lmk) = re_qi_min*1.e6
effrs(i,lmk) = re_qs_min*1.e6

if (imp_physics == imp_physics_thompson) then
call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), &
nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), &
effrl(i,:), effri(i,:), effrs(i,:), islmsk, 1, lm )
! Scale Thompson's effective radii from meter to micron
do k=1,lm
effrl(i,k) = MAX(re_qc_min, MIN(effrl(i,k), re_qc_max))*1.e6
effri(i,k) = MAX(re_qi_min, MIN(effri(i,k), re_qi_max))*1.e6
effrs(i,k) = MAX(re_qs_min, MIN(effrs(i,k), re_qs_max))*1.e6
end do
effrl(i,lmk) = re_qc_min*1.e6
effri(i,lmk) = re_qi_min*1.e6
effrs(i,lmk) = re_qs_min*1.e6
else
call calc_effectRad_tempo(t1d=tlyr(i,:), p1d=plyr(i,:)*100., qv1d=qv_mp(i,:), qc1d=qc_mp(i,:), &
nc1d=nc_mp(i,:), qi1d=qi_mp(i,:), ni1d=ni_mp(i,:), qs1d=qs_mp(i,:), &
re_qc1d=effrl(i,:), re_qi1d=effri(i,:), re_qs1d=effrs(i,:), kts=1, kte=lm, &
lsml=islmsk, configs=tempo_cfg)
! Scale Thompson's effective radii from meter to micron
do k=1,lm
effrl(i,k) = MAX(re_qc_min_tempo, MIN(effrl(i,k), re_qc_max_tempo))*1.e6
effri(i,k) = MAX(re_qi_min_tempo, MIN(effri(i,k), re_qi_max_tempo))*1.e6
effrs(i,k) = MAX(re_qs_min_tempo, MIN(effrs(i,k), re_qs_max_tempo))*1.e6
end do
effrl(i,lmk) = re_qc_min_tempo*1.e6
effri(i,lmk) = re_qi_min_tempo*1.e6
effrs(i,lmk) = re_qs_min_tempo*1.e6
endif

end do
effrr(:,:) = 1000. ! rrain_def=1000.
! Update global arrays
Expand Down Expand Up @@ -976,7 +1034,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,&
& deltaq, sup, dcorr_con, me, icloud, kdt, &
& ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, ntclamt, &
& imp_physics, imp_physics_nssl, imp_physics_fer_hires, &
& imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, &
& imp_physics_gfdl, imp_physics_thompson, imp_physics_tempo, &
& imp_physics_wsm6, imp_physics_tempo, &
& imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, &
& imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, &
& iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, &
Expand Down
15 changes: 15 additions & 0 deletions physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
type = scheme
relative_path = ../../
dependencies = tools/funcphys.f90,hooks/machine.F
dependencies = MP/TEMPO/TEMPO/module_mp_tempo_params.F90,MP/TEMPO/TEMPO/module_mp_tempo_utils.F90
dependencies = MP/Thompson/module_mp_thompson.F90,MP/Thompson/module_mp_thompson_make_number_concentrations.F90
dependencies = Radiation/RRTMG/radcons.f90,Radiation/radiation_aerosols.f
dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f
Expand Down Expand Up @@ -266,6 +267,13 @@
dimensions = ()
type = ty_ozphys
intent = in
[tempo_cfg]
standard_name = configuration_for_TEMPO_microphysics
long_name = configuration information for TEMPO microphysics
units = mixed
dimensions = ()
type = ty_tempo_cfg
intent = in
[iaermdl]
standard_name = control_for_aerosol_radiation_scheme
long_name = control of aerosol scheme in radiation
Expand Down Expand Up @@ -469,6 +477,13 @@
dimensions = ()
type = integer
intent = in
[imp_physics_tempo]
standard_name = identifier_for_tempo_microphysics_scheme
long_name = choice of TEMPO microphysics scheme
units = flag
dimensions = ()
type = integer
intent = in
[imp_physics_gfdl]
standard_name = identifier_for_gfdl_microphysics_scheme
long_name = choice of GFDL microphysics scheme
Expand Down
32 changes: 26 additions & 6 deletions physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,9 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr

use machine, only: kind_phys
use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber
use module_mp_tempo_utils, only: &
make_IceNumber_tempo => make_IceNumber, &
make_DropletNumber_tempo => make_DropletNumber

implicit none

Expand Down Expand Up @@ -211,7 +214,8 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
enddo
endif

if (imp_physics == imp_physics_thompson .and. (ntlnc>0 .or. ntinc>0)) then
if ((imp_physics == imp_physics_thompson .or. imp_physics == imp_physics_tempo) .and. &
(ntlnc>0 .or. ntinc>0)) then
if_convert_dry_rho: if (convert_dry_rho) then
do k=1,levs
do i=1,im
Expand All @@ -225,16 +229,24 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k))
!> - Convert number concentration from moist to dry
nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k))
nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
if (imp_physics == imp_physics_thompson) then
nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
else
nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
endif
!> - Convert number concentrations from dry to moist
gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k))
endif
if (ntinc>0) then
!> - Convert moist mixing ratio to dry mixing ratio
qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k))
!> - Convert number concentration from moist to dry
ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k))
ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k))
if (imp_physics == imp_physics_thompson) then
ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
else
ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
endif
!> - Convert number concentrations from dry to moist
gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k))
endif
Expand All @@ -250,13 +262,21 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
!> - Update cloud water mixing ratio
qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k))
!> - Update cloud water number concentration
gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
if (imp_physics == imp_physics_thompson) then
gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
else
gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber_tempo(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
endif
endif
if (ntinc>0) then
!> - Update cloud ice mixing ratio
qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k))
!> - Update cloud ice number concentration
gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
if (imp_physics == imp_physics_thompson) then
gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
else
gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber_tempo(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
endif
endif
enddo
enddo
Expand Down
1 change: 1 addition & 0 deletions physics/Interstitials/UFS_SCM_NEPTUNE/GFS_suite_interstitial_4.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
type = scheme
relative_path = ../../
dependencies = hooks/machine.F
dependencies = MP/TEMPO/TEMPO/module_mp_tempo_utils.F90
dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90

########################################################################
Expand Down
7 changes: 6 additions & 1 deletion physics/Radiation/radiation_clouds.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -309,6 +309,8 @@ subroutine cld_init &
print *,' --- GFDL Lin cloud microphysics'
elseif (imp_physics == 8) then
print *,' --- Thompson cloud microphysics'
elseif (imp_physics == 88) then
print *,' --- TEMPO cloud microphysics'
elseif (imp_physics == 6) then
print *,' --- WSM6 cloud microphysics'
elseif (imp_physics == 10) then
Expand Down Expand Up @@ -343,6 +345,7 @@ subroutine radiation_clouds_prop &
& ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, ntclamt, &
& imp_physics, imp_physics_nssl, imp_physics_fer_hires, &
& imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, &
& imp_physics_tempo, &
& imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, &
& imp_physics_mg, iovr, iovr_rand, iovr_maxrand, iovr_max, &
& iovr_dcorr, iovr_exp, iovr_exprand, idcor, idcor_con, &
Expand Down Expand Up @@ -518,6 +521,7 @@ subroutine radiation_clouds_prop &
& imp_physics_fer_hires, ! Flag for fer-hires scheme
& imp_physics_gfdl, ! Flag for gfdl scheme
& imp_physics_thompson, ! Flag for thompsonscheme
& imp_physics_tempo, ! Flag for TEMPO scheme
& imp_physics_wsm6, ! Flag for wsm6 scheme
& imp_physics_zhao_carr, ! Flag for zhao-carr scheme
& imp_physics_zhao_carr_pdf, ! Flag for zhao-carr+PDF scheme
Expand Down Expand Up @@ -740,7 +744,8 @@ subroutine radiation_clouds_prop &
& cld_resnow)
endif ! MYNN PBL or GF

elseif(imp_physics == imp_physics_thompson) then ! Thompson MP
elseif(imp_physics == imp_physics_thompson &
& .or. imp_physics == imp_physics_tempo) then ! Thompson/TEMPO MP

if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf &
& .or. imfdeepcnv == imfdeepcnv_c3) then ! MYNN PBL or GF conv
Expand Down

0 comments on commit a2fc440

Please sign in to comment.