diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index 6b72ef23a..3b6d75212 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -57,9 +57,9 @@ intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys @@ -75,9 +75,9 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.meta b/physics/GFS_rrtmgp_cloud_overlap_pre.meta index 7073cac07..24dbeab8e 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.meta +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.meta @@ -66,18 +66,18 @@ kind = kind_phys optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 69bd63b08..6ce429504 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -128,18 +128,18 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 36f388a60..5fb4d57bb 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -75,9 +75,9 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure level - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 88e534595..0632bb4b4 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -98,8 +98,9 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & - con_epsqs, minGPpres, minGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, & - qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) + con_epsqs, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev, & + t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, & + tsfc_radtime, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -112,7 +113,9 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f lslwr ! Call LW radiation real(kind_phys), intent(in) :: & minGPtemp, & ! Minimum temperature allowed in RRTMGP. + maxGPtemp, & ! Maximum ... minGPpres, & ! Minimum pressure allowed in RRTMGP. + maxGPpres, & ! Maximum pressure allowed in RRTMGP. fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. real(kind_phys), intent(in) :: & @@ -142,7 +145,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f raddt ! Radiation time-step real(kind_phys), dimension(ncol), intent(inout) :: & tsfg, & ! Ground temperature - tsfa ! Skin temperature + tsfa, & ! Skin temperature + tsfc_radtime ! Surface temperature at radiation timestep real(kind_phys), dimension(nCol,nLev), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer @@ -202,18 +206,31 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) - ! Bound temperature at layer centers. + ! Bound temperature/pressure at layer centers. do iCol=1,NCOL do iLay=1,nLev if (t_lay(iCol,iLay) .le. minGPtemp) then t_lay(iCol,iLay) = minGPtemp + epsilon(minGPtemp) endif + if (p_lay(iCol,iLay) .le. minGPpres) then + p_lay(iCol,iLay) = minGPpres + epsilon(minGPpres) + endif + if (t_lay(iCol,iLay) .ge. maxGPtemp) then + t_lay(iCol,iLay) = maxGPtemp - epsilon(maxGPtemp) + endif + if (p_lay(iCol,iLay) .ge. maxGPpres) then + p_lay(iCol,iLay) = maxGPpres - epsilon(maxGPpres) + endif enddo enddo ! Temperature at layer-interfaces call cmp_tlev(nCol,nLev,minGPpres,p_lay,t_lay,p_lev,tsfc,t_lev) + ! Save surface temperature at radiation time-step, used for LW flux adjustment betwen + ! radiation calls. + tsfc_radtime = tsfc + ! Compute a bunch of thermodynamic fields needed by the cloud microphysics schemes. ! Relative humidity, saturation mixing-ratio, vapor mixing-ratio, virtual temperature, ! layer thickness,... diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index e33663748..43812d870 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -230,6 +230,15 @@ kind = kind_phys intent = in optional = F +[maxGPpres] + standard_name = maximum_pressure_in_RRTMGP + long_name = maximum pressure allowed in RRTMGP + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [minGPtemp] standard_name = minimum_temperature_in_RRTMGP long_name = minimum temperature allowed in RRTMGP @@ -239,6 +248,15 @@ kind = kind_phys intent = in optional = F +[maxGPtemp] + standard_name = maximum_temperature_in_RRTMGP + long_name = maximum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step @@ -249,18 +267,18 @@ intent = inout optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = inout optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys @@ -284,6 +302,15 @@ kind = kind_phys intent = inout optional = F +[tsfc_radtime] + standard_name = surface_skin_temperature_on_radiation_timestep + long_name = surface skin temperature on radiation timestep + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 2f4bb5419..d9bdc47cd 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -101,9 +101,9 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure level - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index d2a976f47..9bf5c95dd 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -136,18 +136,18 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta index 361431d34..7f7184531 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.meta +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -105,18 +105,18 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 6bc702216..386164b8f 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -234,9 +234,8 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ 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 + 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) & @@ -247,9 +246,9 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ + 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) elseif (icy(i)) then ! ice (and water) @@ -270,8 +269,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, flag_ else ! all water adjsfculw(i) = adjsfculw_wat(i) endif - enddo - endif + enddo endif do i=1,im diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 8b311dc02..780d72efb 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -180,9 +180,9 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, damp_LW_fluxadj, lfnc_k, lfnc_p0, & - & minGPpres, use_LW_jacobian, sfculw, fluxlwUP_jac, & - & t_lay, t_lev, p_lay, p_lev, flux2D_lwUP, flux2D_lwDOWN, & - & pert_radtend, do_sppt,ca_global, & + & use_LW_jacobian, sfculw, fluxlwUP_jac, & + & t_lay, p_lay, p_lev, flux2D_lwUP, flux2D_lwDOWN, & + & pert_radtend, do_sppt,ca_global, tsfc_radtime, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtnp,htrlw, & @@ -195,7 +195,6 @@ subroutine dcyc2t3_run & & ) ! use machine, only : kind_phys - use radiation_tools, only : cmp_tlev implicit none ! @@ -217,11 +216,11 @@ subroutine dcyc2t3_run & & pert_radtend logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & - & deltim, fhswr, minGPpres, lfnc_k, lfnc_p0 + & deltim, fhswr, lfnc_k, lfnc_p0 real(kind=kind_phys), dimension(:), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & - & sfcdsw, sfcnsw, sfculw, tsfc + & sfcdsw, sfcnsw, sfculw, tsfc, tsfc_radtime real(kind=kind_phys), dimension(:), intent(in) :: & & tsfc_lnd, tsfc_ice, tsfc_wat, & @@ -235,7 +234,7 @@ subroutine dcyc2t3_run & & swhc, hlwc, p_lay, t_lay real(kind=kind_phys), dimension(:,:), intent(in) :: p_lev, & - & flux2D_lwUP, flux2D_lwDOWN, fluxlwUP_jac, t_lev + & flux2D_lwUP, flux2D_lwDOWN, fluxlwUP_jac real(kind_phys), intent(in ) :: con_g, con_cp, & & con_pi, con_sbc @@ -264,7 +263,7 @@ subroutine dcyc2t3_run & real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & & rstl, solang, dT real(kind=kind_phys), dimension(im,levs+1) :: flxlwup_adj, & - & flxlwdn_adj, t_lev2 + & flxlwdn_adj real(kind=kind_phys) :: fluxlwnet_adj,fluxlwnet,dT_sfc, & &fluxlwDOWN_jac,lfnc,c1 ! Length scale for flux-adjustment scaling @@ -329,32 +328,27 @@ subroutine dcyc2t3_run & do i = 1, im !> - LW time-step adjustment: - if (use_LW_Jacobian) then - ! F_adj = F_o + (dF/dT) * dT - dT = tf(i) - tsflw(i) - adjsfculw(i) = sfculw(i) + fluxlwUP_jac(i,iSFC) * dT - else - tem1 = tf(i) / tsflw(i) - tem2 = tem1 * tem1 - adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 + tem1 = tf(i) / tsflw(i) + tem2 = tem1 * tem1 + adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 !! - 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. - if (dry(i)) then - tem2 = tsfc_lnd(i) * tsfc_lnd(i) - adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 + 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 + 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 + 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 + 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,:) @@ -384,15 +378,10 @@ subroutine dcyc2t3_run & adjvisdfd(i) = sfcvisdfd(i) * xmu(i) enddo -!> - adjust SW heating rates with zenith angle change and -! add with LW heating to temperature tendency. + ! Adjust the LW and SW heating-rates. + ! For LW, optionally scale using the Jacobian of the upward LW flux. *RRTMGP ONLY* + ! For SW, adjust heating rates with zenith angle change. if (use_LW_jacobian) then - ! - ! Compute temperatute at level interfaces. - ! - call cmp_tlev(im, levs, minGPpres, p_lay, t_lay, p_lev, tsfc, & - & t_lev2) - ! Compute adjusted net LW flux foillowing Hogan and Bozzo 2015 (10.1002/2015MS000455) ! Here we assume that the profile of the downwelling LW Jaconiam has the same shape ! as the upwelling, but scaled and offset. @@ -408,7 +397,8 @@ subroutine dcyc2t3_run & ! p0 = Transition pressure (Pa) - Controlled by namelsit do i = 1, im c1 = fluxlwUP_jac(i,iTOA) / fluxlwUP_jac(i,iSFC) - dT_sfc = t_lev2(i,iSFC) - t_lev(i,iSFC) + !dT_sfc = t_lev2(i,iSFC) - t_lev(i,iSFC) + dT_sfc = tsfc(i) - tsfc_radtime(i) do k = 1, levs ! LW net flux fluxlwnet = (flux2D_lwUP(i, k+1) - flux2D_lwUP(i, k) - & diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 70886e986..689e77eeb 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = dcyc2t3 type = scheme - dependencies = machine.F,physcons.F90,radiation_tools.F90 + dependencies = machine.F,physcons.F90 ######################################################################## [ccpp-arg-table] @@ -169,6 +169,15 @@ kind = kind_phys intent = in optional = F +[tsfc_radtime] + standard_name = surface_skin_temperature_on_radiation_timestep + long_name = surface skin temperature on radiation timestep + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [sfcemis_lnd] standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) @@ -389,15 +398,6 @@ type = logical intent = in optional = F -[minGPpres] - standard_name = minimum_pressure_in_RRTMGP - long_name = minimum pressure allowed in RRTMGP - units = Pa - dimensions = () - 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 @@ -459,15 +459,6 @@ kind = kind_phys intent = in optional = F -[t_lev] - standard_name = air_temperature_at_interface_for_RRTMGP - long_name = air temperature at vertical interface for radiation calculation - units = K - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys - intent = in - optional = F [p_lay] standard_name = air_pressure long_name = mean layer pressure diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index bd4766691..f97aba9a7 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -48,18 +48,18 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 6b72faa41..e36ee5146 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -257,9 +257,9 @@ intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure layer - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index a116ad772..794887283 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -76,7 +76,8 @@ module rrtmgp_lw_gas_optics !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicomm, & - mpirank, mpiroot, gas_concentrations, minGPpres, minGPtemp, errmsg, errflg) + mpirank, mpiroot, gas_concentrations, minGPpres, maxGPpres, minGPtemp, maxGPtemp, & + errmsg, errflg) ! Inputs type(ty_gas_concs), intent(inout) :: & @@ -96,7 +97,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom errflg ! CCPP error code real(kind_phys), intent(out) :: & minGPtemp, & ! Minimum temperature allowed by RRTMGP. - minGPpres ! Minimum pressure allowed by RRTMGP. + maxGPtemp, & ! Maximum ... + minGPpres, & ! Minimum pressure allowed by RRTMGP. + maxGPpres ! Maximum pressure allowed by RRTMGP. ! Local variables integer :: ncid, dimID, varID, status, iGas, ierr, ii, mpierr, iChar @@ -449,7 +452,9 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, mpicom ! The minimum pressure allowed in GP RTE calculations. Used to bound uppermost layer ! temperature (GFS_rrtmgp_pre.F90) minGPpres = lw_gas_props%get_press_min() + maxGPpres = lw_gas_props%get_press_max() minGPtemp = lw_gas_props%get_temp_min() + maxGPtemp = lw_gas_props%get_temp_max() end subroutine rrtmgp_lw_gas_optics_init @@ -469,10 +474,10 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_ ncol, & ! Number of horizontal points nLev ! Number of vertical levels real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) + p_lay, & ! Pressure @ model layer-centers (Pa) t_lay ! Temperature (K) real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (hPa) + p_lev, & ! Pressure @ model layer-interfaces (Pa) t_lev ! Temperature @ model levels real(kind_phys), dimension(ncol), intent(in) :: & tsfg ! Surface ground temperature (K) diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index b0c58b191..45945e424 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -83,6 +83,15 @@ kind = kind_phys intent = out optional = F +[maxGPpres] + standard_name = maximum_pressure_in_RRTMGP + long_name = maximum pressure allowed in RRTMGP + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F [minGPtemp] standard_name = minimum_temperature_in_RRTMGP long_name = minimum temperature allowed in RRTMGP @@ -92,6 +101,15 @@ kind = kind_phys intent = out optional = F +[maxGPtemp] + standard_name = maximum_temperature_in_RRTMGP + long_name = maximum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F ######################################################################## [ccpp-arg-table] @@ -122,18 +140,18 @@ intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure layer - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure level - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index ea50653ac..d2878598d 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -44,7 +44,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nLev, & ! Number of vertical levels nGauss_angles ! Number of angles used in Gaussian quadrature real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (hPa) + p_lev ! Pressure @ model layer-interfaces (Pa) real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & sfc_emiss_byband ! Surface emissivity in each band type(ty_source_func_lw),intent(in) :: & diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 253aa11ca..3ffa24a30 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -65,9 +65,9 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure level - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_sampling.F90 b/physics/rrtmgp_sampling.F90 index 3974da359..9e2360083 100644 --- a/physics/rrtmgp_sampling.F90 +++ b/physics/rrtmgp_sampling.F90 @@ -82,16 +82,16 @@ end function draw_samples ! ! ------------------------------------------------------------------------------------------------- subroutine sampled_mask(randoms, cloud_frac, cloud_mask, overlap_param, randoms2) - ! Inputs + ! Inputs real(wp), dimension(:,:,:), intent(in ) :: randoms ! ngpt,nlay,ncol real(wp), dimension(:,:), intent(in ) :: cloud_frac ! ncol,nlay - ! Outputs + ! Outputs logical, dimension(:,:,:), intent(out) :: cloud_mask ! ncol,nlay,ngpt - ! Inputs (optional) + ! Inputs (optional) real(wp), dimension(:,:), intent(in ), optional :: overlap_param ! ncol,nlay-1 - real(wp), dimension(:,:,:), intent(in ), optional :: randoms2 ! ngpt,nlay,ncol + real(wp), dimension(:,:,:), intent(in ), optional :: randoms2 ! ngpt,nlay,ncol ! Local variables integer :: ncol, nlay, ngpt, icol, ilay, igpt @@ -103,11 +103,11 @@ subroutine sampled_mask(randoms, cloud_frac, cloud_mask, overlap_param, randoms2 logical :: l_use_second_rng = .false. character(len=128) :: error_msg - ! Array dimensions + ! Array dimensions ncol = size(randoms, 3) nlay = size(randoms, 2) ngpt = size(randoms, 1) - + ! Using cloud-overlap parameter (alpha)? if (present(overlap_param)) l_use_overlap_param = .true. @@ -116,67 +116,67 @@ subroutine sampled_mask(randoms, cloud_frac, cloud_mask, overlap_param, randoms2 ! Construct the cloud mask for each column do icol = 1, ncol - cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp - if(.not. any(cloud_mask_layer)) then - cloud_mask(icol,1:nlay,1:ngpt) = .false. - cycle - end if - cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) - cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) - cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. - - ilay = cloud_lay_fst - local_rands(1:ngpt) = randoms(1:ngpt,cloud_lay_fst,icol) - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - do ilay = cloud_lay_fst+1, cloud_lay_lst - ! ################################################################################ - ! Max-random overlap - ! new random deviates if the adjacent layer isn't cloudy - ! same random deviates if the adjacent layer is cloudy - ! ################################################################################ - if (.not. l_use_overlap_param) then - if(cloud_mask_layer(ilay)) then - if(.not. cloud_mask_layer(ilay-1)) local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - else - cloud_mask(icol,ilay,1:ngpt) = .false. - end if - end if ! END COND: Maximum-random overlap - ! ################################################################################ - ! Exponential-random overlap - ! new random deviates if the adjacent layer isn't cloudy - ! correlated deviates if the adjacent layer is cloudy - ! ################################################################################ - if (l_use_overlap_param) then - if(cloud_mask_layer(ilay)) then - if(cloud_mask_layer(ilay-1)) then - ! Create random deviates correlated between this layer and the previous layer - ! (have to remove mean value before enforcing correlation). - rho = overlap_param(icol,ilay-1) - local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & - sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp + cloud_mask_layer(1:nlay) = cloud_frac(icol,1:nlay) > 0._wp + if(.not. any(cloud_mask_layer)) then + cloud_mask(icol,1:nlay,1:ngpt) = .false. + cycle + end if + cloud_lay_fst = findloc(cloud_mask_layer, .true., dim=1) + cloud_lay_lst = findloc(cloud_mask_layer, .true., dim=1, back = .true.) + cloud_mask(icol,1:cloud_lay_fst,1:ngpt) = .false. + + ilay = cloud_lay_fst + local_rands(1:ngpt) = randoms(1:ngpt,cloud_lay_fst,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + do ilay = cloud_lay_fst+1, cloud_lay_lst + ! ################################################################################ + ! Max-random overlap + ! new random deviates if the adjacent layer isn't cloudy + ! same random deviates if the adjacent layer is cloudy + ! ################################################################################ + if (.not. l_use_overlap_param) then + if(cloud_mask_layer(ilay)) then + if(.not. cloud_mask_layer(ilay-1)) local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) else - local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) - end if - cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) - endif - endif ! END COND: Exponential/Exponential-random overlap - ! ################################################################################ - ! Exponential-decorrelation overlap - ! new random deviates if the adjacent layer isn't cloudy - ! correlated deviates if the adjacent layer is cloudy and decorrelation-length - ! ################################################################################ - if (l_use_overlap_param .and. l_use_second_rng) then - where(randoms2(1:nGpt,iLay,iCol) .le. overlap_param(iCol,iLay)) - cloud_mask(iCol,iLay,1:nGpt) = randoms(1:ngpt,iLay-1,iCol) > (1._wp - cloud_frac(iCol,iLay)) - elsewhere - cloud_mask(iCol,iLay,1:nGpt) = randoms(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) - end where - endif ! END COND: Exponential decorrelation-length - end do ! END LOOP: Layers - - ! Set cloud-mask in layer below clouds to false - cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. + cloud_mask(icol,ilay,1:ngpt) = .false. + end if + end if ! END COND: Maximum-random overlap + ! ################################################################################ + ! Exponential-random overlap + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy + ! ################################################################################ + if (l_use_overlap_param) then + if(cloud_mask_layer(ilay)) then + if(cloud_mask_layer(ilay-1)) then + ! Create random deviates correlated between this layer and the previous layer + ! (have to remove mean value before enforcing correlation). + rho = overlap_param(icol,ilay-1) + local_rands(1:ngpt) = rho*(local_rands(1:ngpt) -0.5_wp) + & + sqrt(1._wp-rho*rho)*(randoms(1:ngpt,ilay,icol)-0.5_wp) + 0.5_wp + else + local_rands(1:ngpt) = randoms(1:ngpt,ilay,icol) + end if + cloud_mask(icol,ilay,1:ngpt) = local_rands(1:ngpt) > (1._wp - cloud_frac(icol,ilay)) + endif + endif ! END COND: Exponential/Exponential-random overlap + ! ################################################################################ + ! Exponential-decorrelation overlap + ! new random deviates if the adjacent layer isn't cloudy + ! correlated deviates if the adjacent layer is cloudy and decorrelation-length + ! ################################################################################ + if (l_use_overlap_param .and. l_use_second_rng) then + where(randoms2(1:nGpt,iLay,iCol) .le. overlap_param(iCol,iLay-1)) + cloud_mask(iCol,iLay,1:nGpt) = randoms(1:ngpt,iLay-1,iCol) > (1._wp - cloud_frac(iCol,iLay)) + elsewhere + cloud_mask(iCol,iLay,1:nGpt) = randoms(1:ngpt,iLay,iCol) > (1._wp - cloud_frac(iCol,iLay)) + end where + endif ! END COND: Exponential decorrelation-length + end do ! END LOOP: Layers + + ! Set cloud-mask in layer below clouds to false + cloud_mask(icol,cloud_lay_lst+1:nlay, 1:ngpt) = .false. end do ! END LOOP: Columns end subroutine sampled_mask diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 8c2e9e877..93e5e7eea 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -64,18 +64,18 @@ intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure at vertical interface for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure at vertical layer for radiation calculation - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index bd0ac1169..ccc5ad8c8 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -503,10 +503,10 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) + p_lay, & ! Pressure @ model layer-centers (Pa) t_lay ! Temperature (K) real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & - p_lev, & ! Pressure @ model layer-interfaces (hPa) + p_lev, & ! Pressure @ model layer-interfaces (Pa) t_lev ! Temperature @ model levels type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index f85daf09a..92432631d 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -152,18 +152,18 @@ intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure layer - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure level - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index e2232049b..5ca34b285 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -66,18 +66,18 @@ intent = in optional = F [p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + standard_name = air_pressure_at_layer_for_RRTMGP long_name = air pressure layer - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_layer_dimension) type = real kind = kind_phys intent = in optional = F [p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + standard_name = air_pressure_at_interface_for_RRTMGP long_name = air pressure level - units = hPa + units = Pa dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index d9594c46c..9588c7bd8 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit d9594c46c877a2ab8001f5cd37961efdcf08ad8e +Subproject commit 9588c7bd89e4f51a924f766e313bc42830fb4479