From 258620d12c01faea1da0856f128a9b25d97b0cd1 Mon Sep 17 00:00:00 2001
From: Sam Hatfield <samhatfield@users.noreply.github.com>
Date: Thu, 24 Aug 2023 16:15:29 +0100
Subject: [PATCH] Have all ranks error stop on failed correctness check

Previously only the root rank stopped, which I don't think was raceproof.

Co-authored-by: Willem Deconinck <wdeconinck@me.com>
---
 src/programs/ectrans-benchmark.F90 | 36 +++++++++++++++++++++---------
 1 file changed, 25 insertions(+), 11 deletions(-)

diff --git a/src/programs/ectrans-benchmark.F90 b/src/programs/ectrans-benchmark.F90
index d2ee7231..22445471 100644
--- a/src/programs/ectrans-benchmark.F90
+++ b/src/programs/ectrans-benchmark.F90
@@ -203,6 +203,8 @@ program transform_test
 
 character(len=16) :: cgrid = ''
 
+integer :: ierr
+
 !===================================================================================================
 
 #include "setup_trans0.h"
@@ -801,18 +803,30 @@ program transform_test
     write(nout,*)
 
     if (ncheck > 0) then
-      ! If the maximum spectral norm error across all fields is greater than 100 times the machine
-      ! epsilon, fail the test
-      if (zmaxerrg > real(ncheck, jprb) * epsilon(1.0_jprb)) then
-        write(nout, '(a)') '*******************************'
-        write(nout, '(a)') 'Correctness test failed'
-        write(nout, '(a,1e7.2)') 'Maximum spectral norm error = ', zmaxerrg
-        write(nout, '(a,1e7.2)') 'Error tolerance = ', real(ncheck, jprb) * epsilon(1.0_jprb)
-        write(nout, '(a)') '*******************************'
-        error stop
-      endif
+        ierr = 0
+        if (myproc == 1) then
+            ! If the maximum spectral norm error across all fields is greater than 100 times the machine
+            ! epsilon, fail the test
+            if (zmaxerrg > real(ncheck, jprb) * epsilon(1.0_jprb)) then
+                write(nout, '(a)') '*******************************'
+                write(nout, '(a)') 'Correctness test failed'
+                write(nout, '(a,1e7.2)') 'Maximum spectral norm error = ', zmaxerrg
+                write(nout, '(a,1e7.2)') 'Error tolerance = ', real(ncheck, jprb) * epsilon(1.0_jprb)
+                write(nout, '(a)') '*******************************'
+                ierr = 1
+            endif
+        endif
+  
+        ! Root rank broadcasts the correctness checker result to the other ranks
+        if (luse_mpi) then
+            call mpl_broadcast(ierr, ktag=0)
+        endif
+  
+        ! Halt if correctness checker failed
+        if (ierr == 1) then
+            error stop
+        endif
     endif
-  endif
 endif
 
 if (luse_mpi) then