Skip to content
Open
Show file tree
Hide file tree
Changes from 2 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
)
Comment on lines 136 to 140
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
Comment thread
clark-evans marked this conversation as resolved.
Outdated
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
Comment on lines +197 to +200

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
Comment thread
clark-evans marked this conversation as resolved.
Outdated
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."/>
Comment on lines +195 to +198
</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"/>
Comment on lines 273 to +277
</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="-"
Comment thread
clark-evans marked this conversation as resolved.
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