pkg/compon_communic/mitcplr_all_check.F

C $Header: /u/gcmpack/MITgcm/pkg/compon_communic/mitcplr_initcomp.F,v 1.2 2007/10/08 23:58:21 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
1	C $Header: /u/gcmpack/MITgcm/pkg/compon_communic/mitcplr_initcomp.F,v 1.2 2007/10/08 23:58:21 jmc Exp $
2	C $Name: $
3
4	CBOP
5	C !INTERFACE:
6	SUBROUTINE MITCPLR_ALL_CHECK( errFlag, errMsg )
7
8	C !DESCRIPTION:
9	C ==========================================================
10	C \| SUBROUTINE MITCPLR_ALL_CHECK
11	C \| o Stop every Processes in World if flag is true
12	C ==========================================================
13	C \| Gather error-flag from all processes in World and
14	C \| stop if one is in error. This assumes that every-one
15	C \| (all coupler procs and all components) call this routine
16	C ==========================================================
17
18	IMPLICIT NONE
19
20	C Predefined constants/arrays
21	#include "CPLR_SIG.h"
22	C MPI variables
23	#include "mpif.h"
24
25	C !INPUT/OUTPUT PARAMETERS:
26	C errFlag :: stop if this logical flag is true
27	C errMsg :: error message to print in case it stops
28	LOGICAL errFlag
29	CHARACTER() errMsg
30
31	C !LOCAL VARIABLES:
32	C msgBuf :: I/O Buffer
33	C errCount :: error counter
34	c CHARACTER*(MAX_LEN_MBUF) msgBuf
35	INTEGER errCount, errLoc, mpiRC
36	CEOP
37
38	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
39
40	C-- Collect error from all Procs
41	errLoc = 0
42	IF ( errFlag ) THEN
43	errLoc = 1
44	ENDIF
45	CALL MPI_Allreduce( errLoc, errCount, 1, MPI_INTEGER, MPI_SUM,
46	& MPI_COMM_WORLD, mpiRC )
47
48	IF ( errCount.GE.1 ) THEN
49	C-- Print message
50	IF ( errFlag .AND. errMsg.NE.' ' ) THEN
51	WRITE(LogUnit,'(2A)') ' * ERROR * ', errMsg
52	ENDIF
53	WRITE(LogUnit,'(A,I8,A)')
54	& 'FATAL ERROR for ', errCount, ' Proc(s) ==> Stop here'
55	C-- Finishes
56	c CALL ALL_PROC_DIE( myThid )
57	CALL MPI_FINALIZE( mpiRC )
58	STOP 'ABNORMAL END: S/R MITCPLR_ALL_CHECK'
59	ENDIF
60
61	RETURN
62	END