Dear all:
Is it possible to update element of large array without using reduction in openmp? Since reduction will cause temporarily copying the large array itself, I tend to avoid it, and the fact is that serial computation is faster than reduction with openmp.
I do notice OpenMP question: private vs shared work arrays for reduction exists, but it still cannot solve my problem without using reduction.
Here is my code example that reproduces the race condition that I am having, and hopefully there’s a solution for it!
program main
use iso_Fortran_env, only: rk => real64, ik => int32
use omp_lib
implicit none
integer(ik) :: i, j, t, ipr
real(rk), dimension(10, 10, 3) :: a
real(rk), dimension(10) :: jgrid, tgrid
real(rk), dimension(3, 3) :: pii
real(rk), dimension(3) :: igrid
time0 = omp_get_wtime()
a = 0.0_rk
jgrid = 1.0_rk
tgrid = 2.0_rk
igrid = 3.0_rk
pii = transpose(reshape([0.1_rk, 0.5_rk, 0.4_rk, &
0.3_rk, 0.6_rk, 0.1_rk, &
0.4_rk, 0.1_rk, 0.5_rk], [3, 3]))
! -------------------------------------------- !
! !$omp parallel do collapse(4) reduction(+:a) !
! -------------------------------------------- !
do i = 1, 3, 1
do j = 1, 10, 1
do t = 1, 10, 1
do ipr = 1, 3, 1
a(t, j, ipr) = a(t, j, ipr) + igrid(i)**pii(i, ipr) + jgrid(j)*tgrid(t)
enddo
enddo
enddo
enddo
write(*, *) sum(a)
time1 = omp_get_wtime()
write(*, '(a, F12.6, a)') 'elapsed time: ', time1 - time0, ' seconds.'
end program main
If the !$omp
session remain commented, the serial execution time is:
3123.9733500317811
elapsed time: 0.000041 seconds.
if uncomment the box comment allow the usage of reduction and omp, here’s the result:
3123.9733500317811
elapsed time: 0.001185 seconds.
and if I delete the reduction(+:a)
part, then the result will be different everytime. I think this is the race condition.
Thank you so much!