Skip to content

Commit

Permalink
Add two way fire coupling to fv3atm (NOAA-EMC#815)
Browse files Browse the repository at this point in the history 
* add fire_behavior smoke coupling and flags and export variables for fire behavior

* added: inst_pres_levels, inst_geop_levels, inst_zonal_wind_levels, inst_merid_wind_levels, inst_surface_roughness, inst_temp_height2m, inst_spec_humid_height2m, inst_pres_height_surface, mean_prec_rate, inst_rainfall_amount 

* add fire behavior tendencies to physics

* add hflx_fire and evap_fire to FV3 imports

* added surface emissions fire_smoke imports and initialized the variables and fsmoke tracer index

---------

Co-authored-by: masih <[email protected]>
Co-authored-by: Grant Firl <[email protected]>
  • Loading branch information
@danrosen25 @masih-e @grantfirl
3 people authored Sep 17, 2024
1 parent 40e014f commit a936459
Show file tree
Hide file tree
Showing 6 changed files with 168 additions and 15 deletions.
75 changes: 75 additions & 0 deletions atmos_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3121,6 +3121,54 @@ subroutine assign_importdata(jdat, rc)
endif
endif

fldname = 'hflx_fire'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex)) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
im = GFS_control%chunk_begin(nb)+ix-1
GFS_sfcprop%hflx_fire(im) = datar82d(i-isc+1,j-jsc+1)
enddo
enddo
endif
endif

fldname = 'evap_fire'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex)) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
im = GFS_control%chunk_begin(nb)+ix-1
GFS_sfcprop%evap_fire(im) = datar82d(i-isc+1,j-jsc+1)
enddo
enddo
endif
endif

fldname = 'smoke_fire'
if (trim(impfield_name) == trim(fldname)) then
findex = queryImportFields(fldname)
if (importFieldsValid(findex)) then
!$omp parallel do default(shared) private(i,j,nb,ix)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
im = GFS_control%chunk_begin(nb)+ix-1
GFS_sfcprop%smoke_fire(im) = datar82d(i-isc+1,j-jsc+1)
enddo
enddo
endif
endif

