Skip to content

Commit

Permalink
Cellular automata perturbations of emissions NCAR#94
Browse files Browse the repository at this point in the history 
Cellular automata perturbations of emissions
  • Loading branch information
@SamuelTrahanNOAA
SamuelTrahanNOAA authored Jun 11, 2021
2 parents 83c0177 + db32616 commit f6851f2
Show file tree
Hide file tree
Showing 5 changed files with 106 additions and 16 deletions.
49 changes: 38 additions & 11 deletions gsdchem/gsd_chem_plume_wrapper.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,8 @@ subroutine gsd_chem_plume_wrapper_run(im, kte, kme, ktau, dt, &
w,vegtype,fire_GBBEPx,fire_MODIS, &
ntrac,ntso2,ntpp25,ntbc1,ntoc1,ntpp10, &
gq0,qgrs,ebu,abem,biomass_burn_opt_in,plumerise_flag_in, &
plumerisefire_frq_in,pert_scale_plume, &
plumerisefire_frq_in,pert_scale_plume,ca_emis_plume, &
do_ca,ca_sgs,ca_sgs_emis,vegtype_cpl,ca_sgs_gbbepx_frp, &
emis_amp_plume, do_sppt_emis, sppt_wts, errmsg,errflg)

implicit none
Expand All @@ -59,11 +60,13 @@ subroutine gsd_chem_plume_wrapper_run(im, kte, kme, ktau, dt, &
integer, parameter :: ims=1,jms=1,jme=1, kms=1
integer, parameter :: its=1,jts=1,jte=1, kts=1

logical, intent(in) :: do_sppt_emis
real(kind_phys), optional, intent(in) :: sppt_wts(:,:)
logical, intent(in) :: do_sppt_emis, do_ca, ca_sgs_emis, ca_sgs
real(kind_phys), intent(in) :: sppt_wts(:,:), ca_emis_plume(:)
integer, dimension(im), intent(in) :: vegtype
integer, dimension(im), intent(out) :: vegtype_cpl
real(kind_phys), dimension(im, 5), intent(in) :: fire_GBBEPx
real(kind_phys), dimension(im, 13), intent(in) :: fire_MODIS
real(kind_phys), intent(out) :: ca_sgs_gbbepx_frp(:)
real(kind_phys), dimension(im,kme), intent(in) :: ph3d, pr3d
real(kind_phys), dimension(im,kte), intent(in) :: phl3d, prl3d, tk3d, &
us3d, vs3d, spechum, w
Expand All @@ -89,11 +92,12 @@ subroutine gsd_chem_plume_wrapper_run(im, kte, kme, ktau, dt, &
real(kind_phys), dimension(ims:im, jms:jme, num_ebu_in) :: ebu_in
real(kind_phys), dimension(ims:im, jms:jme) :: &
mean_fct_agef, mean_fct_aggr, mean_fct_agsv, mean_fct_agtf, &
firesize_agef, firesize_aggr, firesize_agsv, firesize_agtf
firesize_agef, firesize_aggr, firesize_agsv, firesize_agtf, &
ca_sgs_gbbepx_frp_with_j
real(kind_phys), dimension(ims:im, jms:jme, num_frp_plume ) :: plume_frp
real(kind_phys) :: dtstep
!integer,parameter :: plumerise_flag = 2 ! 1=MODIS, 2=GBBEPx
logical :: call_plume, scale_fire_emiss
logical :: call_plume, scale_fire_emiss, doing_sgs_emis
logical, save :: firstfire = .true.
real(kind_phys), dimension(1:num_chem) :: ppm2ugkg
real(kind_phys), parameter :: ugkg = 1.e-09_kind_phys !lzhang
Expand All @@ -113,6 +117,7 @@ subroutine gsd_chem_plume_wrapper_run(im, kte, kme, ktau, dt, &
plumerisefire_frq = plumerisefire_frq_in
random_factor = 1.0
curr_secs = ktau * dt
doing_sgs_emis = do_ca .and. ca_sgs_emis .and. .not. ca_sgs

! -- set domain
ide=im
Expand Down Expand Up @@ -146,15 +151,22 @@ subroutine gsd_chem_plume_wrapper_run(im, kte, kme, ktau, dt, &
rri,t_phy,u_phy,v_phy,p_phy,rho_phy,dz8w,p8w, &
z_at_w,vvel, &
ntso2,ntpp25,ntbc1,ntoc1,ntpp10,ntrac,gq0, &
num_chem, num_moist,num_ebu_in, &
num_chem, num_moist,num_ebu_in,ca_sgs_gbbepx_frp_with_j, &
plumerise_flag,num_plume_data,ppm2ugkg, &
mean_fct_agtf,mean_fct_agef,mean_fct_agsv,mean_fct_aggr, &
firesize_agtf,firesize_agef,firesize_agsv,firesize_aggr, &
moist,chem,plume_frp,ebu_in,ivgtyp, &
moist,chem,plume_frp,ebu_in,ivgtyp,ca_emis_plume,doing_sgs_emis,&
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)

! Input to cellular automata
if(doing_sgs_emis) then
do i=ids,ide
ca_sgs_gbbepx_frp(i) = ca_sgs_gbbepx_frp_with_j(i,jds)
vegtype_cpl(i) = vegtype(i)
enddo
endif

! compute wild-fire plumes
if (call_plume) then
Expand Down Expand Up @@ -272,13 +284,13 @@ subroutine gsd_chem_prep_plume( &
ntbc1,ntoc1, &
ntpp10, &
ntrac,gq0, &
num_chem, num_moist,num_ebu_in, &
num_chem, num_moist,num_ebu_in,ca_sgs_gbbepx_frp_with_j, &
plumerise_flag,num_plume_data, &
ppm2ugkg, &
mean_fct_agtf,mean_fct_agef,mean_fct_agsv,mean_fct_aggr, &
firesize_agtf,firesize_agef,firesize_agsv,firesize_aggr, &
moist,chem,plumedist,ebu_in, &
ivgtyp, &
ivgtyp,ca_emis_plume,doing_sgs_emis, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
Expand All @@ -291,6 +303,8 @@ subroutine gsd_chem_prep_plume( &
integer, dimension(ims:ime), intent(in) :: vegtype
integer, intent(in) :: ntrac
integer, intent(in) :: ntso2,ntpp25,ntbc1,ntoc1,ntpp10
logical, intent(in) :: doing_sgs_emis
real(kind=kind_phys), intent(in) :: ca_emis_plume(:)
real(kind=kind_phys), dimension(ims:ime, 5), intent(in) :: fire_GBBEPx
real(kind=kind_phys), dimension(ims:ime, 13), intent(in) :: fire_MODIS
real(kind=kind_phys), dimension(ims:ime, kms:kme), intent(in) :: &
Expand All @@ -308,7 +322,7 @@ subroutine gsd_chem_prep_plume( &
its,ite, jts,jte, kts,kte

real(kind_phys), dimension(num_chem), intent(in) :: ppm2ugkg

real(kind_phys), dimension(:, :), intent(out) :: ca_sgs_gbbepx_frp_with_j
real(kind_phys), dimension(ims:ime, jms:jme, num_ebu_in),intent(out) :: ebu_in

integer,dimension(ims:ime, jms:jme), intent(out) :: ivgtyp
Expand Down Expand Up @@ -463,9 +477,22 @@ subroutine gsd_chem_prep_plume( &
emiss_abu(i,j,p_e_oc) =fire_GBBEPx(i,2)
emiss_abu(i,j,p_e_pm_25)=fire_GBBEPx(i,3)
emiss_abu(i,j,p_e_so2) =fire_GBBEPx(i,4)
plume(i,j,1) =fire_GBBEPx(i,5)
enddo
enddo
if(doing_sgs_emis) then
do j=jts,jte
do i=its,ite
ca_sgs_gbbepx_frp_with_j(i,j) = fire_GBBEPx(i,5)
plume(i,j,1) =ca_emis_plume(i)! *0.5 + fire_GBBEPx(i,5)*0.5
enddo
enddo
else
do j=jts,jte
do i=its,ite
plume(i,j,1) =fire_GBBEPx(i,5)
enddo
enddo
endif
! print*,'hli GBBEPx plume',maxval(plume(:,:,1))
case default
! -- no further option available
Expand Down
51 changes: 51 additions & 0 deletions gsdchem/gsd_chem_plume_wrapper.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,14 @@
kind = kind_phys
intent = in
optional = F
[vegtype_cpl]
standard_name = vegetation_type_classification_for_coupling
long_name = vegetation type at each grid cell copied from vegtype
units = index
dimensions = (horizontal_dimension)
type = integer
intent = out
optional = F
[pr3d]
standard_name = air_pressure_at_interface
long_name = air pressure at model layer interfaces
Expand Down Expand Up @@ -165,6 +173,16 @@
kind = kind_phys
intent = in
optional = F
[ca_sgs_gbbepx_frp]
standard_name = GBBEPx_fire_radiative_power_for_stochastic_physics
long_name = GBBEPx fire radiative power for stochastic physics
units = MW
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_cellular_automata)
intent = out
optional = F
[ntrac]
standard_name = number_of_tracers
long_name = number of tracers
Expand Down Expand Up @@ -213,6 +231,30 @@
type = integer
intent = in
optional = F
[do_ca]
standard_name = flag_for_cellular_automata
long_name = cellular automata main switch
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[ca_sgs_emis]
standard_name = flag_for_sgs_cellular_automata_in_chemical_tracer_emissions
long_name = switch for sgs ca in chemical tracer emissions
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[ca_sgs]
standard_name = flag_for_sgs_cellular_automata
long_name = switch for sgs ca
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[gq0]
standard_name = tracer_concentration_updated_by_physics
long_name = tracer concentration updated by physics
Expand Down Expand Up @@ -258,6 +300,15 @@
kind = kind_phys
intent = in
optional = F
[ca_emis_plume]
standard_name = fraction_of_cellular_automata_for_plume_rise_emissions
long_name = fraction of cellular automata for plume rise emissions
units = frac
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
intent = in
optional = F
[biomass_burn_opt_in]
standard_name = gsd_chem_biomass_burn_opt
long_name = gsd chem biomass burning option
Expand Down
2 changes: 1 addition & 1 deletion physics/GFS_debug.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -819,7 +819,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling,
if (Model%lndp_type /= 0) then
call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%sfc_wts' , Coupling%sfc_wts )
end if
if (Model%do_ca) then
if (Model%do_ca .and. .not. Model%ca_sgs_emis) then
call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca1 ', Coupling%ca1 )
call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_deep ', Coupling%ca_deep )
call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%ca_turb ', Coupling%ca_turb )
Expand Down
12 changes: 8 additions & 4 deletions physics/samfdeepcnv.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, &
& CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,&
& clam,c0s,c1,betal,betas,evfact,evfactl,pgcon,asolfac, &
& do_ca, ca_closure, ca_entr, ca_trigger, nthresh, ca_deep, &
& rainevap,wetdpc_deep,cplchm, &
& rainevap,ca_sgs_emis,wetdpc_deep,cplchm, &
& errmsg,errflg)
!
use machine , only : kind_phys
Expand All @@ -85,7 +85,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, &
real(kind=kind_phys), intent(in) :: psp(im), delp(im,km), &
& prslp(im,km), garea(im), dot(im,km), phil(im,km)
real(kind=kind_phys), dimension(:), intent(in) :: fscav
logical, intent(in) :: hwrf_samfdeep
logical, intent(in) :: hwrf_samfdeep, ca_sgs_emis
real(kind=kind_phys), intent(in) :: nthresh
real(kind=kind_phys), intent(in) :: ca_deep(im)
real(kind=kind_phys), intent(out) :: rainevap(im)
Expand Down Expand Up @@ -334,12 +334,16 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, &
xpwav(i)= 0.
xpwev(i)= 0.
vshear(i) = 0.
rainevap(i) = 0.
gdx(i) = sqrt(garea(i))
if(cplchm) then
wetdpc_deep(i,:) = 0.
endif
enddo
if(do_ca .and. .not. ca_sgs_emis)then
do i=1,im
rainevap(i) = 0.
enddo
endif
!
if (hwrf_samfdeep) then
do i=1,im
Expand Down Expand Up @@ -2739,7 +2743,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, &
enddo
!LB:
if(do_ca)then
if(do_ca .and. .not. ca_sgs_emis)then
do i = 1,im
rainevap(i)=delqev(i)
enddo
Expand Down
8 changes: 8 additions & 0 deletions physics/samfdeepcnv.meta
View file
Original file line number Diff line number Diff line change
Expand Up @@ -628,6 +628,14 @@
kind = kind_phys
intent = out
optional = F
[ca_sgs_emis]
standard_name = flag_for_sgs_cellular_automata_in_chemical_tracer_emissions
long_name = switch for sgs ca in chemical tracer emissions
units = flag
dimensions = ()
type = logical
intent = in
optional = F
[wetdpc_deep]
standard_name = instantaneous_deep_convective_wet_deposition
long_name = instantaneous deep convective wet deposition
Expand Down

0 comments on commit f6851f2

Please sign in to comment.