eesupp/src/barrier.F

C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/barrier.F,v 1.9 2001/09/21 03:54:34 cnh Exp $
C $Name:  $

#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
      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

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