diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 index 01617aa1b..7623f23da 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90 @@ -23,22 +23,22 @@ module GFS_surface_composites_post !! \htmlinclude GFS_surface_composites_post_run.html !! subroutine GFS_surface_composites_post_run ( & - im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & + im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, cpl_fire, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, frac_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, & cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat, & ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & - tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, & - qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, & + tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, hflx_fire, evap_fire, & + qss, qss_wat, qss_lnd, qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, & sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, lkm, iopt_lake, iopt_lake_clm, use_lake_model, & grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, huge, errmsg, errflg) implicit none integer, intent(in) :: im, kice, km, lkm, iopt_lake, iopt_lake_clm - logical, intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice + logical, intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice, cpl_fire logical, intent(in) :: lheatstrg logical, dimension(:), intent(in) :: flag_cice, dry, icy logical, dimension(:), intent(in) :: wet @@ -51,6 +51,7 @@ subroutine GFS_surface_composites_post_run ( snowd_lnd, snowd_ice, tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, zorlo, zorll, zorli, garea + real(kind=kind_phys), dimension(:), intent(in), optional :: hflx_fire, evap_fire real(kind=kind_phys), dimension(:), intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc @@ -275,6 +276,10 @@ subroutine GFS_surface_composites_post_run ( else if (islmsk(i) == 1) then !-- land call composite_land + if (cpl_fire) then + hflx(i) = hflx(i) + hflx_fire(i) + evap(i) = evap(i) + evap_fire(i) + endif elseif (islmsk(i) == 0) then !-- water call composite_wet diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta index 7224d7221..e70eaaa4e 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta @@ -816,6 +816,31 @@ type = real kind = kind_phys intent = in +[hflx_fire] + standard_name = kinematic_surface_upward_sensible_heat_flux_of_fire + long_name = kinematic surface upward sensible heat flux of fire + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[evap_fire] + standard_name = surface_upward_specific_humidity_flux_of_fire + long_name = kinematic surface upward latent heat flux of fire + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical + intent = in [qss] standard_name = surface_specific_humidity long_name = surface air saturation specific humidity diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 index 8e3e0fdbf..648f6bf81 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90 @@ -45,7 +45,7 @@ end subroutine GFS_surface_generic_post_init !> \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, cplaqm, cplchm, cplwav, cpllnd, lssav, dry, icy, wet, & + subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, 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, & @@ -59,7 +59,7 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl implicit none integer, intent(in) :: im - logical, intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, lssav + logical, intent(in) :: cplflx, cplaqm, cplchm, cplwav, cpllnd, cpl_fire, lssav logical, dimension(:), intent(in) :: dry, icy, wet integer, intent(in) :: lsm, lsm_noahmp real(kind=kind_phys), intent(in) :: dtf @@ -136,9 +136,20 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl dswsfci_cpl (i) = adjsfcdsw(i) dlwsfc_cpl (i) = dlwsfc_cpl(i) + adjsfcdlw(i)*dtf dswsfc_cpl (i) = dswsfc_cpl(i) + adjsfcdsw(i)*dtf + enddo + endif + + if (cplflx .or. cpllnd .or. cpl_fire) then + do i=1,im psurfi_cpl (i) = pgr(i) enddo endif + if (cplflx .or. cpl_fire) then + do i=1,im + t2mi_cpl (i) = t2m(i) + q2mi_cpl (i) = q2m(i) + enddo + endif if (cplflx) then do i=1,im @@ -155,8 +166,6 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplaqm, cplchm, cplwav, cpl nlwsfci_cpl(i) = adjsfcdlw(i) - adjsfculw_wat(i) endif nlwsfc_cpl (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf - t2mi_cpl (i) = t2m(i) - q2mi_cpl (i) = q2m(i) enddo endif diff --git a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta index 2c8ae74c0..5e7949b8f 100644 --- a/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta +++ b/physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta @@ -126,6 +126,13 @@ dimensions = () type = logical intent = in +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical + intent = in [lssav] standard_name = flag_for_diagnostics long_name = logical flag for storing diagnostics diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.F90 b/physics/smoke_dust/rrfs_smoke_wrapper.F90 index b6da50ca0..47e6d7a94 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.F90 +++ b/physics/smoke_dust/rrfs_smoke_wrapper.F90 @@ -110,28 +110,30 @@ end subroutine rrfs_smoke_wrapper_init !! !>\section rrfs_smoke_wrapper rrfs-sd Scheme General Algorithm !> @{ - subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, & + subroutine rrfs_smoke_wrapper_run(im, flag_init, kte, kme, ktau, dt, garea, land, jdate, & u10m, v10m, ustar, rlat, rlon, tskin, pb2d, t2m, dpt2m, & pr3d, ph3d,phl3d, prl3d, tk3d, us3d, vs3d, spechum, w, & nsoil, smc, tslb, vegtype_dom, vegtype_frac, soiltyp, nlcat, & - dswsfc, zorl, snow, julian,recmol, & + dswsfc, zorl, snow, julian, recmol, & idat, rain_cpl, rainc_cpl, hf2d, g, pi, con_cp, con_rd, con_fv, & dust12m_in, emi_ant_in, smoke_RRFS, smoke2d_RRFS, & ntrac, qgrs, gq0, chem3d, tile_num, & - ntsmoke, ntdust, ntcoarsepm, imp_physics, imp_physics_thompson, & + ntfsmoke, ntsmoke, ntdust, ntcoarsepm, & + imp_physics, imp_physics_thompson, & nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, & ebb_smoke_in, frp_output, coef_bb, fire_type_out, & ebu_smoke,fhist,min_fplume, & max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout, & + smoke_fire, cpl_fire, & peak_hr_out,lu_nofire_out,lu_qfire_out, & fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, & uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg ) - implicit none integer, intent(in) :: im,kte,kme,ktau,nsoil,tile_num,jdate(8),idat(8) - integer, intent(in) :: ntrac, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat + integer, intent(in) :: ntrac, ntfsmoke, ntsmoke, ntdust, ntcoarsepm, ndvel, nlcat + logical, intent(in) :: flag_init real(kind_phys),intent(in) :: dt, julian, g, pi, con_cp, con_rd, con_fv integer, parameter :: ids=1,jds=1,jde=1, kds=1 @@ -166,6 +168,8 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, real(kind_phys), dimension(:), intent(in), optional :: wetness real(kind_phys), dimension(:), intent(out), optional :: lu_nofire_out,lu_qfire_out integer, dimension(:), intent(out), optional :: fire_type_out + real(kind_phys), dimension(:), intent(in), optional :: smoke_fire + logical, intent(in) :: cpl_fire integer, intent(in) :: imp_physics, imp_physics_thompson integer, dimension(:), intent(in) :: kpbl real(kind_phys), dimension(:), intent(in) :: oro @@ -235,6 +239,19 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate, errmsg = '' errflg = 0 + if (cpl_fire) then + if (flag_init) then + do i=1,im + do k=kts,kte + qgrs(i,k,ntfsmoke) = 0. + end do + end do + endif + do i=1,im + qgrs(i,kts,ntfsmoke) = qgrs(i,kts,ntfsmoke) + smoke_fire(i) + end do + endif + if (.not. do_rrfs_sd) return ! -- set domain diff --git a/physics/smoke_dust/rrfs_smoke_wrapper.meta b/physics/smoke_dust/rrfs_smoke_wrapper.meta index c7afc1d97..739a43d70 100755 --- a/physics/smoke_dust/rrfs_smoke_wrapper.meta +++ b/physics/smoke_dust/rrfs_smoke_wrapper.meta @@ -200,6 +200,13 @@ dimensions = () type = integer intent = in +[flag_init] + standard_name = flag_for_first_timestep + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in [kte] standard_name = vertical_layer_dimension long_name = vertical layer dimension @@ -642,6 +649,13 @@ dimensions = () type = integer intent = in +[ntfsmoke] + standard_name = index_for_fire_smoke_in_tracer_concentration_array + long_name = tracer index for fire smoke + units = index + dimensions = () + type = integer + intent = in [ntdust] standard_name = index_for_dust_in_tracer_concentration_array long_name = tracer index for dust @@ -946,6 +960,22 @@ type = real kind = kind_phys intent = in +[smoke_fire] + standard_name = smoke_emission_of_fire + long_name = smoke emission of fire + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = True +[cpl_fire] + standard_name = do_fire_coupling + long_name = flag controlling fire_behavior collection (default off) + units = flag + dimensions = () + type = logical + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP