eesupp/src/stop_if_error.F

bdad86e11f Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: STOP_IF_ERROR
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE STOP_IF_ERROR( errFlag, errMsg, myThid )
                0008
                0009 C     !DESCRIPTION:
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE STOP_IF_ERROR
                0012 C     | o stop every Processes if flag is true
                0013 C     *==========================================================*
                0014 C     | Presently, gathering of error signal involves a
                0015 C     | global_sum which could degrade performance if called too
                0016 C     | many times. A potentially faster method (not implemented):
                0017 C     | only the proc(s) in error send a non-blocking error signal
                0018 C     | to everybody; however, this requires to check for error
                0019 C     | signal reception before doing any communication.
                0020 C     *==========================================================*
                0021
                0022 C     !USES:
                0023       IMPLICIT NONE
                0024
                0025 C     == Global variables ==
                0026 #include "SIZE.h"
                0027 #include "EEPARAMS.h"
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     errFlag :: stop if this logical flag is true
                0031 C     errMsg  :: error message to print in case it stops
                0032 C     myThid  :: my Thread Id number
                0033       LOGICAL errFlag
                0034       CHARACTER*(*) errMsg
                0035       INTEGER myThid
                0036 CEOP
                0037
                0038 C     !FUNCTIONS
                0039       INTEGER  ILNBLNK
                0040       EXTERNAL ILNBLNK
                0041
                0042 C     == Local variables ==
                0043 C     msgBuf       :: I/O Buffer
                0044 C     errCount     :: error counter
                0045       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0046       INTEGER errCount
                0047
                0048 C--   Collect error from all Threads and Procs
                0049       errCount = 0
                0050       IF ( errFlag ) THEN
                0051         errCount = 1
                0052       ENDIF
                0053       CALL GLOBAL_SUM_INT( errCount, myThid )
                0054
                0055       IF ( errCount.GE.1 ) THEN
                0056 C--   Print message
                0057         IF ( errFlag ) CALL PRINT_ERROR( errMsg, myThid )
                0058         WRITE(msgBuf,'(A,I5,A)')
                0059      &   'occurs', errCount, ' time(s) among all Threads and Procs'
                0060         CALL PRINT_ERROR( msgBuf, myThid )
                0061 C--   Finishes
618f34e4a1 Jean*0062         CALL ALL_PROC_DIE( myThid )
bdad86e11f Jean*0063         STOP 'ABNORMAL END: S/R STOP_IF_ERROR'
                0064       ENDIF
                0065
                0066       RETURN
                0067       END