Skip to content

Commit

Permalink
"update to address code reviewer's comments"
Browse files Browse the repository at this point in the history
  • Loading branch information
haiqinli committed Jan 23, 2024
1 parent 02b3440 commit c0544c2
Show file tree
Hide file tree
Showing 5 changed files with 27 additions and 58 deletions.
14 changes: 0 additions & 14 deletions physics/smoke_dust/dep_dry_mod_emerson.F90
Original file line number Diff line number Diff line change
Expand Up @@ -179,10 +179,6 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, &
eps0 = eps0_grs
end if
! Set if snow greater than 1 cm
! if ( snowh(i,j) .gt. 0.01 ) then ! snow
! A = A_wat
! eps0 = eps0_wat
! endif
! Interception
Ein = Cin * ( dp / A )**vv
! Surface resistance
Expand Down Expand Up @@ -234,25 +230,15 @@ subroutine dry_dep_driver_emerson(rmol,ustar,znt,ndvel,ddvel,vgrav, &
IF (ndt_settl(nv) > 12) ndt_settl(nv) = 12
dt_settl(nv) = REAL(ntdt,kind=kind_phys) /REAL(ndt_settl(nv),kind=kind_phys)
enddo
!do nv = 1, ndvel
! chem_before(nv) = 0._kind_phys
! do k = kts, kte
! chem_before(nv) = chem_before(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2
! enddo
!enddo
! Perform gravitational settling if desired
if ( settling_flag == 1 ) then
call particle_settling(cblk_col,rho_col,delz_col,vg_col,dt_settl,ndt_settl,ndvel,kts,kte)
endif
! Put cblk back into chem array
do nv= 1, ndvel
!chem_after(nv) = 0._kind_phys
!settling_flux(i,j,nv) = 0._kind_phys
do k = kts, kte
chem(i,k,j,chem_pointers(nv)) = cblk_col(k,nv)
!chem_after(nv) = chem_after(nv) + (cblk_col(k,nv) * rho_phy(i,k,j) * delz(i,k,j) ) ! ug/m2
enddo ! k
!settling_flux(i,j,nv) = settling_flux(i,j,nv) + (chem_before(nv) - chem_after(nv)) ! ug/m2
enddo ! nv
end do ! j
end do ! i
Expand Down
27 changes: 12 additions & 15 deletions physics/smoke_dust/module_add_emiss_burn.F90
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, &

INTEGER, PARAMETER :: kfire_max=51 ! max vertical level for BB plume rise

real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm ! For BB emis. diurnal cycle calculation
real(kind_phys) :: timeq, fire_age, age_hr, dt1,dt2,dtm, coef_con ! For BB emis. diurnal cycle calculation

! For Gaussian diurnal cycle
real(kind_phys), PARAMETER :: sc_factor=1. ! to scale up the wildfire emissions, TBD later
Expand Down Expand Up @@ -89,6 +89,8 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, &
if (ebb_dcycle==2) then

! Constants for the fire diurnal cycle calculation
coef_con = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * &
exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 ))
do j=jts,jte
do i=its,ite
fire_age= time_int + (fire_end_hr(i,j)-1._kind_phys)*3600._kind_phys !One hour delay is due to the latency of the RAVE files
Expand All @@ -97,13 +99,12 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, &
SELECT CASE ( fire_type(i,j) ) !Ag, urban fires, bare land etc.
CASE (1)
! these fires will have exponentially decreasing diurnal cycle,
coef_bb_dc(i,j) = 1._kind_phys/((2._kind_phys*pi)**0.5_kind_phys * sigma_fire_dur(1) *fire_age) * &
exp(- ( log(fire_age) - avg_fire_dur(1))**2 /(2._kind_phys*sigma_fire_dur(1)**2 ))
coef_bb_dc(i,j) = coef_con

! IF ( dbg_opt .AND. time_int<5000.) then
! WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j)
! WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j)
! END IF
IF ( dbg_opt .AND. time_int<5000.) then
WRITE(6,*) 'i,j,peak_hr(i,j) ',i,j,peak_hr(i,j)
WRITE(6,*) 'coef_bb_dc(i,j) ',coef_bb_dc(i,j)
END IF

CASE (3)
age_hr= fire_age/3600._kind_phys
Expand All @@ -123,9 +124,6 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, &
dc_hwp= MAX(0._kind_phys,dc_hwp)
dc_hwp= MIN(25._kind_phys,dc_hwp)

!coef_bb_dc(i,j)= sc_factor* fire_hist(i,j)* rate_ebb2(i,j)* (1. + log(
!hwp_(i,j)/ hwp_day_avg(i,j)))

! RAR: Gaussian profile for wildfires
dt1= abs(timeq - peak_hr(i,j))
dt2= timeq_max - peak_hr(i,j) + timeq ! peak hour is always <86400.
Expand All @@ -134,13 +132,12 @@ subroutine add_emis_burn(dtstep,dz8w,rho_phy,pi, &
dc_gp = MAX(0._kind_phys,dc_gp)

dc_fn = MIN(dc_hwp/dc_gp,3._kind_phys)
!coef_bb_dc(i,j) = fire_hist(i,j)* dc_fn
coef_bb_dc(i,j) = fire_hist(i,j)* dc_hwp

! IF ( dbg_opt .AND. time_int<5000.) then
! WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j)
! WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j)
! END IF
IF ( dbg_opt .AND. time_int<5000.) then
WRITE(6,*) 'i,j,fire_hist(i,j),peak_hr(i,j) ', i,j,fire_hist(i,j),peak_hr(i,j)
WRITE(6,*) 'dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j) ',dc_gp,dc_hwp,dc_fn,coef_bb_dc(i,j)
END IF

