From 0dee324287f21b784a07b4a43f2386ca8adc01af Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 29 Apr 2024 21:41:07 +0000 Subject: [PATCH 1/8] Initial plumbing --- .../UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 | 26 +++++++-- .../UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta | 37 +++++++++++- .../UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 | 56 ++++++++++++------- physics/Radiation/RRTMG/radlw_main.F90 | 36 ++++++++++-- physics/Radiation/RRTMG/radlw_main.meta | 40 +++++++++++++ 5 files changed, 164 insertions(+), 31 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 767d3e534..176523259 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -35,7 +35,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& lmfshal, lcnorm, lmfdeep2, lcrick, fhswr, fhlwr, solhr, sup, con_eps, & epsm1, fvirt, rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, & tsfc, slmsk, prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, & - pert_clds, sppt_wts, sppt_amp, cnvw_in, cnvc_in, qgrs, aer_nm, dx, & + pert_clds, sppt_wts, sppt_amp, cnvw_in, cnvc_inout, qgrs, aer_nm, dx, & icloud, iaermdl, iaerflg, con_pi, con_g, con_ttp, con_thgni, si, & !inputs from here and above coszen, coszdg, effrl_inout, effri_inout, effrs_inout, & clouds1, clouds2, clouds3, clouds4, clouds5, qci_conv, & !in/out from here and above @@ -45,7 +45,8 @@ 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, & + cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, & errmsg, errflg) use machine, only: kind_phys @@ -83,6 +84,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& make_RainNumber ! For NRL Ozone use module_ozphys, only: ty_ozphys + + ! For convective-cloud to radiation cloud coupling (RRTMG uses RRTMGP code) + use GFS_rrtmgp_cloud_mp, only: cloud_mp_SAMF + implicit none integer, intent(in) :: im, levs, lm, lmk, lmp, ltp, & @@ -145,9 +150,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & tgrs, sfc_wts, & mg_cld, effrr_in, & - cnvw_in, cnvc_in, & + cnvw_in, & sppt_wts - + real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvc_inout + real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs real(kind=kind_phys), dimension(:,:,:), intent(inout) :: aer_nm @@ -197,6 +203,11 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& clouds8, & clouds9, & cldfra + real(kind=kind_phys), dimension(:,:), intent(out) :: & + cld_cnv_lwp, & + cld_cnv_reliq, & + cld_cnv_iwp, & + cld_cnv_reice real(kind=kind_phys), dimension(:), intent(out) :: cldfra2d real(kind=kind_phys), dimension(:,:), intent(out) :: cldsa @@ -941,7 +952,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ! but it looks like the Zhao-Carr-PDF scheme is not in the CCPP deltaq(i,k1) = 0.0!Tbd%phy_f3d(i,k,5) !GJF: this variable is not in phy_f3d anymore cnvw (i,k1) = cnvw_in(i,k) - cnvc (i,k1) = cnvc_in(i,k) + cnvc (i,k1) = cnvc_inout(i,k) enddo enddo elseif ((npdf3d == 0) .and. (ncnvcld3d == 1)) then ! all other microphysics with pdfcld = .false. and cnvcld = .true. @@ -995,6 +1006,11 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ! endif ! end_if_ntcw +!> - Call cloud_mp_SAMF() to calculate convective cloud properties. + call cloud_mp_SAMF(.false., .false., IM, LM, tlyr, plvl, plyr, & + qstl, rhly, cnvw_in, con_ttp, con_g, 200., cld_cnv_lwp, & + cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cnvc_inout) + !> - Call ppfbet() to perturb cld cover. if (pert_clds) then do i=1,im diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index 15039e822..47880783c 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -9,6 +9,7 @@ dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f,Radiation/radiation_cloud_overlap.F90 dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 dependencies = photochem/module_ozphys.F90 + dependencies = Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 ######################################################################## [ccpp-arg-table] @@ -957,14 +958,14 @@ type = real kind = kind_phys intent = in -[cnvc_in] +[cnvc_inout] standard_name = convective_cloud_area_fraction long_name = convective cloud cover in the phy_f3d array units = frac dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys - intent = in + intent = inout [qgrs] standard_name = tracer_concentration long_name = model layer mean tracer concentration @@ -1351,6 +1352,38 @@ type = real kind = kind_phys intent = out +[cld_cnv_lwp] + standard_name = convective_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[cld_cnv_iwp] + standard_name = convective_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[cld_cnv_reliq] + standard_name = mean_effective_radius_for_liquid_convective_cloud + long_name = mean effective radius for liquid convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out +[cld_cnv_reice] + standard_name = mean_effective_radius_for_ice_convective_cloud + long_name = mean effective radius for ice convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = out [cldsa] standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle,high, total and BL diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 index 79ae1559a..d28da495e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 @@ -20,15 +20,16 @@ module GFS_rrtmgp_cloud_mp real (kind_phys), parameter :: & cld_limit_lower = 0.001, & cld_limit_ovcst = 1.0 - 1.0e-8, & - reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) - reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) + reliq_def = 10.0 , & ! Default liq radius, in stratiform cloud, to 10 micron (used when effr_in=F) + reice_def = 50.0, & ! Default ice radius, in stratiform cloud, to 50 micron (used when effr_in=F) + reliqcnv_def = 10.0 , & ! Default liq radius, in convective cloud, to 10 micron (used when effr_in=F) + reicecnv_def = 50.0, & ! Default ice radius, in convective cloud, to 50 micron (used when effr_in=F) rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme public GFS_rrtmgp_cloud_mp_init, GFS_rrtmgp_cloud_mp_run, GFS_rrtmgp_cloud_mp_finalize - contains !>\defgroup gfs_rrtmgp_cloud_mp_mod GFS RRTMGP Cloud MP Module @@ -250,8 +251,8 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic ! SAMF scale & aerosol-aware mass-flux convective clouds? if (imfdeepcnv == imfdeepcnv_samf) then alpha0 = 200. - call cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, & - cnv_mixratio, con_ttp, con_g, alpha0, & + call cloud_mp_SAMF(.false., .false., nCol, nLev, t_lay, p_lev, p_lay, qs_lay, & + relhum, cnv_mixratio, con_ttp, con_g, alpha0, & cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_cnv_frac) endif @@ -470,24 +471,28 @@ end subroutine cloud_mp_MYNN !! cloud properties. LWP and IWP are computed. !! !! - The liquid and ice cloud effective particle sizes are assigned reference values. +!! (*NOTE* STUB in place to expand this using "cmp_Re") !! -!! - The convective cloud-fraction is computed using Xu-Randall (1996). -!! (DJS asks: Does the SAMF scheme produce a cloud-fraction?) +!! - If cmp_XuRndl = True, the convective cloud-fraction is computed using Xu-Randall (1996). +!! Otherwise, the cloud-fraction provided by the convection scheme is unperturbed. !! !! \section cloud_mp_SAMF_gen General Algorithm - subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, & - cnv_mixratio, con_ttp, con_g, alpha0, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & - cld_cnv_reice, cld_cnv_frac) + subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs_lay, & + relhum, cnv_mixratio, con_ttp, con_g, alpha0, & + cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_cnv_frac) implicit none ! Inputs + logical, intent(in) :: & + cmp_XuRndl, & ! Compute convective cloud fraction using Xu-Randall? + cmp_Re ! Compute liquid/ice particle sizes using ????? integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev ! Number of vertical layers real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravity (m s-2) con_ttp, & ! Triple point temperature of water (K) - alpha0 ! + alpha0 ! Parameter for Xu-Randall scheme. (-) real(kind_phys), dimension(:,:),intent(in) :: & t_lay, & ! Temperature at layer-centers (K) p_lev, & ! Pressure at layer-interfaces (Pa) @@ -510,20 +515,33 @@ subroutine cloud_mp_SAMF(nCol, nLev, t_lay, p_lev, p_lay, qs_lay, relhum, do iLay = 1, nLev do iCol = 1, nCol if (cnv_mixratio(iCol,iLay) > 0._kind_phys) then + ! Partition water paths by phase. tem1 = min(1.0, max(0.0, (con_ttp-t_lay(iCol,iLay))*0.05)) deltaP = abs(p_lev(iCol,iLay+1)-p_lev(iCol,iLay))*0.01 clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP cld_cnv_iwp(iCol,iLay) = clwc * tem1 cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) - cld_cnv_reliq(iCol,iLay) = reliq_def - cld_cnv_reice(iCol,iLay) = reice_def - ! Xu-Randall (1996) cloud-fraction. - cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), alpha0) - endif - enddo - enddo + ! Assign particles size(s). + if (cmp_Re) then + ! do something here a bit more fancy? + else + ! Assume default liquid/ice effective radius (microns) + cld_cnv_reliq(iCol,iLay) = reliqcnv_def + cld_cnv_reice(iCol,iLay) = reicecnv_def + endif + + ! Recompute cloud-fraction using Xu-Randall (1996)? + if (cmp_XuRndl) then + cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), alpha0) + else + ! Otherwise, cloud-fraction from convection scheme will pass through and + ! be used by the radiation. + endif + endif ! No juice. + enddo ! Columns + enddo ! Layers end subroutine cloud_mp_SAMF diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 7bc1ea80c..6b2d011e1 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -430,7 +430,9 @@ subroutine rrtmg_lw_run & & HLW0,HLWB,FLXPRF, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, errmsg, errflg & + & cld_od, & + & cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, & + & cld_cnv_frac, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -626,7 +628,8 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(:,:),intent(in),optional:: & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od + & cld_od, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & + & cld_cnv_reice, cld_cnv_frac real (kind=kind_phys), dimension(:), intent(in) :: sfemis, & & sfgtmp, de_lgth @@ -667,7 +670,7 @@ subroutine rrtmg_lw_run & & clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, & & coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, & & selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, & - & scaleminorn2, temcol, dz + & scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8, cldfrc_cnv real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay @@ -894,6 +897,12 @@ subroutine rrtmg_lw_run & cda2(k) = cld_ref_rain(iplon,k1) cda3(k) = cld_swp(iplon,k1) cda4(k) = cld_ref_snow(iplon,k1) + ! Radiatively active convective cloud? + cda5(k) = cld_cnv_lwp(iplon,k1) + cda6(k) = cld_cnv_reliq(iplon,k1) + cda7(k) = cld_cnv_iwp(iplon,k1) + cda8(k) = cld_cnv_reice(iplon,k1) + cldfrc_cnv(k) = cld_cnv_frac(iplon,k1) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1080,6 +1089,7 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & + & cldfrc_cnv, cda5, cda6, cda7, cda8, & & nlay, nlp1, ipseed(iplon), dz, delgth, iovr, alph, & & ilwcliq, ilwcice, isubclw, & ! --- outputs: @@ -1529,6 +1539,7 @@ end subroutine rlwinit !!\section gen_cldprop cldprop General Algorithm subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs + & cnv_cfrac, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & & nlay, nlp1, ipseed, dz, de_lgth, iovr, alpha, ilwcliq, & & ilwcice, isubclw, cldfmc, taucld & ! --- outputs & ) @@ -1558,6 +1569,11 @@ subroutine cldprop & ! cdat2 - real, layer cloud single scattering albedo nlay ! ! cdat3 - real, layer cloud asymmetry factor nlay ! ! cdat4 - real, optional use nlay ! +! cnv_cfrac - real, layer cloud (cnv) fraction 0:nlp1 ! +! cnv_cliqp - real, layer in-cloud (cnv) liq water path nlay ! +! cnv_reliq - real, mean eff radius for liq (cnv) cloud nlay ! +! cnv_cicep - real, layer in-cloud (cnv) ice water path nlay ! +! cnv_reice - real, mean eff radius for ice cloud (cnv) nlay ! ! cliqp - not used nlay ! ! reliq - not used nlay ! ! cicep - not used nlay ! @@ -1635,7 +1651,8 @@ subroutine cldprop & real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & - & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz + & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz, & + & cnv_cfrac, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice real (kind=kind_phys), intent(in) :: de_lgth real (kind=kind_phys), dimension(nlay), intent(in) :: alpha @@ -1782,7 +1799,16 @@ subroutine cldprop & enddo endif lab_if_cld - enddo lab_do_k + lab_if_cnvcld : if (cnv_cfrac(k) > cldmin) then + print*,'SWALES FOUND SOME CONVECTIVE CLOUD IN RRTMG' + endif lab_if_cnvcld + write(*,'(a10,2f15.8)') 'cfrac = ',cnv_cfrac(k),cfrac(k) + write(*,'(a10,2f15.8)') 'cliqp = ',cnv_cliqp(k),cliqp(k) + write(*,'(a10,2f15.8)') 'reliq = ',cnv_reliq(k),reliq(k) + write(*,'(a10,2f15.8)') 'cicep = ',cnv_cicep(k),cicep(k) + write(*,'(a10,2f15.8)') 'reice = ',cnv_reice(k),reice(k) + + enddo lab_do_k else lab_if_ilwcliq diff --git a/physics/Radiation/RRTMG/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta index f7c80fb20..6484888f8 100644 --- a/physics/Radiation/RRTMG/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -427,6 +427,46 @@ type = real kind = kind_phys intent = in +[cld_cnv_frac] + standard_name = convective_cloud_area_fraction + long_name = convective cloud cover in the phy_f3d array + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_lwp] + standard_name = convective_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_iwp] + standard_name = convective_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_reliq] + standard_name = mean_effective_radius_for_liquid_convective_cloud + long_name = mean effective radius for liquid convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cld_cnv_reice] + standard_name = mean_effective_radius_for_ice_convective_cloud + long_name = mean effective radius for ice convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From faf6a383ade2084531ad0492d7eb9685e7d4e5d9 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 29 Apr 2024 22:03:57 +0000 Subject: [PATCH 2/8] Some reorg --- .../UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 | 6 +- .../UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta | 3 +- .../UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 | 83 +--------- .../UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta | 1 + physics/Radiation/radiation_cloud_optics.F90 | 143 ++++++++++++++++++ 5 files changed, 148 insertions(+), 88 deletions(-) create mode 100644 physics/Radiation/radiation_cloud_optics.F90 diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 176523259..8faafee01 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -65,7 +65,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& & adjust_cloudIce, & & adjust_cloudH2O, & & adjust_cloudFinal - + use module_radiation_cloud_optics, only: cloud_mp_SAMF + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & @@ -84,9 +85,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& make_RainNumber ! For NRL Ozone use module_ozphys, only: ty_ozphys - - ! For convective-cloud to radiation cloud coupling (RRTMG uses RRTMGP code) - use GFS_rrtmgp_cloud_mp, only: cloud_mp_SAMF implicit none diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index 47880783c..9984c5a01 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -4,12 +4,11 @@ relative_path = ../../ dependencies = tools/funcphys.f90,hooks/machine.F 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/RRTMG/radcons.f90,Radiation/radiation_aerosols.f,Radiation/radiation_cloud_optics.F90 dependencies = Radiation/radiation_astronomy.f,Radiation/radiation_clouds.f,Radiation/radiation_gases.f dependencies = Radiation/RRTMG/radlw_param.f,Radiation/RRTMG/radsw_param.f,Radiation/radiation_cloud_overlap.F90 dependencies = SFC_Models/Land/Noah/surface_perturbation.F90 dependencies = photochem/module_ozphys.F90 - dependencies = Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 index d28da495e..102a7b628 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 @@ -9,6 +9,7 @@ module GFS_rrtmgp_cloud_mp use machine, only: kind_phys use radiation_tools, only: check_error_msg use module_radiation_clouds, only: progcld_thompson + use module_radiation_cloud_overlap, only: cloud_mp_SAMF use rrtmgp_lw_cloud_optics, only: & radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,& radice_lwr => radice_lwrLW, radice_upr => radice_uprLW @@ -463,88 +464,6 @@ subroutine cloud_mp_MYNN(nCol, nLev, lsmask, t_lay, p_lev, p_lay, qs_lay, relhum enddo end subroutine cloud_mp_MYNN - -!> \ingroup GFS_rrtmgp_cloud_mp -!! Compute cloud radiative properties for SAMF convective cloud scheme. -!! -!! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice -!! cloud properties. LWP and IWP are computed. -!! -!! - The liquid and ice cloud effective particle sizes are assigned reference values. -!! (*NOTE* STUB in place to expand this using "cmp_Re") -!! -!! - If cmp_XuRndl = True, the convective cloud-fraction is computed using Xu-Randall (1996). -!! Otherwise, the cloud-fraction provided by the convection scheme is unperturbed. -!! -!! \section cloud_mp_SAMF_gen General Algorithm - subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs_lay, & - relhum, cnv_mixratio, con_ttp, con_g, alpha0, & - cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_cnv_frac) - implicit none - - ! Inputs - logical, intent(in) :: & - cmp_XuRndl, & ! Compute convective cloud fraction using Xu-Randall? - cmp_Re ! Compute liquid/ice particle sizes using ????? - integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev ! Number of vertical layers - real(kind_phys), intent(in) :: & - con_g, & ! Physical constant: gravity (m s-2) - con_ttp, & ! Triple point temperature of water (K) - alpha0 ! Parameter for Xu-Randall scheme. (-) - real(kind_phys), dimension(:,:),intent(in) :: & - t_lay, & ! Temperature at layer-centers (K) - p_lev, & ! Pressure at layer-interfaces (Pa) - p_lay, & ! Presure at layer-centers (Pa) - qs_lay, & ! Specific-humidity at layer-centers (kg/kg) - relhum, & ! Relative-humidity (1) - cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) - ! Outputs - real(kind_phys), dimension(:,:),intent(inout) :: & - cld_cnv_lwp, & ! Convective cloud liquid water path - cld_cnv_reliq, & ! Convective cloud liquid effective radius - cld_cnv_iwp, & ! Convective cloud ice water path - cld_cnv_reice, & ! Convective cloud ice effecive radius - cld_cnv_frac ! Convective cloud-fraction - ! Local - integer :: iCol, iLay - real(kind_phys) :: tem0, tem1, deltaP, clwc - - tem0 = 1.0e5/con_g - do iLay = 1, nLev - do iCol = 1, nCol - if (cnv_mixratio(iCol,iLay) > 0._kind_phys) then - ! Partition water paths by phase. - tem1 = min(1.0, max(0.0, (con_ttp-t_lay(iCol,iLay))*0.05)) - deltaP = abs(p_lev(iCol,iLay+1)-p_lev(iCol,iLay))*0.01 - clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP - cld_cnv_iwp(iCol,iLay) = clwc * tem1 - cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) - - ! Assign particles size(s). - if (cmp_Re) then - ! do something here a bit more fancy? - else - ! Assume default liquid/ice effective radius (microns) - cld_cnv_reliq(iCol,iLay) = reliqcnv_def - cld_cnv_reice(iCol,iLay) = reicecnv_def - endif - - ! Recompute cloud-fraction using Xu-Randall (1996)? - if (cmp_XuRndl) then - cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), alpha0) - else - ! Otherwise, cloud-fraction from convection scheme will pass through and - ! be used by the radiation. - endif - endif ! No juice. - enddo ! Columns - enddo ! Layers - - end subroutine cloud_mp_SAMF - !> \ingroup GFS_rrtmgp_cloud_mp !! This routine computes the cloud radiative properties for a "unified cloud". !! - "unified cloud" implies that the cloud-fraction is PROVIDED. diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta index f67259b87..226aeae1d 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.meta @@ -4,6 +4,7 @@ relative_path = ../../ dependencies = hooks/machine.F dependencies = Radiation/radiation_tools.F90,Radiation/radiation_clouds.f,Radiation/RRTMGP/rrtmgp_lw_cloud_optics.F90 + dependencies = Radiation/radiation_cloud_optics.F90 dependencies = MP/Thompson/module_mp_thompson_make_number_concentrations.F90,MP/Thompson/module_mp_thompson.F90 ######################################################################## diff --git a/physics/Radiation/radiation_cloud_optics.F90 b/physics/Radiation/radiation_cloud_optics.F90 new file mode 100644 index 000000000..fe36b664f --- /dev/null +++ b/physics/Radiation/radiation_cloud_optics.F90 @@ -0,0 +1,143 @@ +module module_radiation_cloud_optics + use machine, only: kind_phys + implicit none + + real (kind_phys), parameter :: & + cld_limit_lower = 0.001, & + cld_limit_ovcst = 1.0 - 1.0e-8, & + reliq_def = 10.0 , & ! Default liq radius, in stratiform cloud, to 10 micron (used when effr_in=F) + reice_def = 50.0, & ! Default ice radius, in stratiform cloud, to 50 micron (used when effr_in=F) + reliqcnv_def = 10.0 , & ! Default liq radius, in convective cloud, to 10 micron (used when effr_in=F) + reicecnv_def = 50.0, & ! Default ice radius, in convective cloud, to 50 micron (used when effr_in=F) + rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) + resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) + reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme + reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme +contains + +!> \ingroup radiation_cloud_optics +!! Compute cloud radiative properties for SAMF convective cloud scheme. +!! +!! - The total-cloud convective mixing-ratio is partitioned by phase into liquid/ice +!! cloud properties. LWP and IWP are computed. +!! +!! - The liquid and ice cloud effective particle sizes are assigned reference values. +!! (*NOTE* STUB in place to expand this using "cmp_Re") +!! +!! - If cmp_XuRndl = True, the convective cloud-fraction is computed using Xu-Randall (1996). +!! Otherwise, the cloud-fraction provided by the convection scheme is unperturbed. +!! +!! \section cloud_mp_SAMF_gen General Algorithm + subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs_lay, & + relhum, cnv_mixratio, con_ttp, con_g, alpha0, & + cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_cnv_frac) + implicit none + + ! Inputs + logical, intent(in) :: & + cmp_XuRndl, & ! Compute convective cloud fraction using Xu-Randall? + cmp_Re ! Compute liquid/ice particle sizes using ????? + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev ! Number of vertical layers + real(kind_phys), intent(in) :: & + con_g, & ! Physical constant: gravity (m s-2) + con_ttp, & ! Triple point temperature of water (K) + alpha0 ! Parameter for Xu-Randall scheme. (-) + real(kind_phys), dimension(:,:),intent(in) :: & + t_lay, & ! Temperature at layer-centers (K) + p_lev, & ! Pressure at layer-interfaces (Pa) + p_lay, & ! Presure at layer-centers (Pa) + qs_lay, & ! Specific-humidity at layer-centers (kg/kg) + relhum, & ! Relative-humidity (1) + cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) + ! Outputs + real(kind_phys), dimension(:,:),intent(inout) :: & + cld_cnv_lwp, & ! Convective cloud liquid water path + cld_cnv_reliq, & ! Convective cloud liquid effective radius + cld_cnv_iwp, & ! Convective cloud ice water path + cld_cnv_reice, & ! Convective cloud ice effecive radius + cld_cnv_frac ! Convective cloud-fraction + ! Local + integer :: iCol, iLay + real(kind_phys) :: tem0, tem1, deltaP, clwc + + tem0 = 1.0e5/con_g + do iLay = 1, nLev + do iCol = 1, nCol + if (cnv_mixratio(iCol,iLay) > 0._kind_phys) then + ! Partition water paths by phase. + tem1 = min(1.0, max(0.0, (con_ttp-t_lay(iCol,iLay))*0.05)) + deltaP = abs(p_lev(iCol,iLay+1)-p_lev(iCol,iLay))*0.01 + clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP + cld_cnv_iwp(iCol,iLay) = clwc * tem1 + cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) + + ! Assign particles size(s). + if (cmp_Re) then + ! do something here a bit more fancy? + else + ! Assume default liquid/ice effective radius (microns) + cld_cnv_reliq(iCol,iLay) = reliqcnv_def + cld_cnv_reice(iCol,iLay) = reicecnv_def + endif + + ! Recompute cloud-fraction using Xu-Randall (1996)? + if (cmp_XuRndl) then + cld_cnv_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cnv_mixratio(iCol,iLay), alpha0) + else + ! Otherwise, cloud-fraction from convection scheme will pass through and + ! be used by the radiation. + endif + endif ! No juice. + enddo ! Columns + enddo ! Layers + + end subroutine cloud_mp_SAMF + +!> \ingroup radiation_cloud_optics +!! This function computes the cloud-fraction following. +!! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models +!! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 +!! +!! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P +!! +!! \section cld_frac_XuRandall_gen General Algorithm + function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) + implicit none + ! Inputs + real(kind_phys), intent(in) :: & + p_lay, & ! Pressure (Pa) + qs_lay, & ! Saturation vapor-pressure (Pa) + relhum, & ! Relative humidity + cld_mr, & ! Total cloud mixing ratio + alpha ! Scheme parameter (default=100) + + ! Outputs + real(kind_phys) :: cld_frac_XuRandall + + ! Locals + real(kind_phys) :: clwt, clwm, onemrh, tem1, tem2, tem3 + + ! Parameters + real(kind_phys) :: & + lambda = 0.50, & ! + P = 0.25 + + clwt = 1.0e-6 * (p_lay*0.001) + if (cld_mr > clwt) then + onemrh = max(1.e-10, 1.0 - relhum) + tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) + tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) + tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p + ! + cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) + else + cld_frac_XuRandall = 0.0 + endif + + return + end function cld_frac_XuRandall + +end module module_radiation_cloud_optics From cc92ab7e0241283c8d1cf12267aa422f06420f70 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 30 Apr 2024 14:35:28 +0000 Subject: [PATCH 3/8] Port in UFS, move to SCM --- physics/Radiation/RRTMG/radlw_main.F90 | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 6b2d011e1..c3ee1cd48 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -1797,17 +1797,11 @@ subroutine cldprop & do ib = 1, nbands taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw enddo - + write(*,'(a10,i5,5f15.8)') 'cloudmp - ',k,cfrac(k),cliqp(k),reliq(k),cicep(k),reice(k) endif lab_if_cld lab_if_cnvcld : if (cnv_cfrac(k) > cldmin) then - print*,'SWALES FOUND SOME CONVECTIVE CLOUD IN RRTMG' + write(*,'(a10,i5,5f15.8)') 'cloudcnv - ',k,cnv_cfrac(k),cnv_cliqp(k),cnv_reliq(k),cnv_cicep(k),cnv_reice(k) endif lab_if_cnvcld - write(*,'(a10,2f15.8)') 'cfrac = ',cnv_cfrac(k),cfrac(k) - write(*,'(a10,2f15.8)') 'cliqp = ',cnv_cliqp(k),cliqp(k) - write(*,'(a10,2f15.8)') 'reliq = ',cnv_reliq(k),reliq(k) - write(*,'(a10,2f15.8)') 'cicep = ',cnv_cicep(k),cicep(k) - write(*,'(a10,2f15.8)') 'reice = ',cnv_reice(k),reice(k) - enddo lab_do_k else lab_if_ilwcliq From 5b30fd1c389b2b211f0dcd8d4f7c12298ccc5058 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 30 Apr 2024 17:34:51 +0000 Subject: [PATCH 4/8] LW working --- physics/Radiation/RRTMG/radlw_main.F90 | 93 ++++++++++++++++++-- physics/Radiation/radiation_cloud_optics.F90 | 8 +- physics/Radiation/radiation_clouds.f | 7 +- 3 files changed, 93 insertions(+), 15 deletions(-) diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index c3ee1cd48..4ddebbbff 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -659,7 +659,7 @@ subroutine rrtmg_lw_run & & intent(inout) :: flxprf ! --- locals: - real (kind=kind_phys), dimension(0:nlp1) :: cldfrc + real (kind=kind_phys), dimension(0:nlp1) :: cldfrc, cldfrc_cnv real (kind=kind_phys), dimension(0:nlay) :: totuflux, totdflux, & & totuclfl, totdclfl, tz @@ -670,7 +670,7 @@ subroutine rrtmg_lw_run & & clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, & & coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, & & selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, & - & scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8, cldfrc_cnv + & scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8 real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay @@ -914,7 +914,9 @@ subroutine rrtmg_lw_run & cldfrc(0) = f_one ! padding value only cldfrc(nlp1) = f_zero ! padding value only - + cldfrc_cnv(0) = f_one + cldfrc_cnv(nlp1) = f_zero + !> -# Compute precipitable water vapor for diffusivity angle adjustments. tem1 = f_zero @@ -1010,6 +1012,12 @@ subroutine rrtmg_lw_run & cda2(k) = cld_ref_rain(iplon,k) cda3(k) = cld_swp(iplon,k) cda4(k) = cld_ref_snow(iplon,k) + ! Radiatively active convective cloud? + cda5(k) = cld_cnv_lwp(iplon,k) + cda6(k) = cld_cnv_reliq(iplon,k) + cda7(k) = cld_cnv_iwp(iplon,k) + cda8(k) = cld_cnv_reice(iplon,k) + cldfrc_cnv(k) = cld_cnv_frac(iplon,k) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1021,6 +1029,8 @@ subroutine rrtmg_lw_run & cldfrc(0) = f_one ! padding value only cldfrc(nlp1) = f_zero ! padding value only + cldfrc_cnv(0) = f_one + cldfrc_cnv(nlp1) = f_zero ! --- ... compute precipitable water vapor for diffusivity angle adjustments tem1 = f_zero @@ -1649,10 +1659,10 @@ subroutine cldprop & integer, intent(in) :: nlay, nlp1, ipseed, iovr, ilwcliq, ilwcice,& isubclw - real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac + real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac,cnv_cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz, & - & cnv_cfrac, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice real (kind=kind_phys), intent(in) :: de_lgth real (kind=kind_phys), dimension(nlay), intent(in) :: alpha @@ -1797,10 +1807,77 @@ subroutine cldprop & do ib = 1, nbands taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw enddo - write(*,'(a10,i5,5f15.8)') 'cloudmp - ',k,cfrac(k),cliqp(k),reliq(k),cicep(k),reice(k) endif lab_if_cld - lab_if_cnvcld : if (cnv_cfrac(k) > cldmin) then - write(*,'(a10,i5,5f15.8)') 'cloudcnv - ',k,cnv_cfrac(k),cnv_cliqp(k),cnv_reliq(k),cnv_cicep(k),cnv_reice(k) + ! ##################################################################################### + ! + ! Do we have any convective clouds in this layer? + ! If so, + ! - Compute cloud-optical properties using the convective condensate, and assumed size. + ! - Add radiative contribution from convective cloud to total cloud radiative properties. + ! + ! ##################################################################################### + lab_if_cnvcld : if (cnv_cliqp(k)+cnv_cliqp(k) > 0._kind_phys) then + ! calculation of absorption coefficients due to convective water clouds. + if ( cnv_cliqp(k) <= f_zero ) then + do ib = 1, nbands + tauliq(ib) = f_zero + enddo + else + if ( ilwcliq == 1 ) then + factor = cnv_reliq(k) - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + do ib = 1, nbands + tauliq(ib) = max(f_zero, cnv_cliqp(k)*(absliq1(index,ib) + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) + enddo + endif ! end if_ilwcliq_block + endif ! end if_cldliq_block + + ! calculation of absorption coefficients due to ice clouds. + if ( cnv_cicep(k) <= f_zero ) then + do ib = 1, nbands + tauice(ib) = f_zero + enddo + else + ! ebert and curry approach for all particle sizes though somewhat + ! unjustified for large ice particles + if ( ilwcice == 1 ) then + refice = min(130.0, max(13.0, real(cnv_reice(k)) )) + + do ib = 1, nbands + ia = ipat(ib) ! eb_&_c band index for ice cloud coeff + tauice(ib) = max(f_zero, cnv_cicep(k)*(absice1(1,ia) + absice1(2,ia)/refice) ) + enddo + + ! streamer approach for ice effective radius between 5.0 and 131.0 microns + ! and ebert and curry approach for ice eff radius greater than 131.0 microns. + ! no smoothing between the transition of the two methods. + elseif ( ilwcice == 2 ) then + factor = (cnv_reice(k) - 2.0) / 3.0 + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + + do ib = 1, nbands + tauice(ib) = max(f_zero, cnv_cicep(k)*(absice2(index,ib) + fint*(absice2(index+1,ib) - absice2(index,ib)) )) + enddo + + ! fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns) + elseif ( ilwcice == 3 ) then + dgeice = max(5.0, 1.0315*cnv_reice(k)) + factor = (dgeice - 2.0) / 3.0 + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + + do ib = 1, nbands + tauice(ib) = max(f_zero, cnv_cicep(k)*(absice3(index,ib) + fint*(absice3(index+1,ib) - absice3(index,ib)) )) + enddo + endif ! end if_ilwcice_block + endif ! end if_cnv_cicep_block + ! + do ib = 1, nbands + taucld(ib,k) = taucld(ib,k) + tauice(ib) + tauliq(ib) + enddo endif lab_if_cnvcld enddo lab_do_k diff --git a/physics/Radiation/radiation_cloud_optics.F90 b/physics/Radiation/radiation_cloud_optics.F90 index fe36b664f..564b46a31 100644 --- a/physics/Radiation/radiation_cloud_optics.F90 +++ b/physics/Radiation/radiation_cloud_optics.F90 @@ -52,11 +52,12 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs relhum, & ! Relative-humidity (1) cnv_mixratio ! Convective cloud mixing-ratio (kg/kg) ! Outputs - real(kind_phys), dimension(:,:),intent(inout) :: & + real(kind_phys), dimension(:,:),intent(out) :: & cld_cnv_lwp, & ! Convective cloud liquid water path cld_cnv_reliq, & ! Convective cloud liquid effective radius cld_cnv_iwp, & ! Convective cloud ice water path - cld_cnv_reice, & ! Convective cloud ice effecive radius + cld_cnv_reice ! Convective cloud ice effecive radius + real(kind_phys), dimension(:,:),intent(inout) :: & cld_cnv_frac ! Convective cloud-fraction ! Local integer :: iCol, iLay @@ -72,7 +73,7 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP cld_cnv_iwp(iCol,iLay) = clwc * tem1 cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) - + ! Assign particles size(s). if (cmp_Re) then ! do something here a bit more fancy? @@ -89,6 +90,7 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs else ! Otherwise, cloud-fraction from convection scheme will pass through and ! be used by the radiation. + !cld_cnv_frac(iCol,iLay) = 1._kind_phys endif endif ! No juice. enddo ! Columns diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index 979405cdb..f73c3b26d 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -2122,11 +2122,10 @@ subroutine progcld_thompson_wsm6 & ! clwf(i,k) = clw(i,k) ! enddo ! enddo -! endif - +! endif + !> - Include grid-mean suspended cloud condensate in Xu-Randall cloud fraction !> if xr_cnvcld is true: - if(xr_cnvcld)then do k = 1, NLAY do i = 1, IX @@ -2142,7 +2141,7 @@ subroutine progcld_thompson_wsm6 & enddo enddo endif - + !> - Compute total-cloud liquid/ice condensate path in \f$ g/m^2 \f$. !> The total condensate includes convective condensate. do k = 1, NLAY-1 From 5b8e001200810b34eea0d9b69c393343291c3819 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 2 May 2024 17:12:42 +0000 Subject: [PATCH 5/8] Added convective cloud to SW radiation, plus nml control. --- physics/Radiation/RRTMG/radlw_main.F90 | 44 ++++---- physics/Radiation/RRTMG/radlw_main.meta | 21 ++-- physics/Radiation/RRTMG/radsw_main.F90 | 132 ++++++++++++++++++++++-- physics/Radiation/RRTMG/radsw_main.meta | 39 +++++++ 4 files changed, 194 insertions(+), 42 deletions(-) diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 4ddebbbff..6b9ebf0b7 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -431,8 +431,8 @@ subroutine rrtmg_lw_run & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & & cld_od, & - & cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, & - & cld_cnv_frac, errmsg, errflg & + & add_cnvcld, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, & + & cnvcld_reice, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -613,7 +613,7 @@ subroutine rrtmg_lw_run & iovr_maxrand, iovr_max integer, intent(in) :: icseed(npts) - logical, intent(in) :: lprnt, inc_minor_gas + logical, intent(in) :: lprnt, inc_minor_gas, add_cnvcld real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, & & tlvl @@ -628,8 +628,7 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(:,:),intent(in),optional:: & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & - & cld_cnv_reice, cld_cnv_frac + & cld_od, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice real (kind=kind_phys), dimension(:), intent(in) :: sfemis, & & sfgtmp, de_lgth @@ -659,7 +658,7 @@ subroutine rrtmg_lw_run & & intent(inout) :: flxprf ! --- locals: - real (kind=kind_phys), dimension(0:nlp1) :: cldfrc, cldfrc_cnv + real (kind=kind_phys), dimension(0:nlp1) :: cldfrc real (kind=kind_phys), dimension(0:nlay) :: totuflux, totdflux, & & totuclfl, totdclfl, tz @@ -898,11 +897,10 @@ subroutine rrtmg_lw_run & cda3(k) = cld_swp(iplon,k1) cda4(k) = cld_ref_snow(iplon,k1) ! Radiatively active convective cloud? - cda5(k) = cld_cnv_lwp(iplon,k1) - cda6(k) = cld_cnv_reliq(iplon,k1) - cda7(k) = cld_cnv_iwp(iplon,k1) - cda8(k) = cld_cnv_reice(iplon,k1) - cldfrc_cnv(k) = cld_cnv_frac(iplon,k1) + cda5(k) = cnvcld_lwp(iplon,k1) + cda6(k) = cnvcld_reliq(iplon,k1) + cda7(k) = cnvcld_iwp(iplon,k1) + cda8(k) = cnvcld_reice(iplon,k1) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -914,8 +912,6 @@ subroutine rrtmg_lw_run & cldfrc(0) = f_one ! padding value only cldfrc(nlp1) = f_zero ! padding value only - cldfrc_cnv(0) = f_one - cldfrc_cnv(nlp1) = f_zero !> -# Compute precipitable water vapor for diffusivity angle adjustments. @@ -1013,11 +1009,10 @@ subroutine rrtmg_lw_run & cda3(k) = cld_swp(iplon,k) cda4(k) = cld_ref_snow(iplon,k) ! Radiatively active convective cloud? - cda5(k) = cld_cnv_lwp(iplon,k) - cda6(k) = cld_cnv_reliq(iplon,k) - cda7(k) = cld_cnv_iwp(iplon,k) - cda8(k) = cld_cnv_reice(iplon,k) - cldfrc_cnv(k) = cld_cnv_frac(iplon,k) + cda5(k) = cnvcld_lwp(iplon,k) + cda6(k) = cnvcld_reliq(iplon,k) + cda7(k) = cnvcld_iwp(iplon,k) + cda8(k) = cnvcld_reice(iplon,k) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1029,8 +1024,6 @@ subroutine rrtmg_lw_run & cldfrc(0) = f_one ! padding value only cldfrc(nlp1) = f_zero ! padding value only - cldfrc_cnv(0) = f_one - cldfrc_cnv(nlp1) = f_zero ! --- ... compute precipitable water vapor for diffusivity angle adjustments tem1 = f_zero @@ -1099,7 +1092,7 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & cldfrc_cnv, cda5, cda6, cda7, cda8, & + & add_cnvcld, cda5, cda6, cda7, cda8, & & nlay, nlp1, ipseed(iplon), dz, delgth, iovr, alph, & & ilwcliq, ilwcice, isubclw, & ! --- outputs: @@ -1549,7 +1542,7 @@ end subroutine rlwinit !!\section gen_cldprop cldprop General Algorithm subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & cnv_cfrac, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & + & add_cnvcld, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & & nlay, nlp1, ipseed, dz, de_lgth, iovr, alpha, ilwcliq, & & ilwcice, isubclw, cldfmc, taucld & ! --- outputs & ) @@ -1579,7 +1572,7 @@ subroutine cldprop & ! cdat2 - real, layer cloud single scattering albedo nlay ! ! cdat3 - real, layer cloud asymmetry factor nlay ! ! cdat4 - real, optional use nlay ! -! cnv_cfrac - real, layer cloud (cnv) fraction 0:nlp1 ! +! add_cnvcld - logical, flag to add convective cloud ! ! cnv_cliqp - real, layer in-cloud (cnv) liq water path nlay ! ! cnv_reliq - real, mean eff radius for liq (cnv) cloud nlay ! ! cnv_cicep - real, layer in-cloud (cnv) ice water path nlay ! @@ -1659,7 +1652,8 @@ subroutine cldprop & integer, intent(in) :: nlay, nlp1, ipseed, iovr, ilwcliq, ilwcice,& isubclw - real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac,cnv_cfrac + logical, intent(in) :: add_cnvcld + real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz, & & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice @@ -1816,7 +1810,7 @@ subroutine cldprop & ! - Add radiative contribution from convective cloud to total cloud radiative properties. ! ! ##################################################################################### - lab_if_cnvcld : if (cnv_cliqp(k)+cnv_cliqp(k) > 0._kind_phys) then + lab_if_cnvcld : if (add_cnvcld .and. cnv_cliqp(k)+cnv_cicep(k) > 0._kind_phys) then ! calculation of absorption coefficients due to convective water clouds. if ( cnv_cliqp(k) <= f_zero ) then do ib = 1, nbands diff --git a/physics/Radiation/RRTMG/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta index 6484888f8..09ab3adec 100644 --- a/physics/Radiation/RRTMG/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -427,15 +427,14 @@ type = real kind = kind_phys intent = in -[cld_cnv_frac] - standard_name = convective_cloud_area_fraction - long_name = convective cloud cover in the phy_f3d array - units = frac - dimensions = (horizontal_loop_extent,vertical_layer_dimension) - type = real - kind = kind_phys +[add_cnvcld] + standard_name = flag_to_include_convective_condensate_in_longwave_radiation + long_name = flag to include convective condensate in longwave radiation calculation + units = flag + dimensions = () + type = logical intent = in -[cld_cnv_lwp] +[cnvcld_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path units = g m-2 @@ -443,7 +442,7 @@ type = real kind = kind_phys intent = in -[cld_cnv_iwp] +[cnvcld_iwp] standard_name = convective_cloud_ice_water_path long_name = layer convective cloud ice water path units = g m-2 @@ -451,7 +450,7 @@ type = real kind = kind_phys intent = in -[cld_cnv_reliq] +[cnvcld_reliq] standard_name = mean_effective_radius_for_liquid_convective_cloud long_name = mean effective radius for liquid convective cloud units = um @@ -459,7 +458,7 @@ type = real kind = kind_phys intent = in -[cld_cnv_reice] +[cnvcld_reice] standard_name = mean_effective_radius_for_ice_convective_cloud long_name = mean effective radius for ice convective cloud units = um diff --git a/physics/Radiation/RRTMG/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 index fe63963f5..afeede988 100644 --- a/physics/Radiation/RRTMG/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -506,7 +506,8 @@ subroutine rrtmg_sw_run & & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy, errmsg, errflg & + & cld_od, cld_ssa, cld_asy, add_cnvcld, cnvcld_lwp, & + & cnvcld_reliq, cnvcld_iwp, cnvcld_reice, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -692,7 +693,8 @@ subroutine rrtmg_sw_run & integer, dimension(:), intent(in) :: idxday, icseed logical, intent(in) :: lprnt, lsswr, inc_minor_gas, top_at_1 - + logical, intent(in) :: add_cnvcld + real (kind=kind_phys), dimension(:,:), intent(in) :: & & plvl, tlvl real (kind=kind_phys), dimension(:,:), intent(in) :: & @@ -717,7 +719,8 @@ subroutine rrtmg_sw_run & real (kind=kind_phys), dimension(:,:),intent(in),optional:: & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy + & cld_od, cld_ssa, cld_asy, & + & cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice real(kind=kind_phys),dimension(:,:,:),intent(in)::aeraod real(kind=kind_phys),dimension(:,:,:),intent(in)::aerssa @@ -765,7 +768,7 @@ subroutine rrtmg_sw_run & & pavel, tavel, coldry, colmol, h2ovmr, o3vmr, temcol, & & cliqp, reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, & & cfrac, fac00, fac01, fac10, fac11, forfac, forfrac, & - & selffac, selffrac, rfdelp, dz + & selffac, selffrac, rfdelp, dz, cdat5, cdat6, cdat7, cdat8 real (kind=kind_phys), dimension(nlp1) :: fnet, flxdc, flxuc, & & flxd0, flxu0 @@ -988,6 +991,11 @@ subroutine rrtmg_sw_run & cdat2(k) = cld_ref_rain(j1,kk) ! rain partical effctive radius cdat3(k) = cld_swp(j1,kk) ! cloud snow path cdat4(k) = cld_ref_snow(j1,kk) ! snow partical effctive radius + ! Radiatively active convective cloud? + cdat5(k) = cnvcld_lwp(j1,kk) + cdat6(k) = cnvcld_reliq(j1,kk) + cdat7(k) = cnvcld_iwp(j1,kk) + cdat8(k) = cnvcld_reice(j1,kk) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1081,6 +1089,11 @@ subroutine rrtmg_sw_run & cdat2(k) = cld_ref_rain(j1,k) ! rain partical effctive radius cdat3(k) = cld_swp(j1,k) ! cloud snow path cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius + ! Radiatively active convective cloud? + cdat5(k) = cnvcld_lwp(j1,kk) + cdat6(k) = cnvcld_reliq(j1,kk) + cdat7(k) = cnvcld_iwp(j1,kk) + cdat8(k) = cnvcld_reice(j1,kk) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1132,6 +1145,7 @@ subroutine rrtmg_sw_run & call cldprop & ! --- inputs: & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & + & add_cnvcld, cdat5, cdat6, cdat7, cdat8, & & zcf1, nlay, ipseed(j1), dz, delgth, alph, iswcliq, iswcice,& & isubcsw, iovr, & ! --- outputs: @@ -1565,6 +1579,7 @@ end subroutine rswinit !!\section General_cldprop cldprop General Algorithm subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs + & add_cnvcld, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & & cf1, nlay, ipseed, dz, delgth, alpha, iswcliq, iswcice, & & isubcsw, iovr, taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1654,10 +1669,12 @@ subroutine cldprop & ! --- inputs: integer, intent(in) :: nlay, ipseed, iswcliq, iswcice, isubcsw, & iovr + logical, intent(in) :: add_cnvcld real (kind=kind_phys), intent(in) :: cf1, delgth real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & - & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz + & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz,& + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice real (kind=kind_phys), dimension(nlay), intent(in) :: alpha ! --- outputs: @@ -1881,7 +1898,110 @@ subroutine cldprop & enddo endif lab_if_cld - enddo lab_do_k + ! ##################################################################################### + ! + ! Do we have any convective clouds in this layer? + ! If so, + ! - Compute cloud-optical properties using the convective condensate, and assumed size. + ! - Add radiative contribution from convective cloud to total cloud radiative properties. + ! + ! ##################################################################################### + lab_if_cnvcld : if (add_cnvcld .and. cnv_cliqp(k)+cnv_cicep(k) > 0._kind_phys) then + ! Calculation of absorption coefficients due to convective water clouds. + if ( cnv_cliqp <= f_zero ) then + do ib = nblow, nbhgh + tauliq(ib) = f_zero + ssaliq(ib) = f_zero + asyliq(ib) = f_zero + enddo + else + factor = cnv_reliq - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + + if ( iswcliq == 1 ) then + do ib = nblow, nbhgh + extcoliq = max(f_zero, extliq1(index,ib) + fint*(extliq1(index+1,ib)-extliq1(index,ib)) ) + ssacoliq = max(f_zero, min(f_one, ssaliq1(index,ib) + fint*(ssaliq1(index+1,ib)-ssaliq1(index,ib)) )) + asycoliq = max(f_zero, min(f_one, asyliq1(index,ib) + fint*(asyliq1(index+1,ib)-asyliq1(index,ib)) )) + tauliq(ib) = cnv_cliqp * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq + enddo + elseif ( iswcliq == 2 ) then ! use updated coeffs + do ib = nblow, nbhgh + extcoliq = max(f_zero, extliq2(index,ib) + fint*(extliq2(index+1,ib)-extliq2(index,ib)) ) + ssacoliq = max(f_zero, min(f_one, ssaliq2(index,ib) + fint*(ssaliq2(index+1,ib)-ssaliq2(index,ib)) )) + asycoliq = max(f_zero, min(f_one, asyliq2(index,ib) + fint*(asyliq2(index+1,ib)-asyliq2(index,ib)) )) + tauliq(ib) = cnv_cliqp * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq + enddo + endif ! end if_iswcliq_block + endif ! end if_cldliq_block + ! Calculation of absorption coefficients due to ice clouds. + if ( cnv_cicep <= f_zero ) then + do ib = nblow, nbhgh + tauice(ib) = f_zero + ssaice(ib) = f_zero + asyice(ib) = f_zero + enddo + else + ! Ebert and curry approach for all particle sizes though somewhat + ! unjustified for large ice particles. + if ( iswcice == 1 ) then + refice = min(130.0_kind_phys,max(13.0_kind_phys,cnv_reice)) + do ib = nblow, nbhgh + ia = idxebc(ib) ! eb_&_c band index for ice cloud coeff + extcoice = max(f_zero, abari(ia)+bbari(ia)/refice ) + ssacoice = max(f_zero, min(f_one, f_one-cbari(ia)-dbari(ia)*refice )) + asycoice = max(f_zero, min(f_one, ebari(ia)+fbari(ia)*refice )) + tauice(ib) = cnv_cicep * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice + enddo + ! Streamer approach for ice effective radius between 5.0 and 131.0 microns. + elseif ( iswcice == 2 ) then + refice = min(131.0_kind_phys,max(5.0_kind_phys,cnv_reice)) + factor = (refice - 2.0) / 3.0 + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + do ib = nblow, nbhgh + extcoice = max(f_zero, extice2(index,ib) + fint*(extice2(index+1,ib)-extice2(index,ib)) ) + ssacoice = max(f_zero, min(f_one, ssaice2(index,ib) + fint*(ssaice2(index+1,ib)-ssaice2(index,ib)) )) + asycoice = max(f_zero, min(f_one, asyice2(index,ib) + fint*(asyice2(index+1,ib)-asyice2(index,ib)) )) + tauice(ib) = cnv_cicep * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice + enddo + ! Fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns). + elseif ( iswcice == 3 ) then + dgeice = max( 5.0, min( 140.0, 1.0315*cnv_reice )) + factor = (dgeice - 2.0) / 3.0 + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + do ib = nblow, nbhgh + extcoice = max(f_zero, extice3(index,ib) + fint*(extice3(index+1,ib)-extice3(index,ib)) ) + ssacoice = max(f_zero, min(f_one, ssaice3(index,ib) + fint*(ssaice3(index+1,ib)-ssaice3(index,ib)) )) + asycoice = max(f_zero, min(f_one, asyice3(index,ib) + fint*(asyice3(index+1,ib)-asyice3(index,ib)) )) + tauice(ib) = cnv_cicep * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice + enddo + endif ! end if_iswcice_block + endif ! end if_cnv_cicep_block + + ! Increment optics. + do ib = 1, nbdsw + jb = nblow + ib - 1 + taucw(k,ib) = taucw(k,ib) + tauliq(jb) + tauice(jb) + ssacw(k,ib) = ssacw(k,ib) + ssaliq(jb) + ssaice(jb) + asycw(k,ib) = asycw(k,ib) + asyliq(jb) + asyice(jb) + enddo + + endif lab_if_cnvcld + enddo lab_do_k else lab_if_iswcliq diff --git a/physics/Radiation/RRTMG/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta index 2169a26f0..2ff13a19e 100644 --- a/physics/Radiation/RRTMG/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -495,6 +495,45 @@ type = real kind = kind_phys intent = in +[add_cnvcld] + standard_name = flag_to_include_convective_condensate_in_shortwave_radiation + long_name = flag to include convective condensate in shortwave radiation calculation + units = flag + dimensions = () + type = logical + intent = in +[cnvcld_lwp] + standard_name = convective_cloud_liquid_water_path + long_name = layer convective cloud liquid water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cnvcld_iwp] + standard_name = convective_cloud_ice_water_path + long_name = layer convective cloud ice water path + units = g m-2 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cnvcld_reliq] + standard_name = mean_effective_radius_for_liquid_convective_cloud + long_name = mean effective radius for liquid convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[cnvcld_reice] + standard_name = mean_effective_radius_for_ice_convective_cloud + long_name = mean effective radius for ice convective cloud + units = um + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From dba9fd43f634d55454c602fda9af505dbf2e46f2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 2 May 2024 17:38:47 +0000 Subject: [PATCH 6/8] Add nml options to scale convective cloud properties. --- physics/Radiation/RRTMG/radlw_main.F90 | 16 +++++++++----- physics/Radiation/RRTMG/radlw_main.meta | 14 ++++++++++++ physics/Radiation/RRTMG/radsw_main.F90 | 29 ++++++++++++++----------- physics/Radiation/RRTMG/radsw_main.meta | 14 ++++++++++++ 4 files changed, 54 insertions(+), 19 deletions(-) diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index 6b9ebf0b7..ecb8704c6 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -431,8 +431,9 @@ subroutine rrtmg_lw_run & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & & cld_od, & - & add_cnvcld, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, & - & cnvcld_reice, errmsg, errflg & + & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & + & cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice, & + & errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -613,7 +614,8 @@ subroutine rrtmg_lw_run & iovr_maxrand, iovr_max integer, intent(in) :: icseed(npts) - logical, intent(in) :: lprnt, inc_minor_gas, add_cnvcld + logical, intent(in) :: lprnt, inc_minor_gas, add_cnvcld, & + & scale_ccld_cndste, scale_ccld_optics real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, & & tlvl @@ -1092,7 +1094,8 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & add_cnvcld, cda5, cda6, cda7, cda8, & + & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & + & cda5, cda6, cda7, cda8, & & nlay, nlp1, ipseed(iplon), dz, delgth, iovr, alph, & & ilwcliq, ilwcice, isubclw, & ! --- outputs: @@ -1542,7 +1545,8 @@ end subroutine rlwinit !!\section gen_cldprop cldprop General Algorithm subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & add_cnvcld, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & + & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & & nlay, nlp1, ipseed, dz, de_lgth, iovr, alpha, ilwcliq, & & ilwcice, isubclw, cldfmc, taucld & ! --- outputs & ) @@ -1652,7 +1656,7 @@ subroutine cldprop & integer, intent(in) :: nlay, nlp1, ipseed, iovr, ilwcliq, ilwcice,& isubclw - logical, intent(in) :: add_cnvcld + logical, intent(in) :: add_cnvcld, scale_ccld_cndste, scale_ccld_optics real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz, & diff --git a/physics/Radiation/RRTMG/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta index 09ab3adec..0f2480aae 100644 --- a/physics/Radiation/RRTMG/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -434,6 +434,20 @@ dimensions = () type = logical intent = in +[scale_ccld_cndste] + standard_name = flag_to_scale_convective_condensate_in_radiation_by_convective_updraft_fraction + long_name = flag to scale convective condensate see by radiation using the convective updraft fraction + units = flag + dimensions = () + type = logical + intent = in +[scale_ccld_optics] + standard_name = flag_to_scale_convective_cloud_optics_by_convective_updraft_fraction + long_name = flag to scale convective cloud optics see by radiation using the convective updraft fraction + units = flag + dimensions = () + type = logical + intent = in [cnvcld_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path diff --git a/physics/Radiation/RRTMG/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 index afeede988..794b52958 100644 --- a/physics/Radiation/RRTMG/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -506,8 +506,9 @@ subroutine rrtmg_sw_run & & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy, add_cnvcld, cnvcld_lwp, & - & cnvcld_reliq, cnvcld_iwp, cnvcld_reice, errmsg, errflg & + & cld_od, cld_ssa, cld_asy, add_cnvcld, scale_ccld_cndste, & + & scale_ccld_optics, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, & + & cnvcld_reice, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -693,7 +694,7 @@ subroutine rrtmg_sw_run & integer, dimension(:), intent(in) :: idxday, icseed logical, intent(in) :: lprnt, lsswr, inc_minor_gas, top_at_1 - logical, intent(in) :: add_cnvcld + logical, intent(in) :: add_cnvcld, scale_ccld_cndste, scale_ccld_optics real (kind=kind_phys), dimension(:,:), intent(in) :: & & plvl, tlvl @@ -1145,7 +1146,8 @@ subroutine rrtmg_sw_run & call cldprop & ! --- inputs: & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & - & add_cnvcld, cdat5, cdat6, cdat7, cdat8, & + & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, cdat5, & + & cdat6, cdat7, cdat8, & & zcf1, nlay, ipseed(j1), dz, delgth, alph, iswcliq, iswcice,& & isubcsw, iovr, & ! --- outputs: @@ -1579,7 +1581,8 @@ end subroutine rswinit !!\section General_cldprop cldprop General Algorithm subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & add_cnvcld, cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & + & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & & cf1, nlay, ipseed, dz, delgth, alpha, iswcliq, iswcice, & & isubcsw, iovr, taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1669,7 +1672,7 @@ subroutine cldprop & ! --- inputs: integer, intent(in) :: nlay, ipseed, iswcliq, iswcice, isubcsw, & iovr - logical, intent(in) :: add_cnvcld + logical, intent(in) :: add_cnvcld, scale_ccld_cndste, scale_ccld_optics real (kind=kind_phys), intent(in) :: cf1, delgth real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & @@ -1908,7 +1911,7 @@ subroutine cldprop & ! ##################################################################################### lab_if_cnvcld : if (add_cnvcld .and. cnv_cliqp(k)+cnv_cicep(k) > 0._kind_phys) then ! Calculation of absorption coefficients due to convective water clouds. - if ( cnv_cliqp <= f_zero ) then + if ( cnv_cliqp(k) <= f_zero ) then do ib = nblow, nbhgh tauliq(ib) = f_zero ssaliq(ib) = f_zero @@ -1924,7 +1927,7 @@ subroutine cldprop & extcoliq = max(f_zero, extliq1(index,ib) + fint*(extliq1(index+1,ib)-extliq1(index,ib)) ) ssacoliq = max(f_zero, min(f_one, ssaliq1(index,ib) + fint*(ssaliq1(index+1,ib)-ssaliq1(index,ib)) )) asycoliq = max(f_zero, min(f_one, asyliq1(index,ib) + fint*(asyliq1(index+1,ib)-asyliq1(index,ib)) )) - tauliq(ib) = cnv_cliqp * extcoliq + tauliq(ib) = cnv_cliqp(k) * extcoliq ssaliq(ib) = tauliq(ib) * ssacoliq asyliq(ib) = ssaliq(ib) * asycoliq enddo @@ -1933,14 +1936,14 @@ subroutine cldprop & extcoliq = max(f_zero, extliq2(index,ib) + fint*(extliq2(index+1,ib)-extliq2(index,ib)) ) ssacoliq = max(f_zero, min(f_one, ssaliq2(index,ib) + fint*(ssaliq2(index+1,ib)-ssaliq2(index,ib)) )) asycoliq = max(f_zero, min(f_one, asyliq2(index,ib) + fint*(asyliq2(index+1,ib)-asyliq2(index,ib)) )) - tauliq(ib) = cnv_cliqp * extcoliq + tauliq(ib) = cnv_cliqp(k) * extcoliq ssaliq(ib) = tauliq(ib) * ssacoliq asyliq(ib) = ssaliq(ib) * asycoliq enddo endif ! end if_iswcliq_block endif ! end if_cldliq_block ! Calculation of absorption coefficients due to ice clouds. - if ( cnv_cicep <= f_zero ) then + if ( cnv_cicep(k) <= f_zero ) then do ib = nblow, nbhgh tauice(ib) = f_zero ssaice(ib) = f_zero @@ -1956,7 +1959,7 @@ subroutine cldprop & extcoice = max(f_zero, abari(ia)+bbari(ia)/refice ) ssacoice = max(f_zero, min(f_one, f_one-cbari(ia)-dbari(ia)*refice )) asycoice = max(f_zero, min(f_one, ebari(ia)+fbari(ia)*refice )) - tauice(ib) = cnv_cicep * extcoice + tauice(ib) = cnv_cicep(k) * extcoice ssaice(ib) = tauice(ib) * ssacoice asyice(ib) = ssaice(ib) * asycoice enddo @@ -1970,7 +1973,7 @@ subroutine cldprop & extcoice = max(f_zero, extice2(index,ib) + fint*(extice2(index+1,ib)-extice2(index,ib)) ) ssacoice = max(f_zero, min(f_one, ssaice2(index,ib) + fint*(ssaice2(index+1,ib)-ssaice2(index,ib)) )) asycoice = max(f_zero, min(f_one, asyice2(index,ib) + fint*(asyice2(index+1,ib)-asyice2(index,ib)) )) - tauice(ib) = cnv_cicep * extcoice + tauice(ib) = cnv_cicep(k) * extcoice ssaice(ib) = tauice(ib) * ssacoice asyice(ib) = ssaice(ib) * asycoice enddo @@ -1985,7 +1988,7 @@ subroutine cldprop & extcoice = max(f_zero, extice3(index,ib) + fint*(extice3(index+1,ib)-extice3(index,ib)) ) ssacoice = max(f_zero, min(f_one, ssaice3(index,ib) + fint*(ssaice3(index+1,ib)-ssaice3(index,ib)) )) asycoice = max(f_zero, min(f_one, asyice3(index,ib) + fint*(asyice3(index+1,ib)-asyice3(index,ib)) )) - tauice(ib) = cnv_cicep * extcoice + tauice(ib) = cnv_cicep(k) * extcoice ssaice(ib) = tauice(ib) * ssacoice asyice(ib) = ssaice(ib) * asycoice enddo diff --git a/physics/Radiation/RRTMG/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta index 2ff13a19e..d6e77ab74 100644 --- a/physics/Radiation/RRTMG/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -502,6 +502,20 @@ dimensions = () type = logical intent = in +[scale_ccld_cndste] + standard_name = flag_to_scale_convective_condensate_in_radiation_by_convective_updraft_fraction + long_name = flag to scale convective condensate see by radiation using the convective updraft fraction + units = flag + dimensions = () + type = logical + intent = in +[scale_ccld_optics] + standard_name = flag_to_scale_convective_cloud_optics_by_convective_updraft_fraction + long_name = flag to scale convective cloud optics see by radiation using the convective updraft fraction + units = flag + dimensions = () + type = logical + intent = in [cnvcld_lwp] standard_name = convective_cloud_liquid_water_path long_name = layer convective cloud liquid water path From 7e4086c13e6c31cb5542bcaa7abc96b00bd07ed0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 2 May 2024 21:02:55 +0000 Subject: [PATCH 7/8] Added same Re calculation as in thompson mp progcld --- .../UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 | 11 ++-- .../UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta | 7 +++ .../UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 | 2 +- physics/Radiation/RRTMG/radsw_main.F90 | 8 +-- physics/Radiation/radiation_cloud_optics.F90 | 51 +++++++++++-------- 5 files changed, 49 insertions(+), 30 deletions(-) diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 index 8faafee01..002d4c91a 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.F90 @@ -19,7 +19,7 @@ module GFS_rrtmg_pre !>\section rrtmg_pre_gen General Algorithm subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ltp, imfdeepcnv, imfdeepcnv_gf, imfdeepcnv_c3, me, ncnd, ntrac, & - num_p3d, npdf3d, xr_cnvcld, & + num_p3d, npdf3d, xr_cnvcld, do_phasepart, & ncnvcld3d,ntqv, ntcw,ntiw, ntlnc, ntinc, ntrnc, ntsnc, ntccn, top_at_1,& ntrw, ntsw, ntgl, nthl, ntwa, ntoz, ntsmoke, ntdust, ntcoarsepm, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, & @@ -132,7 +132,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2, pert_clds, lcrick,& lcnorm, top_at_1, lextop, mraerosol - logical, intent(in) :: rrfs_sd, aero_dir_fdb, xr_cnvcld + logical, intent(in) :: rrfs_sd, aero_dir_fdb, xr_cnvcld, do_phasepart logical, intent(in) :: nssl_ccn_on, nssl_invertccn integer, intent(in) :: spp_rad @@ -1005,9 +1005,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, lextop,& ! endif ! end_if_ntcw !> - Call cloud_mp_SAMF() to calculate convective cloud properties. - call cloud_mp_SAMF(.false., .false., IM, LM, tlyr, plvl, plyr, & - qstl, rhly, cnvw_in, con_ttp, con_g, 200., cld_cnv_lwp, & - cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cnvc_inout) + call cloud_mp_SAMF(.false., .true., IM, LM, tlyr, plvl, plyr, & + qstl, rhly, cnvw_in, con_ttp, con_g, 200., xland, & + do_phasepart, cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, & + cld_cnv_reice, cnvc_inout) !> - Call ppfbet() to perturb cld cover. if (pert_clds) then diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta index 9984c5a01..1525b065e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmg_pre.meta @@ -63,6 +63,13 @@ dimensions = () type = logical intent = in +[do_phasepart] + standard_name = flag_for_phase_partitioning_in_radiatively_active_convective_cloud + long_name = flag for partitioning the convective condensate into liquid and ice phase using temperature + units = flag + dimensions = () + type = logical + intent = in [ltp] standard_name = extra_top_layer long_name = extra top layer for radiation diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 index 102a7b628..1adc26b48 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_rrtmgp_cloud_mp.F90 @@ -253,7 +253,7 @@ subroutine GFS_rrtmgp_cloud_mp_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldic if (imfdeepcnv == imfdeepcnv_samf) then alpha0 = 200. call cloud_mp_SAMF(.false., .false., nCol, nLev, t_lay, p_lev, p_lay, qs_lay, & - relhum, cnv_mixratio, con_ttp, con_g, alpha0, & + relhum, cnv_mixratio, con_ttp, con_g, alpha0, lsmask, .true., & cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_cnv_frac) endif diff --git a/physics/Radiation/RRTMG/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 index 794b52958..f1480b4d6 100644 --- a/physics/Radiation/RRTMG/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -1918,7 +1918,7 @@ subroutine cldprop & asyliq(ib) = f_zero enddo else - factor = cnv_reliq - 1.5 + factor = cnv_reliq(k) - 1.5 index = max( 1, min( 57, int( factor ) )) fint = factor - float(index) @@ -1953,7 +1953,7 @@ subroutine cldprop & ! Ebert and curry approach for all particle sizes though somewhat ! unjustified for large ice particles. if ( iswcice == 1 ) then - refice = min(130.0_kind_phys,max(13.0_kind_phys,cnv_reice)) + refice = min(130.0_kind_phys,max(13.0_kind_phys,cnv_reice(k))) do ib = nblow, nbhgh ia = idxebc(ib) ! eb_&_c band index for ice cloud coeff extcoice = max(f_zero, abari(ia)+bbari(ia)/refice ) @@ -1965,7 +1965,7 @@ subroutine cldprop & enddo ! Streamer approach for ice effective radius between 5.0 and 131.0 microns. elseif ( iswcice == 2 ) then - refice = min(131.0_kind_phys,max(5.0_kind_phys,cnv_reice)) + refice = min(131.0_kind_phys,max(5.0_kind_phys,cnv_reice(k))) factor = (refice - 2.0) / 3.0 index = max( 1, min( 42, int( factor ) )) fint = factor - float(index) @@ -1980,7 +1980,7 @@ subroutine cldprop & ! Fu's approach for ice effective radius between 4.8 and 135 microns ! (generalized effective size from 5 to 140 microns). elseif ( iswcice == 3 ) then - dgeice = max( 5.0, min( 140.0, 1.0315*cnv_reice )) + dgeice = max( 5.0, min( 140.0, 1.0315*cnv_reice(k))) factor = (dgeice - 2.0) / 3.0 index = max( 1, min( 45, int( factor ) )) fint = factor - float(index) diff --git a/physics/Radiation/radiation_cloud_optics.F90 b/physics/Radiation/radiation_cloud_optics.F90 index 564b46a31..2163c9edc 100644 --- a/physics/Radiation/radiation_cloud_optics.F90 +++ b/physics/Radiation/radiation_cloud_optics.F90 @@ -1,18 +1,12 @@ module module_radiation_cloud_optics - use machine, only: kind_phys + use machine, only: kind_phys + use module_radiation_clouds, only: retab implicit none real (kind_phys), parameter :: & - cld_limit_lower = 0.001, & - cld_limit_ovcst = 1.0 - 1.0e-8, & - reliq_def = 10.0 , & ! Default liq radius, in stratiform cloud, to 10 micron (used when effr_in=F) - reice_def = 50.0, & ! Default ice radius, in stratiform cloud, to 50 micron (used when effr_in=F) - reliqcnv_def = 10.0 , & ! Default liq radius, in convective cloud, to 10 micron (used when effr_in=F) - reicecnv_def = 50.0, & ! Default ice radius, in convective cloud, to 50 micron (used when effr_in=F) - rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) - resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) - reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme - reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme + reliqcnv_def = 10.0, & ! Default liq radius, in convective cloud, to 10 micron + reicecnv_def = 50.0 ! Default ice radius, in convective cloud, to 50 micron + contains !> \ingroup radiation_cloud_optics @@ -29,21 +23,23 @@ module module_radiation_cloud_optics !! !! \section cloud_mp_SAMF_gen General Algorithm subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs_lay, & - relhum, cnv_mixratio, con_ttp, con_g, alpha0, & + relhum, cnv_mixratio, con_ttp, con_g, alpha0, xland, do_cnv_phase_partition, & cld_cnv_lwp, cld_cnv_reliq, cld_cnv_iwp, cld_cnv_reice, cld_cnv_frac) implicit none ! Inputs logical, intent(in) :: & cmp_XuRndl, & ! Compute convective cloud fraction using Xu-Randall? - cmp_Re ! Compute liquid/ice particle sizes using ????? + cmp_Re, & ! Compute liquid/ice particle sizes using ????? + do_cnv_phase_partition integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev ! Number of vertical layers real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravity (m s-2) con_ttp, & ! Triple point temperature of water (K) - alpha0 ! Parameter for Xu-Randall scheme. (-) + alpha0, & ! Parameter for Xu-Randall scheme. (-) + xland ! Land/Sea mask real(kind_phys), dimension(:,:),intent(in) :: & t_lay, & ! Temperature at layer-centers (K) p_lev, & ! Pressure at layer-interfaces (Pa) @@ -60,23 +56,38 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs real(kind_phys), dimension(:,:),intent(inout) :: & cld_cnv_frac ! Convective cloud-fraction ! Local - integer :: iCol, iLay + integer :: iCol, iLay, idx_rei real(kind_phys) :: tem0, tem1, deltaP, clwc tem0 = 1.0e5/con_g do iLay = 1, nLev do iCol = 1, nCol if (cnv_mixratio(iCol,iLay) > 0._kind_phys) then - ! Partition water paths by phase. - tem1 = min(1.0, max(0.0, (con_ttp-t_lay(iCol,iLay))*0.05)) + ! Compute liquid water path deltaP = abs(p_lev(iCol,iLay+1)-p_lev(iCol,iLay))*0.01 clwc = max(0.0, cnv_mixratio(iCol,iLay)) * tem0 * deltaP - cld_cnv_iwp(iCol,iLay) = clwc * tem1 - cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) + + ! Partition path by phase? + if (do_cnv_phase_partition) then + tem1 = min(1.0, max(0.0, (con_ttp-t_lay(iCol,iLay))*0.05)) + cld_cnv_iwp(iCol,iLay) = clwc * tem1 + cld_cnv_lwp(iCol,iLay) = clwc - cld_cnv_iwp(iCol,iLay) + else + cld_cnv_lwp(iCol,iLay) = clwc + endif ! Assign particles size(s). if (cmp_Re) then - ! do something here a bit more fancy? + ! DJS2024: This is identical to in radiation_clouds.f:_progcld_thompson() + if ((xland(iCol) - 1.5) .gt. 0.) then + cld_cnv_reliq(iCol,iLay) = 9.5 + else + cld_cnv_reliq(iCol,iLay) = 5.5 + endif + idx_rei = int(t_lay(iCol,iLay)-179.) + idx_rei = min(max(idx_rei,1),75) + corr = t_lay(iCol,iLay) - int(t_lay(iCol,iLay)) + cld_cnv_reice(iCol,iLay) = max(5.0, retab(idx_rei)*(1.-corr) + retab(idx_rei+1)*corr) else ! Assume default liquid/ice effective radius (microns) cld_cnv_reliq(iCol,iLay) = reliqcnv_def From 81df8b1b4fe3e7d2f2639a3f08879a472108d106 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 14 May 2024 20:45:04 +0000 Subject: [PATCH 8/8] Added logic to scale onvective optics --- physics/Radiation/RRTMG/radlw_main.F90 | 77 +++++++++++------- physics/Radiation/RRTMG/radlw_main.meta | 8 ++ physics/Radiation/RRTMG/radsw_main.F90 | 86 +++++++++++++------- physics/Radiation/RRTMG/radsw_main.meta | 8 ++ physics/Radiation/radiation_cloud_optics.F90 | 6 +- physics/Radiation/radiation_clouds.f | 2 +- 6 files changed, 127 insertions(+), 60 deletions(-) diff --git a/physics/Radiation/RRTMG/radlw_main.F90 b/physics/Radiation/RRTMG/radlw_main.F90 index ecb8704c6..29ed0dd56 100644 --- a/physics/Radiation/RRTMG/radlw_main.F90 +++ b/physics/Radiation/RRTMG/radlw_main.F90 @@ -433,7 +433,7 @@ subroutine rrtmg_lw_run & & cld_od, & & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & & cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice, & - & errmsg, errflg & + & sigmain, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -630,7 +630,8 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(:,:),intent(in),optional:: & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice + & cld_od, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice,& + & sigmain real (kind=kind_phys), dimension(:), intent(in) :: sfemis, & & sfgtmp, de_lgth @@ -671,7 +672,7 @@ subroutine rrtmg_lw_run & & clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, & & coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, & & selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, & - & scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8 + & scaleminorn2, temcol, dz, cda5, cda6, cda7, cda8, cda9 real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay @@ -903,6 +904,7 @@ subroutine rrtmg_lw_run & cda6(k) = cnvcld_reliq(iplon,k1) cda7(k) = cnvcld_iwp(iplon,k1) cda8(k) = cnvcld_reice(iplon,k1) + cda9(k) = sigmain(iplon,k1) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1015,6 +1017,7 @@ subroutine rrtmg_lw_run & cda6(k) = cnvcld_reliq(iplon,k) cda7(k) = cnvcld_iwp(iplon,k) cda8(k) = cnvcld_reice(iplon,k) + cda9(k) = sigmain(iplon,k) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1095,7 +1098,7 @@ subroutine rrtmg_lw_run & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & - & cda5, cda6, cda7, cda8, & + & cda5, cda6, cda7, cda8, cda9, & & nlay, nlp1, ipseed(iplon), dz, delgth, iovr, alph, & & ilwcliq, ilwcice, isubclw, & ! --- outputs: @@ -1546,7 +1549,7 @@ end subroutine rlwinit subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & - & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, sigmain, & & nlay, nlp1, ipseed, dz, de_lgth, iovr, alpha, ilwcliq, & & ilwcice, isubclw, cldfmc, taucld & ! --- outputs & ) @@ -1581,6 +1584,7 @@ subroutine cldprop & ! cnv_reliq - real, mean eff radius for liq (cnv) cloud nlay ! ! cnv_cicep - real, layer in-cloud (cnv) ice water path nlay ! ! cnv_reice - real, mean eff radius for ice cloud (cnv) nlay ! +! sigmain - real, convective updraft area-fraction nlay ! ! cliqp - not used nlay ! ! reliq - not used nlay ! ! cicep - not used nlay ! @@ -1660,7 +1664,7 @@ subroutine cldprop & real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz, & - & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, sigmain real (kind=kind_phys), intent(in) :: de_lgth real (kind=kind_phys), dimension(nlay), intent(in) :: alpha @@ -1673,7 +1677,7 @@ subroutine cldprop & real (kind=kind_phys), dimension(nlay) :: cldf real (kind=kind_phys) :: dgeice, factor, fint, tauran, tausnw, & - & cldliq, refliq, cldice, refice + & cldliq, refliq, cldice, refice, cnv_cliqp_tmp, cnv_cicep_tmp logical :: lcloudy(ngptlw,nlay) integer :: ia, ib, ig, k, index @@ -1810,13 +1814,29 @@ subroutine cldprop & ! ! Do we have any convective clouds in this layer? ! If so, - ! - Compute cloud-optical properties using the convective condensate, and assumed size. + ! - Compute cloud-optical properties using the provided convective condensate and + ! cloud particle size(s). + ! + ! - If scale_ccld_cndste, prior to computing the convective cloud optics, scale the + ! convective cloud condensate by the convective updraft area fraction. + ! + ! - If scale_ccld_optics, scale the convective cloud optical properties by convective + ! updraft area fraction. + ! ! - Add radiative contribution from convective cloud to total cloud radiative properties. ! ! ##################################################################################### lab_if_cnvcld : if (add_cnvcld .and. cnv_cliqp(k)+cnv_cicep(k) > 0._kind_phys) then - ! calculation of absorption coefficients due to convective water clouds. - if ( cnv_cliqp(k) <= f_zero ) then + ! Scale convective cloud condensate by convective updraft area fraction? + cnv_cliqp_tmp = cnv_cliqp(k) + cnv_cicep_tmp = cnv_cicep(k) + if (scale_ccld_cndste) then + cnv_cliqp_tmp = cnv_cliqp(k)*sigmain(k) + cnv_cicep_tmp = cnv_cicep(k)*sigmain(k) + endif + + ! Calculation of absorption coefficients due to convective water clouds. + if ( cnv_cliqp_tmp <= f_zero ) then do ib = 1, nbands tauliq(ib) = f_zero enddo @@ -1826,54 +1846,55 @@ subroutine cldprop & index = max( 1, min( 57, int( factor ) )) fint = factor - float(index) do ib = 1, nbands - tauliq(ib) = max(f_zero, cnv_cliqp(k)*(absliq1(index,ib) + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) + tauliq(ib) = max(f_zero, cnv_cliqp_tmp*(absliq1(index,ib) + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) enddo endif ! end if_ilwcliq_block endif ! end if_cldliq_block - ! calculation of absorption coefficients due to ice clouds. - if ( cnv_cicep(k) <= f_zero ) then + ! Calculation of absorption coefficients due to ice clouds. + if ( cnv_cicep_tmp <= f_zero ) then do ib = 1, nbands tauice(ib) = f_zero enddo else - ! ebert and curry approach for all particle sizes though somewhat + ! Ebert and Curry approach for all particle sizes though somewhat ! unjustified for large ice particles if ( ilwcice == 1 ) then refice = min(130.0, max(13.0, real(cnv_reice(k)) )) - do ib = 1, nbands ia = ipat(ib) ! eb_&_c band index for ice cloud coeff - tauice(ib) = max(f_zero, cnv_cicep(k)*(absice1(1,ia) + absice1(2,ia)/refice) ) + tauice(ib) = max(f_zero, cnv_cicep_tmp*(absice1(1,ia) + absice1(2,ia)/refice) ) enddo - - ! streamer approach for ice effective radius between 5.0 and 131.0 microns - ! and ebert and curry approach for ice eff radius greater than 131.0 microns. - ! no smoothing between the transition of the two methods. + ! Streamer approach for ice effective radius between 5.0 and 131.0 microns + ! and ebert and curry approach for ice eff radius greater than 131.0 microns. + ! no smoothing between the transition of the two methods. elseif ( ilwcice == 2 ) then factor = (cnv_reice(k) - 2.0) / 3.0 index = max( 1, min( 42, int( factor ) )) fint = factor - float(index) - do ib = 1, nbands - tauice(ib) = max(f_zero, cnv_cicep(k)*(absice2(index,ib) + fint*(absice2(index+1,ib) - absice2(index,ib)) )) + tauice(ib) = max(f_zero, cnv_cicep_tmp*(absice2(index,ib) + fint*(absice2(index+1,ib) - absice2(index,ib)) )) enddo - - ! fu's approach for ice effective radius between 4.8 and 135 microns - ! (generalized effective size from 5 to 140 microns) + ! Fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns) elseif ( ilwcice == 3 ) then dgeice = max(5.0, 1.0315*cnv_reice(k)) factor = (dgeice - 2.0) / 3.0 index = max( 1, min( 45, int( factor ) )) fint = factor - float(index) - do ib = 1, nbands - tauice(ib) = max(f_zero, cnv_cicep(k)*(absice3(index,ib) + fint*(absice3(index+1,ib) - absice3(index,ib)) )) + tauice(ib) = max(f_zero, cnv_cicep_tmp*(absice3(index,ib) + fint*(absice3(index+1,ib) - absice3(index,ib)) )) enddo endif ! end if_ilwcice_block endif ! end if_cnv_cicep_block - ! + + ! Add convective cloud, tauliq and tauice, to non-convective (stratiform) cloud, taucld. do ib = 1, nbands + ! Scale convective cloud optics by updraft area fraction? + if (scale_ccld_optics) then + tauice(ib) = tauice(ib)*sigmain(k) + tauliq(ib) = tauliq(ib)*sigmain(k) + endif taucld(ib,k) = taucld(ib,k) + tauice(ib) + tauliq(ib) enddo endif lab_if_cnvcld diff --git a/physics/Radiation/RRTMG/radlw_main.meta b/physics/Radiation/RRTMG/radlw_main.meta index 0f2480aae..c801c3743 100644 --- a/physics/Radiation/RRTMG/radlw_main.meta +++ b/physics/Radiation/RRTMG/radlw_main.meta @@ -480,6 +480,14 @@ type = real kind = kind_phys intent = in +[sigmain] + standard_name = prognostic_updraft_area_fraction_in_convection + long_name = convective updraft area fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/RRTMG/radsw_main.F90 b/physics/Radiation/RRTMG/radsw_main.F90 index f1480b4d6..36b507d35 100644 --- a/physics/Radiation/RRTMG/radsw_main.F90 +++ b/physics/Radiation/RRTMG/radsw_main.F90 @@ -508,7 +508,7 @@ subroutine rrtmg_sw_run & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & & cld_od, cld_ssa, cld_asy, add_cnvcld, scale_ccld_cndste, & & scale_ccld_optics, cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, & - & cnvcld_reice, errmsg, errflg & + & cnvcld_reice, sigmain, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -721,7 +721,7 @@ subroutine rrtmg_sw_run & & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & & cld_od, cld_ssa, cld_asy, & - & cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice + & cnvcld_lwp, cnvcld_reliq, cnvcld_iwp, cnvcld_reice, sigmain real(kind=kind_phys),dimension(:,:,:),intent(in)::aeraod real(kind=kind_phys),dimension(:,:,:),intent(in)::aerssa @@ -769,7 +769,8 @@ subroutine rrtmg_sw_run & & pavel, tavel, coldry, colmol, h2ovmr, o3vmr, temcol, & & cliqp, reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, & & cfrac, fac00, fac01, fac10, fac11, forfac, forfrac, & - & selffac, selffrac, rfdelp, dz, cdat5, cdat6, cdat7, cdat8 + & selffac, selffrac, rfdelp, dz, cdat5, cdat6, cdat7, cdat8, & + & cdat9 real (kind=kind_phys), dimension(nlp1) :: fnet, flxdc, flxuc, & & flxd0, flxu0 @@ -997,6 +998,7 @@ subroutine rrtmg_sw_run & cdat6(k) = cnvcld_reliq(j1,kk) cdat7(k) = cnvcld_iwp(j1,kk) cdat8(k) = cnvcld_reice(j1,kk) + cdat9(k) = sigmain(j1,kk) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1091,10 +1093,11 @@ subroutine rrtmg_sw_run & cdat3(k) = cld_swp(j1,k) ! cloud snow path cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius ! Radiatively active convective cloud? - cdat5(k) = cnvcld_lwp(j1,kk) - cdat6(k) = cnvcld_reliq(j1,kk) - cdat7(k) = cnvcld_iwp(j1,kk) - cdat8(k) = cnvcld_reice(j1,kk) + cdat5(k) = cnvcld_lwp(j1,k) + cdat6(k) = cnvcld_reliq(j1,k) + cdat7(k) = cnvcld_iwp(j1,k) + cdat8(k) = cnvcld_reice(j1,k) + cdat9(k) = sigmain(j1,k) enddo else ! use diagnostic cloud method do k = 1, nlay @@ -1147,7 +1150,7 @@ subroutine rrtmg_sw_run & ! --- inputs: & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, cdat5, & - & cdat6, cdat7, cdat8, & + & cdat6, cdat7, cdat8, cdat9, & & zcf1, nlay, ipseed(j1), dz, delgth, alph, iswcliq, iswcice,& & isubcsw, iovr, & ! --- outputs: @@ -1582,7 +1585,7 @@ end subroutine rswinit subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs & add_cnvcld, scale_ccld_cndste, scale_ccld_optics, & - & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, & + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, sigmain, & & cf1, nlay, ipseed, dz, delgth, alpha, iswcliq, iswcice, & & isubcsw, iovr, taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1677,7 +1680,7 @@ subroutine cldprop & real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz,& - & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice + & cnv_cliqp, cnv_reliq, cnv_cicep, cnv_reice, sigmain real (kind=kind_phys), dimension(nlay), intent(in) :: alpha ! --- outputs: @@ -1696,7 +1699,7 @@ subroutine cldprop & real (kind=kind_phys) :: dgeice, factor, fint, tauran, tausnw, & & cldliq, refliq, cldice, refice, cldran, cldsnw, refsnw, & & extcoliq, ssacoliq, asycoliq, extcoice, ssacoice, asycoice,& - & dgesnw + & dgesnw, cnv_cliqp_tmp, cnv_cicep_tmp logical :: lcloudy(nlay,ngptsw) integer :: ia, ib, ig, jb, k, index @@ -1905,13 +1908,29 @@ subroutine cldprop & ! ! Do we have any convective clouds in this layer? ! If so, - ! - Compute cloud-optical properties using the convective condensate, and assumed size. + ! - Compute cloud-optical properties using the provided convective condensate and + ! cloud particle size(s). + ! + ! - If scale_ccld_cndste, prior to computing the convective cloud optics, scale the + ! convective cloud condensate by the convective updraft area fraction. + ! + ! - If scale_ccld_optics, scale the convective cloud optical properties by convective + ! updraft area fraction. + ! ! - Add radiative contribution from convective cloud to total cloud radiative properties. ! ! ##################################################################################### lab_if_cnvcld : if (add_cnvcld .and. cnv_cliqp(k)+cnv_cicep(k) > 0._kind_phys) then + ! Scale convective cloud condensate by convective updraft area fraction? + cnv_cliqp_tmp = cnv_cliqp(k) + cnv_cicep_tmp = cnv_cicep(k) + if (scale_ccld_cndste) then + cnv_cliqp_tmp = cnv_cliqp(k)*sigmain(k) + cnv_cicep_tmp = cnv_cicep(k)*sigmain(k) + endif + ! Calculation of absorption coefficients due to convective water clouds. - if ( cnv_cliqp(k) <= f_zero ) then + if ( cnv_cliqp_tmp <= f_zero ) then do ib = nblow, nbhgh tauliq(ib) = f_zero ssaliq(ib) = f_zero @@ -1927,23 +1946,23 @@ subroutine cldprop & extcoliq = max(f_zero, extliq1(index,ib) + fint*(extliq1(index+1,ib)-extliq1(index,ib)) ) ssacoliq = max(f_zero, min(f_one, ssaliq1(index,ib) + fint*(ssaliq1(index+1,ib)-ssaliq1(index,ib)) )) asycoliq = max(f_zero, min(f_one, asyliq1(index,ib) + fint*(asyliq1(index+1,ib)-asyliq1(index,ib)) )) - tauliq(ib) = cnv_cliqp(k) * extcoliq - ssaliq(ib) = tauliq(ib) * ssacoliq - asyliq(ib) = ssaliq(ib) * asycoliq + tauliq(ib) = cnv_cliqp_tmp * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq enddo elseif ( iswcliq == 2 ) then ! use updated coeffs do ib = nblow, nbhgh extcoliq = max(f_zero, extliq2(index,ib) + fint*(extliq2(index+1,ib)-extliq2(index,ib)) ) ssacoliq = max(f_zero, min(f_one, ssaliq2(index,ib) + fint*(ssaliq2(index+1,ib)-ssaliq2(index,ib)) )) asycoliq = max(f_zero, min(f_one, asyliq2(index,ib) + fint*(asyliq2(index+1,ib)-asyliq2(index,ib)) )) - tauliq(ib) = cnv_cliqp(k) * extcoliq - ssaliq(ib) = tauliq(ib) * ssacoliq - asyliq(ib) = ssaliq(ib) * asycoliq + tauliq(ib) = cnv_cliqp_tmp * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq enddo endif ! end if_iswcliq_block endif ! end if_cldliq_block ! Calculation of absorption coefficients due to ice clouds. - if ( cnv_cicep(k) <= f_zero ) then + if ( cnv_cicep_tmp <= f_zero ) then do ib = nblow, nbhgh tauice(ib) = f_zero ssaice(ib) = f_zero @@ -1959,9 +1978,9 @@ subroutine cldprop & extcoice = max(f_zero, abari(ia)+bbari(ia)/refice ) ssacoice = max(f_zero, min(f_one, f_one-cbari(ia)-dbari(ia)*refice )) asycoice = max(f_zero, min(f_one, ebari(ia)+fbari(ia)*refice )) - tauice(ib) = cnv_cicep(k) * extcoice - ssaice(ib) = tauice(ib) * ssacoice - asyice(ib) = ssaice(ib) * asycoice + tauice(ib) = cnv_cicep_tmp * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice enddo ! Streamer approach for ice effective radius between 5.0 and 131.0 microns. elseif ( iswcice == 2 ) then @@ -1973,9 +1992,9 @@ subroutine cldprop & extcoice = max(f_zero, extice2(index,ib) + fint*(extice2(index+1,ib)-extice2(index,ib)) ) ssacoice = max(f_zero, min(f_one, ssaice2(index,ib) + fint*(ssaice2(index+1,ib)-ssaice2(index,ib)) )) asycoice = max(f_zero, min(f_one, asyice2(index,ib) + fint*(asyice2(index+1,ib)-asyice2(index,ib)) )) - tauice(ib) = cnv_cicep(k) * extcoice - ssaice(ib) = tauice(ib) * ssacoice - asyice(ib) = ssaice(ib) * asycoice + tauice(ib) = cnv_cicep_tmp * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice enddo ! Fu's approach for ice effective radius between 4.8 and 135 microns ! (generalized effective size from 5 to 140 microns). @@ -1988,9 +2007,9 @@ subroutine cldprop & extcoice = max(f_zero, extice3(index,ib) + fint*(extice3(index+1,ib)-extice3(index,ib)) ) ssacoice = max(f_zero, min(f_one, ssaice3(index,ib) + fint*(ssaice3(index+1,ib)-ssaice3(index,ib)) )) asycoice = max(f_zero, min(f_one, asyice3(index,ib) + fint*(asyice3(index+1,ib)-asyice3(index,ib)) )) - tauice(ib) = cnv_cicep(k) * extcoice - ssaice(ib) = tauice(ib) * ssacoice - asyice(ib) = ssaice(ib) * asycoice + tauice(ib) = cnv_cicep_tmp * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice enddo endif ! end if_iswcice_block endif ! end if_cnv_cicep_block @@ -1998,6 +2017,15 @@ subroutine cldprop & ! Increment optics. do ib = 1, nbdsw jb = nblow + ib - 1 + ! Scale convective cloud optics by updraft area fraction? + if (scale_ccld_optics) then + tauice(ib) = tauice(ib)*sigmain(k) + tauliq(ib) = tauliq(ib)*sigmain(k) + ssaice(ib) = ssaice(ib)*sigmain(k) + ssaliq(ib) = ssaliq(ib)*sigmain(k) + asyice(ib) = asyice(ib)*sigmain(k) + asyliq(ib) = asyliq(ib)*sigmain(k) + endif taucw(k,ib) = taucw(k,ib) + tauliq(jb) + tauice(jb) ssacw(k,ib) = ssacw(k,ib) + ssaliq(jb) + ssaice(jb) asycw(k,ib) = asycw(k,ib) + asyliq(jb) + asyice(jb) diff --git a/physics/Radiation/RRTMG/radsw_main.meta b/physics/Radiation/RRTMG/radsw_main.meta index d6e77ab74..83ead0758 100644 --- a/physics/Radiation/RRTMG/radsw_main.meta +++ b/physics/Radiation/RRTMG/radsw_main.meta @@ -548,6 +548,14 @@ type = real kind = kind_phys intent = in +[sigmain] + standard_name = prognostic_updraft_area_fraction_in_convection + long_name = convective updraft area fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/Radiation/radiation_cloud_optics.F90 b/physics/Radiation/radiation_cloud_optics.F90 index 2163c9edc..4041f9597 100644 --- a/physics/Radiation/radiation_cloud_optics.F90 +++ b/physics/Radiation/radiation_cloud_optics.F90 @@ -38,7 +38,8 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravity (m s-2) con_ttp, & ! Triple point temperature of water (K) - alpha0, & ! Parameter for Xu-Randall scheme. (-) + alpha0 ! Parameter for Xu-Randall scheme. (-) + real(kind_phys), dimension(:),intent(in) :: & xland ! Land/Sea mask real(kind_phys), dimension(:,:),intent(in) :: & t_lay, & ! Temperature at layer-centers (K) @@ -57,7 +58,7 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs cld_cnv_frac ! Convective cloud-fraction ! Local integer :: iCol, iLay, idx_rei - real(kind_phys) :: tem0, tem1, deltaP, clwc + real(kind_phys) :: tem0, tem1, deltaP, clwc, corr tem0 = 1.0e5/con_g do iLay = 1, nLev @@ -90,6 +91,7 @@ subroutine cloud_mp_SAMF(cmp_XuRndl, cmp_Re, nCol, nLev, t_lay, p_lev, p_lay, qs cld_cnv_reice(iCol,iLay) = max(5.0, retab(idx_rei)*(1.-corr) + retab(idx_rei+1)*corr) else ! Assume default liquid/ice effective radius (microns) + ! DJS2024: Default particle size assumptions are the same as used in stratiform cloud. cld_cnv_reliq(iCol,iLay) = reliqcnv_def cld_cnv_reice(iCol,iLay) = reicecnv_def endif diff --git a/physics/Radiation/radiation_clouds.f b/physics/Radiation/radiation_clouds.f index f73c3b26d..e57624fc6 100644 --- a/physics/Radiation/radiation_clouds.f +++ b/physics/Radiation/radiation_clouds.f @@ -230,7 +230,7 @@ module module_radiation_clouds & cld_init, radiation_clouds_prop, & & progcld_thompson_wsm6, progcld_thompson, cal_cldfra3, & & find_cloudLayers, adjust_cloudIce, adjust_cloudH2O, & - & adjust_cloudFinal, gethml + & adjust_cloudFinal, gethml, retab ! ================= contains