Skip to content

Adding OpenMP parallelization #12

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
pedro-jm merged 1 commit into from
Jul 17, 2025
Merged

Adding OpenMP parallelization #12

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
3 changes: 3 additions & 0 deletions physics/fire_driver_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -70,6 +70,8 @@ subroutine Init_fire_components (grid, config_flags)
end select
call grid%ros_param%Init (grid%ifms, grid%ifme, grid%jfms, grid%jfme)

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij)
do ij = 1, grid%num_tiles
call Extrapol_var_at_bdys (grid%ifms, grid%ifme, grid%jfms, grid%jfme, grid%ifds, grid%ifde, &
grid%jfds, grid%jfde, grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), &
Expand All @@ -82,6 +84,7 @@ subroutine Init_fire_components (grid, config_flags)
call grid%ros_param%Set_params (grid%ifms, grid%ifme, grid%jfms, grid%jfme, grid%i_start(ij), grid%i_end(ij), &
grid%j_start(ij), grid%j_end(ij), grid%fuels, grid%nfuel_cat, grid%fmc_g)
end do
!$OMP END PARALLEL DO

end subroutine Init_fire_components

Expand Down
25 changes: 25 additions & 0 deletions physics/fire_model_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,8 @@ subroutine Advance_fire_model (config_flags, grid)
grid%lfn_out, grid%tign_g, grid%ros, grid%uf, grid%vf, grid%dzdxf, grid%dzdyf, grid%ros_param)

if (DEBUG_LOCAL) call Print_message ('calling Stop_if_close_to_bdy...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -76,8 +78,11 @@ subroutine Advance_fire_model (config_flags, grid)

call Stop_if_close_to_bdy (ifts, ifte, jfts, jfte, ifms, ifme, jfms, jfme, ifds, jfds, ifde, jfde, grid%lfn_out)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('calling Update_ignition_times...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -87,8 +92,12 @@ subroutine Advance_fire_model (config_flags, grid)
call Update_ignition_times (ifts, ifte, jfts, jfte, ifms, ifme, jfms, jfme, ifds, jfds, ifde, jfde, &
time_start, grid%dt, grid%lfn, grid%lfn_out, grid%tign_g)
end do
!$OMP END PARALLEL DO


if (DEBUG_LOCAL) call Print_message ('calling Calc_flame_length...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -98,6 +107,7 @@ subroutine Advance_fire_model (config_flags, grid)
call Calc_flame_length (ifts, ifte, jfts, jfte, ifms, ifme, jfms, jfme, &
grid%ros, grid%ros_param%iboros, grid%flame_length, grid%ros_front, grid%fire_area)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('calling Reinit_level_set...')
if (config_flags%fire_lsm_reinit) call Reinit_level_set (grid%num_tiles, grid%i_start, grid%i_end, grid%j_start, grid%j_end, &
Expand All @@ -107,6 +117,8 @@ subroutine Advance_fire_model (config_flags, grid)
grid%lfn_s1, grid%lfn_s2, grid%lfn_s3, grid%lfn_out, grid%tign_g)

if (DEBUG_LOCAL) call Print_message ('calling Copy_lfnout_to_lfn...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -115,8 +127,11 @@ subroutine Advance_fire_model (config_flags, grid)

call Copy_lfnout_to_lfn (ifts, ifte, jfts, jfte, ifms, ifme, jfms, jfme, grid%lfn_out, grid%lfn)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('calling Ignite_prescribed_fires...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -125,8 +140,11 @@ subroutine Advance_fire_model (config_flags, grid)

call Ignite_prescribed_fires (grid, config_flags, time_start, ifts, ifte, jfts, jfte, ifms, ifme, jfms, jfme, ifds, ifde, jfds, jfde)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('calling Calc_fuel_left...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -136,8 +154,11 @@ subroutine Advance_fire_model (config_flags, grid)
grid%lfn,grid%tign_g,grid%fuel_time, time_start + grid%dt, grid%fuel_frac, grid%fire_area, &
grid%fuel_frac_burnt_dt)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('calling Calc_fire_fluxes...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -146,8 +167,11 @@ subroutine Advance_fire_model (config_flags, grid)
call Calc_fire_fluxes (grid%dt, grid, ifms, ifme, jfms, jfme, ifts, ifte, jfts, jfte, &
ifts, ifte, jfts, jfte, grid%fuel_load_g, grid%fuel_frac_burnt_dt, grid%fgrnhfx, grid%fgrnqfx)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('calling Calc_smoke_emissions...')
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, grid%num_tiles
ifts = grid%i_start(ij)
ifte = grid%i_end(ij)
Expand All @@ -156,6 +180,7 @@ subroutine Advance_fire_model (config_flags, grid)

call Calc_smoke_emissions (grid, config_flags, ifts, ifte, jfts, jfte)
end do
!$OMP END PARALLEL DO

if (DEBUG_LOCAL) call Print_message ('Leaving Advance_fire_model...')

Expand Down
9 changes: 9 additions & 0 deletions physics/fmc_wrffire_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -176,19 +176,28 @@ subroutine Advance_fmc_model (this, fmoist_freq, fmoist_dt, itimestep, dt, ifms,
end if

if (this%run_advance_moisture) then
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij)
do ij = 1, num_tiles
call this%Advance_moisture_classes (itimestep == 1, ifms, ifme, jfms, jfme, i_start(ij), i_end(ij), j_start(ij), j_end(ij), &
fire_rain, fire_t2, fire_q2, fire_psfc, fire_rain_old, fire_t2_old, fire_q2_old, fire_psfc_old, fire_rh_fire, fuelmc_g)
end do
!$OMP END PARALLEL DO

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij)
do ij = 1, num_tiles
call this%Average_moisture_classes (ifms, ifme, jfms, jfme, i_start(ij), i_end(ij), j_start(ij), j_end(ij), nfuel_cat, fmc_g)
end do
!$OMP END PARALLEL DO

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij)
do ij = 1, num_tiles
call ros_param%Set_params (ifms, ifme, jfms, jfme, i_start(ij), i_end(ij), j_start(ij), j_end(ij), &
fuels, nfuel_cat, fmc_g)
end do
!$OMP END PARALLEL DO
end if

end subroutine Advance_fmc_model
Expand Down
74 changes: 67 additions & 7 deletions physics/level_set_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -288,14 +288,16 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &

! to store tendency (rhs of the level set pde)
real, dimension(ifms:ifme, jfms:jfme) :: tend
real :: tbound2, tbound3
real :: tbound2, tbound3, tbound_thread, tbound_min
integer :: i, j, ij, ifts, ifte, jfts, jfte
character (len = :), allocatable :: msg
character (len = 128) :: msg
logical, parameter :: DEBUG_LOCAL = .false.


if (DEBUG_LOCAL) call Print_message ('Entering sub Prop_level_set...')

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, i, j, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -307,10 +309,14 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
end do
end do
end do
!$OMP END PARALLEL DO

! Runge-Kutta step 1
if (DEBUG_LOCAL) call Print_message ('call Calc_tend_ls 1...')

tbound_min = huge(tbound_min)
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte, tbound_thread) SHARED(tbound_min)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -320,9 +326,15 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
call Calc_tend_ls (ifds, ifde, jfds, jfde, ifts, ifte, jfts, jfte, &
ifms, ifme, jfms, jfme, ts, dt, dx, dy, fire_upwinding, &
fire_viscosity, fire_viscosity_bg, fire_viscosity_band, &
fire_viscosity_ngp, fire_lsm_band_ngp, lfn_0, tbound, tend, ros, uf, vf, dzdxf, dzdyf, ros_model)
fire_viscosity_ngp, fire_lsm_band_ngp, lfn_0, tbound_thread, tend, ros, uf, vf, dzdxf, dzdyf, ros_model)

tbound_min = min(tbound_min, tbound_thread)
end do
!$OMP END PARALLEL DO
tbound = tbound_min

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, i, j, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -335,10 +347,14 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
end do
end do
end do
!$OMP END PARALLEL DO

! Runge-Kutta step 2
if (DEBUG_LOCAL) call Print_message ('call Calc_tend_ls 2...')

tbound_min = huge(tbound_min)
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte, tbound_thread) SHARED(tbound_min)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -348,9 +364,15 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
call Calc_tend_ls (ifds, ifde, jfds, jfde, ifts, ifte, jfts, jfte, &
ifms,ifme,jfms,jfme, ts + dt, dt, dx, dy, fire_upwinding, &
fire_viscosity, fire_viscosity_bg, fire_viscosity_band, &
fire_viscosity_ngp, fire_lsm_band_ngp, lfn_1, tbound2, tend, ros, uf, vf, dzdxf, dzdyf, ros_model)
fire_viscosity_ngp, fire_lsm_band_ngp, lfn_1, tbound_thread, tend, ros, uf, vf, dzdxf, dzdyf, ros_model)

tbound_min = min(tbound_min, tbound_thread)
end do
!$OMP END PARALLEL DO
tbound2 = tbound_min

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, i, j, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -363,10 +385,14 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
end do
end do
end do
!$OMP END PARALLEL DO

! Runge-Kutta step 3
if (DEBUG_LOCAL) call Print_message ('call Calc_tend_ls 3...')

tbound_min = huge(tbound_min)
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte, tbound_thread) SHARED(tbound_min)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -376,9 +402,15 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
call Calc_tend_ls (ifds,ifde,jfds,jfde, ifts, ifte, jfts, jfte, &
ifms, ifme, jfms, jfme, ts + dt, dt, dx, dy, fire_upwinding, &
fire_viscosity, fire_viscosity_bg, fire_viscosity_band, &
fire_viscosity_ngp, fire_lsm_band_ngp, lfn_2, tbound3, tend, ros, uf, vf, dzdxf, dzdyf, ros_model)
fire_viscosity_ngp, fire_lsm_band_ngp, lfn_2, tbound_thread, tend, ros, uf, vf, dzdxf, dzdyf, ros_model)

tbound_min = min(tbound_min, tbound_thread)
end do
!$OMP END PARALLEL DO
tbound3 = tbound_min

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, i, j, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -390,13 +422,14 @@ subroutine Prop_level_set (ifds, ifde, jfds, jfde, ifms, ifme, jfms, jfme, &
end do
end do
end do
!$OMP END PARALLEL DO

! CFL check, tbound is the max allowed time step
tbound = min (tbound, tbound2, tbound3)
tbound = min(min(tbound, tbound2), tbound3)

if (dt > tbound) then
!$omp critical
write (msg, '(2(a, f10.2))') 'CFL violation: time step ', dt, ' > bound =', tbound
write (msg, '(a, f10.2, a, f10.2)') 'CFL violation: time step ', dt, ' > bound =', tbound
call Stop_simulation (msg)
!$omp end critical
end if
Expand Down Expand Up @@ -439,6 +472,8 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
threshold_hlu = fire_lsm_band_ngp * dx

! Define S0 based on current lfn values
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, i, j, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -452,7 +487,10 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
end do
end do
end do
!$OMP END PARALLEL DO

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -462,6 +500,7 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
call Extrapol_var_at_bdys (ifms, ifme, jfms, jfme, ifds, ifde, &
jfds, jfde, ifts, ifte, jfts, jfte, lfn_s3)
end do
!$OMP END PARALLEL DO

dt_s = 0.01 * dx
dt_s = 0.0001 * dx
Expand All @@ -470,6 +509,8 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
! 1 iter each time step is enoguh
Loop_iter: do nts = 1, fire_lsm_reinit_iter
! Runge-Kutta step 1
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -481,7 +522,10 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
lfn_s0, lfn_s3, lfn_s3, lfn_s1, 1.0 / 3.0, & ! sign funcition, initial ls, current stage ls, next stage advanced ls, RK coefficient
fire_upwinding_reinit)
end do
!$OMP END PARALLEL DO

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -491,8 +535,11 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
call Extrapol_var_at_bdys (ifms, ifme, jfms, jfme, ifds, ifde, &
jfds, jfde, ifts, ifte, jfts, jfte, lfn_s1)
end do
!$OMP END PARALLEL DO

! Runge-Kutta step 2
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -504,7 +551,10 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
lfn_s0, lfn_s3, lfn_s1, lfn_s2, 1.0 / 2.0, &
fire_upwinding_reinit)
end do
!$OMP END PARALLEL DO

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -514,8 +564,11 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
call Extrapol_var_at_bdys (ifms, ifme, jfms, jfme, ifds, ifde, &
jfds, jfde, ifts, ifte, jfts, jfte, lfn_s2)
end do
!$OMP END PARALLEL DO

! Runge-Kutta step 3
!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -527,7 +580,10 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
lfn_s0, lfn_s3, lfn_s2, lfn_s3, 1.0, &
fire_upwinding_reinit)
end do
!$OMP END PARALLEL DO

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -537,8 +593,11 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
call Extrapol_var_at_bdys (ifms, ifme, jfms, jfme, ifds, ifde, &
jfds,jfde, ifts, ifte, jfts, jfte, lfn_s3)
end do
!$OMP END PARALLEL DO
end do Loop_iter

!$OMP PARALLEL DO &
!$OMP PRIVATE (ij, i, j, ifts, ifte, jfts, jfte)
do ij = 1, num_tiles
ifts = i_start(ij)
ifte = i_end(ij)
Expand All @@ -554,6 +613,7 @@ subroutine Reinit_level_set (num_tiles, i_start, i_end, j_start, j_end, ifms, if
end do
end do
end do
!$OMP END PARALLEL DO

end subroutine Reinit_level_set

Expand Down
Loading