eesupp/src/check_threads.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/check_threads.F,v 1.13 2004/03/27 03:51:50 edhill Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP
C     !ROUTINE: CHECK_THREADS

C     !INTERFACE:
      SUBROUTINE CHECK_THREADS( myThid )
      IMPLICIT NONE

C     !DESCRIPTION:
C     *==========================================================
C     | SUBROUTINE CHECK\_THREADS                                 
C     | o Check that all the threads we need did indeed start.    
C     *========================================================== 
C     | This routine is called during the initialisation phase    
C     | to check whether all the threads have started.            
C     | It is invoked by every thread and if any thread finds an  
C     | error it should set its error flag.                       
C     | Notes:                                                    
C     |  Different mechanisms may be required on different        
C     | platforms to actually perform the check. For example as   
C     | coded here each thread checks for a semaphore set by the  
C     | other threads to see if they are running.                 
C     | It is also possible for a system to schedule threads      
C     | sequentially, unless some system call is made to yield    
C     | the process. This routine would detect this situation too 
C     | and allow a programmer to modify this routine and the     
C     | barrier code to allow threads to be scheduled more        
C     | appropriately.                                            
C     *========================================================== 

C     !USES:
C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"

C     !INPUT PARAMETERS:
C     == Routine arguments ==
C     myThid :: My thread number
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     I :: Loop counter
C     numberThreadRunning :: Count of number of threads this thread
C                            thinks are running.
C     nChecks   :: Number of times checked for all threads. After so
C                  many checks give up and report an error.
C     msgBuffer :: Temp. for preparing text messages.
      INTEGER I
      INTEGER numberThreadsRunning
      INTEGER nChecks
      CHARACTER*(MAX_LEN_MBUF) msgBuffer
CEOP

C
      threadIsRunning(myThid) = .TRUE. 
      nChecks                 = 0
 
   10 CONTINUE
      numberThreadsRunning = 0
      nChecks = nChecks + 1
      DO I = 1, nThreads
       IF ( threadIsRunning(I) )
     &  numberThreadsRunning = numberThreadsRunning+1
      ENDDO
      IF ( nChecks .GT. 10 ) THEN
       thError(myThid) = .TRUE.
       eeBootError     = .TRUE.
       WRITE(msgBuffer,'(A,I5,A,I5,A)')
     &  'S/R INI_CHECK_THREADS: Only ',numberThreadsRunning,
     &  ' thread(s), ',nThreads,' are needed for this configuration!'
        CALL PRINT_ERROR( msgBuffer , myThid)
C--     Not enough threads are running so halt the program.
C       I did not want this here but it is the only place I have found that
C       KAP deadlocks if it there are fewer threads than iterations in a BLOCKED(1)
C       loop. The deadlock appears to be in the routine mppjoin which never 
C       returns. I tried putting the STOP in main or breaking out of the loop in main
C       but this causes KAP to insert a call to mppjoin - which then deadlocks!
        IF ( myThid .EQ. 1 ) THEN
         STOP 'ABNORMAL END: S/R CHECK_THREADS'
        ENDIF
       GOTO 11
      ENDIF
      IF ( numberThreadsRunning .NE. nThreads ) THEN
#ifdef HAVE_SYSTEM
       CALL SYSTEM('sleep 1')
#endif
       GOTO 10
      ENDIF
   11 CONTINUE

C--   check barrier synchronization: 1rst (initial) call.
      CALL BAR_CHECK( 1, myThid )

      RETURN
      END
