Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions src/core_atmosphere/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -135,6 +135,7 @@ set(ATMOSPHERE_CORE_PHYSICS_SMOKE_SOURCES
seas_ngac_mod.F90
ssalt_mod.F90
module_anthro_emissions.F90
module_mp_aero_emissions.F90
)
list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_SMOKE_SOURCES PREPEND physics/physics_noaa/SMOKE/)

Expand Down
77 changes: 53 additions & 24 deletions src/core_atmosphere/physics/mpas_atmphys_driver_smoke.F
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,7 @@ subroutine allocate_smoke(configs)
character(len=StrKIND),pointer :: config_dust_scheme
character(len=StrKIND),pointer :: config_anthro_scheme
character(len=StrKIND),pointer :: config_rwc_scheme
logical, pointer :: config_tempo_aerosolaware

integer, pointer :: ebb_dcycle
integer, pointer :: wetdep_ls_opt
Expand All @@ -55,6 +56,7 @@ subroutine allocate_smoke(configs)
call mpas_pool_get_config(configs,'config_dust_scheme', config_dust_scheme)
call mpas_pool_get_config(configs,'config_anthro_scheme',config_anthro_scheme)
call mpas_pool_get_config(configs,'config_rwc_scheme',config_rwc_scheme)
call mpas_pool_get_config(configs,'config_tempo_aerosolaware',config_tempo_aerosolaware)

call mpas_pool_get_config(configs,'ebb_dcycle', ebb_dcycle)
call mpas_pool_get_config(configs,'plumerise_opt',plumerise_opt)
Expand Down Expand Up @@ -149,10 +151,8 @@ subroutine allocate_smoke(configs)
if(.not.allocated(clayfrac_in_p)) allocate(clayfrac_in_p(ims:ime,jms:jme))
if(.not.allocated(sandfrac_in_p)) allocate(sandfrac_in_p(ims:ime,jms:jme))
if(.not.allocated(uthres_in_p)) allocate(uthres_in_p(ims:ime,jms:jme))
if(.not.allocated(uthres_sg_in_p)) allocate(uthres_sg_in_p(ims:ime,jms:jme))
if(.not.allocated(albedo_drag_p)) allocate(albedo_drag_p(ims:ime,jms:jme))
if(.not.allocated(sep_in_p)) allocate(sep_in_p(ims:ime,jms:jme))
if(.not.allocated(feff_p)) allocate(feff_p(ims:ime,jms:jme))
if(.not.allocated(rdrag_p)) allocate(rdrag_p(ims:ime,jms:jme))
if(.not.allocated(ssm_in_p)) allocate(ssm_in_p(ims:ime,jms:jme))
endif

if ( wetdep_ls_opt .ne. 0 ) then
Expand Down Expand Up @@ -192,6 +192,11 @@ subroutine allocate_smoke(configs)
if(.not.allocated(RWC_annual_sum_unspc_coarse_p)) allocate(RWC_annual_sum_unspc_coarse_p(ims:ime,1:kreswoodcomb,jms:jme))
endif

if (config_tempo_aerosolaware ) then
if(.not.allocated(nwfa2d_p)) allocate(nwfa2d_p(ims:ime,jms:jme))
if(.not.allocated(nifa2d_p)) allocate(nifa2d_p(ims:ime,jms:jme))
endif

end subroutine allocate_smoke

!=================================================================================================================
Expand Down Expand Up @@ -260,10 +265,8 @@ subroutine deallocate_smoke(configs)
if(allocated(clayfrac_in_p) ) deallocate(clayfrac_in_p )
if(allocated(sandfrac_in_p) ) deallocate(sandfrac_in_p )
if(allocated(uthres_in_p) ) deallocate(uthres_in_p )
if(allocated(uthres_sg_in_p) ) deallocate(uthres_sg_in_p )
if(allocated(albedo_drag_p) ) deallocate(albedo_drag_p )
if(allocated(feff_p) ) deallocate(feff_p )
if(allocated(sep_in_p) ) deallocate(sep_in_p )
if(allocated(rdrag_p) ) deallocate(rdrag_p )
if(allocated(ssm_in_p) ) deallocate(ssm_in_p )

if(allocated(ddvel_p) ) deallocate(ddvel_p )
if(allocated(wetdep_resolved_p)) deallocate(wetdep_resolved_p)
Expand All @@ -283,6 +286,9 @@ subroutine deallocate_smoke(configs)
if(allocated(e_bb_out_p) ) deallocate(e_bb_out_p )
if(allocated(e_dust_out_p) ) deallocate(e_dust_out_p )
if(allocated(e_ant_out_p) ) deallocate(e_ant_out_p )

