/[MITgcm]/MITgcm/eesupp/src/check_threads.F
ViewVC logotype

Annotation of /MITgcm/eesupp/src/check_threads.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.12 - (hide annotations) (download)
Tue Nov 11 23:04:50 2003 UTC (20 years, 7 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint52l_pre, hrcube4, hrcube5, checkpoint52d_pre, checkpoint52j_pre, checkpoint52l_post, checkpoint52k_post, checkpoint52f_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint52e_pre, checkpoint52e_post, checkpoint52b_pre, checkpoint52b_post, checkpoint52c_post, checkpoint52f_pre, checkpoint52d_post, checkpoint52a_pre, checkpoint52i_post, checkpoint52h_pre, checkpoint52j_post, branch-netcdf, checkpoint52a_post
Branch point for: netcdf-sm0
Changes since 1.11: +1 -2 lines
 o remove #define

1 edhill 1.12 C $Header: /u/u3/gcmpack/MITgcm/eesupp/src/check_threads.F,v 1.11 2003/11/11 20:38:26 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     C | SUBROUTINE CHECK_THREADS
16     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 cnh 1.1 RETURN
98     END

  ViewVC Help
Powered by ViewVC 1.1.22