eesupp/src/check_threads.F

C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/check_threads.F,v 1.9 2001/05/29 14:01:36 adcroft Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#define HAVE_SYSTEM

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
#ifndef TARGET_T3E
#ifndef TARGET_CRAY_VECTOR
       CALL SYSTEM('sleep 1')
#endif
#endif
#endif
       GOTO 10
      ENDIF
   11 CONTINUE

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