EVOLUTION: Fix possible overflow in update_errors_l2().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2023-12-26 22:18:31 -03:00
parent 7ab1348259
commit 7c292e7095

View File

@ -4205,15 +4205,23 @@ module evolution
integer, intent(in) :: nh, nl
integer :: l, n, p
real(kind=8) :: fnorm, err
type(block_data), pointer :: pdata
integer :: l, n, p
real(kind=8) :: err
logical , save :: first = .true.
real(kind=8), save :: fnorm = 1.0d+00
!-------------------------------------------------------------------------------
!
if (first) then
fnorm = 1.0d+00 / ncells**NDIMS
first = .false.
end if
errors(:) = 0.0d+00
fnorm = 1.0d+00 / (get_nleafs() * ncells**NDIMS)
n = get_dblocks()
@ -4233,7 +4241,7 @@ module evolution
abs(pdata%uu(p,nb:ne,nb:ne, : ,nl)))))**2)
#endif /* NDIMS == 3 */
!$omp atomic update
errors(p) = errors(p) + err
errors(p) = errors(p) + fnorm * err
end do
end do
!$omp end parallel do
@ -4242,7 +4250,7 @@ module evolution
call reduce_sum(errors)
#endif /* MPI */
errors(:) = sqrt(fnorm * errors(:))
errors(:) = sqrt(errors(:) / get_nleafs())
!-------------------------------------------------------------------------------
!