C $Header: /u/gcmpack/MITgcm/eesupp/src/stop_if_error.F,v 1.2 2009/05/26 22:56:32 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
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