From 5b30fd1c389b2b211f0dcd8d4f7c12298ccc5058 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 30 Apr 2024 17:34:51 +0000 Subject: [PATCH] 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