From 4ffbee73a313f4850de8d38e26012b4b203488cf Mon Sep 17 00:00:00 2001 From: Kolen Cheung <10970208+ickc@users.noreply.github.com> Date: Wed, 9 Sep 2026 14:44:07 +0000 Subject: [PATCH 1/4] Link the OpenMP targets when BUILD_OPENMP is enabled BUILD_OPENMP defaults to ON and ShumOptions.cmake runs find_package(OpenMP 3.0 REQUIRED), but nothing ever links the resulting imported targets. No -fopenmp therefore reaches a compile line, _OPENMP is left undefined, and the OpenMP regions in shum_wgdos_packing, shum_horizontal_field_interp, shum_latlon_eq_grids, shum_thread_utils and shum_byteswap are preprocessed away. A CMake build produces a serial library where the Makefile build, which defaults SHUM_OPENMP to true, produces a threaded one, and the option gives no indication that it had no effect. Link OpenMP::OpenMP_C and OpenMP::OpenMP_Fortran to shum. PRIVATE is sufficient because _OPENMP is used inside c_shum_byteswap.c and never in an installed header, so consumers do not need OpenMP flags of their own. The thread_utils unit tests exercise the OpenMP paths directly, so shumlib-tests is given the same linkage in its own right rather than inheriting it. Verified with GCC that -fopenmp now reaches the C and Fortran compile lines of both targets, that libshum links libgomp, and that the fruit test suite still passes; BUILD_OPENMP=OFF continues to configure and build with no OpenMP flags. --- CMakeLists.txt | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4b9588d..bfec365 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -62,6 +62,23 @@ target_compile_definitions(shum PUBLIC ${SHUM_DEFINES}) +# BUILD_OPENMP goes as far as find_package(OpenMP) in ShumOptions.cmake, but +# the imported targets have to be linked for the option to have any effect. +# Without this, no -fopenmp reaches a compile line, _OPENMP is never defined +# and the OpenMP regions are preprocessed away, so a CMake build produces a +# serial library where the Makefile build (SHUM_OPENMP ?= true) produces a +# threaded one. +# +# PRIVATE is sufficient: _OPENMP is used inside c_shum_byteswap.c, never in an +# installed header, so consumers of shumlib do not need OpenMP flags of their +# own. +if(BUILD_OPENMP) + target_link_libraries(shum + PRIVATE + OpenMP::OpenMP_C + OpenMP::OpenMP_Fortran) +endif() + # Install shumlib and the C header files for the sub-libraries that # have them install(TARGETS shum @@ -95,6 +112,16 @@ if(BUILD_TESTS) PUBLIC ${CMAKE_Fortran_MODULE_DIRECTORY}) target_link_libraries(shumlib-tests PUBLIC fruit shum) + # The thread_utils tests exercise the OpenMP paths directly, and shumlib's + # OpenMP linkage is PRIVATE, so the test executable needs the flags in its + # own right. + if(BUILD_OPENMP) + target_link_libraries(shumlib-tests + PRIVATE + OpenMP::OpenMP_C + OpenMP::OpenMP_Fortran) + endif() + add_subdirectory(fruit) setup_shum_fruit() From ba7b2ec42b8abc2481ec434c24f206e50996b194 Mon Sep 17 00:00:00 2001 From: Kolen Cheung <10970208+ickc@users.noreply.github.com> Date: Wed, 16 Sep 2026 16:53:21 +0000 Subject: [PATCH 2/4] add self --- CONTRIBUTORS.md | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index e4f90b3..4d1f42f 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -1,8 +1,9 @@ # Contributors -| GitHub user | Real Name | Affiliation | Date | -| --------------- | ---------------- | ----------- | ---------- | -| james-bruten-mo | James Bruten | Met Office | 2025-12-09 | -| t00sa | Sam Clarke-Green | Met Office | 2026-02-10 | -| jennyhickson | Jenny Hickson | Met Office | 2026-03-02 | -| yaswant | Yaswant Pradhan | Met Office | 2026-07-17 | +| GitHub user | Real Name | Affiliation | Date | +| --------------- | ---------------- | ----------- | ---------- | +| james-bruten-mo | James Bruten | Met Office | 2025-12-09 | +| t00sa | Sam Clarke-Green | Met Office | 2026-02-10 | +| jennyhickson | Jenny Hickson | Met Office | 2026-03-02 | +| yaswant | Yaswant Pradhan | Met Office | 2026-07-17 | +| ickc | Kolen Cheung | University of Exeter | 2026-09-16 | From b2a82353cc2fda4f4e4fc35499110bab6ae9ef7f Mon Sep 17 00:00:00 2001 From: Kolen Cheung <10970208+ickc@users.noreply.github.com> Date: Fri, 30 Oct 2026 15:01:05 +0000 Subject: [PATCH 3/4] Fail fast when thread-utils tests get a smaller OpenMP team The multi-threaded lock tests request 2 or 3 threads and then spin until specific thread IDs act. omp_set_num_threads only requests a team size, so under OMP_THREAD_LIMIT, OMP_DYNAMIC or nesting the team can be smaller and the tests hang forever. Check omp_get_num_threads() inside the parallel region, run the C test only when the team is large enough, and otherwise fail with a message giving the required and actual team size. --- .../test/fruit_test_shum_thread_utils.f90 | 73 ++++++++++++++++--- 1 file changed, 63 insertions(+), 10 deletions(-) diff --git a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 index 8b1b966..d10e9f3 100644 --- a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 +++ b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 @@ -673,6 +673,7 @@ SUBROUTINE test_release_pending_locks LOGICAL(KIND=C_BOOL) :: test_ret INTEGER(KIND=C_INT64_T) :: lock +INTEGER :: team_size lock = -1 @@ -682,12 +683,19 @@ SUBROUTINE test_release_pending_locks CALL assert_true(LOGICAL(lock>0,KIND=C_BOOL), & "Did not generate single lock succesfully [invalid lock number]") +team_size = 3 !$ CALL omp_set_num_threads(3) -!$OMP PARALLEL DEFAULT(NONE) SHARED(lock) REDUCTION(.AND.:test_ret) +!$OMP PARALLEL DEFAULT(NONE) SHARED(lock, team_size) & +!$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$OMP BARRIER -CALL c_test_release_pending_locks(test_ret,lock) +IF (team_size >= 3) CALL c_test_release_pending_locks(test_ret,lock) !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 3) CALL assert_true(test_ret, & "Did not handle/detect release of a lock with pending requests") @@ -733,6 +741,7 @@ END SUBROUTINE test_unlock !$ LOGICAL(KIND=C_BOOL) :: test_ret !$ INTEGER(KIND=C_INT64_T) :: lock +!$ INTEGER :: team_size !$ lock = -1 @@ -744,9 +753,14 @@ END SUBROUTINE test_unlock !$ "Did not generate single lock succesfully [invalid lock number]") !$ CALL omp_set_num_threads(2) -!$OMP PARALLEL DEFAULT(NONE) SHARED(lock) REDUCTION(.AND.:test_ret) -!$ CALL c_test_unlock_foreign(test_ret, lock) +!$OMP PARALLEL DEFAULT(NONE) SHARED(lock, team_size) & +!$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$ IF (omp_get_num_threads() >= 2) CALL c_test_unlock_foreign(test_ret, lock) !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 2) !$ CALL assert_true(test_ret, & !$ "Did not correctly handle unlocking a lock owner by another thread") @@ -760,6 +774,7 @@ END SUBROUTINE test_unlock !$ LOGICAL(KIND=C_BOOL) :: test_ret !$ INTEGER(KIND=C_INT64_T) :: lock +!$ INTEGER :: team_size !$ CALL set_case_name("test_lock_blocking") @@ -769,9 +784,14 @@ END SUBROUTINE test_unlock !$ "Did not generate single lock succesfully [invalid lock number]") !$ CALL omp_set_num_threads(3) -!$OMP PARALLEL DEFAULT(NONE) SHARED(lock) REDUCTION(.AND.:test_ret) -!$ CALL c_test_lock_blocking(test_ret, lock) +!$OMP PARALLEL DEFAULT(NONE) SHARED(lock, team_size) & +!$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$ IF (omp_get_num_threads() >= 3) CALL c_test_lock_blocking(test_ret, lock) !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 3) !$ CALL assert_true(test_ret,"Set locks did not correctly block another thread") !$ END SUBROUTINE test_lock_blocking @@ -784,6 +804,7 @@ END SUBROUTINE test_unlock !$ LOGICAL(KIND=C_BOOL) :: test_ret !$ INTEGER(KIND=C_INT64_T) :: lock +!$ INTEGER :: team_size !$ CALL set_case_name("test_lockqueue_multi") @@ -793,9 +814,14 @@ END SUBROUTINE test_unlock !$ "Did not generate single lock succesfully [invalid lock number]") !$ CALL omp_set_num_threads(3) -!$OMP PARALLEL DEFAULT(NONE) SHARED(lock) REDUCTION(.AND.:test_ret) -!$ CALL c_test_lockqueue_multi(test_ret, lock) +!$OMP PARALLEL DEFAULT(NONE) SHARED(lock, team_size) & +!$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$ IF (omp_get_num_threads() >= 3) CALL c_test_lockqueue_multi(test_ret, lock) !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 3) !$ CALL assert_true(test_ret, "Set locks did not queue correctly") !$ END SUBROUTINE test_lockqueue_multi @@ -808,6 +834,7 @@ END SUBROUTINE test_unlock !$ LOGICAL(KIND=C_BOOL) :: test_ret !$ INTEGER(KIND=C_INT64_T) :: lock +!$ INTEGER :: team_size !$ CALL set_case_name("test_testlock_nonblocking") @@ -817,14 +844,40 @@ END SUBROUTINE test_unlock !$ "Did not generate single lock succesfully [invalid lock number]") !$ CALL omp_set_num_threads(3) -!$OMP PARALLEL DEFAULT(NONE) SHARED(lock) REDUCTION(.AND.:test_ret) -!$ CALL c_test_testlock_nonblocking(test_ret, lock) +!$OMP PARALLEL DEFAULT(NONE) SHARED(lock, team_size) & +!$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$ IF (omp_get_num_threads() >= 3) & +!$ CALL c_test_testlock_nonblocking(test_ret, lock) !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 3) !$ CALL assert_true(test_ret,"Set locks did not correctly block another thread") !$ END SUBROUTINE test_testlock_nonblocking +!------------------------------------------------------------------------------! + +! The multi-threaded C tests spin until specific thread IDs act, so they +! would hang forever if the runtime gave a smaller team than requested (e.g. +! OMP_THREAD_LIMIT, nesting); callers skip them and fail here instead. + +!$ SUBROUTINE assert_team_size(team_size, required) + +!$ IMPLICIT NONE + +!$ INTEGER, INTENT(IN) :: team_size +!$ INTEGER, INTENT(IN) :: required +!$ CHARACTER(LEN=80) :: message + +!$ WRITE(message, "(A,I0,A,I0)") "Test needs an OpenMP team of ", required, & +!$ " threads, got ", team_size +!$ CALL assert_true(LOGICAL(team_size >= required, KIND=C_BOOL), TRIM(message)) + +!$ END SUBROUTINE assert_team_size + !------------------------------------------------------------------------------! SUBROUTINE test_lock_invalid_lock From 43ae98dc56637a3c9513460321234b1aceefb9c8 Mon Sep 17 00:00:00 2001 From: Kolen Cheung <10970208+ickc@users.noreply.github.com> Date: Fri, 30 Oct 2026 15:07:29 +0000 Subject: [PATCH 4/4] Don't assume the requested OpenMP team size in the remaining thread tests test_startOMPparallel and test_startOMPparallelfor checked the parallel region and the iteration split against the number of threads requested. Record the team actually granted and check against that, so they pass with any team size. test_inpar, test_threadid, test_numthreads and test_threadbarrier depend on the exact team, so skip their checks and fail via assert_team_size when the runtime gives fewer threads than requested. --- .../test/c_fruit_test_shum_thread_utils.c | 24 ++++-- .../test/fruit_test_shum_thread_utils.f90 | 81 +++++++++++++------ 2 files changed, 75 insertions(+), 30 deletions(-) diff --git a/shum_thread_utils/test/c_fruit_test_shum_thread_utils.c b/shum_thread_utils/test/c_fruit_test_shum_thread_utils.c index 2e19faa..76e45cb 100644 --- a/shum_thread_utils/test/c_fruit_test_shum_thread_utils.c +++ b/shum_thread_utils/test/c_fruit_test_shum_thread_utils.c @@ -58,6 +58,7 @@ typedef struct DISPATCH_PACK { int64_t iend; int64_t incr; int64_t threads; + int64_t team; size_t exp_iter; size_t *act_iter; size_t tot_act_iter; @@ -1135,6 +1136,7 @@ void c_test_startOMPparallel(bool *test_ret, int64_t *threads) pack.test_ret = 0; pack.threads = *threads; + pack.team = 1; f_shum_startOMPparallel((void **)&pack_ptr, &OMPparallel_dispatch); @@ -1162,6 +1164,7 @@ void c_test_startOMPparallelfor(bool *test_ret, int64_t *in_istart, pack.iend = *in_iend; pack.incr = *in_incr; pack.threads = *threads; + pack.team = 1; pack.exp_iter = 0; pack.tot_act_iter = 0; @@ -1185,8 +1188,10 @@ void c_test_startOMPparallelfor(bool *test_ret, int64_t *in_istart, in_iend, in_incr); - /* Check the thread division was balanced */ - for(i = 1; i < *threads; i++) + /* Check the thread division was balanced across the team we actually got, + * which may be smaller than requested (e.g. OMP_THREAD_LIMIT) + */ + for(i = 1; i < pack.team; i++) { if (pack.act_iter[0] - pack.act_iter[i] > 1) { @@ -1200,7 +1205,7 @@ void c_test_startOMPparallelfor(bool *test_ret, int64_t *in_istart, /* Check the sum of local iteration counts is the total count */ - for(i = 0; i < *threads; i++) + for(i = 0; i < pack.team; i++) { pack.tot_act_iter += pack.act_iter[i]; } @@ -1256,9 +1261,14 @@ static void OMPparallel_dispatch(void **const shareptr) { dispatch_pack *pack = (dispatch_pack *)*shareptr; - /* Check we have a parallel region */ + /* Check we have a parallel region; a team of one is not an active one */ + + if (f_shum_threadID() == 0) + { + pack->team = f_shum_numThreads(); + } - pack->test_ret = f_shum_inPar() || (pack->threads == 1); + pack->test_ret = f_shum_inPar() || (f_shum_numThreads() == 1); } /******************************************************************************/ @@ -1288,7 +1298,7 @@ static void OMPparallelfor_dispatch(void **const shareptr, * This may be on purpose (to cause zero iterations on this thread) if * there are more threads than iterations. */ - if ((*iend-*istart) > pack->threads && pack->exp_iter != 0) + if ((*iend-*istart) > f_shum_numThreads() && pack->exp_iter != 0) { pack->test_ret = 0; } @@ -1302,7 +1312,7 @@ static void OMPparallelfor_dispatch(void **const shareptr, * This may be on purpose (to cause zero iterations on this thread) if * there are more threads than iterations. */ - if ((*iend-*istart) > pack->threads && pack->exp_iter != 0) + if ((*iend-*istart) > f_shum_numThreads() && pack->exp_iter != 0) { pack->test_ret = 0; } diff --git a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 index d10e9f3..f4f667b 100644 --- a/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 +++ b/shum_thread_utils/test/fruit_test_shum_thread_utils.f90 @@ -860,9 +860,11 @@ END SUBROUTINE test_unlock !------------------------------------------------------------------------------! -! The multi-threaded C tests spin until specific thread IDs act, so they -! would hang forever if the runtime gave a smaller team than requested (e.g. -! OMP_THREAD_LIMIT, nesting); callers skip them and fail here instead. +! omp_set_num_threads only requests a team size; the runtime may give fewer +! threads (e.g. OMP_THREAD_LIMIT, nesting). Tests that depend on the exact +! team skip their checks in that case and fail here instead: the multi- +! threaded C lock tests would otherwise spin forever waiting for a thread ID +! that doesn't exist. !$ SUBROUTINE assert_team_size(team_size, required) @@ -1043,6 +1045,7 @@ SUBROUTINE test_inpar LOGICAL(KIND=C_BOOL) :: test_ret !$ LOGICAL :: working +!$ INTEGER :: team_size INTEGER(KIND=C_INT64_T) :: par par = -1 @@ -1061,15 +1064,22 @@ SUBROUTINE test_inpar !$OMP END PARALLEL !$ CALL assert_true(test_ret, "Did not succesfully call c_shum_inPar()") -!$OMP PARALLEL DEFAULT(NONE) PRIVATE(par, working) REDUCTION(.AND.:test_ret) -!$ par = -1 -!$ CALL c_test_inpar(test_ret,par) -!$ working = (par == 1) -!$ IF (working .NEQV. omp_in_parallel()) THEN -!$ working = .FALSE. +!$OMP PARALLEL DEFAULT(NONE) SHARED(team_size) PRIVATE(par, working) & +!$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$ IF (omp_get_num_threads() >= 2) THEN +!$ par = -1 +!$ CALL c_test_inpar(test_ret,par) +!$ working = (par == 1) +!$ IF (working .NEQV. omp_in_parallel()) THEN +!$ working = .FALSE. +!$ END IF +!$ test_ret = working !$ END IF -!$ test_ret = working !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 2) !$ CALL assert_true(test_ret, "c_shum_inPar() did not detect a parallel region") END SUBROUTINE test_inpar @@ -1084,6 +1094,7 @@ SUBROUTINE test_threadid INTEGER(KIND=C_INT64_T) :: tid !$ INTEGER :: i +!$ INTEGER :: team_size tid = -1 @@ -1095,14 +1106,22 @@ SUBROUTINE test_threadid CALL assert_true(test_ret, "Thread ID not zero outside parallel region") !$ CALL omp_set_num_threads(3) -!$OMP PARALLEL DO SCHEDULE(static, 1) DEFAULT(NONE) PRIVATE(tid, i) & +!$OMP PARALLEL DEFAULT(NONE) SHARED(team_size) PRIVATE(tid, i) & !$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$OMP DO SCHEDULE(static, 1) !$ DO i=0,2 -!$ CALL c_test_threadid(test_ret,tid) -!$ IF (tid/=i) test_ret = .FALSE. -!$ IF (tid/=omp_get_thread_num()) test_ret = .FALSE. +!$ IF (omp_get_num_threads() >= 3) THEN +!$ CALL c_test_threadid(test_ret,tid) +!$ IF (tid/=i) test_ret = .FALSE. +!$ IF (tid/=omp_get_thread_num()) test_ret = .FALSE. +!$ END IF !$ END DO -!$OMP END PARALLEL DO +!$OMP END DO +!$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 3) !$ CALL assert_true(test_ret, "Thread IDs not calculated correctly" // & !$ " in parallel region") @@ -1142,6 +1161,7 @@ SUBROUTINE test_barrier LOGICAL(KIND=C_BOOL) :: test_ret, test_ret_arr(max_threads) INTEGER(KIND=C_INT64_T) :: shared1(max_threads), tid +INTEGER :: team_size CALL set_case_name("test_threadbarrier") @@ -1149,20 +1169,26 @@ SUBROUTINE test_barrier test_ret = .FALSE. test_ret_arr = .FALSE. tid = 1 +team_size = max_threads !$ CALL omp_set_num_threads(max_threads) -!$OMP PARALLEL DEFAULT(NONE) SHARED(shared1,test_ret_arr) & +!$OMP PARALLEL DEFAULT(NONE) SHARED(shared1,test_ret_arr,team_size) & !$OMP PRIVATE(tid) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$OMP BARRIER !$ tid = omp_get_thread_num() + 1 -CALL c_test_barrier(test_ret_arr(tid),shared1) +IF (team_size >= max_threads) CALL c_test_barrier(test_ret_arr(tid),shared1) !$OMP END PARALLEL +!$ CALL assert_team_size(team_size, max_threads) test_ret = test_ret_arr(1) !$ test_ret = ALL(test_ret_arr) -CALL assert_true(test_ret, "Barrier test fails!") +IF (team_size >= max_threads) CALL assert_true(test_ret, "Barrier test fails!") END SUBROUTINE test_barrier @@ -1176,6 +1202,7 @@ SUBROUTINE test_numthreads INTEGER(KIND=C_INT64_T) :: numthreads !$ INTEGER :: i +!$ INTEGER :: team_size numthreads = -1 @@ -1197,14 +1224,22 @@ SUBROUTINE test_numthreads !$ CALL omp_set_num_threads(3) -!$OMP PARALLEL DO SCHEDULE(static, 1) DEFAULT(NONE) PRIVATE(numthreads, i) & +!$OMP PARALLEL DEFAULT(NONE) SHARED(team_size) PRIVATE(numthreads, i) & !$OMP REDUCTION(.AND.:test_ret) +!$OMP MASTER +!$ team_size = omp_get_num_threads() +!$OMP END MASTER +!$OMP DO SCHEDULE(static, 1) !$ DO i=0,2 -!$ CALL c_test_numthreads(test_ret,numthreads) -!$ IF (numthreads/=3) test_ret = .FALSE. -!$ IF (numthreads/=omp_get_num_threads()) test_ret = .FALSE. +!$ IF (omp_get_num_threads() >= 3) THEN +!$ CALL c_test_numthreads(test_ret,numthreads) +!$ IF (numthreads/=3) test_ret = .FALSE. +!$ IF (numthreads/=omp_get_num_threads()) test_ret = .FALSE. +!$ END IF !$ END DO -!$OMP END PARALLEL DO +!$OMP END DO +!$OMP END PARALLEL +!$ CALL assert_team_size(team_size, 3) !$ CALL assert_true(test_ret, "Thread count not consistent across threads" // & !$ " in parallel region")