if(allocated(nwfa2d_p) ) deallocate(nwfa2d_p )
if(allocated(nifa2d_p) ) deallocate(nifa2d_p )

!-----------------------------------------------------------------------------------------------------------------

Expand Down Expand Up @@ -330,8 +336,8 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
integer,dimension(:),pointer :: eco_id
real(kind=RKIND),dimension(:),pointer :: hfx_bb, qfx_bb, frac_grid_burned
integer,dimension(:),pointer :: min_bb_plume, max_bb_plume
real(kind=RKIND),dimension(:),pointer :: sandfrac_in, clayfrac_in, uthres_in, uthres_sg_in, &
sep_in, albedo_drag,feff
real(kind=RKIND),dimension(:),pointer :: sandfrac_in, clayfrac_in, uthres_in, &
ssm_in, rdrag
real(kind=RKIND),dimension(:),pointer :: RWC_denominator
real(kind=RKIND),dimension(:,:), pointer :: RWC_annual_sum, RWC_annual_sum_smoke_fine, &
RWC_annual_sum_smoke_coarse,RWC_annual_sum_unspc_fine, &
Expand All @@ -348,6 +354,7 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
character(len=StrKIND),pointer :: config_anthro_scheme
character(len=StrKIND),pointer :: config_rwc_scheme
character(len=StrKIND),pointer :: config_convection_scheme
logical,pointer:: config_tempo_aerosolaware
integer, pointer :: wetdep_ls_opt
integer, pointer :: drydep_opt
integer, pointer :: plumerise_opt
Expand All @@ -356,6 +363,7 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
real(kind=RKIND),dimension(:,:,:),pointer :: scalars
real(kind=RKIND),dimension(:,:,:),pointer :: chem
integer, pointer :: bb_input_prevh !JR
real(kind=RKIND),dimension(:),pointer :: nwfa2d, nifa2d

integer:: i,j,k,n,h,t
integer:: nblocks, blk !JR
Expand All @@ -374,6 +382,7 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
call mpas_pool_get_config(configs,'wetdep_ls_opt',wetdep_ls_opt)
call mpas_pool_get_config(configs,'drydep_opt',drydep_opt)
call mpas_pool_get_config(configs,'config_convection_scheme',config_convection_scheme)
call mpas_pool_get_config(configs,'config_tempo_aerosolaware',config_tempo_aerosolaware)

call mpas_pool_get_config(configs,'plumerise_opt',plumerise_opt)
call mpas_pool_get_config(configs,'add_fire_heat_flux',add_fire_heat_flux)
Expand Down Expand Up @@ -429,10 +438,8 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
call mpas_pool_get_array(diag_physics, 'clayfrac_in',clayfrac_in)
call mpas_pool_get_array(diag_physics, 'sandfrac_in',sandfrac_in)
call mpas_pool_get_array(diag_physics, 'uthres_in',uthres_in)
call mpas_pool_get_array(diag_physics, 'uthres_sg_in',uthres_sg_in)
call mpas_pool_get_array(diag_physics, 'albedo_drag',albedo_drag) ! these have been updated to select
call mpas_pool_get_array(diag_physics, 'feff',feff) ! the correct month
call mpas_pool_get_array(diag_physics, 'sep_in',sep_in)
call mpas_pool_get_array(diag_physics, 'rdrag',rdrag) ! these have been updated to select
call mpas_pool_get_array(diag_physics, 'ssm_in',ssm_in)
endif

if (config_smoke_scheme .ne. 'off' .and. num_e_bb_in .gt. 0 ) then
Expand Down Expand Up @@ -494,6 +501,11 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
if ( num_e_ant_out .gt. 0 .and. config_anthro_scheme .ne. 'off') then
call mpas_pool_get_array(diag_physics, 'e_ant_out',e_ant_out)
endif

if (config_tempo_aerosolaware ) then
call mpas_pool_get_array(diag_physics,'nifa2d',nifa2d)
call mpas_pool_get_array(diag_physics,'nwfa2d',nwfa2d)
endif

chem => scalars(chemistry_start:chemistry_end,:,:)

