eesupp/src/check_threads.F

C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/check_threads.F,v 1.8.2.1 2001/04/12 10:52:48 cnh Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"
#define HAVE_SYSTEM

CStartOfInterface
      SUBROUTINE CHECK_THREADS( myThid )
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     \==========================================================/
      IMPLICIT NONE

C     === Global data ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
C     === Routine areguments ===
C     myThid - My thread number
      INTEGER myThid

CEndOfInterface

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