Skip to content

Commit 1412eb2

Browse files
authored
Fix 8 HPC-sensitive bugs: GPU kernels, MPI broadcast, domain decomposition (#1242)
1 parent e20e260 commit 1412eb2

8 files changed

Lines changed: 15 additions & 16 deletions

File tree

src/common/m_finite_differences.fpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,7 @@ contains
5050
if (z == iz_s%beg) then
5151
divergence = divergence + (-3._wp*fields(3)%sf(x, y, z) + 4._wp*fields(3)%sf(x, y, z + 1) - fields(3)%sf(x, y, z + 2))/(z_cc(z + 2) - z_cc(z))
5252
else if (z == iz_s%end) then
53-
divergence = divergence + (+3._wp*fields(3)%sf(x, y, z) - 4._wp*fields(3)%sf(x, y, z - 1) + fields(2)%sf(x, y, z - 2))/(z_cc(z) - z_cc(z - 2))
53+
divergence = divergence + (+3._wp*fields(3)%sf(x, y, z) - 4._wp*fields(3)%sf(x, y, z - 1) + fields(3)%sf(x, y, z - 2))/(z_cc(z) - z_cc(z - 2))
5454
else
5555
divergence = divergence + (fields(3)%sf(x, y, z + 1) - fields(3)%sf(x, y, z - 1))/(z_cc(z + 1) - z_cc(z - 1))
5656
end if

src/common/m_mpi_common.fpp

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -936,9 +936,9 @@ contains
936936
(j + buff_size*((k + 1) + (n + 1)*l))
937937
q_comm(i)%sf(j + unpack_offset, k, l) = real(buff_recv(r), kind=stp)
938938
#if defined(__INTEL_COMPILER)
939-
if (ieee_is_nan(q_comm(i)%sf(j, k, l))) then
939+
if (ieee_is_nan(q_comm(i)%sf(j + unpack_offset, k, l))) then
940940
print *, "Error", j, k, l, i
941-
error stop "NaN(s) in recv"
941+
call s_mpi_abort("NaN(s) in recv")
942942
end if
943943
#endif
944944
end do
@@ -991,9 +991,9 @@ contains
991991
((k + buff_size) + buff_size*l))
992992
q_comm(i)%sf(j, k + unpack_offset, l) = real(buff_recv(r), kind=stp)
993993
#if defined(__INTEL_COMPILER)
994-
if (ieee_is_nan(q_comm(i)%sf(j, k, l))) then
994+
if (ieee_is_nan(q_comm(i)%sf(j, k + unpack_offset, l))) then
995995
print *, "Error", j, k, l, i
996-
error stop "NaN(s) in recv"
996+
call s_mpi_abort("NaN(s) in recv")
997997
end if
998998
#endif
999999
end do
@@ -1050,9 +1050,9 @@ contains
10501050
(l + buff_size)))
10511051
q_comm(i)%sf(j, k, l + unpack_offset) = real(buff_recv(r), kind=stp)
10521052
#if defined(__INTEL_COMPILER)
1053-
if (ieee_is_nan(q_comm(i)%sf(j, k, l))) then
1053+
if (ieee_is_nan(q_comm(i)%sf(j, k, l + unpack_offset))) then
10541054
print *, "Error", j, k, l, i
1055-
error stop "NaN(s) in recv"
1055+
call s_mpi_abort("NaN(s) in recv")
10561056
end if
10571057
#endif
10581058
end do
@@ -1153,8 +1153,6 @@ contains
11531153

11541154
if (igr) then
11551155
recon_order = igr_order
1156-
else
1157-
recon_order = weno_order
11581156
end if
11591157

11601158
! 3D Cartesian Processor Topology

src/common/m_variables_conversion.fpp

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -852,11 +852,11 @@ contains
852852
end if
853853

854854
if (hypoelasticity) then
855+
if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(damage_idx)%sf(j, k, l)), 0._wp)
855856
$:GPU_LOOP(parallelism='[seq]')
856857
do i = strxb, strxe
857858
! subtracting elastic contribution for pressure calculation
858859
if (G_K > verysmall) then
859-
if (cont_damage) G_K = G_K*max((1._wp - qK_cons_vf(damage_idx)%sf(j, k, l)), 0._wp)
860860
qK_prim_vf(E_idx)%sf(j, k, l) = qK_prim_vf(E_idx)%sf(j, k, l) - &
861861
((qK_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*G_K))/gamma_K
862862
! Double for shear stresses
@@ -1123,11 +1123,10 @@ contains
11231123
end if
11241124

