eesupp/src/stop_if_error.F

C $Header: /u/gcmpack/MITgcm/eesupp/src/stop_if_error.F,v 1.1 2009/04/26 00:16:44 jmc Exp $
C $Name:  $

#include "CPP_EEOPTIONS.h"

CBOP
C     !ROUTINE: STOP_IF_ERROR

C     !INTERFACE:
      SUBROUTINE STOP_IF_ERROR( errFlag, errMsg, myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE STOP_IF_ERROR
C     | o stop every Processes if flag is true
C     *==========================================================*
C     | Presently, gathering of error signal involves a
C     | global_sum which could degrade performance if called too
C     | many times. A potentially faster method (not implemented):
C     | only the proc(s) in error send a non-blocking error signal
C     | to everybody; however, this requires to check for error
C     | signal reception before doing any communication.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     errFlag :: stop if this logical flag is true
C     errMsg  :: error message to print in case it stops
C     myThid  :: my Thread Id number
      LOGICAL errFlag
      CHARACTER*(*) errMsg
      INTEGER myThid
CEOP

C     !FUNCTIONS
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK

C     == Local variables ==
C     msgBuf       :: I/O Buffer
C     errCount     :: error counter
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER errCount

C--   Collect error from all Threads and Procs
      errCount = 0
      IF ( errFlag ) THEN
        errCount = 1
      ENDIF
      CALL GLOBAL_SUM_INT( errCount, myThid )

      IF ( errCount.GE.1 ) THEN
C--   Print message
        IF ( errFlag ) CALL PRINT_ERROR( errMsg, myThid )
        WRITE(msgBuf,'(A,I5,A)')
     &   'occurs', errCount, ' time(s) among all Threads and Procs'
        CALL PRINT_ERROR( msgBuf, myThid )
C--   Finishes
        CALL ALL_PROC_DIE( myThid )
        STOP 'ABNORMAL END: S/R STOP_IF_ERROR'
      ENDIF

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/eesupp/src/stop_if_error.F,v 1.1 2009/04/26 00:16:44 jmc Exp $
2	C $Name: $
3
4	#include "CPP_EEOPTIONS.h"
5
6	CBOP
7	C !ROUTINE: STOP_IF_ERROR
8
9	C !INTERFACE:
10	SUBROUTINE STOP_IF_ERROR( errFlag, errMsg, myThid )
11
12	C !DESCRIPTION:
13	C ==========================================================
14	C \| SUBROUTINE STOP_IF_ERROR
15	C \| o stop every Processes if flag is true
16	C ==========================================================
17	C \| Presently, gathering of error signal involves a
18	C \| global_sum which could degrade performance if called too
19	C \| many times. A potentially faster method (not implemented):
20	C \| only the proc(s) in error send a non-blocking error signal
21	C \| to everybody; however, this requires to check for error
22	C \| signal reception before doing any communication.
23	C ==========================================================
24
25	C !USES:
26	IMPLICIT NONE
27
28	C == Global variables ==
29	#include "SIZE.h"
30	#include "EEPARAMS.h"
31
32	C !INPUT/OUTPUT PARAMETERS:
33	C errFlag :: stop if this logical flag is true
34	C errMsg :: error message to print in case it stops
35	C myThid :: my Thread Id number
36	LOGICAL errFlag
37	CHARACTER() errMsg
38	INTEGER myThid
39	CEOP
40
41	C !FUNCTIONS
42	INTEGER ILNBLNK
43	EXTERNAL ILNBLNK
44
45	C == Local variables ==
46	C msgBuf :: I/O Buffer
47	C errCount :: error counter
48	CHARACTER*(MAX_LEN_MBUF) msgBuf
49	INTEGER errCount
50
51	C-- Collect error from all Threads and Procs
52	errCount = 0
53	IF ( errFlag ) THEN
54	errCount = 1
55	ENDIF
56	CALL GLOBAL_SUM_INT( errCount, myThid )
57
58	IF ( errCount.GE.1 ) THEN
59	C-- Print message
60	IF ( errFlag ) CALL PRINT_ERROR( errMsg, myThid )
61	WRITE(msgBuf,'(A,I5,A)')
62	& 'occurs', errCount, ' time(s) among all Threads and Procs'
63	CALL PRINT_ERROR( msgBuf, myThid )
64	C-- Finishes
65	CALL ALL_PROC_DIE( myThid )
66	STOP 'ABNORMAL END: S/R STOP_IF_ERROR'
67	ENDIF
68
69	RETURN
70	END