#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