eesupp/src/barrier.F

C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/barrier.F,v 1.4 1998/09/29 18:50:56 cnh Exp $

#include "CPP_EEOPTIONS.h"

      SUBROUTINE BARRIER_INIT

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BARRIER.h"

C     === Local Variables ===
      INTEGER I

      DO I=1,nThreads
       key1(1,I) = INVALID
       key2(1,I) = INVALID
       key3(1,I) = INVALID
       door1     = SHUT
       door2     = SHUT
       door3     = SHUT
      ENDDO

      RETURN
      END
      SUBROUTINE BARRIER( myThid )
      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 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     \==========================================================/

#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
#include "BARRIER.h"

C     === Routine arguments ===
      INTEGER myThid

C     === Local variables ===
C     nDone - Counter for number of threads that have 
C             completed a section.
C     I     - Loop counter
      INTEGER nDone
      INTEGER I

CcnhDebugStarts
C      WRITE(myThid,*) ' Barrier entered '
CcnhDebugEnds

C--   Check that thread number is expected range
      IF ( myThid .LT. 1 .OR. myThid .GT. nThreads ) THEN
       WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
       WRITE(0,*) '!!!!!!! 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(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
       WRITE(0,*) '!!!!!!! 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 )
       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(0,*) ' DOOR1 Opened '
C     ENDIF
CcnhDebugEnds

