/[MITgcm]/MITgcm/eesupp/src/barrier.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/barrier.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by cnh, Tue Sep 29 18:50:56 1998 UTC revision 1.14 by jmc, Tue Aug 4 18:01:37 2009 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: BARRIER_INIT
8    
9    C     !INTERFACE:
10        SUBROUTINE BARRIER_INIT        SUBROUTINE BARRIER_INIT
11          IMPLICIT NONE
12    
13    C     !DESCRIPTION:
14    C     *=====================================================================*
15    C     | SUBROUTINE BARRIER\_INIT
16    C     | o Setup global barrier data structures.
17    C     *=====================================================================*
18    C     | Initialise global barrier data structures that can be used in
19    C     | conjunction with MPI or that can also be used to create
20    C     *=====================================================================*
21    
22    C     !USES:
23    C     == Global variables ==
24  #include "SIZE.h"  #include "SIZE.h"
25  #include "EEPARAMS.h"  #include "EEPARAMS.h"
26  #include "EESUPPORT.h"  #include "EESUPPORT.h"
27  #include "BARRIER.h"  #include "BARRIER.h"
28    
29  C     === Local Variables ===  C     !LOCAL VARIABLES:
30    C     == Local Variables ==
31    C     I :: Loop counter
32        INTEGER I        INTEGER I
33    CEOP
34    
35        DO I=1,nThreads        DO I=1,nThreads
36         key1(1,I) = INVALID         key1(1,I) = INVALID
# Line 19  C     === Local Variables === Line 39  C     === Local Variables ===
39         door1     = SHUT         door1     = SHUT
40         door2     = SHUT         door2     = SHUT
41         door3     = SHUT         door3     = SHUT
42           bCount(I) = 0
43           masterSet(I) = 0
44        ENDDO        ENDDO
45    
46        RETURN        RETURN
47        END        END
48    
49    CBOP
50    C     !ROUTINE: BARRIER
51    
52    C     !INTERFACE:
53        SUBROUTINE BARRIER( myThid )        SUBROUTINE BARRIER( myThid )
54        IMPLICIT NONE        IMPLICIT NONE
 C  
 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 don't 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 won't 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     \==========================================================/  
