From 8364e618a0e02bde9cf50fbda12b039794c40e65 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 6 Nov 2020 15:35:19 -0700 Subject: [PATCH 01/27] Thompson MP in GP. Not complete. --- physics/GFS_rrtmgp_pre.F90 | 20 +- physics/GFS_rrtmgp_pre.meta | 18 + physics/GFS_rrtmgp_thompsonmp_pre.F90 | 358 ++++++++++++++++ physics/GFS_rrtmgp_thompsonmp_pre.meta | 555 +++++++++++++++++++++++++ physics/module_SGSCloud_RadPre.F90 | 49 --- 5 files changed, 942 insertions(+), 58 deletions(-) create mode 100644 physics/GFS_rrtmgp_thompsonmp_pre.F90 create mode 100644 physics/GFS_rrtmgp_thompsonmp_pre.meta diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 0e5d65f5c..f4542dffb 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -143,10 +143,10 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & - fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & - con_eps, con_epsm1, con_fvirt, con_epsqs, & - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & + fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,& + con_epsm1, con_fvirt, con_epsqs, & + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& gas_concentrations, errmsg, errflg) ! Inputs @@ -195,8 +195,10 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, real(kind_phys), dimension(nCol,nLev), intent(out) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer + q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers - relhum ! Relative-humidity at model-layers + relhum, & ! Relative-humidity at model-layers + qs_lay ! Saturation vapor pressure at model-layers real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface @@ -209,8 +211,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o - real(kind_phys) :: es, qs, tem1, tem2 - real(kind_phys), dimension(nCol,nLev) :: o3_lay, q_lay + real(kind_phys) :: es, tem1, tem2 + real(kind_phys), dimension(nCol,nLev) :: o3_lay real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables @@ -265,8 +267,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, do iCol=1,NCOL do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs ) ) + qs_lay(iCol,iLay) = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs_lay(iCol,iLay) ) ) tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + con_fvirt*q_lay(iCol,iLay)) enddo enddo diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 7fa69c0f6..904c0e4e7 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -328,6 +328,24 @@ kind = kind_phys intent = out optional = F +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg/kg + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 new file mode 100644 index 000000000..f815ba0cc --- /dev/null +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -0,0 +1,358 @@ +! ######################################################################################## +! This module contains the interface between the THOMPSON macrophysics and the RRTMGP radiation +! schemes. Only compatable with Model%imp_physics = Model%imp_physics_thompson +! ######################################################################################## +module GFS_rrtmgp_thompsonmp_pre + use machine, only: & + kind_phys + use rrtmgp_aux, only: & + check_error_msg + use module_radiation_cloud_overlap, only: & + cmp_dcorr_lgth, & + get_alpha_exp + use module_mp_thompson, only: & + calc_effectRad, & + Nt_c + use module_mp_thompson_make_number_concentrations, only: & + make_IceNumber, & + make_DropletNumber, & + make_RainNumber + + ! Parameters specific to THOMPSONMP scheme. + real(kind_phys), parameter :: & + 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) + 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) + cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + + public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_thompsonmp_pre_init() + end subroutine GFS_rrtmgp_thompsonmp_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run +!! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html +!! + subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice,& + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, yearlen, doSWrad, doLWrad, effr_in, julian, & + lat, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, & + qs_lay, q_lay, relhum, cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, lmfdeep2, ltaerosol, & + iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, idcor_hogan, idcor_oreopoulos, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & + deltaZb, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + ncnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid amount. + i_cldice, & ! cloud ice amount. + i_cldrain, & ! cloud rain amount. + i_cldsnow, & ! cloud snow amount. + i_cldgrpl, & ! cloud groupel amount. + i_cldtot, & ! cloud total amount. + i_cldliq_nc, & ! cloud liquid number concentration. + i_cldice_nc, & ! cloud ice number concentration. + i_twa, & ! water friendly aerosol. + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + logical, intent(in) :: & + doSWrad, & ! Call SW radiation? + doLWrad, & ! Call LW radiation + effr_in, & ! Use cloud effective radii provided by model? + uni_cld, & ! + lmfshal, & ! + lmfdeep2, & ! + ltaerosol ! + real(kind_phys), intent(in) :: & + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq, & ! Physical constant(?): Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = 0, default is idcor = 1) + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude (radians) + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + t_lay, & ! Temperature (K) + qs_lay, & ! Saturation vapor pressure (Pa) + q_lay, & ! water-vapor mixing ratio (kg/kg) + relhum, & ! Relative humidity + p_lay, & ! Pressure at model-layers (Pa) + cld_frac_mg ! Cloud-fraction from MG scheme. WTF????? + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! In/Outs + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac, & ! Precipitation fraction + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZb ! Layer thickness (km) + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, xrc3 + real(kind_phys), dimension(nLev+1) :: hgtb + real(kind_phys), dimension(nLev) :: hgtc + real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate + integer :: iCol,iLay,l,iSFC,iTOA + real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& + re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa + logical :: top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (doSWrad .or. doLWrad)) return + + ! What is vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + ! Initialize outputs + cld_lwp(:,:) = 0.0 + cld_reliq(:,:) = 0.0 + cld_iwp(:,:) = 0.0 + cld_reice(:,:) = 0.0 + cld_rwp(:,:) = 0.0 + cld_rerain(:,:) = 0.0 + cld_swp(:,:) = 0.0 + cld_resnow(:,:) = 0.0 + + ! #################################################################################### + ! Pull out cloud information for THOMPSON MP scheme. + ! #################################################################################### + + ! Cloud condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel + tracer(1:nCol,1:nLev,i_cldgrpl) + + ! + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds + ! + + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re + rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) + orho = 1./rho + do iLay = 1, nLev + do iCol = 1, nCol + qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + if (ltaerosol) then + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) + else + nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + endif + enddo + enddo + + ! Update number concentration, consistent with sub-grid clouds + do iLay = 1, nLev + do iCol = 1, nCol + if (ltaerosol .and. qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then + nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho(iCol,iLay), nwfa(iCol,iLay)) * orho(iCol,iLay) + endif + if (qi_mp(iCol,iLay) > 1.e-12 .and. ni_mp(iCol,iLay) < 100.) then + ni_mp(iCol,iLay) = make_IceNumber(qi_mp(iCol,iLay)*rho(iCol,iLay), t_lay(iCol,iLay)) * orho(iCol,iLay) + endif + enddo + enddo + + ! Call Thompson's subroutine to compute effective radii + do iCol=1,nCol + call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & + nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & + re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) + enddo + + ! Scale Thompson's effective radii from meter to micron and update global effective radii. + effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 + effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 + effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 + + if (uni_cld) then + if (effr_in) then + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = rerain_def + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) + else + cld_reliq(1:nCol,1:nLev) = reliq_def + cld_reice(1:nCol,1:nLev) = reice_def + cld_rerain(1:nCol,1:nLev) = rerain_def + cld_resnow(1:nCol,1:nLev) = resnow_def + endif ! effr_in + endif ! uni_cld + + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) + + ! Condensate and effective size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay = 1, nLev + do iCol = 1, nCol + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + if (cld_frac(iCol,iLay) .ge. cllimit) then + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 + cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 + cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 + cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 + endif + enddo + enddo + + ! #################################################################################### + ! Cloud (and precipitation) overlap + ! #################################################################################### + + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! + do iCol=1,nCol + if (top_at_1) then + ! Layer thickness (km) + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(nLev+1) = 0._kind_phys + do iLay=nLev,1,-1 + hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = nLev, 1, -1 + pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & + abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) + hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) + enddo + ! Layer thickness between centers + do iLay = nLev-1, 1, -1 + deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) + enddo + deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) + else + do iLay=nLev,1,-1 + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(1) = 0._kind_phys + do iLay=1,nLev + hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = 1, nLev + pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & + abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) + hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) + enddo + ! Layer thickness between centers + do iLay = 2, nLev + deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) + enddo + deltaZb(iCol,1) = hgtc(1) - hgtb(1) + endif + enddo + + ! + ! Cloud decorrelation length + ! + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(nCol, abs(lat/con_pi), con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con + endif + + ! + ! Cloud overlap parameter + ! + call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) + + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 1, nLev + do iCol = 1, nCol + if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then + cloud_overlap_param(iCol,iLay) = 0._kind_phys + endif + enddo + enddo + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + + end subroutine GFS_rrtmgp_thompsonmp_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_thompsonmp_pre_finalize() + end subroutine GFS_rrtmgp_thompsonmp_pre_finalize +end module GFS_rrtmgp_thompsonmp_pre \ No newline at end of file diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta new file mode 100644 index 000000000..a2bc0af2b --- /dev/null +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -0,0 +1,555 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_thompsonmp_pre + type = scheme + dependencies = rrtmgp_aux.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_thompspnmp_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[uni_cld] + standard_name = flag_for_uni_cld + long_name = flag for uni_cld + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfshal] + standard_name = flag_for_lmfshal + long_name = flag for lmfshal + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfdeep2] + standard_name = flag_for_scale_aware_mass_flux_convection + long_name = flag for some scale-aware mass-flux convection scheme active + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldrain] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldsnow] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldgrpl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldtot] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldliq_nc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice_nc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_twa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_frac_mg] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method + long_name = flag for cloud overlap method used by radiation scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = F +[idcor] + standard_name = flag_for_decorrelation_length_method + long_name = flag for decorrelation length method used in cloud overlap method (iovr) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dcorr_con] + standard_name = decorreltion_length_used_by_overlap_method + long_name = decorrelation length (default) used by cloud overlap method (iovr) + units = km + dimensions = () + type = real + intent = in + kind = kind_phys + optional = F +[idcor_con] + standard_name = flag_for_constant_decorrelation_length_method + long_name = choice of decorrelation length computation (costant) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_hogan] + standard_name = flag_for_hogan_decorrelation_length_method + long_name = choice of decorrelation length computation (hogan) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_oreopoulos] + standard_name = flag_for_oreopoulos_decorrelation_length_method + long_name = choice of decorrelation length computation (oreopoulos) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg/kg + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZb] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index ebc5ea2ae..592b88e32 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -293,55 +293,6 @@ subroutine sgscloud_radpre_run( & endif ! timestep > 1 -!> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. - - do i =1, im - rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range -! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range - enddo - - do id = 1, 4 - tem1 = ptopc(id,2) - ptopc(id,1) - do i =1, im - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - - cldcnv = 0. - -! DH* 20200723 -! iovr == 4 or 5 requires alpha, which is computed in GFS_rrmtg_pre, -! which comes after SGSCloud_RadPre. Computing alpha here requires -! a lot more input variables and computations (dzlay etc.), and -! recomputing it in GFS_rrmtg_pre is a waste of time. Workaround: -! pass a dummy array initialized to zero to gethml for other values of iovr. - if ( iovr == 4 .or. iovr == 5 ) then - errmsg = 'Logic error in sgscloud_radpre: iovr==4 or 5 not implemented' - errflg = 1 - return - end if -!! Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options -! if ( iovr == 4 .or. iovr == 5 ) then -! call get_alpha_exp & -!! --- inputs: -! (im, nlay, dzlay, iovr, latdeg, julian, yearlen, clouds1, & -!! --- outputs: -! alpha & -! ) -! endif - alpha_dummy = 0.0 -! *DH 2020723 - -!> - Recompute the diagnostic high, mid, low, total and bl cloud fraction - call gethml & -! --- inputs: - ( plyr, ptop1, clouds1, cldcnv, dz, de_lgth, alpha_dummy, & -! --- outputs: - im, nlay, cldsa, mtopa, mbota) - - !print*,"===Finished adding subgrid clouds to the resolved-scale clouds" - !print*,"qc_save:",qc_save(1,1)," qi_save:",qi_save(1,1) - end subroutine sgscloud_radpre_run end module sgscloud_radpre From 50c6e6f9a1bbe93b3f1b997401e58848e76c73fb Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 9 Nov 2020 16:00:50 -0700 Subject: [PATCH 02/27] ThompsonMP w/ RRTMGP working --- physics/GFS_rrtmgp_gfdlmp_pre.meta | 2 +- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 136 +++++++++++++++---------- physics/GFS_rrtmgp_thompsonmp_pre.meta | 48 ++++++--- 3 files changed, 117 insertions(+), 69 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 3841afc9b..90f4d5daf 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_gfdlmp_pre type = scheme - dependencies = rrtmgp_aux.F90 + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index f815ba0cc..646e45c31 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -17,6 +17,7 @@ module GFS_rrtmgp_thompsonmp_pre make_IceNumber, & make_DropletNumber, & make_RainNumber + implicit none ! Parameters specific to THOMPSONMP scheme. real(kind_phys), parameter :: & @@ -44,6 +45,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i lat, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, & qs_lay, q_lay, relhum, cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, lmfdeep2, ltaerosol, & iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, idcor_hogan, idcor_oreopoulos, & + do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & deltaZb, errmsg, errflg) @@ -72,7 +74,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i idcor, & ! Choice of method for decorrelation length computation idcor_con, & ! Flag for decorrelation-length. Use constant value idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + idcor_oreopoulos, & ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + imfdeepcnv, & ! Choice of mass-flux deep convection scheme + imfdeepcnv_gf ! Flag for Grell-Freitas deep convection scheme logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation @@ -80,7 +84,8 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i uni_cld, & ! lmfshal, & ! lmfdeep2, & ! - ltaerosol ! + ltaerosol, & ! + do_mynnedmf ! Flag to activate MYNN-EDMF real(kind_phys), intent(in) :: & julian, & ! Julian day con_pi, & ! Physical constant: pi @@ -104,7 +109,12 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i tracer ! Cloud condensate amount in layer by type () ! In/Outs - real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for ice cloud-particles (microns) effrin_cldsnow ! Effective radius for snow cloud-particles (microns) @@ -113,11 +123,6 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i real(kind_phys), dimension(nCol),intent(out) :: & de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_frac, & ! Total cloud fraction - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effecive radius cld_swp, & ! Cloud snow water path cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path @@ -132,7 +137,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i errflg ! Error flag ! Local variables - real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, xrc3 + real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, clwmin, clwf real(kind_phys), dimension(nLev+1) :: hgtb real(kind_phys), dimension(nLev) :: hgtc real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate @@ -156,16 +161,6 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i iSFC = 1 iTOA = nLev endif - - ! Initialize outputs - cld_lwp(:,:) = 0.0 - cld_reliq(:,:) = 0.0 - cld_iwp(:,:) = 0.0 - cld_reice(:,:) = 0.0 - cld_rwp(:,:) = 0.0 - cld_rerain(:,:) = 0.0 - cld_swp(:,:) = 0.0 - cld_resnow(:,:) = 0.0 ! #################################################################################### ! Pull out cloud information for THOMPSON MP scheme. @@ -177,11 +172,20 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - - ! - ! Compute effective radii for liquid/ice/snow using subgrid scale clouds - ! - + + ! Cloud particle size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay = 1, nLev + do iCol = 1, nCol + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) + cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) + cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + enddo + enddo + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) orho = 1./rho @@ -214,6 +218,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i enddo enddo + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds ! Call Thompson's subroutine to compute effective radii do iCol=1,nCol call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & @@ -225,42 +230,61 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 - - if (uni_cld) then - if (effr_in) then - cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) - cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) - cld_rerain(1:nCol,1:nLev) = rerain_def - cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) - else - cld_reliq(1:nCol,1:nLev) = reliq_def - cld_reice(1:nCol,1:nLev) = reice_def - cld_rerain(1:nCol,1:nLev) = rerain_def - cld_resnow(1:nCol,1:nLev) = resnow_def - endif ! effr_in - endif ! uni_cld + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = rerain_def - ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these + ! magic numbers are coming from. + if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv + ! Cloud-fraction + if (uni_cld) then + cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + else + clwmin = 0.0 + if (.not. lmfshal) then + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + endif + enddo + enddo + else + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + endif + enddo + enddo + endif + endif + endif + ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) - - ! Condensate and effective size - deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. - do iLay = 1, nLev - do iCol = 1, nCol - ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(iCol,iLay) .ge. cllimit) then - tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) - cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 - cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 - cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 - cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 - endif - enddo - enddo - + ! #################################################################################### ! Cloud (and precipitation) overlap ! #################################################################################### diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index a2bc0af2b..bcc394c82 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] name = GFS_rrtmgp_thompsonmp_pre type = scheme - dependencies = rrtmgp_aux.F90 + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] - name = GFS_rrtmgp_thompspnmp_pre_run + name = GFS_rrtmgp_thompsonmp_pre_run type = scheme [nCol] standard_name = horizontal_loop_extent @@ -212,7 +212,7 @@ intent = in optional = F [iovr] - standard_name = flag_for_cloud_overlap_method + standard_name = flag_for_cloud_overlap_method_for_radiation long_name = flag for cloud overlap method used by radiation scheme units = flag dimensions = () @@ -302,6 +302,30 @@ type = integer intent = in optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -426,7 +450,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_lwp] standard_name = cloud_liquid_water_path @@ -435,16 +459,16 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_iwp] standard_name = cloud_ice_water_path @@ -453,16 +477,16 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_swp] standard_name = cloud_snow_water_path @@ -476,7 +500,7 @@ [cld_resnow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -494,7 +518,7 @@ [cld_rerain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys From 0865ca98a4ac71c743d22e70acd7e204143adee0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 9 Nov 2020 16:08:58 -0700 Subject: [PATCH 03/27] Some readability changes --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 171 +++++++++++++------------- 1 file changed, 85 insertions(+), 86 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 646e45c31..c10252fee 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -4,19 +4,19 @@ ! ######################################################################################## module GFS_rrtmgp_thompsonmp_pre use machine, only: & - kind_phys + kind_phys use rrtmgp_aux, only: & - check_error_msg + check_error_msg use module_radiation_cloud_overlap, only: & - cmp_dcorr_lgth, & - get_alpha_exp + cmp_dcorr_lgth, & + get_alpha_exp use module_mp_thompson, only: & - calc_effectRad, & - Nt_c + calc_effectRad, & + Nt_c use module_mp_thompson_make_number_concentrations, only: & - make_IceNumber, & - make_DropletNumber, & - make_RainNumber + make_IceNumber, & + make_DropletNumber, & + make_RainNumber implicit none ! Parameters specific to THOMPSONMP scheme. @@ -26,30 +26,30 @@ module GFS_rrtmgp_thompsonmp_pre 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) cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme - - public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize - + + public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize + contains ! ###################################################################################### ! ###################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_init() end subroutine GFS_rrtmgp_thompsonmp_pre_init - + ! ###################################################################################### ! ###################################################################################### !! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run !! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html !! subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice,& - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, yearlen, doSWrad, doLWrad, effr_in, julian, & - lat, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, & - qs_lay, q_lay, relhum, cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, lmfdeep2, ltaerosol, & - iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, idcor_hogan, idcor_oreopoulos, & - do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, & + yearlen, doSWrad, doLWrad, effr_in, julian, lat, p_lev, p_lay, tv_lay, t_lay, & + effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, & + cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, & + lmfdeep2, ltaerosol, iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, & + idcor_hogan, idcor_oreopoulos, do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & deltaZb, errmsg, errflg) - implicit none ! Inputs integer, intent(in) :: & @@ -107,8 +107,8 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & tracer ! Cloud condensate amount in layer by type () - - ! In/Outs + + ! In/Outs real(kind_phys), dimension(nCol,nLev), intent(inout) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path @@ -143,15 +143,15 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate integer :: iCol,iLay,l,iSFC,iTOA real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& - re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa + re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa logical :: top_at_1 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. (doSWrad .or. doLWrad)) return - + ! What is vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then @@ -165,7 +165,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i ! #################################################################################### ! Pull out cloud information for THOMPSON MP scheme. ! #################################################################################### - + ! Cloud condensate cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water @@ -191,21 +191,21 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i orho = 1./rho do iLay = 1, nLev do iCol = 1, nCol - qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) - qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) - qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) - qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) - nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) - if (ltaerosol) then - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) - nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) - else - nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) - endif + qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + if (ltaerosol) then + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) + else + nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + endif enddo enddo - + ! Update number concentration, consistent with sub-grid clouds do iLay = 1, nLev do iCol = 1, nCol @@ -217,13 +217,13 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i endif enddo enddo - + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds ! Call Thompson's subroutine to compute effective radii do iCol=1,nCol call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & - nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & - re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) + nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & + re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) enddo ! Scale Thompson's effective radii from meter to micron and update global effective radii. @@ -234,61 +234,60 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) cld_rerain(1:nCol,1:nLev) = rerain_def - - ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these - ! magic numbers are coming from. + + ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these + ! magic numbers are coming from. if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv - ! Cloud-fraction - if (uni_cld) then + ! Cloud-fraction + if (uni_cld) then cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else - clwmin = 0.0 - if (.not. lmfshal) then - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + clwmin = 0.0 + if (.not. lmfshal) then + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) endif - enddo - enddo - else - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) - endif - enddo + enddo enddo - endif - endif - endif - + else + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + endif + enddo + enddo + endif + endif + endif + ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) ! #################################################################################### ! Cloud (and precipitation) overlap ! #################################################################################### - + ! ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) ! @@ -379,4 +378,4 @@ end subroutine GFS_rrtmgp_thompsonmp_pre_run ! ######################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_finalize() end subroutine GFS_rrtmgp_thompsonmp_pre_finalize -end module GFS_rrtmgp_thompsonmp_pre \ No newline at end of file +end module GFS_rrtmgp_thompsonmp_pre From c30535ff5fc1050b40f0e9d0536af08850e55087 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 10 Nov 2020 15:35:31 -0700 Subject: [PATCH 04/27] Further refinements to ThompsonMP - RRTMGP coupling --- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 192 ++++++++++++++++ physics/GFS_rrtmgp_cloud_overlap_pre.meta | 265 ++++++++++++++++++++++ physics/GFS_rrtmgp_thompsonmp_pre.F90 | 257 ++++++--------------- physics/GFS_rrtmgp_thompsonmp_pre.meta | 159 +------------ 4 files changed, 532 insertions(+), 341 deletions(-) create mode 100644 physics/GFS_rrtmgp_cloud_overlap_pre.F90 create mode 100644 physics/GFS_rrtmgp_cloud_overlap_pre.meta diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 new file mode 100644 index 000000000..08bc82d05 --- /dev/null +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -0,0 +1,192 @@ +! ######################################################################################## +! +! ######################################################################################## +module GFS_rrtmgp_cloud_overlap_pre + use machine, only: kind_phys + use rrtmgp_aux, only: check_error_msg + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + + public GFS_rrtmgp_cloud_overlap_pre_init, GFS_rrtmgp_cloud_overlap_pre_run, GFS_rrtmgp_cloud_overlap_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_cloud_overlap_pre_init() + end subroutine GFS_rrtmgp_cloud_overlap_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_cloud_overlap_pre_run +!! \htmlinclude GFS_rrtmgp_cloud_overlap_pre_run.html +!! + subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWrad, & + julian, lat, p_lev, p_lay, tv_lay, con_pi, con_g, con_rd, con_epsq, dcorr_con, & + idcor, iovr, iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, & + idcor_oreopoulos, cld_frac, & + cloud_overlap_param, precip_overlap_param, de_lgth, deltaZc, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + logical, intent(in) :: & + doSWrad, & ! Call SW radiation? + doLWrad ! Call LW radiation + real(kind_phys), intent(in) :: & + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq, & ! Physical constant: Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = idcor_con) + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + cld_frac ! Total cloud fraction + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZc ! Layer thickness (from layer-centers)(km) + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1,pfac + real(kind_phys), dimension(nLev+1) :: hgtb + real(kind_phys), dimension(nLev) :: hgtc + integer :: iCol,iLay,l,iSFC,iTOA + real(kind_phys), dimension(nCol,nLev) :: deltaZ + logical :: top_at_1 + + if (.not. (doSWrad .or. doLWrad)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! What is vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! + do iCol=1,nCol + if (top_at_1) then + ! Layer thickness (km) + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(nLev+1) = 0._kind_phys + do iLay=nLev,1,-1 + hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = nLev, 1, -1 + pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & + abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) + hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) + enddo + ! Layer thickness between centers + do iLay = nLev-1, 1, -1 + deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) + enddo + deltaZc(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) + else + do iLay=nLev,1,-1 + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(1) = 0._kind_phys + do iLay=1,nLev + hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = 1, nLev + pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & + abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) + hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) + enddo + ! Layer thickness between centers + do iLay = 2, nLev + deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) + enddo + deltaZc(iCol,1) = hgtc(1) - hgtb(1) + endif + enddo + + ! + ! Cloud decorrelation length + ! + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con + endif + + ! + ! Cloud overlap parameter + ! + if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then + call get_alpha_exp(nCol, nLev, deltaZc, de_lgth, cloud_overlap_param) + else + de_lgth(:) = 0. + cloud_overlap_param(:,:) = 0. + endif + + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 1, nLev + do iCol = 1, nCol + if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then + cloud_overlap_param(iCol,iLay) = 0._kind_phys + endif + enddo + enddo + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + + end subroutine GFS_rrtmgp_cloud_overlap_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_cloud_overlap_pre_finalize() + end subroutine GFS_rrtmgp_cloud_overlap_pre_finalize +end module GFS_rrtmgp_cloud_overlap_pre diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.meta b/physics/GFS_rrtmgp_cloud_overlap_pre.meta new file mode 100644 index 000000000..273832362 --- /dev/null +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.meta @@ -0,0 +1,265 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_cloud_overlap_pre + type = scheme + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_cloud_overlap_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + intent = in + kind = kind_phys + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = flag for cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor] + standard_name = flag_for_decorrelation_length_method + long_name = flag for decorrelation length method used in cloud overlap method (iovr) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_con] + standard_name = flag_for_constant_decorrelation_length_method + long_name = choice of decorrelation length computation (costant) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_hogan] + standard_name = flag_for_hogan_decorrelation_length_method + long_name = choice of decorrelation length computation (hogan) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_oreopoulos] + standard_name = flag_for_oreopoulos_decorrelation_length_method + long_name = choice of decorrelation length computation (oreopoulos) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dcorr_con] + standard_name = decorreltion_length_used_by_overlap_method + long_name = decorrelation length (default) used by cloud overlap method (iovr) + units = km + dimensions = () + type = real + intent = in + kind = kind_phys + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZc] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index c10252fee..758e810fb 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -7,9 +7,6 @@ module GFS_rrtmgp_thompsonmp_pre kind_phys use rrtmgp_aux, only: & check_error_msg - use module_radiation_cloud_overlap, only: & - cmp_dcorr_lgth, & - get_alpha_exp use module_mp_thompson, only: & calc_effectRad, & Nt_c @@ -40,16 +37,14 @@ end subroutine GFS_rrtmgp_thompsonmp_pre_init !! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run !! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html !! - subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice,& - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, & - yearlen, doSWrad, doLWrad, effr_in, julian, lat, p_lev, p_lay, tv_lay, t_lay, & - effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, & - cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, & - lmfdeep2, ltaerosol, iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, & - idcor_hogan, idcor_oreopoulos, do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & - deltaZb, errmsg, errflg) + subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, doLWrad, & + i_cldliq, i_cldice, i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, & + i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & + effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, cld_frac_mg, con_g, & + con_rd, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & + imfdeepcnv_gf, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -66,15 +61,6 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i i_cldliq_nc, & ! cloud liquid number concentration. i_cldice_nc, & ! cloud ice number concentration. i_twa, & ! water friendly aerosol. - yearlen, & ! Length of current year (365/366) WTF? - iovr, & ! Choice of cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos, & ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) imfdeepcnv, & ! Choice of mass-flux deep convection scheme imfdeepcnv_gf ! Flag for Grell-Freitas deep convection scheme logical, intent(in) :: & @@ -87,14 +73,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i ltaerosol, & ! do_mynnedmf ! Flag to activate MYNN-EDMF real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant(?): Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = 0, default is idcor = 1) - real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude (radians) + con_rd ! Physical constant: gas-constant for dry air + real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) t_lay, & ! Temperature (K) @@ -120,28 +101,21 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i effrin_cldsnow ! Effective radius for snow cloud-particles (microns) ! Outputs - real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param, & ! Precipitation overlap parameter - deltaZb ! Layer thickness (km) + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag ! Local variables - real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, clwmin, clwf - real(kind_phys), dimension(nLev+1) :: hgtb - real(kind_phys), dimension(nLev) :: hgtc + real(kind_phys) :: alpha0, pfac, tem1, cld_mr real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,iSFC,iTOA + integer :: iCol,iLay,l real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa logical :: top_at_1 @@ -151,21 +125,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i errflg = 0 if (.not. (doSWrad .or. doLWrad)) return - - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif - - ! #################################################################################### - ! Pull out cloud information for THOMPSON MP scheme. - ! #################################################################################### - + ! Cloud condensate cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water @@ -235,147 +195,74 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) cld_rerain(1:nCol,1:nLev) = rerain_def - ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these - ! magic numbers are coming from. + ! Compute cloud-fraction. Else, use value provided if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv ! Cloud-fraction if (uni_cld) then cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else - clwmin = 0.0 - if (.not. lmfshal) then - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) - endif - enddo - enddo - else - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) - endif - enddo + if( lmfshal) alpha0 = 100. ! Default + if(.not. lmfshal) alpha0 = 2000. + ! Xu-Randall (1996) cloud-fraction + do iLay = 1, nLev + do iCol = 1, nCol + cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & + cld_condensate(iCol,iLay,4) + cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0) enddo - endif + enddo endif endif ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) - ! #################################################################################### - ! Cloud (and precipitation) overlap - ! #################################################################################### - - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! - do iCol=1,nCol - if (top_at_1) then - ! Layer thickness (km) - do iLay=1,nLev - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(nLev+1) = 0._kind_phys - do iLay=nLev,1,-1 - hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = nLev, 1, -1 - pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & - abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) - hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) - enddo - ! Layer thickness between centers - do iLay = nLev-1, 1, -1 - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) - enddo - deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) - else - do iLay=nLev,1,-1 - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(1) = 0._kind_phys - do iLay=1,nLev - hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = 1, nLev - pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & - abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) - hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) - enddo - ! Layer thickness between centers - do iLay = 2, nLev - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) - enddo - deltaZb(iCol,1) = hgtc(1) - hgtb(1) - endif - enddo - - ! - ! Cloud decorrelation length - ! - if (idcor == idcor_hogan) then - call cmp_dcorr_lgth(nCol, abs(lat/con_pi), con_pi, de_lgth) - endif - if (idcor == idcor_oreopoulos) then - call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) - endif - if (idcor == idcor_con) then - de_lgth(:) = dcorr_con - endif - - ! - ! Cloud overlap parameter - ! - call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) - - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then - do iLay = 1, nLev - do iCol = 1, nCol - if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then - cloud_overlap_param(iCol,iLay) = 0._kind_phys - endif - enddo - enddo - endif - - ! - ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) - ! - precip_overlap_param = cloud_overlap_param - end subroutine GFS_rrtmgp_thompsonmp_pre_run - ! ######################################################################################### - ! ######################################################################################### + ! ###################################################################################### + ! ###################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_finalize() end subroutine GFS_rrtmgp_thompsonmp_pre_finalize + + ! ###################################################################################### + ! 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 + ! + ! ###################################################################################### + function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) + + ! 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 end module GFS_rrtmgp_thompsonmp_pre diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index bcc394c82..b00e27fd8 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_thompsonmp_pre type = scheme - dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 + dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] @@ -203,105 +203,6 @@ kind = kind_phys intent = in optional = F -[yearlen] - standard_name = number_of_days_in_year - long_name = number of days in a year - units = days - dimensions = () - type = integer - intent = in - optional = F -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = flag for cloud overlap method used by radiation scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[julian] - standard_name = julian_day - long_name = julian day - units = days - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_dimension) - type = real - intent = in - kind = kind_phys - optional = F -[idcor] - standard_name = flag_for_decorrelation_length_method - long_name = flag for decorrelation length method used in cloud overlap method (iovr) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[dcorr_con] - standard_name = decorreltion_length_used_by_overlap_method - long_name = decorrelation length (default) used by cloud overlap method (iovr) - units = km - dimensions = () - type = real - intent = in - kind = kind_phys - optional = F -[idcor_con] - standard_name = flag_for_constant_decorrelation_length_method - long_name = choice of decorrelation length computation (costant) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_hogan] - standard_name = flag_for_hogan_decorrelation_length_method - long_name = choice of decorrelation length computation (hogan) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_oreopoulos] - standard_name = flag_for_oreopoulos_decorrelation_length_method - long_name = choice of decorrelation length computation (oreopoulos) - units = flag - dimensions = () - type = integer - intent = in - optional = F [do_mynnedmf] standard_name = do_mynnedmf long_name = flag to activate MYNN-EDMF @@ -398,15 +299,6 @@ kind = kind_phys intent = in optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -424,25 +316,7 @@ type = real kind = kind_phys intent = in - optional = F -[con_epsq] - standard_name = minimum_value_of_specific_humidity - long_name = floor value for specific humidity - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -532,34 +406,7 @@ type = real kind = kind_phys intent = out - optional = F -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[deltaZb] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 254382d85426c65a5c1b3193ad50fd4255d2267c Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 12 Nov 2020 13:27:45 -0700 Subject: [PATCH 05/27] Cleanup of GP-ThMP interface. New scheme file for cloud-overlap pre. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 192 ++++---------------------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 155 +-------------------- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 36 ++--- 3 files changed, 45 insertions(+), 338 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 52e1a7b74..31c67d62f 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -14,8 +14,7 @@ module GFS_rrtmgp_gfdlmp_pre 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 scheme - reice_max = 150.0, & ! Maximum ice size allowed by scheme - cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + reice_max = 150.0 ! Maximum ice size allowed by scheme public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize @@ -31,13 +30,11 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, doSWrad, doLWrad, effr_in, & - julian, lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & - effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, dcorr_con, idcor, iovr, & - iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, idcor_oreopoulos, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, doSWrad, doLWrad, effr_in, & + p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + effrin_cldsnow, tracer, con_g, con_rd, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & - deltaZb, errmsg, errflg) + cld_rerain, precip_frac, errmsg, errflg) implicit none ! Inputs @@ -51,29 +48,14 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld i_cldrain, & ! Index into tracer array for cloud rain. i_cldsnow, & ! Index into tracer array for cloud snow. i_cldgrpl, & ! Index into tracer array for cloud groupel. - i_cldtot, & ! Index into tracer array for cloud total amount. - yearlen, & ! Length of current year (365/366) WTF? - iovr, & ! Choice of cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + i_cldtot ! Index into tracer array for cloud total amount. logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation effr_in ! Provide hydrometeor radii from macrophysics? real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant(?): Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = idcor_con) - real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude + con_rd ! Physical constant: gas-constant for dry air real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) p_lay, & ! Pressure at model-layers (Pa) @@ -87,8 +69,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld tracer ! Cloud condensate amount in layer by type () ! Outputs - real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path @@ -99,10 +79,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param, & ! Precipitation overlap parameter - deltaZb ! Layer thickness (km) + precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -110,10 +87,8 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Local variables real(kind_phys) :: tem1,pfac - real(kind_phys), dimension(nLev+1) :: hgtb - real(kind_phys), dimension(nLev) :: hgtc real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,ncndl,iSFC,iTOA + integer :: iCol,iLay,l,ncndl real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ logical :: top_at_1 @@ -131,16 +106,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld return endif - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif - ! Initialize outputs cld_lwp(:,:) = 0.0 cld_reliq(:,:) = reliq_def @@ -161,143 +126,38 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - ! Since we combine the snow and grapuel, define local variable for number of condensate types. - ncndl = min(4,ncnd) - - ! Set really tiny suspended particle amounts to clear - do l=1,ncndl - do iLay=1,nLev - do iCol=1,nCol - if (cld_condensate(iCol,iLay,l) < con_epsq) cld_condensate(iCol,iLay,l) = 0.0 - enddo - enddo - enddo - - ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) - - ! Precipitation fraction (Hack. For now use cloud-fraction) - precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) - - ! Condensate and effective size + ! Cloud water path (g/m2) deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay = 1, nLev do iCol = 1, nCol ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(iCol,iLay) .ge. cllimit) then - tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) - cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 - cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 - cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 - cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 - endif + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) + cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) + cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + enddo + enddo + + ! Particle size + do iLay = 1, nLev + do iCol = 1, nCol ! Use radii provided from the macrophysics if (effr_in) then cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) - else - cld_reliq(iCol,iLay) = reliq_def - cld_reice(iCol,iLay) = reice_def - cld_rerain(iCol,iLay) = rerain_def - cld_resnow(iCol,iLay) = resnow_def endif enddo enddo - ! #################################################################################### - ! Cloud (and precipitation) overlap - ! #################################################################################### - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! - do iCol=1,nCol - if (top_at_1) then - ! Layer thickness (km) - do iLay=1,nLev - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(nLev+1) = 0._kind_phys - do iLay=nLev,1,-1 - hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = nLev, 1, -1 - pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & - abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) - hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) - enddo - ! Layer thickness between centers - do iLay = nLev-1, 1, -1 - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) - enddo - deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) - else - do iLay=nLev,1,-1 - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(1) = 0._kind_phys - do iLay=1,nLev - hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = 1, nLev - pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & - abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) - hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) - enddo - ! Layer thickness between centers - do iLay = 2, nLev - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) - enddo - deltaZb(iCol,1) = hgtc(1) - hgtb(1) - endif - enddo - - ! - ! Cloud decorrelation length - ! - if (idcor == idcor_hogan) then - call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) - endif - if (idcor == idcor_oreopoulos) then - call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) - endif - if (idcor == idcor_con) then - de_lgth(:) = dcorr_con - endif - - ! - ! Cloud overlap parameter - ! - if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then - call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) - else - de_lgth(:) = 0. - cloud_overlap_param(:,:) = 0. - endif - - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then - do iLay = 1, nLev - do iCol = 1, nCol - if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then - cloud_overlap_param(iCol,iLay) = 0._kind_phys - endif - enddo - enddo - endif - - ! - ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) - ! - precip_overlap_param = cloud_overlap_param + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + end subroutine GFS_rrtmgp_gfdlmp_pre_run ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 90f4d5daf..5894d9f5d 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -146,32 +146,6 @@ type = real kind = kind_phys intent = in - optional = F -[yearlen] - standard_name = number_of_days_in_year - long_name = number of days in a year - units = days - dimensions = () - type = integer - intent = in - optional = F -[julian] - standard_name = julian_day - long_name = julian day - units = days - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - intent = in - kind = kind_phys optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa @@ -209,15 +183,6 @@ kind = kind_phys intent = in optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -236,97 +201,6 @@ kind = kind_phys intent = in optional = F -[con_epsq] - standard_name = minimum_value_of_specific_humidity - long_name = floor value for specific humidity - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = flag for cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor] - standard_name = flag_for_decorrelation_length_method - long_name = flag for decorrelation length method used in cloud overlap method (iovr) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_con] - standard_name = flag_for_constant_decorrelation_length_method - long_name = choice of decorrelation length computation (costant) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_hogan] - standard_name = flag_for_hogan_decorrelation_length_method - long_name = choice of decorrelation length computation (hogan) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_oreopoulos] - standard_name = flag_for_oreopoulos_decorrelation_length_method - long_name = choice of decorrelation length computation (oreopoulos) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[dcorr_con] - standard_name = decorreltion_length_used_by_overlap_method - long_name = decorrelation length (default) used by cloud overlap method (iovr) - units = km - dimensions = () - type = real - intent = in - kind = kind_phys - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -416,34 +290,7 @@ type = real kind = kind_phys intent = out - optional = F -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[deltaZb] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 758e810fb..8b63090c0 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -16,13 +16,9 @@ module GFS_rrtmgp_thompsonmp_pre make_RainNumber implicit none - ! Parameters specific to THOMPSONMP scheme. + ! Parameters specific to THOMPSON MP scheme. real(kind_phys), parameter :: & - 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) - 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) - cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + rerain_def = 1000.0 ! Default rain radius to 1000 microns public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize @@ -67,10 +63,10 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation effr_in, & ! Use cloud effective radii provided by model? - uni_cld, & ! - lmfshal, & ! - lmfdeep2, & ! - ltaerosol, & ! + uni_cld, & ! Use provided cloud-fraction? + lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall + lmfdeep2, & ! Flag for some scale-aware mass-flux convection scheme active + ltaerosol, & ! Flag for aerosol option do_mynnedmf ! Flag to activate MYNN-EDMF real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant @@ -133,7 +129,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - ! Cloud particle size + ! Cloud water path (g/m2) deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay = 1, nLev do iCol = 1, nCol @@ -146,22 +142,23 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do enddo enddo + ! Cloud particle sizes and number concentrations... + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) orho = 1./rho do iLay = 1, nLev do iCol = 1, nCol qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) - qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) - qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) - qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) - nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) if (ltaerosol) then - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) else nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) endif enddo enddo @@ -201,7 +198,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do if (uni_cld) then cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else - if( lmfshal) alpha0 = 100. ! Default + if( lmfshal) alpha0 = 100. ! Default (from GATE simulations) if(.not. lmfshal) alpha0 = 2000. ! Xu-Randall (1996) cloud-fraction do iLay = 1, nLev @@ -242,10 +239,13 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) 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, & ! From e2143c4b0cc7f3c9550b3258029ac8dbbb2726f2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 16 Nov 2020 14:45:39 -0700 Subject: [PATCH 06/27] Added option for including scattering in LW clouds. --- physics/rrtmgp_lw_cloud_optics.F90 | 47 +++++++------ physics/rrtmgp_lw_cloud_optics.meta | 12 +++- physics/rrtmgp_lw_cloud_sampling.F90 | 19 ++--- physics/rrtmgp_lw_cloud_sampling.meta | 16 +++-- physics/rrtmgp_lw_rte.F90 | 99 ++++++++++++++++++--------- physics/rrtmgp_lw_rte.meta | 14 +++- physics/rrtmgp_sampling.F90 | 9 ++- physics/rrtmgp_sw_cloud_optics.F90 | 16 ++--- physics/rrtmgp_sw_cloud_sampling.F90 | 4 +- 9 files changed, 152 insertions(+), 84 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index f45f08dd1..a7aeecffe 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -3,7 +3,7 @@ module rrtmgp_lw_cloud_optics use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf @@ -20,14 +20,15 @@ module rrtmgp_lw_cloud_optics contains - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_init() - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & - nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, & + mpirank, mpiroot, lw_cloud_props, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -52,7 +53,7 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ integer, intent(out) :: & errflg ! Error code - ! Variables that will be passed to cloud_optics%load() + ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -264,16 +265,16 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ end subroutine rrtmgp_lw_cloud_optics_init - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_run() - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_cloud_optics_run !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, & - cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & - precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nrghice, p_lay, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) ! Inputs @@ -281,7 +282,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw doLWrad, & ! Logical flag for longwave radiation call doG_cldoptics, & ! Use legacy RRTMG cloud-optics? doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -313,7 +315,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - type(ty_optical_props_1scl),intent(out) :: & + type(ty_optical_props_2str),intent(inout) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) real(kind_phys), dimension(ncol,nLev), intent(out) :: & @@ -337,14 +339,19 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw ! Allocate space for RRTMGP DDTs containing cloud radiative properties ! Cloud optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + ! Precipitation optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_1scl(& - ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + ! Compute cloud-optics for RTE. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! i) RRTMGP cloud-optics. @@ -388,7 +395,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) - + end subroutine rrtmgp_lw_cloud_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 809e8abf0..cf0418eb4 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -159,6 +159,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -321,7 +329,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [lw_optical_props_precipByBand] @@ -329,7 +337,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [errmsg] diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index cfb86eb3a..7120e125b 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,7 +1,7 @@ module rrtmgp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg @@ -47,12 +47,13 @@ end subroutine rrtmgp_lw_cloud_sampling_init subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & - lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & + doGP_lwscat, lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for shortwave radiation call + doLWrad, & ! Logical flag for shortwave radiation call + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical layers @@ -78,7 +79,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data - type(ty_optical_props_1scl),intent(in) :: & + type(ty_optical_props_2str),intent(in) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) @@ -87,7 +88,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - type(ty_optical_props_1scl),intent(out) :: & + type(ty_optical_props_2str),intent(out) :: & lw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (clouds) lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) @@ -112,7 +113,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& - lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) + lw_optical_props_clouds%alloc_2str(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -170,7 +171,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_lw_cloud_sampling_run_draw_samples',& - draw_samples(cldfracMCICA, & + draw_samples(cldfracMCICA, doGP_lwscat, & lw_optical_props_cloudsByBand, & lw_optical_props_clouds)) @@ -180,7 +181,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& - lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) + lw_optical_props_precip%alloc_2str(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -230,7 +231,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_lw_precip_sampling_run_draw_samples',& - draw_samples(precipfracSAMP, & + draw_samples(precipfracSAMP, doGP_lwscat, & lw_optical_props_precipByBand, & lw_optical_props_precip)) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 54f3c63af..2438f715c 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -53,6 +53,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -198,7 +206,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = in optional = F [lw_optical_props_precipByBand] @@ -206,7 +214,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = in optional = F [lw_optical_props_clouds] @@ -214,7 +222,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [lw_optical_props_precip] @@ -222,7 +230,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [errmsg] diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index dc49260f6..ccbd80629 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -5,7 +5,7 @@ module rrtmgp_lw_rte use mo_rte_kind, only: wl use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rte_lw, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband use mo_source_functions, only: ty_source_func_lw @@ -28,17 +28,18 @@ end subroutine rrtmgp_lw_rte_init !! \section arg_table_rrtmgp_lw_rte_run !! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p_lay, & - t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky,& - lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & - fluxlwDOWN_jac, errmsg, errflg) + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & + nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, & + lw_optical_props_clrsky, lw_optical_props_clouds, lw_optical_props_aerosol, & + nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & + fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad, & ! Logical flag for longwave radiation call doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? - use_LW_jacobian ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -57,10 +58,11 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p type(ty_source_func_lw),intent(in) :: & sources ! RRTMGP DDT: longwave source functions type(ty_optical_props_1scl),intent(inout) :: & + lw_optical_props_aerosol, &! RRTMGP DDT: longwave aerosol radiative properties lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties - type(ty_optical_props_1scl),intent(in) :: & - lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties - lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_optical_props_2str),intent(inout) :: & + lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties + ! Outputs real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) @@ -106,6 +108,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) + !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%finalize()) ! Call RTE solver if (doLWclrsky) then @@ -128,31 +131,61 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! ! All-sky fluxes ! - ! Add cloud optics to clear-sky optics - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - ! Call RTE solver - if (use_LW_jacobian) then - ! Compute LW Jacobians - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) - flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Add clear-sky optics to cloud-optics (2-stream) + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%increment(lw_optical_props_clouds)) + !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%finalize()) + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + ! No scattering in LW clouds. else - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature - end if - + ! Add cloud optics to clear-sky optics (scalar) + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) + !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%finalize()) + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + endif + ! Store fluxes fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 857ab834c..7adcc2c74 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -32,6 +32,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -122,8 +130,8 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl - intent = in + type = ty_optical_props_2str + intent = inout optional = F [lw_optical_props_aerosol] standard_name = longwave_optical_properties_for_aerosols @@ -131,7 +139,7 @@ units = DDT dimensions = () type = ty_optical_props_1scl - intent = in + intent = inout optional = F [sources] standard_name = longwave_source_function diff --git a/physics/rrtmgp_sampling.F90 b/physics/rrtmgp_sampling.F90 index 29a9064a2..3974da359 100644 --- a/physics/rrtmgp_sampling.F90 +++ b/physics/rrtmgp_sampling.F90 @@ -36,9 +36,10 @@ module rrtmgp_sampling ! McICA-sampled cloud optical properties ! ! ------------------------------------------------------------------------------------------------- - function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) + function draw_samples(cloud_mask,do_twostream,clouds,clouds_sampled) result(error_msg) ! Inputs logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt + logical, intent(in ) :: do_twostream ! Do two-stream? class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band ! Outputs @@ -66,8 +67,10 @@ function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) type is (ty_optical_props_2str) select type(clouds_sampled) type is (ty_optical_props_2str) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + if (do_twostream) then + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + endif class default error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" end select diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 505fe7853..fec067d9e 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -1,8 +1,8 @@ module rrtmgp_sw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_aux, only: check_error_msg @@ -20,15 +20,15 @@ module rrtmgp_sw_cloud_optics real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s contains - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & - nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props,& - errmsg, errflg) + subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, & + mpirank, mpiroot, sw_cloud_props, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -53,7 +53,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ integer, intent(out) :: & errflg ! CCPP error code - ! Variables that will be passed to cloud_optics%load() + ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -276,7 +276,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & - 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) end subroutine rrtmgp_sw_cloud_optics_init diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index ba4097e96..e74ceb4e5 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -181,7 +181,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_sw_cloud_sampling_run_draw_samples', & - draw_samples(cldfracMCICA, & + draw_samples(cldfracMCICA, .true., & sw_optical_props_cloudsByBand, & sw_optical_props_clouds)) @@ -239,7 +239,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_sw_precip_sampling_run_draw_samples', & - draw_samples(precipfracSAMP, & + draw_samples(precipfracSAMP, .true., & sw_optical_props_precipByBand, & sw_optical_props_precip)) From 92eb240ca610c8dec846e5d4c6774c2ce0e60ddd Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 16 Nov 2020 17:33:50 -0700 Subject: [PATCH 07/27] Added finalize calls to rrtmgp_lw_rte --- physics/rrtmgp_lw_rte.F90 | 6 +++--- physics/rte-rrtmgp | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index ccbd80629..bc7bdd5bd 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -108,7 +108,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, ! ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) - !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%finalize()) + call lw_optical_props_aerosol%finalize() ! Call RTE solver if (doLWclrsky) then @@ -136,7 +136,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, if (doGP_lwscat) then ! Add clear-sky optics to cloud-optics (2-stream) call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%increment(lw_optical_props_clouds)) - !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%finalize()) + call lw_optical_props_clrsky%finalize() if (use_LW_jacobian) then ! Compute LW Jacobians @@ -162,7 +162,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, else ! Add cloud optics to clear-sky optics (scalar) call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%finalize()) + call lw_optical_props_clouds%finalize() if (use_LW_jacobian) then ! Compute LW Jacobians diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..38822b3cc 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 38822b3cc686517ab87a039e5dedd57ebbe527d2 From e0643105f0c540ff268ccd4b317b9a9c31c3893a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 17 Nov 2020 11:08:59 -0700 Subject: [PATCH 08/27] Bug fix in LW Jacobian application --- physics/GFS_suite_interstitial.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 551f0e600..38ea1800a 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -245,10 +245,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (use_GP_jacobian) then ! Compute adjustment to the surface flux using Jacobian. if(linit_mod) then - dT(:) = (skt(:) - sktp1r(:)) + dT(:) = (sktp1r(:) - skt(:)) adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) else - adjsfculw(:) = 0. + adjsfculw(:) = fluxlwUP(:,1) linit_mod = .true. endif From 13ea6a534485be5ee9fcc89e6b17c90d01584428 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 10:45:09 -0700 Subject: [PATCH 09/27] Housekeeping --- physics/rrtmgp_lw_rte.F90 | 15 ++++----------- physics/rrtmgp_lw_rte.meta | 27 --------------------------- 2 files changed, 4 insertions(+), 38 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index bc7bdd5bd..cf85aa7f2 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -29,10 +29,10 @@ end subroutine rrtmgp_lw_rte_init !! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, & - lw_optical_props_clrsky, lw_optical_props_clouds, lw_optical_props_aerosol, & - nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac, errmsg, errflg) + nLev, p_lev, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac,& + errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -44,13 +44,8 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nGauss_angles ! Number of angles used in Gaussian quadrature - real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) - t_lay ! Temperature (K) real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & p_lev ! Pressure @ model layer-interfaces (hPa) - real(kind_phys), dimension(ncol), intent(in) :: & - skt ! Surface(skin) temperature (K) type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: longwave spectral information real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & @@ -79,8 +74,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) ! Local variables - integer :: & - iCol, iBand, iLay type(ty_fluxes_byband) :: & flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 7adcc2c74..443792edf 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -64,15 +64,6 @@ type = integer intent = in optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure layer - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level @@ -82,24 +73,6 @@ kind = kind_phys intent = in optional = F -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[skt] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band long_name = surface emissivity in each RRTMGP LW band From 567b003bce2171da350c883c3b31dca43c261998 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 12:21:50 -0700 Subject: [PATCH 10/27] Add guard against out-of-range effective radii used by LUTs in GP cloud-optics. --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 11 ++++++++++- physics/GFS_rrtmgp_thompsonmp_pre.meta | 2 +- physics/rrtmgp_lw_cloud_optics.F90 | 13 +++++++++---- physics/rrtmgp_sw_cloud_optics.F90 | 13 +++++++++---- 4 files changed, 29 insertions(+), 10 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 8b63090c0..a4dbac22c 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -14,6 +14,7 @@ module GFS_rrtmgp_thompsonmp_pre make_IceNumber, & make_DropletNumber, & make_RainNumber + use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr implicit none ! Parameters specific to THOMPSON MP scheme. @@ -183,10 +184,18 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) enddo - ! Scale Thompson's effective radii from meter to micron and update global effective radii. + ! Scale Thompson's effective radii from meter to micron effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 + + ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from + ! 2.5 - 21.5 microns for liquid clouds, + ! 10 - 180 microns for ice-clouds + effrin_cldliq = max(radliq_lwr, effrin_cldliq, radliq_upr) + effrin_cldice = max(radice_lwr, effrin_cldice, radice_upr) + + ! Update global effective radii arrays. cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index b00e27fd8..e3baf1f6f 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_thompsonmp_pre type = scheme - dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 + dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90, rrtmgp_lw_cloud_optics.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index a7aeecffe..1086cee7c 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -17,6 +17,11 @@ module rrtmgp_lw_cloud_optics absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr ! Ice particle size lower bound for LUT interpolation contains @@ -55,11 +60,11 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr, & ! Ice particle size lower bound for LUT interpolation + !radice_lwr, & ! Ice particle size upper bound for LUT interpolation + !radice_upr, & ! Ice particle size lower bound for LUT interpolation radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & lut_extliq, & ! LUT shortwave liquid extinction coefficient diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index fec067d9e..92f007a99 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -18,6 +18,11 @@ module rrtmgp_sw_cloud_optics a0s = 0.0, & ! a1s = 1.5 ! real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr ! Ice particle size lower bound for LUT interpolation contains ! ###################################################################################### @@ -55,11 +60,11 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr, & ! Ice particle size lower bound for LUT interpolation + !radice_lwr, & ! Ice particle size upper bound for LUT interpolation + !radice_upr, & ! Ice particle size lower bound for LUT interpolation radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & lut_extliq, & ! LUT shortwave liquid extinction coefficient From 26bd34afdc36c4468d2f1d7ed2f501862ad2c1f9 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 12:43:18 -0700 Subject: [PATCH 11/27] Bug in previous commit --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index a4dbac22c..710c75ef8 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -192,9 +192,11 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from ! 2.5 - 21.5 microns for liquid clouds, ! 10 - 180 microns for ice-clouds - effrin_cldliq = max(radliq_lwr, effrin_cldliq, radliq_upr) - effrin_cldice = max(radice_lwr, effrin_cldice, radice_upr) - + where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr + where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr + where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr + where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + ! Update global effective radii arrays. cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) From f81a1943629cb6158dd8f514e4ab330ed5ecf578 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 14:12:53 -0700 Subject: [PATCH 12/27] Added logic to pnly guard effective radii when using GP cloud-optics. --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 16 ++++++++++------ physics/GFS_rrtmgp_thompsonmp_pre.meta | 18 +++++++++++++++++- 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 710c75ef8..bd109ddf4 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -39,7 +39,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, cld_frac_mg, con_g, & con_rd, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & - imfdeepcnv_gf, & + imfdeepcnv_gf, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, errmsg, errflg) @@ -68,7 +68,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall lmfdeep2, & ! Flag for some scale-aware mass-flux convection scheme active ltaerosol, & ! Flag for aerosol option - do_mynnedmf ! Flag to activate MYNN-EDMF + do_mynnedmf, & ! Flag to activate MYNN-EDMF + doGP_cldoptics_LUT,& ! Flag to do GP cloud-optics (LUTs) + doGP_cldoptics_PADE ! (PADE approximation) real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant con_rd ! Physical constant: gas-constant for dry air @@ -192,10 +194,12 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from ! 2.5 - 21.5 microns for liquid clouds, ! 10 - 180 microns for ice-clouds - where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr - where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr - where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr - where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr + where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr + where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr + where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + endif ! Update global effective radii arrays. cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index e3baf1f6f..2368a7337 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -226,7 +226,23 @@ dimensions = () type = integer intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation From cfc437e6ad5d37400ac01fe022e54b3323a15b02 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 24 Nov 2020 11:31:34 -0700 Subject: [PATCH 13/27] Some changes tot est in UFS. --- physics/GFS_rrtmgp_lw_post.F90 | 10 +++--- physics/GFS_rrtmgp_lw_post.meta | 12 ++++---- physics/GFS_rrtmgp_pre.F90 | 46 +++++++++++++++++++++++----- physics/GFS_rrtmgp_pre.meta | 8 +++++ physics/rrtmgp_lw_cloud_optics.F90 | 10 +++--- physics/rrtmgp_lw_cloud_sampling.F90 | 8 +++-- physics/rrtmgp_lw_gas_optics.F90 | 10 +++--- physics/rrtmgp_lw_gas_optics.meta | 2 +- 8 files changed, 75 insertions(+), 31 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 537ce8879..e6f6a59a5 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -65,12 +65,12 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & sfcdlw, & ! Total sky sfc downward lw flux (W/m2) tsflw ! surface air temp during lw calculation (K) - type(sfcflw_type), dimension(nCol), intent(out) :: & + type(sfcflw_type), dimension(nCol), intent(inout) :: & sfcflw ! LW radiation fluxes at sfc - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrlw ! LW all-sky heating rate type(topflw_type), dimension(nCol), intent(out) :: & topflw ! lw_fluxes_top_atmosphere @@ -80,13 +80,13 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag errflg ! Outputs (optional) - type(proflw_type), dimension(nCol, nLev+1), optional, intent(out) :: & + type(proflw_type), dimension(nCol, nLev+1), optional, intent(inout) :: & flxprf_lw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrlwc ! Longwave clear-sky heating-rate (K/sec) ! Local variables diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 2218bc55e..a87b6adcb 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -196,7 +196,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcflw] standard_name = lw_fluxes_sfc @@ -204,7 +204,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = sfcflw_type - intent = out + intent = inout optional = F [tsflw] standard_name = surface_midlayer_air_temperature_in_longwave_radiation @@ -213,7 +213,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [htrlw] standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step @@ -222,7 +222,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [topflw] standard_name = lw_fluxes_top_atmosphere @@ -238,7 +238,7 @@ units = W m-2 dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = proflw_type - intent = out + intent = inout optional = T [htrlwc] standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step @@ -247,7 +247,7 @@ dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys - intent = out + intent = inout optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index f4542dffb..35e1eb67c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -145,7 +145,7 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,& - con_epsm1, con_fvirt, con_epsqs, & + con_epsm1, con_fvirt, con_epsqs, lw_gas_props, & raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& gas_concentrations, errmsg, errflg) @@ -181,6 +181,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, prsi ! Pressure at model-interfaces (Pa) real(kind_phys), dimension(nCol,nLev,nTracers) :: & qgrs ! Tracer concentrations (kg/kg) + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: ! Outputs character(len=*), intent(out) :: & @@ -198,7 +200,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers relhum, & ! Relative-humidity at model-layers - qs_lay ! Saturation vapor pressure at model-layers + qs_lay ! Saturation vapor pressure at model-layers real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface @@ -212,7 +214,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, logical :: top_at_1 real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, tem1, tem2 - real(kind_phys), dimension(nCol,nLev) :: o3_lay + real(kind_phys), dimension(nCol,nLev) :: o3_lay, tem2da, tem2db real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables @@ -250,14 +252,44 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) - ! Temperature at layer-interfaces + ! Temperature at layer-interfaces if (top_at_1) then + tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) + tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1) ) + tem2db(iCol,1) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,1)) ) + tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) + enddo + ! t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) - t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + do iLay = 2, iSFC + do iCol = 1, nCol + t_lev(iCol,iLay) = t_lay(iCol,iLay) + (t_lay(iCol,iLay-1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) + enddo + enddo + !t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else + tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) + tem2db(1:nCol,2:iTOA) = log(p_lev(1:nCol,2:iTOA)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1)) + tem2db(iCol,1) = log(p_lev(iCol,1)) + tem2db(iCol,iTOA) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,iTOA)) ) + enddo + ! t_lev(1:NCOL,1) = tsfc(1:NCOL) - t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + do iLay = 1, iTOA-1 + do iCol = 1, nCol + t_lev(iCol,iLay+1) = t_lay(iCol,iLay) + (t_lay(iCol,iLay+1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) + enddo + enddo + !t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif @@ -321,7 +353,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### tsfg(1:NCOL) = tsfc(1:NCOL) - tsfa(1:NCOL) = tsfc(1:NCOL) + tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)!tsfc(1:NCOL) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 904c0e4e7..136898bb3 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -247,6 +247,14 @@ kind = kind_phys intent = in optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 1086cee7c..023df62ec 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -347,14 +347,14 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - lw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys lw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys ! Precipitation optics [nCol,nLev,nBands] call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - lw_optical_props_precipByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys lw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. @@ -393,9 +393,9 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & cld_frac, icliq_lw, icice_lw, tau_cld, tau_precip) - endif - lw_optical_props_cloudsByBand%tau = tau_cld - lw_optical_props_precipByBand%tau = tau_precip + lw_optical_props_cloudsByBand%tau = tau_cld + lw_optical_props_precipByBand%tau = tau_precip + endif endif ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 7120e125b..902a4e20f 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -12,7 +12,7 @@ module rrtmgp_lw_cloud_sampling contains ! ######################################################################################### - ! SUBROUTINE mcica_init + ! SUBROUTINE rrtmgp_lw_cloud_sampling_init() ! ######################################################################################### !! \section arg_table_rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_init.html @@ -97,8 +97,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables @@ -114,6 +114,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_2str(nCol, nLev, lw_gas_props)) + lw_optical_props_clouds%tau(:,:,:) = 0._kind_phys + lw_optical_props_clouds%ssa(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -182,6 +184,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_precip%alloc_2str(nCol, nLev, lw_gas_props)) + lw_optical_props_precip%tau(:,:,:) = 0._kind_phys + lw_optical_props_precip%ssa(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 787db6bb4..813699ae0 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -282,7 +282,7 @@ end subroutine rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& - t_lev, skt, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) + t_lev, tsfg, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -299,7 +299,7 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ p_lev, & ! Pressure @ model layer-interfaces (hPa) t_lev ! Temperature @ model levels real(kind_phys), dimension(ncol), intent(in) :: & - skt ! Surface(skin) temperature (K) + tsfg ! Surface ground temperature (K) type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) @@ -328,11 +328,11 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ p_lay, & ! IN - Pressure @ layer-centers (Pa) p_lev, & ! IN - Pressure @ layer-interfaces (Pa) t_lay, & ! IN - Temperature @ layer-centers (K) - skt, & ! IN - Skin-temperature (K) + tsfg, & ! IN - Skin-temperature (K) gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties - sources, & ! OUT - RRTMGP DDT: source functions - tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) + sources))!, & ! OUT - RRTMGP DDT: source functions + !tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) end subroutine rrtmgp_lw_gas_optics_run diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 92d475d24..3eab78be2 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -165,7 +165,7 @@ kind = kind_phys intent = in optional = F -[skt] +[tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K From 610c6e30512c7a5ecdbf34c6657f60c619491538 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 2 Dec 2020 10:53:54 -0700 Subject: [PATCH 14/27] Some cleanup --- physics/GFS_rrtmgp_pre.F90 | 6 ++---- physics/rrtmgp_lw_gas_optics.F90 | 4 ++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 35e1eb67c..25f65567a 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -269,8 +269,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) enddo - enddo - !t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + enddo t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) @@ -288,8 +287,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) enddo - enddo - !t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + enddo t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 813699ae0..f8a01b982 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -331,8 +331,8 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ tsfg, & ! IN - Skin-temperature (K) gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties - sources))!, & ! OUT - RRTMGP DDT: source functions - !tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) + sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) end subroutine rrtmgp_lw_gas_optics_run From c346d074426f9eb12762df7c0b5a8164554eb57a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 09:22:11 -0700 Subject: [PATCH 15/27] Fixed bug in argument intent for GP SW routines. --- physics/GFS_rrtmgp_sw_post.F90 | 14 +++++++------- physics/GFS_rrtmgp_sw_post.meta | 32 ++++++++++++++++---------------- physics/GFS_rrtmgp_sw_pre.F90 | 20 +++++++++----------- physics/GFS_rrtmgp_sw_pre.meta | 21 +++++++++++++++------ physics/rrtmgp_lw_pre.F90 | 9 +++++---- physics/rrtmgp_lw_pre.meta | 15 ++++++++++++--- 6 files changed, 64 insertions(+), 47 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 3a9871a5c..f89c2e7e7 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -77,7 +77,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky cldtausw ! approx .55mu band layer cloud optical depth ! Inputs (optional) - type(cmpfsw_type), dimension(nCol), intent(in), optional :: & + type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux at (W/m2) ! uvbf0 - clear sky downward uv-b flux at (W/m2) @@ -89,7 +89,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & nirbmdi, & ! sfc nir beam sw downward flux (W/m2) nirdfdi, & ! sfc nir diff sw downward flux (W/m2) visbmdi, & ! sfc uv+vis beam sw downward flux (W/m2) @@ -100,11 +100,11 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky visdfui, & ! sfc uv+vis diff sw upward flux (W/m2) sfcnsw, & ! total sky sfc netsw flx into ground sfcdsw ! - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrsw ! SW all-sky heating rate - type(sfcfsw_type), dimension(nCol), intent(out) :: & + type(sfcfsw_type), dimension(nCol), intent(inout) :: & sfcfsw ! sw radiation fluxes at sfc - type(topfsw_type), dimension(nCol), intent(out) :: & + type(topfsw_type), dimension(nCol), intent(inout) :: & topfsw ! sw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg @@ -112,13 +112,13 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, nLev), intent(out), optional :: & + type(profsw_type), dimension(nCol, nLev), intent(inout), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrswc ! Clear-sky heating rate (K/s) ! Local variables diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 77f7b15a6..2dc412118 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -266,7 +266,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirdfdi] standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step @@ -275,7 +275,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visbmdi] standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -284,7 +284,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visdfdi] standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -293,7 +293,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirbmui] standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step @@ -302,7 +302,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirdfui] standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step @@ -311,7 +311,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visbmui] standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -320,7 +320,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visdfui] standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -329,7 +329,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcnsw] standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step @@ -338,7 +338,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcdsw] standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step @@ -347,7 +347,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step @@ -356,7 +356,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcfsw] standard_name = sw_fluxes_sfc @@ -364,7 +364,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = sfcfsw_type - intent = out + intent = inout optional = F [topfsw] standard_name = sw_fluxes_top_atmosphere @@ -372,7 +372,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = topfsw_type - intent = out + intent = inout optional = F [htrswc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step @@ -381,7 +381,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = T [flxprf_sw] standard_name = RRTMGP_sw_fluxes @@ -389,7 +389,7 @@ units = W m-2 dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_plus_one) type = profsw_type - intent = out + intent = inout optional = T [scmpsw] standard_name = components_of_surface_downward_shortwave_fluxes @@ -397,7 +397,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = cmpfsw_type - intent = in + intent = inout optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 179c622f5..1268ed26f 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -27,12 +27,11 @@ end subroutine GFS_rrtmgp_sw_pre_init !! \htmlinclude GFS_rrtmgp_sw_pre.html !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & - lndp_prt_list, doSWrad, solhr, & - lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & - relhum, p_lev, sw_gas_props, & - nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) + lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & + tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & + sfc_wts, p_lay, tv_lay, relhum, p_lev, sw_gas_props, nday, idxday, coszen, coszdg, & + sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & + errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -58,7 +57,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ sncovr, & ! Surface snow area fraction (frac) snoalb, & ! Maximum snow albedo (frac) zorl, & ! Surface roughness length (cm) - tsfc, & ! Surface skin temperature (K) + tsfg, & ! Surface ground temperature for radiation (K) + tsfa, & ! Lowest model layer air temperature for radiation (K) hprime, & ! Standard deviation of subgrid orography (m) alvsf, & ! Mean vis albedo with strong cosz dependency (frac) alnsf, & ! Mean nir albedo with strong cosz dependency (frac) @@ -84,7 +84,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ nday ! Number of daylit points integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points - real(kind_phys), dimension(ncol), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & coszen, & ! Cosine of SZA coszdg, & ! Cosine of SZA, daytime sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo @@ -132,7 +132,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ ! #################################################################################### alb1d(:) = 0. lndp_alb = -999. - call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & + call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, lndp_alb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. @@ -148,8 +148,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ else nday = 0 idxday = 0 - coszen(1:nCol) = 0. - coszdg(1:nCol) = 0. sfc_alb_nir_dir(:,1:nCol) = 0. sfc_alb_nir_dif(:,1:nCol) = 0. sfc_alb_uvvis_dir(:,1:nCol) = 0. diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index b24ab5710..202f1667a 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -154,15 +154,24 @@ kind = kind_phys intent = in optional = F -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [hprime] standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography @@ -356,7 +365,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [coszdg] standard_name = daytime_mean_cosz_over_rad_call_period @@ -365,7 +374,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfc_alb_dif] standard_name = surface_diffused_shortwave_albedo @@ -374,7 +383,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index caee7308e..358e49bee 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -24,8 +24,8 @@ end subroutine rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run !! \htmlinclude rrtmgp_lw_pre_run.html !! - subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, tsfc, & - hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & + tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -39,7 +39,8 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc zorl, & ! Surface roughness length (cm) snowd, & ! water equivalent snow depth (mm) sncovr, & ! Surface snow are fraction (1) - tsfc, & ! Surface skin temperature (K) + tsfg, & ! Surface ground temperature for radiation (K) + tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: spectral information for LW calculation @@ -66,7 +67,7 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfc, tsfc, hprime, nCol, semis) + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, nCol, semis) ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 8084ecf90..1f329dd8d 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -77,15 +77,24 @@ kind = kind_phys intent = in optional = F -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [hprime] standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography From 95e8fd9f218374d869f3481a7964431155c0f008 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 11:22:11 -0700 Subject: [PATCH 16/27] Moved use of LW jacobian for adjustment into dcyc2.f --- physics/GFS_suite_interstitial.F90 | 31 ++----------------- physics/GFS_suite_interstitial.meta | 46 +---------------------------- physics/dcyc2.f | 43 +++++++++++++++++---------- physics/dcyc2.meta | 26 ++++++++++++++++ physics/rrtmgp_lw_rte.F90 | 10 +++---- physics/rrtmgp_lw_rte.meta | 4 +-- 6 files changed, 64 insertions(+), 96 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 38ea1800a..c5d203457 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) implicit none @@ -184,17 +184,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw - - ! RRTMGP - logical, intent(in ) :: & - use_GP_jacobian ! Use RRTMGP LW Jacobian of upwelling to adjust the surface flux? - real(kind=kind_phys), intent(in ), dimension(im) :: & - skt ! Skin temperature - real(kind=kind_phys), intent(inout), dimension(im) :: & - sktp1r ! Skin temperature at previous timestep - real(kind=kind_phys), intent(in ), dimension(im,levs+1), optional :: & - fluxlwUP, & ! Upwelling LW flux (W/m2) - fluxlwUP_jac ! Jacobian of upwelling LW flux (W/m2/K) ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -211,7 +200,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer :: i, k real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn - real(kind=kind_phys), dimension(im) :: tx1, tx2, dT + real(kind=kind_phys), dimension(im) :: tx1, tx2 real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys), parameter :: qmin = 1.0e-10_kind_phys, epsln=1.0e-10_kind_phys @@ -241,20 +230,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - - if (use_GP_jacobian) then - ! Compute adjustment to the surface flux using Jacobian. - if(linit_mod) then - dT(:) = (sktp1r(:) - skt(:)) - adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) - else - adjsfculw(:) = fluxlwUP(:,1) - linit_mod = .true. - endif - - ! Store surface temperature for next iteration - sktp1r(:) = skt(:) - else + if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -292,7 +268,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif - endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index b27884f9a..dba0567ce 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -785,51 +785,7 @@ type = real kind = kind_phys intent = in - optional = F -[use_GP_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in - optional = F -[skt] - standard_name = air_temperature_at_lowest_model_layer - long_name = air temperature at lowest model layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sktp1r] - standard_name = surface_skin_temperature_at_previous_time_step - long_name = surface skin temperature at previous time step - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 22eece516..3e4f3b615 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -179,6 +179,7 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & + & use_LW_jacobian, fluxlwUP, fluxlwUP_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtc, & @@ -210,6 +211,7 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet + logical, intent(in) :: use_LW_jacobian real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr @@ -227,6 +229,9 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc + real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & + & fluxlwUP, & + & fluxlwUP_jac ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & @@ -303,21 +308,29 @@ subroutine dcyc2t3_run & !! - compute \a sfc upward LW flux from current \a sfc temperature. ! note: sfc emiss effect is not appied here, and will be dealt in other place - if (dry(i)) then - tem2 = tsfc_lnd(i) * tsfc_lnd(i) - adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) - endif - if (icy(i)) then - tem2 = tsfc_ice(i) * tsfc_ice(i) - adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ice(i)) * adjsfcdlw(i) - endif - if (wet(i)) then - tem2 = tsfc_wat(i) * tsfc_wat(i) - adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_wat(i)) * adjsfcdlw(i) - endif + if (use_LW_Jacobian) then + ! Change in surface air-temperature since last radiation call. + tem1 = tsflw(i) - tf(i) + adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + else + if (dry(i)) then + tem2 = tsfc_lnd(i) * tsfc_lnd(i) + adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) + endif + if (icy(i)) then + tem2 = tsfc_ice(i) * tsfc_ice(i) + adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_ice(i)) * adjsfcdlw(i) + endif + if (wet(i)) then + tem2 = tsfc_wat(i) * tsfc_wat(i) + adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_wat(i)) * adjsfcdlw(i) + endif + endif ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) ! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 6fbc7f8b6..c36f63bd6 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -506,6 +506,32 @@ kind = kind_phys intent = out optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fluxlwUP] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index cf85aa7f2..f2dfb0694 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -63,15 +63,13 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky ! All-sky flux (W/m2) + fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) + fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) + fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag - ! Outputs (optional) - real(kind_phys), dimension(ncol,nLev+1), intent(out), optional :: & - fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) - fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) + errflg ! CCPP error flag ! Local variables type(ty_fluxes_byband) :: & diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 443792edf..1d5300f5c 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -166,7 +166,7 @@ type = real kind = kind_phys intent = out - optional = T + optional = F [fluxlwDOWN_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward long_name = RRTMGP Jacobian downward of longwave flux profile @@ -175,7 +175,7 @@ type = real kind = kind_phys intent = out - optional = T + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From d0174a32df95e5ad15037c4feead7c93bd6d34a4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 14:24:39 -0700 Subject: [PATCH 17/27] Use tsfc from lsm for dt in GP lw sfc flux adjustment. --- physics/dcyc2.f | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 3e4f3b615..ada372aa6 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -309,11 +309,19 @@ subroutine dcyc2t3_run & ! note: sfc emiss effect is not appied here, and will be dealt in other place if (use_LW_Jacobian) then - ! Change in surface air-temperature since last radiation call. - tem1 = tsflw(i) - tf(i) - adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 - adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 - adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + ! F_adj = F_o + (dF/dT) * dT + if (dry(i)) then + adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tsfc_lnd(i)) + endif + if (icy(i)) then + adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tsfc_ice(i)) + endif + if (wet(i)) then + adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tsfc_wat(i)) + endif else if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) From 17ea62b6d8aaa8af8c1df8d216673bdcc94fe93f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 15:16:45 -0700 Subject: [PATCH 18/27] Compute GP LW adjustement in dcyc2, pass through GFS_suite_interstitial --- physics/GFS_suite_interstitial.F90 | 7 +++++-- physics/GFS_suite_interstitial.meta | 8 ++++++++ physics/dcyc2.f | 20 +++++--------------- physics/dcyc2.meta | 9 +++++++++ 4 files changed, 27 insertions(+), 17 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index c5d203457..89508ea17 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) implicit none @@ -184,6 +184,9 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + + ! RRTMGP inputs + logical, intent(in ) :: use_LW_jacobian ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -230,7 +233,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - + if (.not. use_LW_jacobian) if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index dba0567ce..c3bdbc611 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -637,6 +637,14 @@ kind = kind_phys intent = in optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [dlwsfc] standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface downwelling LW flux multiplied by timestep diff --git a/physics/dcyc2.f b/physics/dcyc2.f index ada372aa6..6061de509 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -184,7 +184,7 @@ subroutine dcyc2t3_run & ! --- input/output: & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -244,7 +244,7 @@ subroutine dcyc2t3_run & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat + & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat, adjsfculw character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -309,19 +309,9 @@ subroutine dcyc2t3_run & ! note: sfc emiss effect is not appied here, and will be dealt in other place if (use_LW_Jacobian) then - ! F_adj = F_o + (dF/dT) * dT - if (dry(i)) then - adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tsfc_lnd(i)) - endif - if (icy(i)) then - adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tsfc_ice(i)) - endif - if (wet(i)) then - adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tsfc_wat(i)) - endif + ! F_adj = F_o + (dF/dT) * dT + adjsfculw(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tf(i)) else if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index c36f63bd6..fd748edfd 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -389,6 +389,15 @@ kind = kind_phys intent = out optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) From 95d271e9937b6407135f343c6a4b019fcc4973b0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 15:18:57 -0700 Subject: [PATCH 19/27] Omission from previous commit --- physics/GFS_suite_interstitial.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 89508ea17..1086e444b 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -233,7 +233,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - if (.not. use_LW_jacobian) + if (.not. use_LW_jacobian) then if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -271,6 +271,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif + endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf From a6372010f345caa343e0d484d70dfd6b6c91b1c5 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 10:37:59 -0700 Subject: [PATCH 20/27] Save temperatures from LSM at radiaiton time-steps for LW adjustment. --- physics/GFS_suite_interstitial.F90 | 9 +----- physics/GFS_suite_interstitial.meta | 10 +------ physics/dcyc2.f | 35 ++++++++++++++++++----- physics/dcyc2.meta | 44 +++++++++++++++++++++++------ 4 files changed, 65 insertions(+), 33 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 1086e444b..b7ea2f792 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) implicit none @@ -184,9 +184,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw - - ! RRTMGP inputs - logical, intent(in ) :: use_LW_jacobian ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -231,9 +228,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... sfc lw fluxes used by atmospheric model are saved for output -! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed -! --- ... and provided as inputs in this routine. - if (.not. use_LW_jacobian) then if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -271,7 +265,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif - endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c3bdbc611..0c055d17c 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -636,15 +636,7 @@ type = real kind = kind_phys intent = in - optional = F -[use_LW_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in - optional = F + optional = F [dlwsfc] standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface downwelling LW flux multiplied by timestep diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 6061de509..fe39a187f 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -179,12 +179,13 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & - & use_LW_jacobian, fluxlwUP, fluxlwUP_jac, & + & use_LW_jacobian, doLWrad, fluxlwUP, fluxlwUP_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: + & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt, & & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -211,7 +212,7 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian + logical, intent(in) :: use_LW_jacobian, doLWrad real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr @@ -229,6 +230,9 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & & fluxlwUP, & & fluxlwUP_jac @@ -244,7 +248,7 @@ subroutine dcyc2t3_run & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat, adjsfculw + & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -309,9 +313,26 @@ subroutine dcyc2t3_run & ! note: sfc emiss effect is not appied here, and will be dealt in other place if (use_LW_Jacobian) then - ! F_adj = F_o + (dF/dT) * dT - adjsfculw(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tf(i)) + ! Update temperature for LW flux adjustment at radiation calls. + if (doLWrad) then + tsfc_lnd_radt(i) = tsfc_lnd(i) + tsfc_wat_radt(i) = tsfc_wat(i) + tsfc_ice_radt(i) = tsfc_ice(i) + endif + + ! F_adj = F_o + (dF/dT) * dT + if (dry(i)) then + adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsfc_lnd_radt(i) - tsfc_lnd(i)) + endif + if (icy(i)) then + adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsfc_ice_radt(i) - tsfc_ice(i)) + endif + if (wet(i)) then + adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsfc_wat_radt(i) - tsfc_wat(i)) + endif else if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index fd748edfd..8ccf5d9d1 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -106,6 +106,33 @@ kind = kind_phys intent = in optional = F +[tsfc_lnd_radt] + standard_name = surface_skin_temperature_over_land_interstitial_at_radiation_timestep + long_name = surface skin temperature over land at first call to radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_wat_radt] + standard_name = surface_skin_temperature_over_ocean_interstitial_at_radiation_timestep + long_name = surface skin temperature over ocean at first call to radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_ice_radt] + standard_name = surface_skin_temperature_over_ice_interstitial_at_radiation_timestep + long_name = surface skin temperature over ice at first call to radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [tf] standard_name = air_temperature_at_lowest_model_layer long_name = air temperature at lowest model layer @@ -389,15 +416,6 @@ kind = kind_phys intent = out optional = F -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) @@ -523,6 +541,14 @@ type = logical intent = in optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F [fluxlwUP] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile From dc13504c6347eac639ba74f7612c091918df0bbb Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 21:06:38 +0000 Subject: [PATCH 21/27] Some reorganization. --- physics/GFS_suite_interstitial.F90 | 75 ++++++++++++++++----------- physics/dcyc2.f | 83 ++++++++++++++++++------------ 2 files changed, 96 insertions(+), 62 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index b7ea2f792..c8f962886 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -150,9 +150,17 @@ module GFS_suite_interstitial_2 contains subroutine GFS_suite_interstitial_2_init () + open(97,file='dump97.txt',status='unknown') + open(98,file='dump98.txt',status='unknown') + open(99,file='dump99.txt',status='unknown') + open(100,file='dump100.txt',status='unknown') end subroutine GFS_suite_interstitial_2_init subroutine GFS_suite_interstitial_2_finalize() + close(97) + close(98) + close(99) + close(100) end subroutine GFS_suite_interstitial_2_finalize #if 0 !> \section arg_table_GFS_suite_interstitial_2_run Argument Table @@ -228,43 +236,52 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... sfc lw fluxes used by atmospheric model are saved for output - if (frac_grid) then - do i=1,im + if (frac_grid) then + do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) endif - enddo - else - do i=1,im + enddo + else + do i=1,im if (dry(i)) then ! all land - adjsfculw(i) = adjsfculw_lnd(i) + adjsfculw(i) = adjsfculw_lnd(i) elseif (icy(i)) then ! ice (and water) - tem = one - cice(i) - if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_wat(i) /= huge) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = ulwsfc_cice(i) - endif - else - if (wet(i) .and. adjsfculw_wat(i) /= huge) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = adjsfculw_ice(i) - endif - endif + tem = one - cice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = ulwsfc_cice(i) + endif + else + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = adjsfculw_ice(i) + endif + endif else ! all water - adjsfculw(i) = adjsfculw_wat(i) + adjsfculw(i) = adjsfculw_wat(i) endif - enddo - endif + enddo + endif + + write(97,*) "#####" + write(97,*) adjsfculw + write(98,*) "#####" + write(98,*) adjsfculw_lnd + write(99,*) "#####" + write(99,*) adjsfculw_wat + write(100,*) "#####" + write(100,*) adjsfculw_ice do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/dcyc2.f b/physics/dcyc2.f index fe39a187f..d5ad9759f 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -17,9 +17,17 @@ module dcyc2t3 contains subroutine dcyc2t3_init() + open(93,file='dumpLND.txt',status='unknown') + open(94,file='dumpWAT.txt',status='unknown') + open(95,file='dumpICE.txt',status='unknown') + open(96,file='dumpFLUX.txt',status='unknown') end subroutine dcyc2t3_init subroutine dcyc2t3_finalize() + close(93) + close(94) + close(95) + close(96) end subroutine dcyc2t3_finalize ! ===================================================================== ! @@ -232,10 +240,10 @@ subroutine dcyc2t3_run & &, swhc, hlwc real(kind=kind_phys), dimension(im), intent(inout) :: & - & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt + & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & - & fluxlwUP, & - & fluxlwUP_jac + & fluxlwUP, & + & fluxlwUP_jac ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & @@ -300,40 +308,49 @@ subroutine dcyc2t3_run & enddo endif ! - do i = 1, im + ! Update temperature for LW flux adjustment at radiation calls. + if (doLWrad) then + tsfc_lnd_radt(1:im) = tsfc_lnd(1:im) + tsfc_wat_radt(1:im) = tsfc_wat(1:im) + tsfc_ice_radt(1:im) = tsfc_ice(1:im) + endif + + write(93,*) "#######",doLWrad + write(93,*) tsfc_lnd + write(93,*) "-" + write(93,*) tsfc_lnd_radt + write(94,*) "#######" + write(94,*) tsfc_wat - tsfc_wat_radt + write(95,*) "#######" + write(95,*) tsfc_ice - tsfc_ice_radt + write(96,*) "#######" + write(96,*) fluxlwUP(:,1) + write(96,*) "-" + write(96,*) fluxlwUP_jac(:,1) + + do i = 1, im !> - LW time-step adjustment: + if (use_LW_Jacobian) then + ! F_adj = F_o + (dF/dT) * dT + if (dry(i)) then + adjsfculw_lnd(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * + & (tsfc_lnd_radt(i) - tsfc_lnd(i)) + endif + if (icy(i)) then + adjsfculw_ice(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * + & (tsfc_ice_radt(i) - tsfc_ice(i)) + endif + if (wet(i)) then + adjsfculw_wat(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * + & (tsfc_wat_radt(i) - tsfc_wat(i)) + endif + else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. !! compute 4th power of the ratio of \c tf in the lowest model layer over the mean value \c tsflw. - tem1 = tf(i) / tsflw(i) - tem2 = tem1 * tem1 - adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 - -!! - compute \a sfc upward LW flux from current \a sfc temperature. -! note: sfc emiss effect is not appied here, and will be dealt in other place - - if (use_LW_Jacobian) then - ! Update temperature for LW flux adjustment at radiation calls. - if (doLWrad) then - tsfc_lnd_radt(i) = tsfc_lnd(i) - tsfc_wat_radt(i) = tsfc_wat(i) - tsfc_ice_radt(i) = tsfc_ice(i) - endif - - ! F_adj = F_o + (dF/dT) * dT - if (dry(i)) then - adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsfc_lnd_radt(i) - tsfc_lnd(i)) - endif - if (icy(i)) then - adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsfc_ice_radt(i) - tsfc_ice(i)) - endif - if (wet(i)) then - adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsfc_wat_radt(i) - tsfc_wat(i)) - endif - else + tem1 = tf(i) / tsflw(i) + tem2 = tem1 * tem1 + adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 From 64abfa90afc9e1a8896bfa66583cac5592315d62 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 14:30:17 -0700 Subject: [PATCH 22/27] Intent(out) -> intent(inout) --- physics/rrtmgp_lw_rte.F90 | 2 +- physics/rrtmgp_lw_rte.meta | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index f2dfb0694..1c86db5f1 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -59,7 +59,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties ! Outputs - real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & + real(kind_phys), dimension(ncol,nLev+1), intent(inout) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 1d5300f5c..d249c77d6 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -129,7 +129,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_allsky] standard_name = RRTMGP_lw_flux_profile_downward_allsky @@ -138,7 +138,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwUP_clrsky] standard_name = RRTMGP_lw_flux_profile_upward_clrsky @@ -147,7 +147,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_clrsky] standard_name = RRTMGP_lw_flux_profile_downward_clrsky @@ -156,7 +156,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward @@ -165,7 +165,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward @@ -174,7 +174,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message From 9a48b33b91ebcd33bd818c81c8d3b6b1a4d3e1e9 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 15:53:07 -0700 Subject: [PATCH 23/27] Use combined land/sea/ice surface temperature for LW adjustment of surface flux. --- physics/dcyc2.f | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index d5ad9759f..62b9f554b 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -311,10 +311,14 @@ subroutine dcyc2t3_run & ! Update temperature for LW flux adjustment at radiation calls. if (doLWrad) then - tsfc_lnd_radt(1:im) = tsfc_lnd(1:im) - tsfc_wat_radt(1:im) = tsfc_wat(1:im) - tsfc_ice_radt(1:im) = tsfc_ice(1:im) + do i = 1, im + tsfc_lnd_radt(i) = minval([tsfc_lnd(i),tsfc_wat(i), + & tsfc_ice(i)]) + enddo + !tsfc_wat_radt(1:im) = tsfc_wat(1:im) + !tsfc_ice_radt(1:im) = tsfc_ice(1:im) endif + write(93,*) "#######",doLWrad write(93,*) tsfc_lnd @@ -339,11 +343,11 @@ subroutine dcyc2t3_run & endif if (icy(i)) then adjsfculw_ice(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_ice_radt(i) - tsfc_ice(i)) + & (tsfc_lnd_radt(i) - tsfc_ice(i)) endif if (wet(i)) then adjsfculw_wat(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_wat_radt(i) - tsfc_wat(i)) + & (tsfc_lnd_radt(i) - tsfc_wat(i)) endif else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. From ae1430921506c942509a3ebba9cd0785a3de316a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 16:24:32 -0700 Subject: [PATCH 24/27] Added print statements for diag. --- physics/GFS_suite_interstitial.F90 | 20 ++++--------------- physics/dcyc2.f | 31 +++++++----------------------- 2 files changed, 11 insertions(+), 40 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index c8f962886..898f6d454 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -150,17 +150,9 @@ module GFS_suite_interstitial_2 contains subroutine GFS_suite_interstitial_2_init () - open(97,file='dump97.txt',status='unknown') - open(98,file='dump98.txt',status='unknown') - open(99,file='dump99.txt',status='unknown') - open(100,file='dump100.txt',status='unknown') end subroutine GFS_suite_interstitial_2_init subroutine GFS_suite_interstitial_2_finalize() - close(97) - close(98) - close(99) - close(100) end subroutine GFS_suite_interstitial_2_finalize #if 0 !> \section arg_table_GFS_suite_interstitial_2_run Argument Table @@ -274,14 +266,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo endif - write(97,*) "#####" - write(97,*) adjsfculw - write(98,*) "#####" - write(98,*) adjsfculw_lnd - write(99,*) "#####" - write(99,*) adjsfculw_wat - write(100,*) "#####" - write(100,*) adjsfculw_ice + print*, 'adjsfculw: ',adjsfculw + print*, 'adjsfculw_lnd: ',adjsfculw_lnd + print*, 'adjsfculw_wat: ',adjsfculw_wat + print*, 'adjsfculw_ice: ',adjsfculw_ice do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 62b9f554b..6e1197113 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -17,17 +17,9 @@ module dcyc2t3 contains subroutine dcyc2t3_init() - open(93,file='dumpLND.txt',status='unknown') - open(94,file='dumpWAT.txt',status='unknown') - open(95,file='dumpICE.txt',status='unknown') - open(96,file='dumpFLUX.txt',status='unknown') end subroutine dcyc2t3_init subroutine dcyc2t3_finalize() - close(93) - close(94) - close(95) - close(96) end subroutine dcyc2t3_finalize ! ===================================================================== ! @@ -315,23 +307,14 @@ subroutine dcyc2t3_run & tsfc_lnd_radt(i) = minval([tsfc_lnd(i),tsfc_wat(i), & tsfc_ice(i)]) enddo - !tsfc_wat_radt(1:im) = tsfc_wat(1:im) - !tsfc_ice_radt(1:im) = tsfc_ice(1:im) endif - - - write(93,*) "#######",doLWrad - write(93,*) tsfc_lnd - write(93,*) "-" - write(93,*) tsfc_lnd_radt - write(94,*) "#######" - write(94,*) tsfc_wat - tsfc_wat_radt - write(95,*) "#######" - write(95,*) tsfc_ice - tsfc_ice_radt - write(96,*) "#######" - write(96,*) fluxlwUP(:,1) - write(96,*) "-" - write(96,*) fluxlwUP_jac(:,1) + + print*, 'tsfc_lnd_radt: ',tsfc_lnd + print*, 'tsfc_lnd: ',tsfc_lnd_radt + print*, 'tsfc_wat: ',tsfc_wat + print*, 'tsfc_ice: ',tsfc_ice + print*, 'fluxlwUP(:,1): ',fluxlwUP(:,1) + print*, 'fluxlwUP_jac(:,1): ',fluxlwUP_jac(:,1) do i = 1, im !> - LW time-step adjustment: From 250de74fce42c6ecda654f4d47508d9ffa3c5335 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 8 Dec 2020 21:45:23 +0000 Subject: [PATCH 25/27] Cleanup of GP LW flux adjustment using Jacobian of surface upwelling. --- physics/GFS_rrtmgp_lw_post.F90 | 14 +++--- physics/GFS_rrtmgp_lw_post.meta | 9 ++++ physics/GFS_suite_interstitial.F90 | 14 +++--- physics/GFS_suite_interstitial.meta | 10 ++++- physics/dcyc2.f | 59 ++++++------------------ physics/dcyc2.meta | 70 +++++++++-------------------- physics/rrtmgp_lw_rte.F90 | 22 ++++++--- physics/rrtmgp_lw_rte.meta | 17 ++----- 8 files changed, 87 insertions(+), 128 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index e6f6a59a5..e2dbd17fa 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -27,7 +27,7 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & - sfcdlw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + sfcdlw, sfculw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -65,11 +65,12 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(inout) :: & - sfcdlw, & ! Total sky sfc downward lw flux (W/m2) - tsflw ! surface air temp during lw calculation (K) - type(sfcflw_type), dimension(nCol), intent(inout) :: & - sfcflw ! LW radiation fluxes at sfc + real(kind_phys), dimension(nCol), intent(inout) :: & + sfcdlw, & ! Total sky sfc downward lw flux (W/m2) + sfculw, & ! Total sky sfc upward lw flux (W/m2) + tsflw ! surface air temp during lw calculation (K) + type(sfcflw_type), dimension(nCol), intent(inout) :: & + sfcflw ! LW radiation fluxes at sfc real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrlw ! LW all-sky heating rate type(topflw_type), dimension(nCol), intent(out) :: & @@ -160,6 +161,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! Radiation fluxes for other physics processes sfcdlw(:) = sfcflw(:)%dnfxc + sfculw(:) = sfcflw(:)%upfxc ! ####################################################################################### ! Save LW diagnostics diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index a87b6adcb..72a82421e 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -198,6 +198,15 @@ kind = kind_phys intent = inout optional = F +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [sfcflw] standard_name = lw_fluxes_sfc long_name = lw radiation fluxes at sfc diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 898f6d454..62efa00d5 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,14 +163,14 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) implicit none ! interface variables integer, intent(in ) :: im, levs, imfshalcnv logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv - logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid, use_LW_jacobian real(kind=kind_phys), intent(in ) :: dtf, cp, hvap logical, intent(in ), dimension(im) :: flag_cice @@ -183,7 +183,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer, intent(inout), dimension(im) :: kinver real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat - real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + real(kind=kind_phys), intent(inout), dimension(im) :: adjsfculw ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -227,7 +227,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo ! --- ... sfc lw fluxes used by atmospheric model are saved for output - + if (.not. use_LW_jacobian) then if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -265,11 +265,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif - - print*, 'adjsfculw: ',adjsfculw - print*, 'adjsfculw_lnd: ',adjsfculw_lnd - print*, 'adjsfculw_wat: ',adjsfculw_wat - print*, 'adjsfculw_ice: ',adjsfculw_ice + endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 0c055d17c..fdf1716f1 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -601,6 +601,14 @@ kind = kind_phys intent = inout optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [adjsfculw] standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time @@ -608,7 +616,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 6e1197113..389496d07 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -42,7 +42,7 @@ end subroutine dcyc2t3_finalize ! ( solhr,slag,sdec,cdec,sinlat,coslat, ! ! xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat, ! ! tf,tsflw,sfcemis_lnd,sfcemis_ice,sfcemis_wat, ! -! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! +! sfcdsw,sfcnsw,sfcdlw,sfculw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! ! im, levs, deltim, fhswr, ! @@ -50,7 +50,7 @@ end subroutine dcyc2t3_finalize ! input/output: ! ! dtdt,dtdtc, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! @@ -76,6 +76,7 @@ end subroutine dcyc2t3_finalize ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! ! sfcdlw (im) - real, total sky sfc downward lw flux ( w/m**2 ) ! +! sfculw (im) - real, total sky sfc upward lw flux ( w/m**2 ) ! ! swh(im,levs) - real, total sky sw heating rates ( k/s ) ! ! swhc(im,levs) - real, clear sky sw heating rates ( k/s ) ! ! hlw(im,levs) - real, total sky lw heating rates ( k/s ) ! @@ -179,13 +180,12 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & - & use_LW_jacobian, doLWrad, fluxlwUP, fluxlwUP_jac, & + & use_LW_jacobian, sfculw, sfculw_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: - & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt, & & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -212,13 +212,13 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian, doLWrad + logical, intent(in) :: use_LW_jacobian real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr real(kind=kind_phys), dimension(im), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & - & sfcdsw, sfcnsw + & sfcdsw, sfcnsw, sfculw, sfculw_jac real(kind=kind_phys), dimension(im), intent(in) :: & & tsfc_lnd, tsfc_ice, tsfc_wat, & @@ -231,19 +231,13 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc - real(kind=kind_phys), dimension(im), intent(inout) :: & - & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt - real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & - & fluxlwUP, & - & fluxlwUP_jac - ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & &, dtdtc ! --- outputs: real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd @@ -256,7 +250,7 @@ subroutine dcyc2t3_run & ! --- locals: integer :: i, k, nstp, nstl, it, istsun(im) real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & - & rstl, solang + & rstl, solang, dT ! !===> ... begin here ! @@ -301,43 +295,18 @@ subroutine dcyc2t3_run & endif ! - ! Update temperature for LW flux adjustment at radiation calls. - if (doLWrad) then - do i = 1, im - tsfc_lnd_radt(i) = minval([tsfc_lnd(i),tsfc_wat(i), - & tsfc_ice(i)]) - enddo - endif - - print*, 'tsfc_lnd_radt: ',tsfc_lnd - print*, 'tsfc_lnd: ',tsfc_lnd_radt - print*, 'tsfc_wat: ',tsfc_wat - print*, 'tsfc_ice: ',tsfc_ice - print*, 'fluxlwUP(:,1): ',fluxlwUP(:,1) - print*, 'fluxlwUP_jac(:,1): ',fluxlwUP_jac(:,1) - do i = 1, im + tem1 = tf(i) / tsflw(i) + tem2 = tem1 * tem1 + adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 !> - LW time-step adjustment: if (use_LW_Jacobian) then ! F_adj = F_o + (dF/dT) * dT - if (dry(i)) then - adjsfculw_lnd(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_lnd_radt(i) - tsfc_lnd(i)) - endif - if (icy(i)) then - adjsfculw_ice(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_lnd_radt(i) - tsfc_ice(i)) - endif - if (wet(i)) then - adjsfculw_wat(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_lnd_radt(i) - tsfc_wat(i)) - endif + dT = tf(i) - tsflw(i) + adjsfculw(i) = sfculw(i) + sfculw_jac(i) * dT else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. !! compute 4th power of the ratio of \c tf in the lowest model layer over the mean value \c tsflw. - tem1 = tf(i) / tsflw(i) - tem2 = tem1 * tem1 - adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 8ccf5d9d1..efba0a5f5 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -105,33 +105,6 @@ type = real kind = kind_phys intent = in - optional = F -[tsfc_lnd_radt] - standard_name = surface_skin_temperature_over_land_interstitial_at_radiation_timestep - long_name = surface skin temperature over land at first call to radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[tsfc_wat_radt] - standard_name = surface_skin_temperature_over_ocean_interstitial_at_radiation_timestep - long_name = surface skin temperature over ocean at first call to radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[tsfc_ice_radt] - standard_name = surface_skin_temperature_over_ice_interstitial_at_radiation_timestep - long_name = surface skin temperature over ice at first call to radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout optional = F [tf] standard_name = air_temperature_at_lowest_model_layer @@ -205,6 +178,15 @@ kind = kind_phys intent = in optional = F +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [swh] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate on radiation time step @@ -443,6 +425,15 @@ kind = kind_phys intent = out optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [xmu] standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave fluxes @@ -541,28 +532,11 @@ type = logical intent = in optional = F -[doLWrad] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[fluxlwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile +[sfculw_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward_at_surface + long_name = RRTMGP Jacobian upward longwave flux at surface units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 1c86db5f1..321214a02 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -31,8 +31,7 @@ end subroutine rrtmgp_lw_rte_init subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & nLev, p_lev, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac,& - errmsg, errflg) + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, sfculw_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -59,13 +58,13 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties ! Outputs + real(kind_phys), dimension(ncol), intent(inout) :: & + sfculw_jac ! Jacobian of upwelling LW surface radiation (W/m2/K) real(kind_phys), dimension(ncol,nLev+1), intent(inout) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) - fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) - fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) + fluxlwDOWN_clrsky ! All-sky flux (W/m2) character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & @@ -76,8 +75,10 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(nCol,nLev+1) :: fluxlwUP_jac,fluxlwDOWN_jac logical :: & top_at_1 + integer :: iSFC, iTOA ! Initialize CCPP error handling variables errmsg = '' @@ -87,7 +88,14 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, ! Vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - + if (top_at_1) then + iSFC = nLev+1 + iTOA = 1 + else + iSFC = 1 + iTOA = nLev+1 + endif + ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -140,6 +148,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + sfculw_jac = fluxlwUP_jac(:,iSFC) else call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clouds, & ! IN - optical-properties @@ -166,6 +175,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + sfculw_jac = fluxlwUP_jac(:,iSFC) else call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clrsky, & ! IN - optical-properties diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index d249c77d6..d295fa511 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -158,20 +158,11 @@ kind = kind_phys intent = inout optional = F -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile +[sfculw_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward_at_surface + long_name = RRTMGP Jacobian upward longwave flux at surface units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = inout - optional = F -[fluxlwDOWN_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward - long_name = RRTMGP Jacobian downward of longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout From ea5e44fcc691c9a5fedcb96f13e0ca85259c7844 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 16 Dec 2020 15:51:33 +0000 Subject: [PATCH 26/27] Updated rte submodule --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 37313e512087fc47f51bf12375e724c80fa3c18c Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 16 Dec 2020 17:26:38 +0000 Subject: [PATCH 27/27] Changes from code review --- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 4 ++-- physics/GFS_rrtmgp_pre.F90 | 14 ++++++------- physics/GFS_rrtmgp_pre.meta | 26 ++++++++++++------------ physics/GFS_rrtmgp_thompsonmp_pre.F90 | 11 +++++----- physics/GFS_rrtmgp_thompsonmp_pre.meta | 10 ++++----- physics/rrtmgp_lw_cloud_optics.F90 | 2 +- physics/rrtmgp_lw_cloud_optics.meta | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 2 +- 8 files changed, 35 insertions(+), 36 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 index 08bc82d05..05b8ee79e 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -78,12 +78,12 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra real(kind_phys), dimension(nCol,nLev) :: deltaZ logical :: top_at_1 - if (.not. (doSWrad .or. doLWrad)) return - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (.not. (doSWrad .or. doLWrad)) return + ! What is vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 25f65567a..73828999f 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -189,24 +189,24 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), intent(out) :: & + real(kind_phys), intent(inout) :: & raddt ! Radiation time-step - real(kind_phys), dimension(ncol), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & tsfg, & ! Ground temperature tsfa ! Skin temperature - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers relhum, & ! Relative-humidity at model-layers - qs_lay ! Saturation vapor pressure at model-layers - real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & + qs_lay ! Saturation vapor pressure at model-layers + real(kind_phys), dimension(nCol,nLev+1), intent(inout) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface - real(kind_phys), dimension(nCol, nLev, nTracers),intent(out) :: & + real(kind_phys), dimension(nCol, nLev, nTracers),intent(inout) :: & tracer ! Array containing trace gases - type(ty_gas_concs),intent(out) :: & + type(ty_gas_concs),intent(inout) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios ! Local variables diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 136898bb3..d07f9c137 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -262,7 +262,7 @@ dimensions = () type = real kind = kind_phys - intent = out + intent = inout optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa @@ -271,7 +271,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa @@ -280,7 +280,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP @@ -289,7 +289,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP @@ -298,7 +298,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation @@ -307,7 +307,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsfa] standard_name = surface_air_temperature_for_radiation @@ -316,7 +316,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [tv_lay] standard_name = virtual_temperature @@ -325,7 +325,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [relhum] standard_name = relative_humidity @@ -334,7 +334,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [qs_lay] standard_name = saturation_vapor_pressure @@ -343,7 +343,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [q_lay] standard_name = water_vapor_mixing_ratio @@ -352,7 +352,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [tracer] standard_name = chemical_tracers @@ -361,7 +361,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys - intent = out + intent = inout optional = F [gas_concentrations] standard_name = Gas_concentrations_for_RRTMGP_suite @@ -369,7 +369,7 @@ units = DDT dimensions = () type = ty_gas_concs - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index bd109ddf4..ea27f3d2b 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -95,17 +95,16 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_reliq, & ! Cloud liquid effective radius cld_iwp, & ! Cloud ice water path cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac, & ! Precipitation fraction effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for ice cloud-particles (microns) effrin_cldsnow ! Effective radius for snow cloud-particles (microns) ! Outputs - real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain, & ! Cloud rain effective radius - precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index 2368a7337..90ec59760 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -385,7 +385,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_resnow] standard_name = mean_effective_radius_for_snow_flake @@ -394,7 +394,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rwp] standard_name = cloud_rain_water_path @@ -403,7 +403,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rerain] standard_name = mean_effective_radius_for_rain_drop @@ -412,7 +412,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [precip_frac] standard_name = precipitation_fraction_by_layer @@ -421,7 +421,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 023df62ec..341c19fc2 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -323,7 +323,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw type(ty_optical_props_2str),intent(inout) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - real(kind_phys), dimension(ncol,nLev), intent(out) :: & + real(kind_phys), dimension(ncol,nLev), intent(inout) :: & cldtaulw ! Approx 10.mu band layer cloud optical depth ! Local variables diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index cf0418eb4..c57e70a33 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -322,7 +322,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [lw_optical_props_cloudsByBand] standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 92f007a99..f08cd7181 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -281,7 +281,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & - 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) end subroutine rrtmgp_sw_cloud_optics_init