C $Header: /u/gcmpack/MITgcm/eesupp/src/barrier.F,v 1.14 2009/08/04 18:01:37 jmc Exp $
C $Name: $
#include "CPP_EEOPTIONS.h"
CBOP
C !ROUTINE: BARRIER_INIT
C !INTERFACE:
SUBROUTINE BARRIER_INIT
IMPLICIT NONE
C !DESCRIPTION:
C *=====================================================================*
C | SUBROUTINE BARRIER\_INIT
C | o Setup global barrier data structures.
C *=====================================================================*
C | Initialise global barrier data structures that can be used in
C | conjunction with MPI or that can also be used to create
C *=====================================================================*
C !USES:
C == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BARRIER.h"
C !LOCAL VARIABLES:
C == Local Variables ==
C I :: Loop counter
INTEGER I
CEOP
DO I=1,nThreads
key1(1,I) = INVALID
key2(1,I) = INVALID
key3(1,I) = INVALID
door1 = SHUT
door2 = SHUT
door3 = SHUT
bCount(I) = 0
masterSet(I) = 0
ENDDO
RETURN
END
CBOP
C !ROUTINE: BARRIER
C !INTERFACE:
SUBROUTINE BARRIER( myThid )
IMPLICIT NONE
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE BARRIER
C | o Barrier routine that uses "busy waiting".
C *==========================================================*
C | This routine provides a pure fortran mechanism to
C | synchronise multiple threads in a multi-threaded code.
C | No thread can leave this routine before all the threads
C | have entered it.
C | Notes
C | =====
C | The door and key variables are assumed to have been
C | initialized once an initial state of key = INVALID
C | and door = SHUT.
C | We use the routine FOOL\_THE\_COMPILER to stop compilers
C | generating code which might simply set and test a
C | register value. Shared-memory systems only maintain
C | coherency over process caches and not registers.
C | Also we have to be a bit careful regarding sequential
C | consistency - or lack of it. At the moment the code
C | assumes a total store order memory model, which some
C | machines do not have! However, I have yet to find a
C | problem with this I think because the tolerances in
C | terms of memory ordering i.e. a little bit of reordering
C | probably will not break the barrier mechanism!
C | On non-cache coherent systems e.g. T3E we need to use
C | a library function to do barriers.
C | Note - The PANIC tests can be removed for working code
C | I have left them in without an ifdef option
C | because without them programming errors can
C | lead to infinitely spinning code. If you are
C | confident that your code is OK then removing
C | them may increase performance. Do not remove these
C | lines to make your code "work" If the code is
C | stopping in these PANIC blocks then something is
C | wrong with your program and it needs to be fixed.
C *==========================================================*
C !USES:
C == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BARRIER.h"
C !INPUT PARAMETERS:
C == Routine arguments ==
INTEGER myThid
C !LOCAL VARIABLES:
C === Local variables ===
C nDone :: Counter for number of threads that have
C completed a section.
C I :: Loop counter
INTEGER nDone
INTEGER I
CEOP
CcnhDebugStarts
C WRITE(myThid,*) ' Barrier entered '
CcnhDebugEnds
#ifdef USE_OMP_THREADING
C$OMP BARRIER
bCount(myThid) = bCount(myThid) + 1
IF ( masterSet(myThid) .NE. 0 ) THEN
PRINT *, 'BARRIER called for master reg myThid == ',
& myThid, masterSet(myThid)
ENDIF
Cdbg C$OMP BARRIER
Cdbg DO I=2, nThreads
Cdbg IF (bCount(I) .NE. bCount(1) ) THEN
Cdbg PRINT *, bCount(1:nThreads)
Cdbg CALL SYSTEM('sleep 1')
Cdbg PRINT *, bCount(1:nThreads)
Cdbg PRINT *, bCount(1:nThreads)
Cdbg PRINT *, bCount(1:nThreads)
Cdbg PRINT *, bCount(1:nThreads)
Cdbg STOP ' barrier out of sync '
Cdbg ENDIF
Cdbg ENDDO
Cdbg C$OMP BARRIER
RETURN
#endif
C-- Check that thread number is expected range
IF ( myThid .LT. 1 .OR. myThid .GT. nThreads ) THEN
WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
& myThid, ' nThreads = ', nThreads
STOP 'ABNROMAL END: S/R BARRIER'
ENDIF
C-- When every threads key1 is valid thread 1 will open door1.
IF ( key1(1,myThid) .EQ. VALID ) THEN
WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
& myThid, ' key1 already validated'
STOP 'ABNROMAL END: S/R BARRIER'
ENDIF
key1(1,myThid) = VALID
IF ( myThid .eq. 1 ) THEN
10 CONTINUE
nDone = 0
DO I=1,nThreads
if ( key1(1,I) .EQ. VALID ) nDone = nDone+1
ENDDO
CALL FOOL_THE_COMPILER( key1(1,1) )
IF ( nDone .LT. nThreads ) GOTO 10
door1 = OPEN
ELSE
11 CONTINUE
CALL FOOL_THE_COMPILER( door1 )
IF ( door1 .NE. OPEN ) GOTO 11
ENDIF
C-- Invalidate keys for door1 here as it is now open
key1(1,myThid) = INVALID
CcnhDebugStarts
C IF ( myThid .EQ. 1 ) THEN
C WRITE(*,*) ' DOOR1 Opened '
C ENDIF
CcnhDebugEnds
C-- I can now shut door3 because I know everyone has reached
C-- door1. I can not shut door1 because I do not know if everyone
C-- has "gone" through the door yet. Nobody has yet reached
C-- door3 because they have to go through door2 first.
IF ( myThid .EQ. 1 ) THEN
door3 = SHUT
ENDIF
C-- When every threads key2 is valid thread 1 will open door2.
C Notes
C =====
C I think that to work with any memory model ( i.e. relaxed,
C partial store, total store) the variables key1, key2 and key3
C might need to be set to invalid by thread 1.
C
IF ( key2(1,myThid) .EQ. VALID ) THEN
WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
& myThid, ' key2 already validated'
STOP 'ABNROMAL END: S/R BARRIER'
ENDIF
key2(1,myThid) = VALID
C
IF ( myThid .eq. 1 ) THEN
20 CONTINUE
nDone = 0
DO I=1,nThreads
if ( key2(1,I) .EQ. VALID ) nDone = nDone+1
ENDDO
CALL FOOL_THE_COMPILER( key2(1,1) )
IF ( nDone .LT. nThreads ) GOTO 20
door2 = OPEN
ELSE
21 CONTINUE
CALL FOOL_THE_COMPILER( door2 )
IF ( door2 .NE. OPEN ) GOTO 21
ENDIF
C-- Invalidate keys for door2 here as it is now open
key2(1,myThid) = INVALID
C-- I can now shut door1 because I know everyone has reached
C-- door2. I can not shut door2 because I do not know if everyone
C-- has "gone" through the door yet. Nobody has yet reached
C-- door1 because they have to go through door3 first.
IF ( myThid .EQ. 1 ) THEN
door1 = SHUT
ENDIF
C-- When every threads key3 is valid thread 1 will open door3.
IF ( key3(1,myThid) .EQ. VALID ) THEN
WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
& myThid, ' key3 already validated'
STOP 'ABNROMAL END: S/R BARRIER'
ENDIF
key3(1,myThid) = VALID
C
IF ( myThid .eq. 1 ) THEN
30 CONTINUE
nDone = 0
DO I=1,nThreads
if ( key3(1,I) .EQ. VALID ) nDone = nDone+1
ENDDO
CALL FOOL_THE_COMPILER( key3(1,1) )
IF ( nDone .LT. nThreads ) GOTO 30
door3 = OPEN
ELSE
31 CONTINUE
CALL FOOL_THE_COMPILER( door3 )
IF ( door3 .NE. OPEN ) GOTO 31
ENDIF
C-- Invalidate keys for door3 here as it is now open
key3(1,myThid) = INVALID
C-- I can now shut door2 because I know everyone has reached
C-- door3. I can not shut door3 because I do not know if everyone
C-- has "gone" through the door yet. Nobody has yet reached
C-- door2 because they have to go through door1 first.
IF ( myThid .EQ. 1 ) THEN
door2 = SHUT
ENDIF
CcnhDebugStarts
C WRITE(myThid,*) ' Barrier exited '
CcnhDebugEnds
RETURN
END
CBOP
SUBROUTINE BARRIER_MS( myThid )
IMPLICIT NONE
C !USES:
C == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BARRIER.h"
INTEGER myThid
masterSet(myThid) = masterSet(myThid) + 1
RETURN
END
SUBROUTINE BARRIER_MU( myThid )
IMPLICIT NONE
C !USES:
C == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BARRIER.h"
INTEGER myThid
masterSet(myThid) = masterSet(myThid) - 1
RETURN
END