11251125
if (hypoelasticity) then
1126+
if (cont_damage) G = G*max((1._wp - q_prim_vf(damage_idx)%sf(j, k, l)), 0._wp)
11261127
do i = strxb, strxe
11271128
! adding elastic contribution
11281129
if (G > verysmall) then
1129-
if (cont_damage) G = G*max((1._wp - q_prim_vf(damage_idx)%sf(j, k, l)), 0._wp)
1130-
11311130
q_cons_vf(E_idx)%sf(j, k, l) = q_cons_vf(E_idx)%sf(j, k, l) + &
11321131
(q_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*G)
11331132
! Double for shear stresses

src/pre_process/m_data_output.fpp

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -483,6 +483,8 @@ contains
483483
integer :: m_glb_ds, n_glb_ds, p_glb_ds
484484
integer :: m_glb_save, n_glb_save, p_glb_save ! Size of array being saved
485485

486+
loc_violations = 0._wp
487+
486488
if (down_sample) then
487489
if ((mod(m + 1, 3) > 0) .or. (mod(n + 1, 3) > 0) .or. (mod(p + 1, 3) > 0)) then
488490
loc_violations = 1._wp

src/pre_process/m_mpi_proxy.fpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ contains
5858
& 'igr', 'down_sample', 'simplex_perturb','fft_wrt', 'hyper_cleaning' ]
5959
call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
6060
#:endfor
61-
call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
61+
call MPI_BCAST(fluid_rho(1), num_fluids_max, mpi_p, 0, MPI_COMM_WORLD, ierr)
6262

6363
#:for VAR in [ 'x_domain%beg', 'x_domain%end', 'y_domain%beg', &
6464
& 'y_domain%end', 'z_domain%beg', 'z_domain%end', 'a_x', 'a_y', &

src/simulation/m_cbc.fpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -930,7 +930,7 @@ contains
930930
if (bc_${XYZ}$%grcbc_in) then
931931
$:GPU_LOOP(parallelism='[seq]')
932932
do i = 2, momxb
933-
L(2) = c**3._wp*Ma*(alpha_rho(i - 1) - alpha_rho_in(i - 1, ${CBC_DIR}$))/Del_in(${CBC_DIR}$) - c*Ma*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$)
933+
L(i) = c**3._wp*Ma*(alpha_rho(i - 1) - alpha_rho_in(i - 1, ${CBC_DIR}$))/Del_in(${CBC_DIR}$) - c*Ma*(pres - pres_in(${CBC_DIR}$))/Del_in(${CBC_DIR}$)
934934
end do
935935
if (n > 0) then
936936
L(momxb + 1) = c*Ma*(vel(dir_idx(2)) - vel_in(${CBC_DIR}$, dir_idx(2)))/Del_in(${CBC_DIR}$)

src/simulation/m_mpi_proxy.fpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -145,7 +145,7 @@ contains
145145

146146
#:for VAR in [ 'dt','weno_eps','teno_CT','pref','rhoref','R0ref','Web','Ca', 'sigma', &
147147
& 'Re_inv', 'poly_sigma', 'palpha_eps', 'ptgalpha_eps', 'pi_fac', &
148-
& 'bc_x%vb1','bc_x%vb2','bc_x%vb3','bc_x%ve1','bc_x%ve2','bc_x%ve2', &
148+
& 'bc_x%vb1','bc_x%vb2','bc_x%vb3','bc_x%ve1','bc_x%ve2','bc_x%ve3', &
149149
& 'bc_y%vb1','bc_y%vb2','bc_y%vb3','bc_y%ve1','bc_y%ve2','bc_y%ve3', &
150150
& 'bc_z%vb1','bc_z%vb2','bc_z%vb3','bc_z%ve1','bc_z%ve2','bc_z%ve3', &
151151
& 'bc_x%pres_in','bc_x%pres_out','bc_y%pres_in','bc_y%pres_out', 'bc_z%pres_in','bc_z%pres_out', &

src/simulation/m_start_up.fpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -965,7 +965,7 @@ contains
965965
do j = 0, m
966966
if (ieee_is_nan(real(q_cons_ts(stor)%vf(i)%sf(j, k, l), kind=wp))) then
967967
print *, "NaN(s) in timestep output.", j, k, l, i, proc_rank, t_step, m, n, p
968-
error stop "NaN(s) in timestep output."
968+
call s_mpi_abort("NaN(s) in timestep output.")
969969
end if
970970
end do
971971
end do

0 commit comments

Comments
 (0)