1	jmc	1.14	C $Header: /u/gcmpack/MITgcm/eesupp/src/check_threads.F,v 1.13 2004/03/27 03:51:50 edhill Exp $
2	adcroft	1.9	C $Name: $
3	cnh	1.1
4			#include "CPP_EEOPTIONS.h"
5
6	cnh	1.10	CBOP
7			C !ROUTINE: CHECK_THREADS
8
9			C !INTERFACE:
10	cnh	1.1	SUBROUTINE CHECK_THREADS( myThid )
11	adcroft	1.4	IMPLICIT NONE
12	cnh	1.1
13	cnh	1.10	C !DESCRIPTION:
14			C *==========================================================
15	edhill	1.13	C \| SUBROUTINE CHECK\_THREADS
16	cnh	1.10	C \| o Check that all the threads we need did indeed start.
17			C *==========================================================
18			C \| This routine is called during the initialisation phase
19			C \| to check whether all the threads have started.
20			C \| It is invoked by every thread and if any thread finds an
21			C \| error it should set its error flag.
22			C \| Notes:
23			C \| Different mechanisms may be required on different
24			C \| platforms to actually perform the check. For example as
25			C \| coded here each thread checks for a semaphore set by the
26			C \| other threads to see if they are running.
27			C \| It is also possible for a system to schedule threads
28			C \| sequentially, unless some system call is made to yield
29			C \| the process. This routine would detect this situation too
30			C \| and allow a programmer to modify this routine and the
31			C \| barrier code to allow threads to be scheduled more
32			C \| appropriately.
33			C *==========================================================
34
35			C !USES:
36			C == Global variables ==
37	cnh	1.1	#include "SIZE.h"
38			#include "EEPARAMS.h"
39			#include "EESUPPORT.h"
40	cnh	1.10
41			C !INPUT PARAMETERS:
42			C == Routine arguments ==
43			C myThid :: My thread number
44	cnh	1.1	INTEGER myThid
45
46	cnh	1.10	C !LOCAL VARIABLES:
47			C == Local variables ==
48			C I :: Loop counter
49			C numberThreadRunning :: Count of number of threads this thread
50			C thinks are running.
51			C nChecks :: Number of times checked for all threads. After so
52			C many checks give up and report an error.
53			C msgBuffer :: Temp. for preparing text messages.
54	cnh	1.1	INTEGER I
55			INTEGER numberThreadsRunning
56			INTEGER nChecks
57			CHARACTER*(MAX_LEN_MBUF) msgBuffer
58	cnh	1.10	CEOP
59
60	cnh	1.1	C
61			threadIsRunning(myThid) = .TRUE.
62			nChecks = 0
63
64			10 CONTINUE
65			numberThreadsRunning = 0
66			nChecks = nChecks + 1
67			DO I = 1, nThreads
68			IF ( threadIsRunning(I) )
69			& numberThreadsRunning = numberThreadsRunning+1
70			ENDDO
71			IF ( nChecks .GT. 10 ) THEN
72			thError(myThid) = .TRUE.
73			eeBootError = .TRUE.
74	adcroft	1.4	WRITE(msgBuffer,'(A,I5,A,I5,A)')
75	cnh	1.1	& 'S/R INI_CHECK_THREADS: Only ',numberThreadsRunning,
76			& ' thread(s), ',nThreads,' are needed for this configuration!'
77			CALL PRINT_ERROR( msgBuffer , myThid)
78			C-- Not enough threads are running so halt the program.
79	cnh	1.3	C I did not want this here but it is the only place I have found that
80	cnh	1.1	C KAP deadlocks if it there are fewer threads than iterations in a BLOCKED(1)
81			C loop. The deadlock appears to be in the routine mppjoin which never
82			C returns. I tried putting the STOP in main or breaking out of the loop in main
83			C but this causes KAP to insert a call to mppjoin - which then deadlocks!
84			IF ( myThid .EQ. 1 ) THEN
85			STOP 'ABNORMAL END: S/R CHECK_THREADS'
86			ENDIF
87			GOTO 11
88			ENDIF
89			IF ( numberThreadsRunning .NE. nThreads ) THEN
90	heimbach	1.7	#ifdef HAVE_SYSTEM
91	cnh	1.1	CALL SYSTEM('sleep 1')
92	adcroft	1.5	#endif
93	cnh	1.1	GOTO 10
94			ENDIF
95			11 CONTINUE
96	adcroft	1.9
97	jmc	1.14	C-- check barrier synchronization: 1rst (initial) call.
98			CALL BAR_CHECK( 1, myThid )
99
100	cnh	1.1	RETURN
101			END