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

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

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

revision 1.14 by jmc, Sat Jul 29 20:58:31 2006 UTC revision 1.15 by jmc, Thu Sep 1 14:55:24 2011 UTC
# Line 8  C     !ROUTINE: CHECK_THREADS Line 8  C     !ROUTINE: CHECK_THREADS
8    
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE CHECK_THREADS( myThid )        SUBROUTINE CHECK_THREADS( myThid )
       IMPLICIT NONE  
11    
12  C     !DESCRIPTION:  C     !DESCRIPTION:
13  C     *==========================================================  C     *==========================================================
14  C     | SUBROUTINE CHECK\_THREADS                                  C     | SUBROUTINE CHECK\_THREADS
15  C     | o Check that all the threads we need did indeed start.      C     | o Check that all the threads we need did indeed start.
16  C     *==========================================================  C     *==========================================================
17  C     | This routine is called during the initialisation phase      C     | This routine is called during the initialisation phase
18  C     | to check whether all the threads have started.              C     | to check whether all the threads have started.
19  C     | It is invoked by every thread and if any thread finds an    C     | It is invoked by every thread and if any thread finds an
20  C     | error it should set its error flag.                        C     | error it should set its error flag.
21  C     | Notes:                                                      C     | Notes:
22  C     |  Different mechanisms may be required on different          C     |  Different mechanisms may be required on different
23  C     | platforms to actually perform the check. For example as    C     | platforms to actually perform the check. For example as
24  C     | coded here each thread checks for a semaphore set by the    C     | coded here each thread checks for a semaphore set by the
25  C     | other threads to see if they are running.                  C     | other threads to see if they are running.
26  C     | It is also possible for a system to schedule threads        C     | It is also possible for a system to schedule threads
27  C     | sequentially, unless some system call is made to yield      C     | sequentially, unless some system call is made to yield
28  C     | the process. This routine would detect this situation too  C     | the process. This routine would detect this situation too
29  C     | and allow a programmer to modify this routine and the      C     | and allow a programmer to modify this routine and the
30  C     | barrier code to allow threads to be scheduled more          C     | barrier code to allow threads to be scheduled more
31  C     | appropriately.                                              C     | appropriately.
32  C     *==========================================================  C     *==========================================================
33    
34  C     !USES:  C     !USES:
35          IMPLICIT NONE
36  C     == Global variables ==  C     == Global variables ==
37  #include "SIZE.h"  #include "SIZE.h"
38  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 43  C     == Routine arguments == Line 43  C     == Routine arguments ==
43  C     myThid :: My thread number  C     myThid :: My thread number
44        INTEGER myThid        INTEGER myThid
45    
46    C     !FUNCTIONS:
47    #ifdef USE_OMP_THREADING
48          INTEGER  OMP_GET_NUM_THREADS
49          EXTERNAL OMP_GET_NUM_THREADS
50    #endif
51    
52  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
53  C     == Local variables ==  C     == Local variables ==
54  C     I :: Loop counter  C     I         :: Loop counter
55  C     numberThreadRunning :: Count of number of threads this thread  C     numberThreadRunning :: Count of number of threads this thread
56  C                            thinks are running.  C                            thinks are running.
57  C     nChecks   :: Number of times checked for all threads. After so  C     nChecks   :: Number of times checked for all threads. After so
58  C                  many checks give up and report an error.  C                  many checks give up and report an error.
59  C     msgBuffer :: Temp. for preparing text messages.  C     msgBuf    :: Informational/error message buffer
60        INTEGER I        INTEGER I
61        INTEGER numberThreadsRunning        INTEGER numberThreadsRunning
62        INTEGER nChecks        INTEGER nChecks
63        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuf
64  CEOP  CEOP
65    
66  C  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
67        threadIsRunning(myThid) = .TRUE.  
68    #ifdef USE_OMP_THREADING
69    C--   Check early-on that number of threads match
70          IF ( OMP_GET_NUM_THREADS() .NE. nThreads ) THEN
71           WRITE(msgBuf,'(2A,I6)') 'CHECK_THREADS:',
72         &              ' from "eedata", nThreads=', nThreads
73           CALL PRINT_ERROR( msgBuf, myThid )
74           WRITE(msgBuf,'(2A,I6)') ' not equal to ',
75         &              'Env.Var. OMP_NUM_THREADS=', OMP_GET_NUM_THREADS()
76           CALL PRINT_ERROR( msgBuf, myThid )
77    c      CALL ALL_PROC_DIE( myThid )
78    c      _BARRIER
79    c      STOP 'ABNORMAL END: S/R CHECK_THREADS'
80           IF ( myThid.EQ.1 ) STOP 'ABNORMAL END: S/R CHECK_THREADS'
81           GOTO 11
82          ENDIF
83    #endif /* USE_OMP_THREADING */
84    
85          threadIsRunning(myThid) = .TRUE.
86        nChecks                 = 0        nChecks                 = 0
87    
88     10 CONTINUE     10 CONTINUE
89        numberThreadsRunning = 0        numberThreadsRunning = 0
90        nChecks = nChecks + 1        nChecks = nChecks + 1
# Line 71  C Line 95  C
95        IF ( nChecks .GT. 10 ) THEN        IF ( nChecks .GT. 10 ) THEN
96         thError(myThid) = .TRUE.         thError(myThid) = .TRUE.
97         eeBootError     = .TRUE.         eeBootError     = .TRUE.
98         WRITE(msgBuffer,'(A,I5,A,I5,A)')         WRITE(msgBuf,'(A,I5,A,I5,A)')
99       &  'S/R INI_CHECK_THREADS: Only ',numberThreadsRunning,       &  'S/R INI_CHECK_THREADS: Only ',numberThreadsRunning,
100       &  ' thread(s), ',nThreads,' are needed for this configuration!'       &  ' thread(s), ',nThreads,' are needed for this configuration!'
101          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuf, myThid )
102  C--     Not enough threads are running so halt the program.  C--     Not enough threads are running so halt the program.
103  C       I did not want this here but it is the only place I have found that  C       I did not want this here but it is the only place I have found that
104  C       KAP deadlocks if it there are fewer threads than iterations in a BLOCKED(1)  C       KAP deadlocks if it there are fewer threads than iterations in a BLOCKED(1)
105  C       loop. The deadlock appears to be in the routine mppjoin which never  C       loop. The deadlock appears to be in the routine mppjoin which never
106  C       returns. I tried putting the STOP in main or breaking out of the loop in main  C       returns. I tried putting the STOP in main or breaking out of the loop in main
107  C       but this causes KAP to insert a call to mppjoin - which then deadlocks!  C       but this causes KAP to insert a call to mppjoin - which then deadlocks!
108          IF ( myThid .EQ. 1 ) THEN          IF ( myThid .EQ. 1 ) THEN
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22