forked from altMITgcm/MITgcm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
bar2.F
142 lines (121 loc) · 4.1 KB
/
bar2.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
C $Header: /u/gcmpack/MITgcm/eesupp/src/bar2.F,v 1.4 2001/09/21 03:54:34 cnh Exp $
C $Name: $
#include "CPP_EEOPTIONS.h"
CBOP
C !ROUTINE: BAR2_INIT
C !INTERFACE:
SUBROUTINE BAR2_INIT( myThid )
IMPLICIT NONE
C !DESCRIPTION:
C *=====================================================================*
C | SUBROUTINE BAR2_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 "BAR2.h"
C
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C myThid :: Thread number of this instance of BAR2_INIT
INTEGER myThid
C !LOCAL VARIABLES:
C == Local variables ==
C I :: Loop counter
INTEGER I
CEOP
C
DO I = 1, lShare4
BAR2_level(I,myThid) = 0
BAR2_barrierCount(I,myThid) = 0
BAR2_spinsCount(I,myThid) = 0
BAR2_spinsCount(I,myThid) = 0
BAR2_spinsMax (I,myThid) = 0
BAR2_spinsMin (I,myThid) = 1000000000
ENDDO
C
bar2CollectStatistics = .TRUE.
C
RETURN
END
CBOP
C !ROUTINE: BAR2
C !INTERFACE:
SUBROUTINE BAR2( myThid )
IMPLICIT NONE
C !DESCRIPTION:
C *=====================================================================*
C | SUBROUTINE BAR2
C | o Global barrier routine.
C *=====================================================================*
C | Implements a simple true shared memory barrier that uses a global
C | heap array that all threads can access to synchronise. Each thread
C | writes to a predefined location. One thread polls the locations. Other
C | threads poll an all clear assertion location. Once the polling
C | thread that is looping over locations sees writes for each thread is
C | writes the all clear assertion location and everyone proceeds. A
C | cyclic series of locations is used to ensure that race conditions do
C | not occur. A few simple statistics are recorded giving number of
C | barrier calls, max, min and aggregate polling loop counts.
C *=====================================================================*
C !USES:
C == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BAR2.h"
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C myThid :: Thread number of this instance of BAR2
INTEGER myThid
C !LOCAL VARIABLES:
C == Local variables ==
C myLevel :: Temp. to hold "active" barrier level
C nDone :: Temp. for counting number of threads that
C have reached the barrier.
C I :: Loop counter
C spinCount :: Temp. for doing statistics on how many
C times barrier code looped.
INTEGER myLevel
INTEGER nDone
INTEGER I
INTEGER spinCount
CEOP
C
spinCount = 0
C
IF ( myThid .NE. 1 ) THEN
BAR2_level(1,myThid) = BAR2_level(1,myThid)+1
myLevel = BAR2_level(1,myThid)
10 CONTINUE
IF ( BAR2_level(1,1) .EQ. myLevel ) GOTO 11
spinCount = spinCount+1
CALL FOOL_THE_COMPILER( BAR2_level )
GOTO 10
11 CONTINUE
ELSE
myLevel = BAR2_level(1,1)
12 CONTINUE
CALL FOOL_THE_COMPILER( BAR2_level )
nDone = 1
DO I = 2, nThreads
IF ( BAR2_level(1,1) .EQ. BAR2_level(1,I)-1 ) nDone = nDone+1
ENDDO
spinCount = spinCount+1
IF ( nDone .LT. nThreads ) GOTO 12
BAR2_level(1,1) = myLevel+1
ENDIF
C
BAR2_barrierCount(1,myThid) = BAR2_barrierCount(1,myThid)+1
BAR2_spinsCount(1,myThid) = BAR2_spinsCount(1,myThid)+spinCount
BAR2_spinsMax (1,myThid) = MAX(BAR2_spinsMax(1,myThid),spinCount)
BAR2_spinsMin (1,myThid) = MIN(BAR2_spinsMin(1,myThid),spinCount)
C
RETURN
END