Expand Down Expand Up @@ -693,6 +705,10 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
rainncv_p(i,j) = rainncv(i)
dpt2m_p(i,j) = 280. !dewpoint_surface(i)
mavail_p(i,j) = mavail(i)
if ( config_tempo_aerosolaware ) then
nifa2d_p(i,j) = nifa2d(i)
nwfa2d_p(i,j) = nwfa2d(i)
endif
enddo
enddo
!
Expand All @@ -704,10 +720,8 @@ subroutine smoke_from_MPAS(dt_dyn, time_lev, emission_input, state, configs, &
sandfrac_in_p(i,j) = sandfrac_in(i)
clayfrac_in_p(i,j) = clayfrac_in(i)
uthres_in_p(i,j) = uthres_in(i)
uthres_sg_in_p(i,j) = uthres_sg_in(i)
albedo_drag_p(i,j) = albedo_drag(i)
feff_p(i,j) = feff(i)
sep_in_p(i,j) = sep_in(i)
rdrag_p(i,j) = rdrag(i)
ssm_in_p(i,j) = ssm_in(i)
enddo
enddo
endif
Expand Down Expand Up @@ -803,12 +817,14 @@ subroutine smoke_to_MPAS(configs,time_lev,state,diag_physics,tend_physics,its,it
real(kind=RKIND),dimension(:,:,:),pointer:: e_bb_out, e_dust_out, e_ant_out
real(kind=RKIND),dimension(:),pointer :: aero_emis_for_enhmix
integer,dimension(:),pointer:: min_bb_plume, max_bb_plume
real(kind=RKIND),dimension(:), pointer:: nwfa2d, nifa2d

integer,pointer :: chemistry_start,chemistry_end
integer,pointer :: ebb_dcycle
character(len=StrKIND),pointer :: config_smoke_scheme
character(len=StrKIND),pointer :: config_dust_scheme
character(len=StrKIND),pointer :: config_anthro_scheme
logical,pointer:: config_tempo_aerosolaware
integer, pointer :: wetdep_ls_opt
integer, pointer :: drydep_opt
integer, pointer :: plumerise_opt
Expand Down Expand Up @@ -838,6 +854,7 @@ subroutine smoke_to_MPAS(configs,time_lev,state,diag_physics,tend_physics,its,it
call mpas_pool_get_config(configs,'config_smoke_scheme', config_smoke_scheme)
call mpas_pool_get_config(configs,'config_dust_scheme', config_dust_scheme)
call mpas_pool_get_config(configs,'config_anthro_scheme',config_anthro_scheme)
call mpas_pool_get_config(configs,'config_tempo_aerosolaware',config_tempo_aerosolaware)
call mpas_pool_get_config(configs,'ebb_dcycle', ebb_dcycle)
call mpas_pool_get_config(configs,'wetdep_ls_opt',wetdep_ls_opt)
call mpas_pool_get_config(configs,'drydep_opt',drydep_opt)
Expand Down Expand Up @@ -876,6 +893,11 @@ subroutine smoke_to_MPAS(configs,time_lev,state,diag_physics,tend_physics,its,it
endif
endif

if (config_tempo_aerosolaware ) then
call mpas_pool_get_array(diag_physics,'nifa2d',nifa2d)
call mpas_pool_get_array(diag_physics,'nwfa2d',nwfa2d)
endif

chem => scalars(chemistry_start:chemistry_end,:,:)

do j = jts,jte
Expand Down Expand Up @@ -989,6 +1011,10 @@ subroutine smoke_to_MPAS(configs,time_lev,state,diag_physics,tend_physics,its,it
qfx_bb(i) = qfx_bb_p(i,j)
endif
endif
if (config_tempo_aerosolaware ) then
nifa2d(i) = nifa2d_p(i,j)
nwfa2d(i) = nwfa2d_p(i,j)
endif
enddo
enddo

Expand Down Expand Up @@ -1063,6 +1089,7 @@ subroutine driver_smoke(itimestep,time_lev,emission_input,state,configs, &
logical,pointer :: calc_bb_emis_online
logical,pointer :: add_fire_heat_flux
logical,pointer :: add_fire_moist_flux
logical,pointer :: config_mp_aero_emission
integer,pointer :: plumerisefire_frq
real(kind=RKIND),pointer :: dust_alpha, dust_gamma
real(kind=RKIND),pointer :: dust_drylimit_factor, dust_moist_correction
Expand Down Expand Up @@ -1100,7 +1127,9 @@ subroutine driver_smoke(itimestep,time_lev,emission_input,state,configs, &
call mpas_pool_get_config(configs,'bb_beta',bb_beta)
call mpas_pool_get_config(configs,'bb_qv_scale_factor',bb_qv_scale_factor)
call mpas_pool_get_config(configs,'config_rwc_scheme',config_rwc_scheme)
call mpas_pool_get_config(configs,'rwc_emis_scale_factor',rwc_emis_scale_factor)
call mpas_pool_get_config(configs,'rwc_emis_scale_factor',rwc_emis_scale_factor)
! Namelist: aerosol emission for tempo mp
call mpas_pool_get_config(configs,'config_mp_aero_emission',config_mp_aero_emission)
! Namelist: Wet/dry deposition
call mpas_pool_get_config(configs,'wetdep_ls_opt',wetdep_ls_opt)
call mpas_pool_get_config(configs,'wetdep_ls_alpha',wetdep_ls_alpha)
Expand Down Expand Up @@ -1199,10 +1228,9 @@ subroutine driver_smoke(itimestep,time_lev,emission_input,state,configs, &
frac_grid_burned = frac_grid_burned_p, &
min_bb_plume = min_bb_plume_p, max_bb_plume = max_bb_plume_p, &
coef_bb_dc = coef_bb_dc_p, nblocks = nblocks, &
! --- Dust related arrays
! --- (FENGSHA) Dust related arrays
sandfrac_in = sandfrac_in_p, clayfrac_in = clayfrac_in_p, &
uthres_in = uthres_in_p, uthres_sg_in = uthres_sg_in_p, &
albedo_drag_in = albedo_drag_p, feff_in = feff_p, sep_in = sep_in_p, &
uthres_in = uthres_in_p, rdrag_in = rdrag_p, ssm_in = ssm_in_p, &
! --- Dry/Wet deposition, settling
wetdep_ls_opt = wetdep_ls_opt, drydep_flux = drydep_flux_p, &
tend_chem_settle = tend_chem_settle_p, ddvel = ddvel_p, &
Expand Down Expand Up @@ -1239,16 +1267,17 @@ subroutine driver_smoke(itimestep,time_lev,emission_input,state,configs, &
v_phy = v_p , qv = qv_p , vvel = w_p , &
qc_vis = qc_p, qr_vis = qr_p, qi_vis = qi_p, qs_vis = qs_p, qg_vis = qg_p, &
blcldw_vis = qcbl_p, blcldi_vis = qibl_p, &
coszen = coszr_p, &
coszen = coszr_p , config_mp_aero_emission = config_mp_aero_emission, &
aod3d_smoke = aod3d_smoke_p, aod3d = aod3d_p, vis = vis_p , &
pi_phy = pi_p , rho_phy = rho_p , kpbl = kpbl_p , &
nsoil = num_soils , smois = smois_p , tslb = tslb_p , &
ivgtyp = ivgtyp_p , isltyp = isltyp_p , nlcat = num_landcat, &
swdown = swdown_p , z0 = z0_p , snowh = snowh_p , &
julian = curr_julday , rmol = rmol_p , raincv = raincv_p , &
rainncv = rainncv_p , dpt2m = dpt2m_p , znt = znt_p , &
rainncv = rainncv_p , dpt2m = dpt2m_p , znt = znt_p , &
mavail = mavail_p , g = gravity , vegfra = vegfra_p , &
landusef = landusef_p , cldfrac = cldfrac_p , ktop_deep= ktop_deep_p, &
nwfa2d = nwfa2d_p , nifa2d = nifa2d_p , &
cp = cp , rd = R_d , gmt = gmt , &
ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
Expand Down
15 changes: 5 additions & 10 deletions src/core_atmosphere/physics/mpas_atmphys_update_surface.F
Original file line number Diff line number Diff line change
Expand Up @@ -78,10 +78,8 @@ subroutine physics_update_surface(current_date,config_sfc_albedo,config_gvf_upda
real(kind=RKIND),dimension(:,:),pointer:: lai12m
real(kind=RKIND),dimension(:) ,pointer:: lai

real(kind=RKIND),dimension(:,:),pointer:: feff_m_in
real(kind=RKIND),dimension(:,:),pointer:: albedo_drag_m_in
real(kind=RKIND),dimension(:),pointer :: feff
real(kind=RKIND),dimension(:),pointer :: albedo_drag
real(kind=RKIND),dimension(:,:),pointer:: rdrag_m_in
real(kind=RKIND),dimension(:),pointer :: rdrag

!local variables:
integer:: iCell
Expand All @@ -101,10 +99,8 @@ subroutine physics_update_surface(current_date,config_sfc_albedo,config_gvf_upda
call mpas_pool_get_array(sfc_input,'lai12m' , lai12m )
call mpas_pool_get_array(diag_physics,'lai ' , lai )

call mpas_pool_get_array(diag_physics,'feff_m_in' , feff_m_in )
call mpas_pool_get_array(diag_physics,'albedo_drag_m_in', albedo_drag_m_in)
call mpas_pool_get_array(diag_physics,'feff' , feff )
call mpas_pool_get_array(diag_physics,'albedo_drag' , albedo_drag )
call mpas_pool_get_array(diag_physics,'rdrag_m_in', rdrag_m_in)
call mpas_pool_get_array(diag_physics,'rdrag' , rdrag )

!updates the surface background albedo for the current date as a function of the monthly-mean
!surface background albedo valid on the 15th day of the month, if config_sfc_albedo is true:
Expand All @@ -121,8 +117,7 @@ subroutine physics_update_surface(current_date,config_sfc_albedo,config_gvf_upda

! Updates the dust input data to the current month
if(config_dust_scheme .ne. 'off') then
call monthly_interp_to_date(nCellsSolve,current_date,feff_m_in,feff)
call monthly_interp_to_date(nCellsSolve,current_date,albedo_drag_m_in,albedo_drag)
call monthly_interp_to_date(nCellsSolve,current_date,rdrag_m_in,rdrag)
endif

!updates the green-ness fraction for the current date as a function of the monthly-mean green-
Expand Down
6 changes: 2 additions & 4 deletions src/core_atmosphere/physics/mpas_atmphys_vars.F
Original file line number Diff line number Diff line change
Expand Up @@ -293,10 +293,8 @@ module mpas_atmphys_vars
clayfrac_in_p, &!
sandfrac_in_p, &!
uthres_in_p, &!
uthres_sg_in_p, &!
albedo_drag_p, &!
feff_p, &!
sep_in_p !
rdrag_p, &!
ssm_in_p !
! Input biomass burning emissions - JLS
real(kind=RKIND),dimension(:,:,:,:),allocatable:: &
e_ant_in_p, e_bb_in_p, e_bio_in_p, e_vol_in_p
Expand Down
22 changes: 9 additions & 13 deletions src/core_atmosphere/physics/registry.chemistry.xml
Original file line number Diff line number Diff line change
Expand Up @@ -192,6 +192,10 @@
units="-"
description="Flag that controls artificially enhancing the PBL exhange coefs"
possbile_values=".true. or .false."/>
<nml_option name="config_mp_aero_emission" type="logical" default_value="false" in_defaults="false"
units="-"
description="Flag that controls aerosol emissions for Tempo microphysics"
possbile_values=".true. or .false."/>
</nml_record>

<!-- **************************************************************************************** -->
Expand Down Expand Up @@ -269,10 +273,8 @@
<var name="sandfrac_in"/>
<var name="clayfrac_in"/>
<var name="uthres_in"/>
<var name="uthres_sg_in"/>
<var name="sep_in"/>
<var name="albedo_drag_m_in"/>
<var name="feff_m_in"/>
<var name="ssm_in"/>
<var name="rdrag_m_in"/>
</stream>

<stream name="anthro_input"
Expand Down Expand Up @@ -452,28 +454,22 @@
<var name="feff" type="real" dimensions="nCells Time" units="-"
description="drag partition (alternate)"
packages="mpas_dust_in"/>
<var name="albedo_drag" type="real" dimensions="nCells Time" units="-"
<var name="rdrag" type="real" dimensions="nCells Time" units="-"
description="drag partition"
packages="mpas_dust_in"/>
<var name="uthres_in" type="real" dimensions="nCells" units="-"
description="threshold friction velocity"
packages="mpas_dust_in"/>
<var name="uthres_sg_in" type="real" dimensions="nCells" units="-"
description="threshold friction velocity (alternate)"
packages="mpas_dust_in"/>
<var name="sandfrac_in" type="real" dimensions="nCells" units="-"
description="sand fraction"
packages="mpas_dust_in"/>
<var name="clayfrac_in" type="real" dimensions="nCells" units="-"
description="clay fraction"
packages="mpas_dust_in"/>
<var name="albedo_drag_m_in" type="real" dimensions="nMonths nCells" units="-"
<var name="rdrag_m_in" type="real" dimensions="nMonths nCells" units="-"
description="drag partition"
packages="mpas_dust_in"/>
<var name="feff_m_in" type="real" dimensions="nMonths nCells" units="-"
description="drag partition (alternate)"
packages="mpas_dust_in"/>
<var name="sep_in" type="real" dimensions="nCells" units="-"
<var name="ssm_in" type="real" dimensions="nCells" units="-"
description="soil erosion potential"
packages="mpas_dust_in"/>
<var name="aod3d_smoke" type="real" dimensions="nVertLevels nCells Time" units="-"
Expand Down
Loading