Skip to content

Commit

Permalink
Cellular automata perturbations of emissions (NOAA-EMC#94) from Samue…
Browse files Browse the repository at this point in the history
…lTrahanNOAA

Cellular automata perturbations of emissions
  • Loading branch information
SamuelTrahanNOAA authored Jun 11, 2021
1 parent 42849b5 commit 6bf1f0e
Show file tree
Hide file tree
Showing 5 changed files with 259 additions and 4 deletions.
48 changes: 45 additions & 3 deletions ccpp/data/GFS_typedefs.F90
Original file line number Diff line number Diff line change
Expand Up @@ -508,6 +508,13 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: ca_shal (:) => null() !
real (kind=kind_phys), pointer :: ca_rad (:) => null() !
real (kind=kind_phys), pointer :: ca_micro (:) => null() !
real (kind=kind_phys), pointer :: ca_sgs_gbbepx_frp(:) => null()
real (kind=kind_phys), pointer :: ca_emis_anthro(:) => null()
real (kind=kind_phys), pointer :: ca_emis_dust(:) => null()
real (kind=kind_phys), pointer :: ca_emis_plume(:) => null()
real (kind=kind_phys), pointer :: ca_emis_seas(:) => null()
real (kind=kind_phys) :: ca_sgs_emis_scale
integer, pointer :: vegtype_cpl(:) => null()
real (kind=kind_phys), pointer :: condition(:) => null() !
real (kind=kind_phys), pointer :: vfact_ca(:) => null() !
!--- stochastic physics
Expand Down Expand Up @@ -1068,6 +1075,7 @@ module GFS_typedefs
integer :: nseed_g !< cellular automata seed frequency
logical :: do_ca !< cellular automata main switch
logical :: ca_sgs !< switch for sgs ca
logical :: ca_sgs_emis !< switch for sgs ca on tracer emissions
logical :: ca_global !< switch for global ca on prognostic fields
logical :: ca_global_emis !< switch for global ca application to tracer emissions
logical :: ca_global_any !< true if ca_global or ca_global_emis are true
Expand Down Expand Up @@ -1616,6 +1624,8 @@ module GFS_typedefs
real (kind=kind_phys), pointer :: ca_shal (:) => null() !< cellular automata fraction
real (kind=kind_phys), pointer :: ca_rad (:) => null() !< cellular automata fraction
real (kind=kind_phys), pointer :: ca_micro (:) => null() !< cellular automata fraction
real (kind=kind_phys), pointer :: ca_condition(:)=> null() !< cellular automata fraction
real (kind=kind_phys), pointer :: ca_plume(:) => null() !< cellular automata fraction

real (kind=kind_phys), pointer :: skebu_wts(:,:) => null() !< 10 meter u wind speed
real (kind=kind_phys), pointer :: skebv_wts(:,:) => null() !< 10 meter v wind speed
Expand Down Expand Up @@ -2903,8 +2913,12 @@ subroutine coupling_create (Coupling, IM, Model)
endif

!-- cellular automata
allocate (Coupling%vegtype_cpl(IM))
allocate (Coupling%condition(IM))
allocate (Coupling%vfact_ca(Model%levs))
Coupling%vegtype_cpl = clear_val
Coupling%vfact_ca = clear_val
Coupling%condition = clear_val
if (Model%do_ca) then
allocate (Coupling%ca1 (IM))
allocate (Coupling%ca2 (IM))
Expand All @@ -2914,7 +2928,6 @@ subroutine coupling_create (Coupling, IM, Model)
allocate (Coupling%ca_shal (IM))
allocate (Coupling%ca_rad (IM))
allocate (Coupling%ca_micro (IM))
Coupling%vfact_ca = clear_val
Coupling%ca1 = clear_val
Coupling%ca2 = clear_val
Coupling%ca3 = clear_val
Expand All @@ -2923,7 +2936,19 @@ subroutine coupling_create (Coupling, IM, Model)
Coupling%ca_shal = clear_val
Coupling%ca_rad = clear_val
Coupling%ca_micro = clear_val
Coupling%condition = clear_val
if(Model%ca_sgs_emis) then
allocate(Coupling%ca_sgs_gbbepx_frp(IM))
allocate(Coupling%ca_emis_anthro(IM))
allocate(Coupling%ca_emis_dust(IM))
allocate(Coupling%ca_emis_plume(IM))
allocate(Coupling%ca_emis_seas(IM))
Coupling%ca_sgs_gbbepx_frp = clear_val
Coupling%ca_emis_anthro = clear_val
Coupling%ca_emis_dust = clear_val
Coupling%ca_emis_plume = clear_val
Coupling%ca_emis_seas = clear_val
Coupling%ca_sgs_emis_scale = 0 ! must be 0, not zero or clear_val
endif
endif

! -- GSDCHEM coupling options
Expand Down Expand Up @@ -3465,6 +3490,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
integer :: nspinup = 1
logical :: do_ca = .false.
logical :: ca_sgs = .false.
logical :: ca_sgs_emis = .false.
logical :: ca_global = .false.
logical :: ca_global_emis = .false.
logical :: ca_smooth = .false.
Expand Down Expand Up @@ -3655,7 +3681,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
!--- cellular automata
nca, ncells, nlives, nca_g, ncells_g, nlives_g, nfracseed, &
nseed, nseed_g, nthresh, do_ca, &
ca_sgs, ca_global,iseed_ca,ca_smooth, &
ca_sgs, ca_sgs_emis, ca_global,iseed_ca,ca_smooth, &
nspinup,ca_amplitude,nsmooth,ca_closure,ca_entr,ca_trigger, &
!--- IAU
iau_delthrs,iaufhrs,iau_inc_files,iau_filter_increments, &
Expand Down Expand Up @@ -4361,6 +4387,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%ca_global_any = ca_global .or. ca_global_emis
Model%do_ca = do_ca
Model%ca_sgs = ca_sgs
Model%ca_sgs_emis = ca_sgs_emis
Model%iseed_ca = iseed_ca
Model%ca_smooth = ca_smooth
Model%nspinup = nspinup
Expand All @@ -4371,6 +4398,13 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, &
Model%ca_entr = ca_entr
Model%ca_trigger = ca_trigger

if(Model%ca_sgs .and. Model%ca_sgs_emis) then
if(Model%me==Model%master) then
write(0,*) 'Cannot have both ca_sgs and ca_sgs_emis on at the same time.'
endif
stop 1
endif

! IAU flags
!--- iau parameters
Model%iaufhrs = iaufhrs
Expand Down Expand Up @@ -5448,6 +5482,7 @@ subroutine control_print(Model)
print *, ' ca_global : ', Model%ca_global
print *, ' ca_global_emis : ', Model%ca_global_emis
print *, ' ca_sgs : ', Model%ca_sgs
print *, ' ca_sgs_emis : ', Model%ca_sgs_emis
print *, ' do_ca : ', Model%do_ca
print *, ' iseed_ca : ', Model%iseed_ca
print *, ' ca_smooth : ', Model%ca_smooth
Expand Down Expand Up @@ -6158,6 +6193,13 @@ subroutine diag_create (Diag, IM, Model)
Diag%exch_m = clear_val
endif

if(Model%do_ca .and. Model%ca_sgs_emis) then
allocate(Diag%ca_plume(IM))
allocate(Diag%ca_condition(IM))
Diag%ca_condition = clear_val
Diag%ca_plume = clear_val
endif

! Auxiliary arrays in output for debugging
if (Model%naux2d>0) then
allocate (Diag%aux2d(IM,Model%naux2d))
Expand Down
52 changes: 52 additions & 0 deletions ccpp/data/GFS_typedefs.meta
Original file line number Diff line number Diff line change
Expand Up @@ -2129,6 +2129,46 @@
type = real
kind = kind_phys
active = (flag_for_cellular_automata)
[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)
[ca_emis_anthro]
standard_name = fraction_of_cellular_automata_for_anthropogenic_emissions
long_name = fraction of cellular automata for anthropogenic emissions
units = frac
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_cellular_automata)
[ca_emis_dust]
standard_name = fraction_of_cellular_automata_for_dust_emissions
long_name = fraction of cellular automata for dust emissions
units = frac
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_cellular_automata)
[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
active = (flag_for_cellular_automata)
[ca_emis_seas]
standard_name = fraction_of_cellular_automata_for_sea_salt_emissions
long_name = fraction of cellular automata for sea salt emissions
units = frac
dimensions = (horizontal_dimension)
type = real
kind = kind_phys
active = (flag_for_cellular_automata)
[vfact_ca]
standard_name = vertical_weight_for_ca
long_name = vertical weight for ca
Expand All @@ -2144,6 +2184,12 @@
type = real
kind = kind_phys
active = (flag_for_cellular_automata)
[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
[condition]
standard_name = physics_field_for_coupling
long_name = physics_field_for_coupling
Expand Down Expand Up @@ -4273,6 +4319,12 @@
units = flag
dimensions = ()
type = logical
[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
[ca_global]
standard_name = flag_for_global_cellular_automata
long_name = switch for global ca
Expand Down
81 changes: 81 additions & 0 deletions ccpp/driver/GFS_diagnostics.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2121,6 +2121,87 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop
ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_micro(:)
enddo

IF (Model%ca_sgs_emis) THEN

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_sgs_gbbepx_frp'
ExtDiag(idx)%desc = 'CA sgs GBBEPx frp'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_sgs_gbbepx_frp(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_emis_anthro'
ExtDiag(idx)%desc = 'CA emis anthro'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_emis_anthro(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_emis_dust'
ExtDiag(idx)%desc = 'CA emis dust'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_emis_dust(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_emis_plume'
ExtDiag(idx)%desc = 'CA emis plume'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_emis_plume(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_emis_seas'
ExtDiag(idx)%desc = 'CA emis seas'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%ca_emis_seas(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_condition_diag'
ExtDiag(idx)%desc = 'CA condition diag'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_condition(:)
enddo

idx = idx + 1
ExtDiag(idx)%axes = 2
ExtDiag(idx)%name = 'ca_plume_diag'
ExtDiag(idx)%desc = 'CA plume diag'
ExtDiag(idx)%unit = '%'
ExtDiag(idx)%mod_name = 'gfs_phys'
allocate (ExtDiag(idx)%data(nblks))
do nb = 1,nblks
ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ca_plume(:)
enddo

ENDIF

if (Model%ldiag_ugwp) THEN
!
! VAY-2018: Momentum and Temp-re tendencies
Expand Down
Loading

0 comments on commit 6bf1f0e

Please sign in to comment.