eesupp/src/bar2.F

048ce7bdb7 Chri*0001 #include "CPP_EEOPTIONS.h"
                0002
4c563c2ee9 Chri*0003 CBOP
                0004 C     !ROUTINE: BAR2_INIT
                0005
                0006 C     !INTERFACE:
048ce7bdb7 Chri*0007       SUBROUTINE BAR2_INIT( myThid )
e7ea7a463f Alis*0008       IMPLICIT NONE
4c563c2ee9 Chri*0009
                0010 C     !DESCRIPTION:
                0011 C     *=====================================================================*
2b4c849245 Ed H*0012 C     | SUBROUTINE BAR2\_INIT
4c563c2ee9 Chri*0013 C     | o Setup global barrier data structures.
                0014 C     *=====================================================================*
                0015 C     | Initialise global barrier data structures that can be used in
                0016 C     | conjunction with MPI or that can also be used to create
                0017 C     *=====================================================================*
                0018
                0019 C     !USES:
                0020 C     == Global variables ==
048ce7bdb7 Chri*0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "EESUPPORT.h"
                0024 #include "BAR2.h"
                0025 C
4c563c2ee9 Chri*0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine arguments ==
                0029 C     myThid :: Thread number of this instance of BAR2_INIT
048ce7bdb7 Chri*0030       INTEGER myThid
4c563c2ee9 Chri*0031
                0032 C     !LOCAL VARIABLES:
                0033 C     == Local variables ==
                0034 C     I :: Loop counter
048ce7bdb7 Chri*0035       INTEGER I
4c563c2ee9 Chri*0036 CEOP
                0037
048ce7bdb7 Chri*0038 C
                0039       DO I = 1, lShare4
                0040        BAR2_level(I,myThid) = 0
                0041        BAR2_barrierCount(I,myThid) = 0
                0042        BAR2_spinsCount(I,myThid) = 0
                0043        BAR2_spinsCount(I,myThid) = 0
                0044        BAR2_spinsMax  (I,myThid) = 0
                0045        BAR2_spinsMin  (I,myThid) = 1000000000
                0046       ENDDO
                0047 C
                0048       bar2CollectStatistics = .TRUE.
                0049 C
                0050       RETURN
                0051       END
4c563c2ee9 Chri*0052
                0053 CBOP
                0054
                0055 C     !ROUTINE: BAR2
                0056
                0057 C     !INTERFACE:
048ce7bdb7 Chri*0058       SUBROUTINE BAR2( myThid )
e7ea7a463f Alis*0059       IMPLICIT NONE
4c563c2ee9 Chri*0060
                0061 C     !DESCRIPTION:
                0062 C     *=====================================================================*
                0063 C     | SUBROUTINE BAR2
84f025f053 Jean*0064 C     | o Global barrier routine.
4c563c2ee9 Chri*0065 C     *=====================================================================*
                0066 C     | Implements a simple true shared memory barrier that uses a global
                0067 C     | heap array that all threads can access to synchronise. Each thread
                0068 C     | writes to a predefined location. One thread polls the locations. Other
                0069 C     | threads poll an all clear assertion location. Once the polling
                0070 C     | thread that is looping over locations sees writes for each thread is
                0071 C     | writes the all clear assertion location and everyone proceeds. A
                0072 C     | cyclic series of locations is used to ensure that race conditions do
                0073 C     | not occur. A few simple statistics are recorded giving number of
                0074 C     | barrier calls, max, min and aggregate polling loop counts.
                0075 C     *=====================================================================*
                0076
                0077 C     !USES:
                0078 C     == Global variables ==
048ce7bdb7 Chri*0079 #include "SIZE.h"
                0080 #include "EEPARAMS.h"
                0081 #include "EESUPPORT.h"
                0082 #include "BAR2.h"