CASE DEFAULT
END SELECT
Expand Down
2 changes: 1 addition & 1 deletion physics/smoke_dust/rrfs_smoke_config.F90
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ module rrfs_smoke_config

! --
integer, parameter :: CHEM_OPT_GOCART= 1
integer, parameter :: num_moist=3, num_chem=20, num_emis_seas=5, num_emis_dust=5
integer, parameter :: num_moist=2, num_chem=20, num_emis_seas=5, num_emis_dust=5

! -- hydrometeors
integer, parameter :: p_qv=1
Expand Down
14 changes: 4 additions & 10 deletions physics/smoke_dust/rrfs_smoke_wrapper.F90
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate,
nwfa, nifa, emanoc, emdust, emseas, drydep_flux_out, wetdpr, &
ebb_smoke_in, frp_output, coef_bb, fire_type_out, &
ebu_smoke,fhist,min_fplume, &
max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout,fire_in, &
max_fplume, hwp, hwp_ave, wetness, ndvel, ddvel_inout, &
peak_hr_out,lu_nofire_out,lu_qfire_out, &
fire_heat_flux_out, frac_grid_burned_out, kpbl,oro, &
uspdavg, hpbl_thetav, mpicomm, mpirank, mpiroot, errmsg,errflg )
Expand Down Expand Up @@ -154,8 +154,7 @@ subroutine rrfs_smoke_wrapper_run(im, kte, kme, ktau, dt, garea, land, jdate,
real(kind_phys), dimension(:), intent(inout) :: emdust, emseas, emanoc
real(kind_phys), dimension(:), intent(inout) :: ebb_smoke_in,coef_bb, frp_output, fhist
real(kind_phys), dimension(:,:), intent(inout) :: ebu_smoke
real(kind_phys), dimension(:,:), intent(inout) :: fire_in
real(kind_phys), dimension(:), intent(out) :: fire_heat_flux_out, frac_grid_burned_out
real(kind_phys), dimension(:), intent(out ) :: fire_heat_flux_out, frac_grid_burned_out
real(kind_phys), dimension(:), intent(inout) :: max_fplume, min_fplume, uspdavg, hpbl_thetav
real(kind_phys), dimension(:), intent(inout) :: hwp, peak_hr_out
real(kind_phys), dimension(:), intent(inout) :: hwp_ave
Expand Down Expand Up @@ -816,13 +815,8 @@ subroutine rrfs_smoke_prep( &
vvel(i,k,j)=-w(i,kkp)*rri(i,k,j)/g
moist(i,k,j,:)=0.
moist(i,k,j,1)=gq0(i,kkp,1)
!if (t_phy(i,k,j) > 265.) then
moist(i,k,j,2)=gq0(i,kkp,2)
if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0.
!else
! moist(i,k,j,2)=0.
if(moist(i,k,j,3) < 1.e-8)moist(i,k,j,3)=0.
!endif
moist(i,k,j,2)=gq0(i,kkp,2)
if (moist(i,k,j,2) < 1.e-8) moist(i,k,j,2)=0.
!--
zmid(i,k,j)=phl3d(i,kkp)/g
enddo
Expand Down
28 changes: 10 additions & 18 deletions physics/smoke_dust/rrfs_smoke_wrapper.meta
Original file line number Diff line number Diff line change
Expand Up @@ -731,9 +731,9 @@
kind = kind_phys
intent = inout
[fire_type_out]
standard_name = fire_type_out
standard_name = fire_type
long_name = type of fire
units = none
units = 1
dimensions = (horizontal_loop_extent)
type = integer
intent = out
Expand Down Expand Up @@ -791,17 +791,17 @@
type = integer
intent = in
[uspdavg]
standard_name = bl_averaged_wind_speed
standard_name = mean_wind_speed_in_boundary_layer
long_name = average wind speed within the boundary layer
units = none
units = m s-1
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = inout
[hpbl_thetav]
standard_name = pbl_height_thetav
standard_name = atmosphere_boundary_layer_thickness_from_modified_parcel
long_name = pbl height based on modified parcel method
units = none
units = m
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
Expand Down Expand Up @@ -861,32 +861,24 @@
type = real
kind = kind_phys
intent = inout
[fire_in]
standard_name = smoke_fire_auxiliary_input
long_name = smoke fire auxiliary input variables
units = various
dimensions = (horizontal_loop_extent,fire_auxiliary_data_extent)
type = real
kind = kind_phys
intent = inout
[peak_hr_out]
standard_name = peak_hr_fire
long_name = hour of peak fire emissions
units = none
long_name = time_of_peak_fire_emissions
units = s
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[lu_nofire_out]
standard_name = lu_nofire_out
standard_name = sum_of_land_use_fractions_for_no_fire_pixels
long_name = land use of no fire pixels for type
units = frac
dimensions = (horizontal_loop_extent)
type = real
kind = kind_phys
intent = out
[lu_qfire_out]
standard_name = lu_qfire_out
standard_name = sum_of_land_use_fractions_for_cropland_fire_pixels
long_name = land use of fire pixels for type
units = frac
dimensions = (horizontal_loop_extent)
Expand Down

0 comments on commit c0544c2

Please sign in to comment.