Skip to content

Fix omp reproducible #727

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

Open
JanStreffing wants to merge 10 commits into
base: main
Choose a base branch
from
Open

Fix omp reproducible #727

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
7b06d1a
part1, making omp-reproducible work again
JanStreffing Jun 25, 2025
74cc3f6
more order
JanStreffing Jun 25, 2025
88cd8de
move +src/oce_ale_ssh_splitexpl_subcycl.F90OMP ORDERED to outside if …
JanStreffing Jun 25, 2025
5b3d73e
compiles with __openmp_reproducible and gcc 13
JanStreffing Jun 25, 2025
3d9edc8
runs with Intel
Nov 2, 2025
e33cace
Merge branch 'main' into fix_omp_reproducible
JanStreffing Nov 27, 2025
b81ac04
Fix OpenMP warnings: correct privatization and reduction clauses
JanStreffing Nov 27, 2025
0d8cd77
Fix preprocessor directive nesting in ice_EVP.F90
JanStreffing Nov 27, 2025
831735d
Merge branch 'main' into fix_omp_reproducible
JanStreffing Jan 23, 2026
ea47b28
save wip
JanStreffing Jan 25, 2026
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
10 changes: 9 additions & 1 deletion src/gen_modules_diag.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3266,7 +3266,11 @@ subroutine dvd_add_difflux_bhvisc(do_SDdvd, tr_num, dvd_tot, tr, trstar, gamma0_
! first round
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(edge, nz, ednodes, edelem, elnodes_l, elnodes_r, &
!$OMP nu1, nl1, du, dv, dt, len, vi)
!$OMP DO
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do edge=1, myDim_edge2D!+eDim_edge2D
! skip boundary edges only consider inner edges
if (myList_edge2D(edge) > edge2D_in) cycle
Expand Down Expand Up @@ -3313,7 +3317,11 @@ subroutine dvd_add_difflux_bhvisc(do_SDdvd, tr_num, dvd_tot, tr, trstar, gamma0_

!___________________________________________________________________________
! second round:
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do edge=1, myDim_edge2D!+eDim_edge2D
! skip boundary edges only consider inner edges
if (myList_edge2D(edge) > edge2D_in) cycle
Expand Down
65 changes: 58 additions & 7 deletions src/gen_support.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -337,13 +337,16 @@ subroutine integrate_nod_2D(data, int2D, partit, mesh)
#if !defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(row)
!$OMP DO REDUCTION (+: lval)
#endif
do row=1, myDim_nod2D
lval=lval+data(row)*areasvol(ulevels_nod2D(row),row)
end do
#if !defined(__openmp_reproducible)
!$OMP END DO
!$OMP END PARALLEL
#else
! Use serial computation for reproducible results
do row=1, myDim_nod2D
lval=lval+data(row)*areasvol(ulevels_nod2D(row),row)
end do
#endif
int2D=0.0_WP
call MPI_AllREDUCE(lval, int2D, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
Expand Down Expand Up @@ -374,21 +377,32 @@ subroutine integrate_nod_3D(data, int3D, partit, mesh)
#include "associate_mesh_ass.h"

lval=0.0_WP
#if defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(row, k, lval_row)
!$OMP DO ORDERED
#else
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(row, k, lval_row) REDUCTION(+: lval)
#endif
do row=1, myDim_nod2D
lval_row = 0.
do k=ulevels_nod2D(row), nlevels_nod2D(row)-1
lval_row=lval_row+data(k, row)*areasvol(k,row)*hnode_new(k,row) ! --> TEST_cavity
end do
#if defined(__openmp_reproducible)
!$OMP ORDERED
#endif
!$OMP ATOMIC UPDATE
lval = lval + lval_row
#if defined(__openmp_reproducible)
!$OMP END ORDERED
#else
lval = lval + lval_row
#endif
end do
#if defined(__openmp_reproducible)
!$OMP END DO
!$OMP END PARALLEL
#else
!$OMP END PARALLEL DO
#endif

int3D=0.0_WP
call MPI_AllREDUCE(lval, int3D, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
Expand Down Expand Up @@ -539,23 +553,31 @@ FUNCTION omp_min_max_sum1(arr, pos1, pos2, what, partit, nan)

CASE ('min')
val=arr(1)
#if !defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(n)
!$OMP DO REDUCTION(min: val)
do n=pos1, pos2
val=min(val, arr(n))
end do
!$OMP END DO
!$OMP END PARALLEL
#else
val = minval(arr(pos1:pos2))
#endif

CASE ('max')
val=arr(1)
#if !defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(n)
!$OMP DO REDUCTION(max: val)
do n=pos1, pos2
val=max(val, arr(n))
end do
!$OMP END DO
!$OMP END PARALLEL
#else
val = maxval(arr(pos1:pos2))
#endif

CASE DEFAULT
if (partit%mype==0) write(*,*) trim(what), ' is not implemented in omp_min_max_sum case!'
Expand All @@ -575,7 +597,7 @@ FUNCTION omp_min_max_sum2(arr, pos11, pos12, pos21, pos22, what, partit, nan)
character(3), intent(in) :: what
real(kind=WP), optional :: nan !to be implemented upon the need (for masked arrays)
real(kind=WP) :: omp_min_max_sum2
real(kind=WP) :: val, vmasked, val_part(pos11:pos12)
real(kind=WP) :: val, vmasked, val_part(pos21:pos22)
integer :: i, j


Expand All @@ -588,6 +610,7 @@ FUNCTION omp_min_max_sum2(arr, pos11, pos12, pos21, pos22, what, partit, nan)
CASE ('min')
if (.not. present(nan)) vmasked=huge(vmasked) !just some crazy number
val=arr(1,1)
#if !defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i, j)
!$OMP DO REDUCTION(min: val)
do j=pos21, pos22
Expand All @@ -597,10 +620,14 @@ FUNCTION omp_min_max_sum2(arr, pos11, pos12, pos21, pos22, what, partit, nan)
end do
!$OMP END DO
!$OMP END PARALLEL
#else
val = minval(arr(pos11:pos12,pos21:pos22), mask=(arr(pos11:pos12,pos21:pos22)/=vmasked))
#endif

CASE ('max')
if (.not. present(nan)) vmasked=tiny(vmasked) !just some crazy number
val=arr(1,1)
#if !defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i, j)
!$OMP DO REDUCTION(max: val)
do j=pos21, pos22
Expand All @@ -610,6 +637,9 @@ FUNCTION omp_min_max_sum2(arr, pos11, pos12, pos21, pos22, what, partit, nan)
end do
!$OMP END DO
!$OMP END PARALLEL
#else
val = maxval(arr(pos11:pos12,pos21:pos22), mask=(arr(pos11:pos12,pos21:pos22)/=vmasked))
#endif

CASE ('sum')
if (.not. present(nan)) vmasked=huge(vmasked) !just some crazy number
Expand Down Expand Up @@ -663,7 +693,12 @@ subroutine integrate_elem_3D(data, int3D, partit, mesh)
#include "associate_mesh_ass.h"

lval=0.0_WP
#if defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(row, k, lval_row)
!$OMP DO ORDERED
#else
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(row, k, lval_row) REDUCTION(+: lval)
#endif
do row=1, myDim_elem2D
if(elem2D_nodes(1, row) > myDim_nod2D) cycle
lval_row = 0.
Expand All @@ -672,13 +707,19 @@ subroutine integrate_elem_3D(data, int3D, partit, mesh)
end do
#if defined(__openmp_reproducible)
!$OMP ORDERED
#endif
!$OMP ATOMIC UPDATE
lval = lval + lval_row
#if defined(__openmp_reproducible)
!$OMP END ORDERED
#else
lval = lval + lval_row
#endif
end do
#if defined(__openmp_reproducible)
!$OMP END DO
!$OMP END PARALLEL
#else
!$OMP END PARALLEL DO
#endif

int3D=0.0_WP
call MPI_AllREDUCE(lval, int3D, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
Expand Down Expand Up @@ -707,7 +748,12 @@ subroutine integrate_elem_2D(data, int2D, partit, mesh)
#include "associate_mesh_ass.h"

lval=0.0_WP
#if defined(__openmp_reproducible)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(row)
!$OMP DO ORDERED
#else
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(row) REDUCTION(+: lval)
#endif
do row=1, myDim_elem2D
if(elem2D_nodes(1, row) > myDim_nod2D) cycle
#if defined(__openmp_reproducible)
Expand All @@ -718,7 +764,12 @@ subroutine integrate_elem_2D(data, int2D, partit, mesh)
!$OMP END ORDERED
#endif
end do
#if defined(__openmp_reproducible)
!$OMP END DO
!$OMP END PARALLEL
#else
!$OMP END PARALLEL DO
#endif

int2D=0.0_WP
call MPI_AllREDUCE(lval, int2D, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
Expand Down
8 changes: 8 additions & 0 deletions src/ice_EVP.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -227,7 +227,11 @@ subroutine stress2rhs(ice, partit, mesh)
#endif

#ifndef ENABLE_OPENACC
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
!$ACC PARALLEL LOOP GANG VECTOR DEFAULT(PRESENT)
#if !defined(DISABLE_OPENACC_ATOMICS)
Expand Down Expand Up @@ -716,7 +720,11 @@ subroutine EVPdynamics(ice, partit, mesh)
! apply sea ice velocity boundary condition

#ifndef ENABLE_OPENACC
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
! With the binary data of np2 goes only inside the first if
!$ACC PARALLEL LOOP GANG VECTOR DEFAULT(PRESENT)
Expand Down
30 changes: 29 additions & 1 deletion src/ice_fct.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -759,7 +759,11 @@ subroutine ice_fem_fct(tr_array_id, ice, partit, mesh)
#endif

#ifndef ENABLE_OPENACC
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
#if !defined(DISABLE_OPENACC_ATOMICS)
!$ACC PARALLEL LOOP GANG VECTOR PRIVATE(elnodes) DEFAULT(PRESENT)
Expand Down Expand Up @@ -901,7 +905,11 @@ subroutine ice_fem_fct(tr_array_id, ice, partit, mesh)
#endif

#ifndef ENABLE_OPENACC
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
#if !defined(DISABLE_OPENACC_ATOMICS)
!$ACC PARALLEL LOOP GANG VECTOR PRIVATE(elnodes) DEFAULT(PRESENT)
Expand Down Expand Up @@ -959,7 +967,11 @@ subroutine ice_fem_fct(tr_array_id, ice, partit, mesh)
end do
#ifndef ENABLE_OPENACC
!$OMP END DO
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
!$ACC END PARALLEL LOOP
#if !defined(DISABLE_OPENACC_ATOMICS)
Expand Down Expand Up @@ -1018,7 +1030,11 @@ subroutine ice_fem_fct(tr_array_id, ice, partit, mesh)
end do
#ifndef ENABLE_OPENACC
!$OMP END DO
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
!$ACC END PARALLEL LOOP
#if !defined(DISABLE_OPENACC_ATOMICS)
Expand Down Expand Up @@ -1078,7 +1094,11 @@ subroutine ice_fem_fct(tr_array_id, ice, partit, mesh)
end do
#ifndef ENABLE_OPENACC
!$OMP END DO
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
!$ACC END PARALLEL LOOP
#endif
Expand Down Expand Up @@ -1166,8 +1186,12 @@ SUBROUTINE ice_mass_matrix_fill(ice, partit, mesh)
mass_matrix => ice%work%fct_massmatrix(:)
!
! a)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(n, k, row, elem, elnodes, q, offset, ipos, aa)
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(n, k, row, elem, elnodes, q, offset, ipos, aa, flag, iflag)
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
DO elem=1,myDim_elem2D
elnodes=elem2D_nodes(:,elem)

Expand Down Expand Up @@ -1326,7 +1350,11 @@ subroutine ice_TG_rhs_div(ice, partit, mesh)

#ifndef ENABLE_OPENACC
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(diff, entries, um, vm, vol, dx, dy, n, q, row, elem, elnodes, c1, c2, c3, c4, cx1, cx2, cx3, cx4, entries2)
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
#else
#if !defined(DISABLE_OPENACC_ATOMICS)
!$ACC PARALLEL LOOP GANG VECTOR PRIVATE(elnodes, dx, dy, entries, entries2) DEFAULT(PRESENT)
Expand Down
24 changes: 24 additions & 0 deletions src/ice_maEVP.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -245,7 +245,11 @@ subroutine ssh2rhs(ice, partit, mesh)
!_____________________________________________________________________________
! use floating sea ice for zlevel and zstar
if (use_floatice .and. .not. trim(which_ale)=='linfs') then
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do elem=1,myDim_elem2d
elnodes=elem2D_nodes(:,elem)
!_______________________________________________________________________
Expand Down Expand Up @@ -285,7 +289,11 @@ subroutine ssh2rhs(ice, partit, mesh)
end do
!$OMP END DO
else
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do elem=1,myDim_elem2d
elnodes=elem2D_nodes(:,elem)
!_______________________________________________________________________
Expand Down Expand Up @@ -371,7 +379,11 @@ subroutine stress2rhs_m(ice, partit, mesh)
!$OMP END PARALLEL DO

!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(elem, elnodes, k, row, dx, dy, vol, mf, aa, bb, mass, cluster_area, elevation_elem)
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do elem=1,myDim_elem2d
elnodes=elem2D_nodes(:,elem)
!_______________________________________________________________________
Expand Down Expand Up @@ -545,7 +557,11 @@ subroutine EVPdynamics_m(ice, partit, mesh)
! use floating sea ice for zlevel and zstar
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(el, elnodes, vol, dx, dy, p_ice, n, bb, aa)
if (use_floatice .and. .not. trim(which_ale)=='linfs') then
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do el=1,myDim_elem2d
elnodes=elem2D_nodes(:,el)

Expand Down Expand Up @@ -588,7 +604,11 @@ subroutine EVPdynamics_m(ice, partit, mesh)
!_____________________________________________________________________________
! use levitating sea ice for linfs, zlevel and zstar
else
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do el=1,myDim_elem2d
elnodes=elem2D_nodes(:,el)
!_______________________________________________________________________
Expand Down Expand Up @@ -685,7 +705,11 @@ subroutine EVPdynamics_m(ice, partit, mesh)
! SD, 30.07.2014
!_______________________________________________________________________
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(el, i, ed, row, elnodes, dx, dy, meancos, eps1, eps2, delta, pressure, umod, drag, rhsu, rhsv, det, n)
#if defined(__openmp_reproducible)
!$OMP DO ORDERED
#else
!$OMP DO
#endif
do el=1,myDim_elem2D
if (ulevels(el)>1) cycle

Expand Down
Loading
Loading