diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 8d013a442..b9395ab41 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -395,8 +395,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, ntwa, ntia, ntgl, ntoz, ntke, ntkev,nqrimef, & trans_aero, ntchs, ntchm, ntccn, nthl, nthnc, ntgv, nthv, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & - imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, & - ltaerosol, nssl_hail_on, cplflx, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf,& + imp_physics_fer_hires, imp_physics_nssl, nssl_ccn_on, ltaerosol, nssl_hail_on, & + cplflx, cplaqm, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, lsidea, hybedmf, do_shoc, satmedmf, & shinhong, do_ysu, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, dtend, dtidx, index_of_temperature, index_of_x_wind, index_of_y_wind, & index_of_process_pbl, dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, & @@ -419,7 +419,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires integer, intent(in) :: imp_physics_nssl logical, intent(in) :: nssl_ccn_on, nssl_hail_on - logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, lsidea + logical, intent(in) :: ltaerosol, cplflx, cplaqm, cplchm, lssav, ldiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu logical, intent(in) :: flag_for_pbl_generic_tend @@ -741,6 +741,29 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, end if end if + if (cplaqm .and. .not.cplflx) then + do i=1,im + if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES + if ( .not. wet(i)) then ! no open water + if (kdt > 1) then !use results from CICE + dtsfci_cpl(i) = dtsfc_cice(i) + dqsfci_cpl(i) = dqsfc_cice(i) + else !use PBL fluxes when CICE fluxes is unavailable + dtsfci_cpl(i) = dtsfc1(i)*hffac(i) + dqsfci_cpl(i) = dqsfc1(i) + end if + elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*max(q1(i), qmin))) + dtsfci_cpl(i) = cp * rho * hflx_wat(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = hvap * rho * evap_wat(i) ! latent heat flux over open ocean + else ! use results from PBL scheme for 100% open ocean + dtsfci_cpl(i) = dtsfc1(i)*hffac(i) + dqsfci_cpl(i) = dqsfc1(i) + endif + endif ! Ocean only, NO LAKES + enddo + end if + !-------------------------------------------------------lssav if loop ---------- if (lssav) then do i=1,im diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 9e0d68a7d..4845b2192 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -728,6 +728,13 @@ dimensions = () type = logical intent = in +[cplaqm] + standard_name = flag_for_air_quality_coupling + long_name = flag controlling cplaqm collection (default off) + units = flag + dimensions = () + type = logical + intent = in [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 1b39409b3..aecc6fcf7 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -274,7 +274,7 @@ end subroutine GFS_surface_generic_post_finalize !> \section arg_table_GFS_surface_generic_post_run Argument Table !! \htmlinclude GFS_surface_generic_post_run.html !! - subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, icy, wet, & + subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, lssav, dry, icy, wet, & lsm, lsm_noahmp, dtf, ep1d, gflx, tgrs_1, qgrs_1, ugrs_1, vgrs_1, & adjsfcdlw, adjsfcdsw, adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd, adjsfculw, adjsfculw_wat, adjnirbmu, adjnirdfu, & adjvisbmu, adjvisdfu, t2m, q2m, u10m, v10m, tsfc, tsfc_wat, pgr, xcosz, evbs, evcw, trans, sbsno, snowc, snohf, pah, pahi, & @@ -288,7 +288,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, implicit none integer, intent(in) :: im - logical, intent(in) :: cplflx, cplchm, cplwav, lssav + logical, intent(in) :: cplflx, cplaqm, cplchm, cplwav, lssav logical, dimension(:), intent(in) :: dry, icy, wet integer, intent(in) :: lsm, lsm_noahmp real(kind=kind_phys), intent(in) :: dtf @@ -416,6 +416,34 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplchm, cplwav, lssav, dry, enddo endif + if (cplaqm .and. .not.cplflx) then + do i=1,im + t2mi_cpl (i) = t2m(i) + q2mi_cpl (i) = q2m(i) + psurfi_cpl (i) = pgr(i) + if (wet(i)) then ! some open water +! --- compute open water albedo + xcosz_loc = max( zero, min( one, xcosz(i) )) + ocalnirdf_cpl = 0.06_kind_phys + ocalnirbm_cpl = max(albdf, 0.026_kind_phys/(xcosz_loc**1.7_kind_phys+0.065_kind_phys) & + & + 0.15_kind_phys * (xcosz_loc-0.1_kind_phys) * (xcosz_loc-0.5_kind_phys) & + & * (xcosz_loc-one)) + ocalvisdf_cpl = 0.06_kind_phys + ocalvisbm_cpl = ocalnirbm_cpl + + nswsfci_cpl(i) = adjnirbmd(i) * (one-ocalnirbm_cpl) + & + adjnirdfd(i) * (one-ocalnirdf_cpl) + & + adjvisbmd(i) * (one-ocalvisbm_cpl) + & + adjvisdfd(i) * (one-ocalvisdf_cpl) + else + nswsfci_cpl(i) = adjnirbmd(i) - adjnirbmu(i) + & + adjnirdfd(i) - adjnirdfu(i) + & + adjvisbmd(i) - adjvisbmu(i) + & + adjvisdfd(i) - adjvisdfu(i) + endif + enddo + endif + if (lssav) then do i=1,im gflux(i) = gflux(i) + gflx(i) * dtf diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 28c88c5ea..a2493a825 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -558,6 +558,13 @@ dimensions = () type = logical intent = in +[cplaqm] + standard_name = flag_for_air_quality_coupling + long_name = flag controlling cplaqm collection (default off) + units = flag + dimensions = () + type = logical + intent = in [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 817897fe7..e61d3be5e 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -196,6 +196,8 @@ end subroutine lsm_noah_finalize ! smcwlt2 - real, dry soil moisture threshold im ! ! smcref2 - real, soil moisture threshold im ! ! wet1 - real, normalized soil wetness im ! +! lai - real, leaf area index (dimensionless) im ! +! rca - real, canopy resistance (s/m) im ! ! ! ! ==================== end of description ===================== ! @@ -225,7 +227,7 @@ subroutine lsm_noah_run & ! --- outputs: & sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & & cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & - & smcwlt2, smcref2, wet1, errmsg, errflg & + & smcwlt2, smcref2, wet1, lai, rca, errmsg, errflg & & ) ! !use machine , only : kind_phys @@ -282,7 +284,7 @@ subroutine lsm_noah_run & real (kind=kind_phys), dimension(:), intent(inout) :: sncovr1, & & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, & - & wet1 + & wet1, lai, rca character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -552,6 +554,8 @@ subroutine lsm_noah_run & !!\n ssoil - soil heat flux (\f$W m^{-2}\f$: negative if downward from surface) !!\n runoff1 - surface runoff (\f$m s^{-1}\f$), not infiltrating the surface !!\n runoff2 - subsurface runoff (\f$m s^{-1}\f$), drainage out bottom +!!\n xlai - leaf area index (dimensionless) +!!\n rca - canopy resistance (s/m) evap(i) = eta hflx(i) = sheat @@ -590,6 +594,9 @@ subroutine lsm_noah_run & ! ---- ... outside sflx, roughness uses cm as unit (update after snow's effect) zorl(i) = z0*100.0_kind_phys + lai(i) = xlai + rca(i) = rc + !> - Do not return the following output fields to parent model: !!\n ec - canopy water evaporation (m s-1) !!\n edir - direct soil evaporation (m s-1) @@ -610,7 +617,6 @@ subroutine lsm_noah_run & !!\n rc - canopy resistance (s m-1) !!\n pc - plant coefficient (unitless fraction, 0-1) where pc*etp !! = actual transp -!!\n xlai - leaf area index (dimensionless) !!\n rsmin - minimum canopy resistance (s m-1) !!\n rcs - incoming solar rc factor (dimensionless) !!\n rct - air temperature rc factor (dimensionless) diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index a3aa9044e..2ce7c3e6c 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -734,6 +734,22 @@ type = real kind = kind_phys intent = inout +[lai] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[rca] + standard_name = aerodynamic_resistance_in_canopy + long_name = canopy resistance + units = s m-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP