Skip to content

Commit

Permalink
fix regressions
Browse files Browse the repository at this point in the history
  • Loading branch information
sbryngelson committed Jan 6, 2024
1 parent 6c3dd9e commit da30d51
Show file tree
Hide file tree
Showing 10 changed files with 34 additions and 25 deletions.
6 changes: 3 additions & 3 deletions src/common/include/macros.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -13,16 +13,16 @@
@:LOG({'@:ALLOCATE(${re.sub(' +', ' ', ', '.join(args))}$)'})
allocate (${', '.join(args)}$)
#:if MFC_COMPILER == 'Cray'
!$acc enter data create(${', '.join([ arg.split('(')[0] for arg in args ])}$)
!$acc enter data create(${', '.join([ arg.split('(')[0] for arg in args ])}$)
#:else
!$acc enter data create(${', '.join(args)}$)
!$acc enter data create(${', '.join(args)}$)
#:endif
#:enddef ALLOCATE

#:def DEALLOCATE(*args)
@:LOG({'@:DEALLOCATE(${re.sub(' +', ' ', ', '.join(args))}$)'})
deallocate (${', '.join(args)}$)
!$acc exit data delete(${', '.join(args)}$)
!$acc exit data delete(${', '.join(args)}$)
#:enddef DEALLOCATE

#define t_vec3 real(kind(0d0)), dimension(1:3)
Expand Down
2 changes: 1 addition & 1 deletion src/simulation/m_bubbles.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ contains

!$acc update device(rs, vs)
if (.not. polytropic) then
!$acc update device(ps, ms)
!$acc update device(ps, ms)
end if

end subroutine
Expand Down
2 changes: 1 addition & 1 deletion src/simulation/m_data_output.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -566,7 +566,7 @@ contains
if (prim_vars_wrt .or. (n == 0 .and. p == 0)) then
call s_convert_conservative_to_primitive_variables(q_cons_vf, q_prim_vf)
do i = 1, sys_size
!$acc update host(q_prim_vf(i)%sf(:,:,:))
!$acc update host(q_prim_vf(i)%sf(:,:,:))
end do
! q_prim_vf(bubxb) stores the value of nb needed in riemann solvers, so replace with true primitive value (=1d0)
if (qbmm) then
Expand Down
8 changes: 4 additions & 4 deletions src/simulation/m_global_parameters.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@ module m_global_parameters
integer :: cpu_start, cpu_end, cpu_rate

#:if not MFC_CASE_OPTIMIZATION
!$acc declare create(num_dims, weno_polyn, weno_order)
!$acc declare create(num_dims, weno_polyn, weno_order)
#:endif

!$acc declare create(mpp_lim, num_fluids, model_eqns, mixture_err, alt_soundspeed, avg_state, mapped_weno, mp_weno, weno_eps, hypoelasticity, relax, palpha_eps,ptgalpha_eps)
Expand Down Expand Up @@ -282,7 +282,7 @@ module m_global_parameters
integer :: R0_type

#:if not MFC_CASE_OPTIMIZATION
!$acc declare create(nb)
!$acc declare create(nb)
#:endif

!$acc declare create(R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, nmomsp, nmomtot, R0_type, ptil, bubble_model, thermal, poly_sigma)
Expand Down Expand Up @@ -495,8 +495,8 @@ contains
#:if not MFC_CASE_OPTIMIZATION
! Determining the degree of the WENO polynomials
weno_polyn = (weno_order - 1)/2
!$acc update device(weno_polyn)
!$acc update device(nb)
!$acc update device(weno_polyn)
!$acc update device(nb)
#:endif

! Initializing the number of fluids for which viscous effects will
Expand Down
12 changes: 6 additions & 6 deletions src/simulation/m_mpi_proxy.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -991,7 +991,7 @@ contains
#if defined(MFC_OpenACC) && defined(__PGI)
if (cu_mpi .eqv. .false.) then
!$acc update device(q_cons_buff_recv)
!$acc update device(q_cons_buff_recv)
end if
#endif
Expand Down Expand Up @@ -1272,7 +1272,7 @@ contains
end if
if (cu_mpi .eqv. .false.) then
!$acc update device(q_cons_buff_recv)
!$acc update device(q_cons_buff_recv)
end if
! Unpacking buffer received from bc_x%end
Expand Down Expand Up @@ -1560,7 +1560,7 @@ contains
#if defined(MFC_OpenACC) && defined(__PGI)
if (cu_mpi .eqv. .false.) then
!$acc update device(q_cons_buff_recv)
!$acc update device(q_cons_buff_recv)
end if
#endif
Expand Down Expand Up @@ -1843,7 +1843,7 @@ contains
#if defined(MFC_OpenACC) && defined(__PGI)
if (cu_mpi .eqv. .false.) then
!$acc update device(q_cons_buff_recv)
!$acc update device(q_cons_buff_recv)
end if
#endif
Expand Down Expand Up @@ -2093,7 +2093,7 @@ contains
#if defined(MFC_OpenACC) && defined(__PGI)
if (cu_mpi .eqv. .false.) then
!$acc update device(q_cons_buff_recv)
!$acc update device(q_cons_buff_recv)
end if
#endif
Expand Down Expand Up @@ -2338,7 +2338,7 @@ contains
#if defined(MFC_OpenACC) && defined(__PGI)
if (cu_mpi .eqv. .false.) then
!$acc update device(q_cons_buff_recv)
!$acc update device(q_cons_buff_recv)
end if
#endif
Expand Down
2 changes: 1 addition & 1 deletion src/simulation/m_qbmm.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ contains
nterms = 7
end if

!$acc update device(nterms)
!$acc update device(nterms)

#:endif

Expand Down
12 changes: 6 additions & 6 deletions src/simulation/m_start_up.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -891,7 +891,7 @@ contains

if (probe_wrt) then
do i = 1, sys_size
!$acc update host(q_cons_ts(1)%vf(i)%sf)
!$acc update host(q_cons_ts(1)%vf(i)%sf)
end do
end if

Expand Down Expand Up @@ -999,8 +999,8 @@ contains
end do

if (qbmm .and. .not. polytropic) then
!$acc update host(pb_ts(1)%sf)
!$acc update host(mv_ts(1)%sf)
!$acc update host(pb_ts(1)%sf)
!$acc update host(mv_ts(1)%sf)
end if

call s_write_data_files(q_cons_ts(1)%vf, q_prim_vf, t_step)
Expand Down Expand Up @@ -1168,18 +1168,18 @@ contains
!$acc update device(m, n, p)
!$acc update device(momxb, momxe, bubxb, bubxe, advxb, advxe, contxb, contxe, strxb, strxe)
do i = 1, sys_size
!$acc update device(q_cons_ts(1)%vf(i)%sf)
!$acc update device(q_cons_ts(1)%vf(i)%sf)
end do
if (qbmm .and. .not. polytropic) then
!$acc update device(pb_ts(1)%sf, mv_ts(1)%sf)
!$acc update device(pb_ts(1)%sf, mv_ts(1)%sf)
end if
!$acc update device(dt, sys_size, pref, rhoref, gamma_idx, pi_inf_idx, E_idx, alf_idx, stress_idx, mpp_lim, bubbles, hypoelasticity, alt_soundspeed, avg_state, num_fluids, model_eqns, num_dims, mixture_err, nb, weight, grid_geometry, cyl_coord, mapped_weno, mp_weno, weno_eps)
!$acc update device(nb, R0ref, Ca, Web, Re_inv, weight, R0, V0, bubbles, polytropic, polydisperse, qbmm, R0_type, ptil, bubble_model, thermal, poly_sigma)
!$acc update device(R_n, R_v, phi_vn, phi_nv, Pe_c, Tw, pv, M_n, M_v, k_n, k_v, pb0, mass_n0, mass_v0, Pe_T, Re_trans_T, Re_trans_c, Im_trans_T, Im_trans_c, omegaN , mul0, ss, gamma_v, mu_v, gamma_m, gamma_n, mu_n, gam)
!$acc update device(monopole, num_mono)
!$acc update device(relax)
if (relax) then
!$acc update device(palpha_eps, ptgalpha_eps)
!$acc update device(palpha_eps, ptgalpha_eps)
end if
end subroutine s_initialize_gpu_vars

Expand Down
2 changes: 1 addition & 1 deletion src/simulation/m_time_steppers.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -703,7 +703,7 @@ contains
integer :: i !< Generic loop iterator

do i = 1, sys_size
!$acc update host(q_prim_vf(i)%sf)
!$acc update host(q_prim_vf(i)%sf)
end do

if (t_step == t_step_start) then
Expand Down
2 changes: 1 addition & 1 deletion src/simulation/m_weno.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -449,7 +449,7 @@ contains

! END: Computing WENO5 Coefficients ================================
if (weno_dir == 1) then
!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
!$acc update device(poly_coef_cbL_x, poly_coef_cbR_x, d_cbL_x, d_cbR_x, beta_coef_x)
elseif (weno_dir == 2) then
!$acc update device(poly_coef_cbL_y, poly_coef_cbR_y, d_cbL_y, d_cbR_y, beta_coef_y)
else
Expand Down
11 changes: 10 additions & 1 deletion toolchain/indenter.py
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ def adjust_indentation(input_file, output_file):
startingloop1='!$acc parallel loop'
startingloop2='!$acc loop'
max_empty_lines=4
indent_len=4

with open(input_file, 'r') as file_in, open(output_file, 'w') as file_out:
lines = file_in.readlines()
Expand All @@ -39,7 +40,9 @@ def adjust_indentation(input_file, output_file):
# if the following line starts with [end, else, contains], skip to looking up
if lines[j].lstrip().startswith('end') or \
lines[j].lstrip().startswith('contains') or \
lines[j].lstrip().startswith('else'):
lines[j].lstrip().startswith('else') or \
lines[j].lstrip().startswith('#:end') or \
lines[j].lstrip().startswith('#:else'):
empty_lines = max_empty_lines
# skip empty lines
elif lines[j].strip() == '':
Expand All @@ -59,6 +62,12 @@ def adjust_indentation(input_file, output_file):
# if line 2 above ends with line continuation, indent at that level
if lines[k-1].strip().endswith('&'):
indent = len(lines[k-1]) - len(lines[k-1].lstrip())
# if line above starts a loop or branch, indent
elif lines[k].lstrip().startswith('if') or \
lines[k].lstrip().startswith('do') or \
lines[k].lstrip().startswith('#:else') or \
lines[k].lstrip().startswith('#:if'):
indent = indent_len + (len(lines[k]) - len(lines[k].lstrip()))
# else indent at level of line above
else:
indent = len(lines[k]) - len(lines[k].lstrip())
Expand Down

0 comments on commit da30d51

Please sign in to comment.