84f025f053 Jean*0083
4c563c2ee9 Chri*0084 C     !INPUT/OUTPUT PARAMETERS:
                0085 C     == Routine arguments ==
                0086 C     myThid :: Thread number of this instance of BAR2
048ce7bdb7 Chri*0087       INTEGER myThid
4c563c2ee9 Chri*0088
                0089 C     !LOCAL VARIABLES:
                0090 C     == Local variables ==
                0091 C     myLevel   :: Temp. to hold "active" barrier level
                0092 C     nDone     :: Temp. for counting number of threads that
                0093 C                  have reached the barrier.
                0094 C     I         :: Loop counter
                0095 C     spinCount :: Temp. for doing statistics on how many
                0096 C                  times barrier code looped.
048ce7bdb7 Chri*0097       INTEGER myLevel
                0098       INTEGER nDone
                0099       INTEGER I
                0100       INTEGER spinCount
4c563c2ee9 Chri*0101 CEOP
                0102
a6a74ff42f Chri*0103 #ifdef USE_OMP_THREADING
                0104 C$OMP BARRIER
                0105       BAR2_barrierCount(1,myThid) = BAR2_barrierCount(1,myThid)+1
                0106 Cdbg C$OMP BARRIER
                0107 Cdbg       DO I = 2, nThreads
                0108 Cdbg        IF ( BAR2_barrierCount(1,I) .NE. BAR2_barrierCount(1,1) ) THEN
                0109 Cdbg         PRINT *, BAR2_barrierCount(1,1:nThreads)
                0110 Cdbg         CALL SYSTEM('sleep 1')
                0111 Cdbg         PRINT *, BAR2_barrierCount(1,1:nThreads)
                0112 Cdbg         Stop ' bar2 OUT OF SYNC '
                0113 Cdbg        ENDIF
                0114 Cdbg       ENDDO
                0115 Cdbg C$OMP BARRIER
                0116       RETURN
                0117 #endif
                0118
048ce7bdb7 Chri*0119       spinCount = 0
84f025f053 Jean*0120
048ce7bdb7 Chri*0121       IF ( myThid .NE. 1 ) THEN
                0122
                0123        BAR2_level(1,myThid) = BAR2_level(1,myThid)+1
                0124        myLevel              = BAR2_level(1,myThid)
                0125    10  CONTINUE
                0126         IF ( BAR2_level(1,1) .EQ. myLevel  ) GOTO 11
                0127         spinCount = spinCount+1
84f025f053 Jean*0128         CALL FOOL_THE_COMPILER( BAR2_level(1,1) )
048ce7bdb7 Chri*0129        GOTO 10
                0130    11  CONTINUE
                0131
                0132       ELSE
                0133
                0134        myLevel = BAR2_level(1,1)
                0135    12  CONTINUE
84f025f053 Jean*0136         CALL FOOL_THE_COMPILER( BAR2_level(1,1) )
048ce7bdb7 Chri*0137         nDone   = 1
                0138         DO I = 2, nThreads
                0139          IF ( BAR2_level(1,1) .EQ. BAR2_level(1,I)-1 ) nDone = nDone+1
                0140         ENDDO
                0141         spinCount = spinCount+1
                0142        IF ( nDone .LT. nThreads ) GOTO 12
                0143
                0144        BAR2_level(1,1) = myLevel+1
                0145
                0146       ENDIF
84f025f053 Jean*0147
048ce7bdb7 Chri*0148       BAR2_barrierCount(1,myThid) = BAR2_barrierCount(1,myThid)+1
                0149       BAR2_spinsCount(1,myThid) = BAR2_spinsCount(1,myThid)+spinCount
                0150       BAR2_spinsMax  (1,myThid) = MAX(BAR2_spinsMax(1,myThid),spinCount)
                0151       BAR2_spinsMin  (1,myThid) = MIN(BAR2_spinsMin(1,myThid),spinCount)
84f025f053 Jean*0152
048ce7bdb7 Chri*0153       RETURN
                0154       END