C $Header: /u/gcmpack/MITgcm/pkg/compon_communic/mitcplr_all_check.F,v 1.1 2013/12/02 21:35:45 jmc Exp $ C $Name: $ CBOP C !INTERFACE: SUBROUTINE MITCPLR_ALL_CHECK( errFlag, errMsg ) C !DESCRIPTION: C *==========================================================* C | SUBROUTINE MITCPLR_ALL_CHECK C | o Stop every Processes in World if flag is true C *==========================================================* C | Gather error-flag from all processes in World and C | stop if one is in error. This assumes that every-one C | (all coupler procs and all components) call this routine C *==========================================================* IMPLICIT NONE C Predefined constants/arrays #include "CPLR_SIG.h" C MPI variables #include "mpif.h" C !INPUT/OUTPUT PARAMETERS: C errFlag :: stop if this logical flag is true C errMsg :: error message to print in case it stops LOGICAL errFlag CHARACTER*(*) errMsg C !LOCAL VARIABLES: C msgBuf :: I/O Buffer C errCount :: error counter c CHARACTER*(MAX_LEN_MBUF) msgBuf INTEGER errCount, errLoc, mpiRC CEOP C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C-- Collect error from all Procs errLoc = 0 IF ( errFlag ) THEN errLoc = 1 ENDIF CALL MPI_ALLREDUCE( errLoc, errCount, 1, MPI_INTEGER, MPI_SUM, & MPI_COMM_WORLD, mpiRC ) IF ( errCount.GE.1 ) THEN C-- Print message IF ( errFlag .AND. errMsg.NE.' ' ) THEN WRITE(LogUnit,'(2A)') ' *** ERROR *** ', errMsg ENDIF WRITE(LogUnit,'(A,I8,A)') & 'FATAL ERROR for ', errCount, ' Proc(s) ==> Stop here' C-- Finishes c CALL ALL_PROC_DIE( myThid ) CALL MPI_FINALIZE( mpiRC ) STOP 'ABNORMAL END: S/R MITCPLR_ALL_CHECK' ENDIF RETURN END