C--   I can now shut door3 because I know everyone has reached
C--   door1. I can't shut door1 because I don't 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(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
       WRITE(0,*) '!!!!!!! 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 )
       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't shut door2 because I don't 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(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
       WRITE(0,*) '!!!!!!! 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 )
       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't shut door3 because I don't 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
1	cnh	1.5	C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/barrier.F,v 1.4 1998/09/29 18:50:56 cnh Exp $
2	cnh	1.1
3			#include "CPP_EEOPTIONS.h"
4
5			SUBROUTINE BARRIER_INIT
6	cnh	1.4
7			#include "SIZE.h"
8	cnh	1.1	#include "EEPARAMS.h"
9			#include "EESUPPORT.h"
10			#include "BARRIER.h"
11
12			C === Local Variables ===
13			INTEGER I
14
15			DO I=1,nThreads
16			key1(1,I) = INVALID
17			key2(1,I) = INVALID
18			key3(1,I) = INVALID
19			door1 = SHUT
20			door2 = SHUT
21			door3 = SHUT
22			ENDDO
23
24			RETURN
25			END
26			SUBROUTINE BARRIER( myThid )
27			IMPLICIT NONE
28			C
29			C /==========================================================\
30			C \| SUBROUTINE BARRIER \|
31			C \| o Barrier routine that uses "busy waiting". \|
32			C \|==========================================================\|
33			C \| This routine provides a pure fortran mechanism to \|
34			C \| synchronise multiple threads in a multi-threaded code. \|
35			C \| No thread can leave this routine before all the threads \|
36			C \| have entered it. \|
37			C \| Notes \|
38			C \| ===== \|
39			C \| The door and key variables are assumed to have been \|
40			C \| initialized once an initial state of key = INVALID \|
41			C \| and door = SHUT. \|
42			C \| We use the routine FOOL_THE_COMPILER to stop compilers \|
43			C \| generating code which might simply set and test a \|
44			C \| register value. Shared-memory systems only maintain \|
45			C \| coherency over process caches and not registers. \|
46			C \| Also we have to be a bit careful regarding sequential \|
47			C \| consistency - or lack of it. At the moment the code \|
48			C \| assumes a total store order memory model, which some \|
49	cnh	1.5	C \| machines do not have! However, I have yet to find a \|
50	cnh	1.1	C \| problem with this I think because the tolerances in \|
51			C \| terms of memory ordering i.e. a little bit of reordering \|
52	cnh	1.5	C \| probably will not break the barrier mechanism! \|
53	cnh	1.1	C \| On non-cache coherent systems e.g. T3E we need to use \|
54			C \| a library function to do barriers. \|
55			C \| Note - The PANIC tests can be removed for working code \|
56			C \| I have left them in without an ifdef option \|
57			C \| because without them programming errors can \|
58			C \| lead to infinitely spinning code. If you are \|
59			C \| confident that your code is OK then removing \|
60			C \| them may increase performance. Do not remove these\|
61			C \| lines to make your code "work" If the code is \|
62			C \| stopping in these PANIC blocks then something is \|
63			C \| wrong with your program and it needs to be fixed. \|
64			C \==========================================================/
65	cnh	1.4
66			#include "SIZE.h"
67	cnh	1.1	#include "EEPARAMS.h"
68			#include "EESUPPORT.h"
69			#include "BARRIER.h"
70
71			C === Routine arguments ===
72			INTEGER myThid
73
74			C === Local variables ===
75			C nDone - Counter for number of threads that have
76			C completed a section.
77			C I - Loop counter
78			INTEGER nDone
79			INTEGER I
80
81			CcnhDebugStarts
82	cnh	1.3	C WRITE(myThid,*) ' Barrier entered '
83	cnh	1.1	CcnhDebugEnds
84
85			C-- Check that thread number is expected range
86			IF ( myThid .LT. 1 .OR. myThid .GT. nThreads ) THEN
87			WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
88	cnh	1.5	WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
89			& myThid, ' nThreads = ', nThreads
90	cnh	1.1	STOP 'ABNROMAL END: S/R BARRIER'
91			ENDIF
92
93			C-- When every threads key1 is valid thread 1 will open door1.
94			IF ( key1(1,myThid) .EQ. VALID ) THEN
95			WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
96	cnh	1.5	WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
97			& myThid, ' key1 already validated'
98	cnh	1.1	STOP 'ABNROMAL END: S/R BARRIER'
99			ENDIF
100			key1(1,myThid) = VALID
101
102			IF ( myThid .eq. 1 ) THEN
103			10 CONTINUE
104			nDone = 0
105			DO I=1,nThreads
106			if ( key1(1,I) .EQ. VALID ) nDone = nDone+1
107			ENDDO
108			CALL FOOL_THE_COMPILER( key1 )
109			IF ( nDone .LT. nThreads ) GOTO 10
110			door1 = OPEN
111			ELSE
112			11 CONTINUE
113			CALL FOOL_THE_COMPILER( door1 )
114			IF ( door1 .NE. OPEN ) GOTO 11
115			ENDIF
116			C-- Invalidate keys for door1 here as it is now open
117			key1(1,myThid) = INVALID
118
119			CcnhDebugStarts
120			C IF ( myThid .EQ. 1 ) THEN
121			C WRITE(0,*) ' DOOR1 Opened '
122			C ENDIF
123			CcnhDebugEnds
124
125			C-- I can now shut door3 because I know everyone has reached
126			C-- door1. I can't shut door1 because I don't know if everyone
127			C-- has "gone" through the door yet. Nobody has yet reached
128			C-- door3 because they have to go through door2 first.
129			IF ( myThid .EQ. 1 ) THEN
130			door3 = SHUT
131			ENDIF
132
133			C-- When every threads key2 is valid thread 1 will open door2.
134			C Notes
135			C =====
136			C I think that to work with any memory model ( i.e. relaxed,
137			C partial store, total store) the variables key1, key2 and key3
138			C might need to be set to invalid by thread 1.
139			C
140			IF ( key2(1,myThid) .EQ. VALID ) THEN
141			WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
142	cnh	1.5	WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
143			& myThid, ' key2 already validated'
144	cnh	1.1	STOP 'ABNROMAL END: S/R BARRIER'
145			ENDIF
146			key2(1,myThid) = VALID
147			C
148			IF ( myThid .eq. 1 ) THEN
149			20 CONTINUE
150			nDone = 0
151			DO I=1,nThreads
152			if ( key2(1,I) .EQ. VALID ) nDone = nDone+1
153			ENDDO
154			CALL FOOL_THE_COMPILER( key2 )
155			IF ( nDone .LT. nThreads ) GOTO 20
156			door2 = OPEN
157			ELSE
158			21 CONTINUE
159			CALL FOOL_THE_COMPILER( door2 )
160			IF ( door2 .NE. OPEN ) GOTO 21
161			ENDIF
162
163			C-- Invalidate keys for door2 here as it is now open
164			key2(1,myThid) = INVALID
165
166			C-- I can now shut door1 because I know everyone has reached
167			C-- door2. I can't shut door2 because I don't know if everyone
168			C-- has "gone" through the door yet. Nobody has yet reached
169			C-- door1 because they have to go through door3 first.
170			IF ( myThid .EQ. 1 ) THEN
171			door1 = SHUT
172			ENDIF
173
174
175			C-- When every threads key3 is valid thread 1 will open door3.
176			IF ( key3(1,myThid) .EQ. VALID ) THEN
177			WRITE(0,*) '!!!!!!! PANIC !!!!!!! CATASTROPHIC ERROR'
178	cnh	1.5	WRITE(0,*) '!!!!!!! PANIC !!!!!!! in S/R BARRIER myThid = ',
179			& myThid, ' key3 already validated'
180	cnh	1.1	STOP 'ABNROMAL END: S/R BARRIER'
181			ENDIF
182			key3(1,myThid) = VALID
183			C
184			IF ( myThid .eq. 1 ) THEN
185			30 CONTINUE
186			nDone = 0
187			DO I=1,nThreads
188			if ( key3(1,I) .EQ. VALID ) nDone = nDone+1
189			ENDDO
190			CALL FOOL_THE_COMPILER( key3 )
191			IF ( nDone .LT. nThreads ) GOTO 30
192			door3 = OPEN
193			ELSE
194			31 CONTINUE
195			CALL FOOL_THE_COMPILER( door3 )
196			IF ( door3 .NE. OPEN ) GOTO 31
197			ENDIF
198
199			C-- Invalidate keys for door3 here as it is now open
200			key3(1,myThid) = INVALID
201
202			C-- I can now shut door2 because I know everyone has reached
203			C-- door3. I can't shut door3 because I don't know if everyone
204			C-- has "gone" through the door yet. Nobody has yet reached
205			C-- door2 because they have to go through door1 first.
206			IF ( myThid .EQ. 1 ) THEN
207			door2 = SHUT
208			ENDIF
209
210			CcnhDebugStarts
211	cnh	1.3	C WRITE(myThid,*) ' Barrier exited '
212	cnh	1.1	CcnhDebugEnds
213
214			RETURN
215			END