! write post merge import data to NetCDF file.
if (GFS_control%cpl_imp_dbg) then
call ESMF_FieldGet(importFields(n), grid=grid, rc=rc)
Expand Down Expand Up @@ -3294,6 +3342,21 @@ subroutine setup_exportdata(rc)
do nb = 1, Atm_block%nblks
select case (trim(fieldname))
!--- Instantaneous quantities
! Instantaneous mean layer pressure (Pa)
case ('inst_pres_levels')
call block_data_copy_or_fill(datar83d, GFS_statein%prsl, zeror8, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! Instantaneous geopotential at model layer centers (m2 s-2)
case ('inst_geop_levels')
call block_data_copy_or_fill(datar83d, GFS_statein%phil, zeror8, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! Instantaneous zonal wind (m s-1)
case ('inst_zonal_wind_levels')
call block_data_copy_or_fill(datar83d, GFS_statein%ugrs, zeror8, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! Instantaneous meridional wind (m s-1)
case ('inst_merid_wind_levels')
call block_data_copy_or_fill(datar83d, GFS_statein%vgrs, zeror8, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! Instantaneous surface roughness length (cm)
case ('inst_surface_roughness')
call block_data_copy(datar82d, GFS_sfcprop%zorl, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! Instantaneous u wind (m/s) 10 m above ground
case ('inst_zonal_wind_height10m')
call block_data_copy(datar82d, GFS_coupling%u10mi_cpl, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
Expand Down Expand Up @@ -3378,6 +3441,9 @@ subroutine setup_exportdata(rc)
! Land/Sea mask (sea:0,land:1)
case ('inst_land_sea_mask', 'slmsk')
call block_data_copy(datar82d, GFS_sfcprop%slmsk, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! Total precipitation amount in each time step
case ('inst_rainfall_amount')
call block_data_copy(datar82d, GFS_sfcprop%tprcp, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
!--- Mean quantities
! MEAN Zonal compt of momentum flux (N/m**2)
case ('mean_zonal_moment_flx_atm')
Expand Down Expand Up @@ -3430,6 +3496,15 @@ subroutine setup_exportdata(rc)
! MEAN NET sfc uv+vis diffused flux (W/m**2)
case ('mean_net_sw_vis_dif_flx')
call block_data_copy(datar82d, GFS_coupling%nvisdf_cpl, Atm_block, nb, rtime, spval, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! MEAN precipitation rate (kg/m2/s)
case ('mean_prec_rate')
call block_data_copy(datar82d, GFS_sfcprop%tprcp, Atm_block, nb, rtimek, spval, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! MEAN convective precipitation rate (kg/m2/s)
case ('mean_prec_rate_conv')
call block_data_copy(datar82d, GFS_coupling%rainc_cpl, Atm_block, nb, rtimek, spval, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! MEAN snow precipitation rate (kg/m2/s)
case ('mean_fprec_rate')
call block_data_copy(datar82d, GFS_coupling%snow_cpl, Atm_block, nb, rtimek, spval, offset=GFS_Control%chunk_begin(nb), rc=localrc)
! oceanfrac used by atm to calculate fluxes
case ('openwater_frac_in_atm')
call block_data_combine_fractions(datar82d, GFS_sfcprop%oceanfrac, GFS_sfcprop%fice, Atm_block, nb, offset=GFS_Control%chunk_begin(nb), rc=localrc)
Expand Down
35 changes: 29 additions & 6 deletions ccpp/data/GFS_typedefs.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -297,6 +297,11 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: hflx (:) => null() !<
real (kind=kind_phys), pointer :: qss (:) => null() !<

!--- fire_behavior
real (kind=kind_phys), pointer :: hflx_fire (:) => null() !< kinematic surface upward sensible heat flux of fire
real (kind=kind_phys), pointer :: evap_fire (:) => null() !< kinematic surface upward latent heat flux of fire
real (kind=kind_phys), pointer :: smoke_fire (:) => null() !< smoke emission of fire

!-- In/Out
real (kind=kind_phys), pointer :: maxupmf(:) => null() !< maximum up draft mass flux for Grell-Freitas
real (kind=kind_phys), pointer :: conv_act(:) => null() !< convective activity counter for Grell-Freitas
Expand Down Expand Up @@ -766,6 +771,7 @@ module GFS_typedefs
logical :: cpllnd !< default no cpllnd collection
logical :: cpllnd2atm !< default no lnd->atm coupling
logical :: rrfs_sd !< default no rrfs_sd collection
logical :: cpl_fire !< default no fire_behavior collection
logical :: use_cice_alb !< default .false. - i.e. don't use albedo imported from the ice model
logical :: cpl_imp_mrg !< default no merge import with internal forcings
logical :: cpl_imp_dbg !< default no write import data to file post merge
Expand Down Expand Up @@ -1485,6 +1491,7 @@ module GFS_typedefs
integer :: nto2 !< tracer index for oxygen
integer :: ntwa !< tracer index for water friendly aerosol
integer :: ntia !< tracer index for ice friendly aerosol
integer :: ntfsmoke !< tracer index for fire smoke
integer :: ntsmoke !< tracer index for smoke
integer :: ntdust !< tracer index for dust
integer :: ntcoarsepm !< tracer index for coarse PM
Expand Down Expand Up @@ -2864,6 +2871,16 @@ subroutine sfcprop_create (Sfcprop, Model)
Sfcprop%lu_qfire = clear_val
endif

!--- if fire_behavior is on
if(Model%cpl_fire) then
allocate (Sfcprop%hflx_fire (IM))
allocate (Sfcprop%evap_fire (IM))
allocate (Sfcprop%smoke_fire (IM))
Sfcprop%hflx_fire = zero
Sfcprop%evap_fire = zero
Sfcprop%smoke_fire = zero
endif

end subroutine sfcprop_create


Expand Down Expand Up @@ -2923,7 +2940,7 @@ subroutine coupling_create (Coupling, Model)
Coupling%tsfc_radtime = clear_val
endif

if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm .or. Model%ca_global .or. Model%cpllnd) then
if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm .or. Model%ca_global .or. Model%cpllnd .or. Model%cpl_fire) then
allocate (Coupling%rain_cpl (IM))
allocate (Coupling%snow_cpl (IM))
Coupling%rain_cpl = clear_val
Expand Down Expand Up @@ -2952,7 +2969,7 @@ subroutine coupling_create (Coupling, Model)
! Coupling%zorlwav_cpl = clear_val
! endif

if (Model%cplflx .or. Model%cpllnd) then
if (Model%cplflx .or. Model%cpllnd .or. Model%cpl_fire) then
allocate (Coupling%dlwsfci_cpl (IM))
allocate (Coupling%dswsfci_cpl (IM))
allocate (Coupling%dlwsfc_cpl (IM))
Expand Down Expand Up @@ -2986,7 +3003,7 @@ subroutine coupling_create (Coupling, Model)
Coupling%nvisdf_cpl = clear_val
end if

if (Model%cplflx) then
if (Model%cplflx .or. Model%cpl_fire) then
!--- incoming quantities
allocate (Coupling%slimskin_cpl (IM))
allocate (Coupling%dusfcin_cpl (IM))
Expand Down Expand Up @@ -3151,7 +3168,7 @@ subroutine coupling_create (Coupling, Model)
Coupling%pfl_lsan = clear_val
endif

if (Model%cplchm .or. Model%cplflx .or. Model%cpllnd) then
if (Model%cplchm .or. Model%cplflx .or. Model%cpllnd .or. Model%cpl_fire) then
!--- accumulated convective rainfall
allocate (Coupling%rainc_cpl (IM))
Coupling%rainc_cpl = clear_val
Expand Down Expand Up @@ -3359,6 +3376,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
logical :: cpllnd = .false. !< default no cpllnd collection
logical :: cpllnd2atm = .false. !< default no cpllnd2atm coupling
logical :: rrfs_sd = .false. !< default no rrfs_sd collection
logical :: cpl_fire = .false. !< default no fire behavior colleciton
logical :: use_cice_alb = .false. !< default no cice albedo
logical :: cpl_imp_mrg = .false. !< default no merge import with internal forcings
logical :: cpl_imp_dbg = .false. !< default no write import data to file post merge
Expand Down Expand Up @@ -4006,7 +4024,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
!--- coupling parameters
cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, &
cplchm, cpllnd, cpllnd2atm, cpl_imp_mrg, cpl_imp_dbg, &
rrfs_sd, use_cice_alb, &
cpl_fire, rrfs_sd, use_cice_alb, &
#ifdef IDEA_PHYS
lsidea, weimer_model, f107_kp_size, f107_kp_interval, &
f107_kp_skip_size, f107_kp_data_size, f107_kp_read_in_start, &
Expand Down Expand Up @@ -4379,6 +4397,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &

!--- RRFS-SD
Model%rrfs_sd = rrfs_sd
Model%cpl_fire = cpl_fire
Model%dust_drylimit_factor = dust_drylimit_factor
Model%dust_moist_correction = dust_moist_correction
Model%dust_moist_opt = dust_moist_opt
Expand Down Expand Up @@ -5191,12 +5210,14 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%nqrimef = get_tracer_index(Model%tracer_names, 'q_rimef', Model%me, Model%master, Model%debug)
Model%ntwa = get_tracer_index(Model%tracer_names, 'liq_aero', Model%me, Model%master, Model%debug)
Model%ntia = get_tracer_index(Model%tracer_names, 'ice_aero', Model%me, Model%master, Model%debug)
if (Model%cpl_fire) then
Model%ntfsmoke = get_tracer_index(Model%tracer_names, 'fsmoke', Model%me, Model%master, Model%debug)
endif
if (Model%rrfs_sd) then
Model%ntsmoke = get_tracer_index(Model%tracer_names, 'smoke', Model%me, Model%master, Model%debug)
Model%ntdust = get_tracer_index(Model%tracer_names, 'dust', Model%me, Model%master, Model%debug)
Model%ntcoarsepm = get_tracer_index(Model%tracer_names, 'coarsepm', Model%me, Model%master, Model%debug)
endif

!--- initialize parameters for atmospheric chemistry tracers
call Model%init_chemistry(tracer_types)

Expand Down Expand Up @@ -6502,6 +6523,7 @@ subroutine control_print(Model)
print *, ' cpllnd : ', Model%cpllnd
print *, ' cpllnd2atm : ', Model%cpllnd2atm
print *, ' rrfs_sd : ', Model%rrfs_sd
print *, ' cpl_fire : ', Model%cpl_fire
print *, ' use_cice_alb : ', Model%use_cice_alb
print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg
print *, ' cpl_imp_dbg : ', Model%cpl_imp_dbg
Expand Down Expand Up @@ -6973,6 +6995,7 @@ subroutine control_print(Model)
print *, ' nto2 : ', Model%nto2
print *, ' ntwa : ', Model%ntwa
print *, ' ntia : ', Model%ntia
print *, ' ntfsmoke : ', Model%ntfsmoke
print *, ' ntsmoke : ', Model%ntsmoke
print *, ' ntdust : ', Model%ntdust
print *, ' ntcoarsepm : ', Model%ntcoarsepm
Expand Down
46 changes: 41 additions & 5 deletions ccpp/data/GFS_typedefs.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2363,6 +2363,30 @@
type = real
kind = kind_phys
active = (do_smoke_coupling)
[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
active = (do_fire_coupling)
[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
active = (do_fire_coupling)
[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
active = (do_fire_coupling)

########################################################################
[ccpp-table-properties]
Expand Down Expand Up @@ -2472,15 +2496,15 @@
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling .or. flag_for_land_coupling)
active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling .or. flag_for_land_coupling .or. do_fire_coupling)
[snow_cpl]
standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling
long_name = total snow precipitation
units = m
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_surface_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata .or. flag_for_land_coupling)
active = (flag_for_surface_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata .or. flag_for_land_coupling .or. do_fire_coupling)
[dusfc_cpl]
standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep
long_name = cumulative sfc x momentum flux multiplied by timestep
Expand Down Expand Up @@ -2744,15 +2768,15 @@
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling)
active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling .or. do_fire_coupling)
[q2mi_cpl]
standard_name = specific_humidity_at_2m_for_coupling
long_name = instantaneous Q2m
units = kg kg-1
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling)
active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling .or. do_fire_coupling)
[u10mi_cpl]
standard_name = x_wind_at_10m_for_coupling
long_name = instantaneous U10m
Expand Down Expand Up @@ -2784,7 +2808,7 @@
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling .or. flag_for_land_coupling)
active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling .or. flag_for_land_coupling .or. do_fire_coupling)
[ulwsfcin_cpl]
standard_name = surface_upwelling_longwave_flux_from_coupled_process
long_name = surface upwelling LW flux for coupling
Expand Down Expand Up @@ -3634,6 +3658,12 @@
units = flag
dimensions = ()
type = logical
[cpl_fire]
standard_name = do_fire_coupling
long_name = flag controlling fire_behavior collection (default off)
units = flag
dimensions = ()
type = logical
[cpl_imp_mrg]
standard_name = flag_for_merging_imported_data
long_name = flag controlling cpl_imp_mrg for imported data (default off)
Expand Down Expand Up @@ -6549,6 +6579,12 @@
units = index
dimensions = ()
type = integer
[ntfsmoke]
standard_name = index_for_fire_smoke_in_tracer_concentration_array
long_name = tracer index for fire smoke
units = index
dimensions = ()
type = integer
[ntdust]
standard_name = index_for_dust_in_tracer_concentration_array
long_name = tracer index for dust
Expand Down
13 changes: 13 additions & 0 deletions ccpp/driver/GFS_diagnostics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4653,6 +4653,19 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
enddo
end if thompson_extended_diagnostics

if (Model%cpl_fire .and. Model%ntfsmoke>0) then
idx = idx + 1
ExtDiag(idx)%axes = 3
ExtDiag(idx)%name = 'fsmoke'
ExtDiag(idx)%desc = 'smoke concentration'
ExtDiag(idx)%unit = 'kg kg-1'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var3 => Statein%qgrs(Model%chunk_begin(nb):Model%chunk_end(nb),:,Model%ntfsmoke)
enddo
endif

if (Model%rrfs_sd .and. Model%ntsmoke>0) then

idx = idx + 1
Expand Down
2 changes: 1 addition & 1 deletion ccpp/physics
Submodule physics updated 6 files
+9 −4 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.F90
+25 −0 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_composites_post.meta
+13 −4 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.F90
+7 −0 physics/Interstitials/UFS_SCM_NEPTUNE/GFS_surface_generic_post.meta
+22 −5 physics/smoke_dust/rrfs_smoke_wrapper.F90
+30 −0 physics/smoke_dust/rrfs_smoke_wrapper.meta
Loading

0 comments on commit a936459

Please sign in to comment.