55    
56    C     !DESCRIPTION:
57    C     *==========================================================*
58    C     | SUBROUTINE BARRIER
59    C     | o Barrier routine that uses "busy waiting".
60    C     *==========================================================*
61    C     | This routine provides a pure fortran mechanism to
62    C     | synchronise multiple threads in a multi-threaded code.
63    C     | No thread can leave this routine before all the threads
64    C     | have entered it.
65    C     | Notes
66    C     | =====
67    C     | The door and key variables are assumed to have been
68    C     | initialized once an initial state of key = INVALID
69    C     | and door = SHUT.
70    C     | We use the routine FOOL\_THE\_COMPILER to stop compilers
71    C     | generating code which might simply set and test a
72    C     | register value. Shared-memory systems only maintain
73    C     | coherency over process caches and not registers.
74    C     | Also we have to be a bit careful regarding sequential
75    C     | consistency - or lack of it. At the moment the code
76    C     | assumes a total store order memory model, which some
77    C     | machines do not have! However, I have yet to find a
78    C     | problem with this I think because the tolerances in
79    C     | terms of memory ordering i.e. a little bit of reordering
80    C     | probably will not break the barrier mechanism!
81    C     | On non-cache coherent systems e.g. T3E we need to use
82    C     | a library function to do barriers.
83    C     | Note - The PANIC tests can be removed for working code
84    C     |        I have left them in without an ifdef option
85    C     |        because without them programming errors can
86    C     |        lead to infinitely spinning code. If you are
87    C     |        confident that your code is OK then removing
88    C     |        them may increase performance. Do not remove these
89    C     |        lines to make your code "work" If the code is
90    C     |        stopping in these PANIC blocks then something is
91    C     |        wrong with your program and it needs to be fixed.
92    C     *==========================================================*
93    
94    C     !USES:
95    C     == Global variables ==
96  #include "SIZE.h"  #include "SIZE.h"
97  #include "EEPARAMS.h"  #include "EEPARAMS.h"
98  #include "EESUPPORT.h"  #include "EESUPPORT.h"
99  #include "BARRIER.h"  #include "BARRIER.h"
100    
101  C     === Routine arguments ===  C     !INPUT PARAMETERS:
102    C     == Routine arguments ==
103        INTEGER myThid        INTEGER myThid
104    
105    C     !LOCAL VARIABLES:
106  C     === Local variables ===  C     === Local variables ===
107  C     nDone - Counter for number of threads that have  C     nDone :: Counter for number of threads that have
108  C             completed a section.  C              completed a section.
109  C     I     - Loop counter  C     I     :: Loop counter
110        INTEGER nDone        INTEGER nDone
111        INTEGER I        INTEGER I
112    CEOP
113    
114  CcnhDebugStarts  CcnhDebugStarts
115  C      WRITE(myThid,*) ' Barrier entered '  C      WRITE(myThid,*) ' Barrier entered '
116  CcnhDebugEnds  CcnhDebugEnds
117    
118    #ifdef USE_OMP_THREADING
119    C$OMP BARRIER
120          bCount(myThid) = bCount(myThid) + 1
121          IF ( masterSet(myThid) .NE. 0 ) THEN
122           PRINT *, 'BARRIER called for master reg myThid == ',
123         &   myThid, masterSet(myThid)
124          ENDIF
125    Cdbg C$OMP BARRIER
126    Cdbg       DO I=2, nThreads
127    Cdbg        IF (bCount(I) .NE. bCount(1) ) THEN
128    Cdbg          PRINT *, bCount(1:nThreads)
129    Cdbg          CALL SYSTEM('sleep 1')
130    Cdbg          PRINT *, bCount(1:nThreads)
131    Cdbg          PRINT *, bCount(1:nThreads)
132    Cdbg          PRINT *, bCount(1:nThreads)
133    Cdbg          PRINT *, bCount(1:nThreads)
134    Cdbg          STOP ' barrier out of sync '
135    Cdbg        ENDIF
136    Cdbg       ENDDO
137    Cdbg C$OMP BARRIER
138          RETURN
139    #endif
140    
141  C--   Check that thread number is expected range  C--   Check that thread number is expected range
142        IF ( myThid .LT. 1 .OR. myThid .GT. nThreads ) THEN        IF ( myThid .LT. 1 .OR. myThid .GT. nThreads ) THEN
143         WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
144         WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ', myThid, ' nThreads = ', nThreads         WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ',
145         &  myThid, ' nThreads = ', nThreads
146         STOP 'ABNROMAL END: S/R BARRIER'         STOP 'ABNROMAL END: S/R BARRIER'
147        ENDIF        ENDIF
148    
149  C--   When every threads key1 is valid thread 1 will open door1.  C--   When every threads key1 is valid thread 1 will open door1.
150        IF ( key1(1,myThid) .EQ. VALID ) THEN        IF ( key1(1,myThid) .EQ. VALID ) THEN
151         WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
152         WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ', myThid, ' key1 already validated'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ',
153         &  myThid, ' key1 already validated'
154         STOP 'ABNROMAL END: S/R BARRIER'         STOP 'ABNROMAL END: S/R BARRIER'
155        ENDIF        ENDIF
156        key1(1,myThid) = VALID        key1(1,myThid) = VALID
# Line 103  C--   When every threads key1 is valid t Line 161  C--   When every threads key1 is valid t
161          DO I=1,nThreads          DO I=1,nThreads
162           if ( key1(1,I) .EQ. VALID ) nDone = nDone+1           if ( key1(1,I) .EQ. VALID ) nDone = nDone+1
163          ENDDO          ENDDO
164          CALL FOOL_THE_COMPILER( key1 )          CALL FOOL_THE_COMPILER( key1(1,1) )
165         IF ( nDone .LT. nThreads ) GOTO 10         IF ( nDone .LT. nThreads ) GOTO 10
166         door1 = OPEN         door1 = OPEN
167        ELSE        ELSE
# Line 116  C--   Invalidate keys for door1 here as Line 174  C--   Invalidate keys for door1 here as
174    
175  CcnhDebugStarts  CcnhDebugStarts
176  C     IF ( myThid .EQ. 1 ) THEN  C     IF ( myThid .EQ. 1 ) THEN
177  C      WRITE(0,*) ' DOOR1 Opened '  C      WRITE(*,*) ' DOOR1 Opened '
178  C     ENDIF  C     ENDIF
179  CcnhDebugEnds  CcnhDebugEnds
180    
181  C--   I can now shut door3 because I know everyone has reached  C--   I can now shut door3 because I know everyone has reached
182  C--   door1. I can't shut door1 because I don't know if everyone  C--   door1. I can not shut door1 because I do not know if everyone
183  C--   has "gone" through the door yet. Nobody has yet reached  C--   has "gone" through the door yet. Nobody has yet reached
184  C--   door3 because they have to go through door2 first.  C--   door3 because they have to go through door2 first.
185        IF ( myThid .EQ. 1 ) THEN        IF ( myThid .EQ. 1 ) THEN
# Line 131  C--   door3 because they have to go thro Line 189  C--   door3 because they have to go thro
189  C--   When every threads key2 is valid thread 1 will open door2.  C--   When every threads key2 is valid thread 1 will open door2.
190  C     Notes  C     Notes
191  C     =====  C     =====
192  C      I don't understand memory ordering and sequential consistency.  C     I think that to work with any memory model ( i.e. relaxed,
 C     I think that to work with any memory model ( i.e. relaxed,  
193  C     partial store, total store) the variables key1, key2 and key3  C     partial store, total store) the variables key1, key2 and key3
194  C     might need to be set to invalid by thread 1.  C     might need to be set to invalid by thread 1.
195  C      C
196        IF ( key2(1,myThid) .EQ. VALID ) THEN        IF ( key2(1,myThid) .EQ. VALID ) THEN
197         WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
198         WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ', myThid, ' key2 already validated'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ',
199         &  myThid, ' key2 already validated'
200         STOP 'ABNROMAL END: S/R BARRIER'         STOP 'ABNROMAL END: S/R BARRIER'
201        ENDIF        ENDIF
202        key2(1,myThid) = VALID        key2(1,myThid) = VALID
# Line 149  C Line 207  C
207          DO I=1,nThreads          DO I=1,nThreads
208           if ( key2(1,I) .EQ. VALID ) nDone = nDone+1           if ( key2(1,I) .EQ. VALID ) nDone = nDone+1
209          ENDDO          ENDDO
210          CALL FOOL_THE_COMPILER( key2 )          CALL FOOL_THE_COMPILER( key2(1,1) )
211         IF ( nDone .LT. nThreads ) GOTO 20         IF ( nDone .LT. nThreads ) GOTO 20
212         door2 = OPEN         door2 = OPEN
213        ELSE        ELSE
# Line 162  C--   Invalidate keys for door2 here as Line 220  C--   Invalidate keys for door2 here as
220        key2(1,myThid) = INVALID        key2(1,myThid) = INVALID
221    
222  C--   I can now shut door1 because I know everyone has reached  C--   I can now shut door1 because I know everyone has reached
223  C--   door2. I can't shut door2 because I don't know if everyone  C--   door2. I can not shut door2 because I do not know if everyone
224  C--   has "gone" through the door yet. Nobody has yet reached  C--   has "gone" through the door yet. Nobody has yet reached
225  C--   door1 because they have to go through door3 first.  C--   door1 because they have to go through door3 first.
226        IF ( myThid .EQ. 1 ) THEN        IF ( myThid .EQ. 1 ) THEN
227         door1 = SHUT         door1 = SHUT
228        ENDIF        ENDIF
229        
230        
231  C--   When every threads key3 is valid thread 1 will open door3.  C--   When every threads key3 is valid thread 1 will open door3.
232        IF ( key3(1,myThid) .EQ. VALID ) THEN        IF ( key3(1,myThid) .EQ. VALID ) THEN
233         WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
234         WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ', myThid, ' key3 already validated'         WRITE(*,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER  myThid = ',
235         &  myThid, ' key3 already validated'
236         STOP 'ABNROMAL END: S/R BARRIER'         STOP 'ABNROMAL END: S/R BARRIER'
237        ENDIF        ENDIF
238        key3(1,myThid) = VALID        key3(1,myThid) = VALID
# Line 184  C Line 243  C
243          DO I=1,nThreads          DO I=1,nThreads
244           if ( key3(1,I) .EQ. VALID ) nDone = nDone+1           if ( key3(1,I) .EQ. VALID ) nDone = nDone+1
245          ENDDO          ENDDO
246          CALL FOOL_THE_COMPILER( key3 )          CALL FOOL_THE_COMPILER( key3(1,1) )
247         IF ( nDone .LT. nThreads ) GOTO 30         IF ( nDone .LT. nThreads ) GOTO 30
248         door3 = OPEN         door3 = OPEN
249        ELSE        ELSE
# Line 197  C--   Invalidate keys for door3 here as Line 256  C--   Invalidate keys for door3 here as
256        key3(1,myThid) = INVALID        key3(1,myThid) = INVALID
257    
258  C--   I can now shut door2 because I know everyone has reached  C--   I can now shut door2 because I know everyone has reached
259  C--   door3. I can't shut door3 because I don't know if everyone  C--   door3. I can not shut door3 because I do not know if everyone
260  C--   has "gone" through the door yet. Nobody has yet reached  C--   has "gone" through the door yet. Nobody has yet reached
261  C--   door2 because they have to go through door1 first.  C--   door2 because they have to go through door1 first.
262        IF ( myThid .EQ. 1 ) THEN        IF ( myThid .EQ. 1 ) THEN
# Line 207  C--   door2 because they have to go thro Line 266  C--   door2 because they have to go thro
266  CcnhDebugStarts  CcnhDebugStarts
267  C      WRITE(myThid,*) ' Barrier exited '  C      WRITE(myThid,*) ' Barrier exited '
268  CcnhDebugEnds  CcnhDebugEnds
269        
270          RETURN
271          END
272    
273    CBOP
274          SUBROUTINE BARRIER_MS( myThid )
275          IMPLICIT NONE
276    
277    C     !USES:
278    C     == Global variables ==
279    #include "SIZE.h"
280    #include "EEPARAMS.h"
281    #include "EESUPPORT.h"
282    #include "BARRIER.h"
283          INTEGER myThid
284    
285          masterSet(myThid) = masterSet(myThid) + 1
286    
287          RETURN
288          END
289          SUBROUTINE BARRIER_MU( myThid )
290          IMPLICIT NONE
291    
292    C     !USES:
293    C     == Global variables ==
294    #include "SIZE.h"
295    #include "EEPARAMS.h"
296    #include "EESUPPORT.h"
297    #include "BARRIER.h"
298          INTEGER myThid
299    
300          masterSet(myThid) = masterSet(myThid) - 1
301    
302        RETURN        RETURN
303        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22