eesupp/src/all_proc_die.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: ALL_PROC_DIE

C     !INTERFACE:
      SUBROUTINE ALL_PROC_DIE( myThid )

C     !DESCRIPTION:
C     *==========================================================*
C     | SUBROUTINE ALL_PROC_DIE
C     | o when all process call this routine, die cleanly:
C     |   set Error-Flag and call MPI finalise
C     *==========================================================*
C     | used before a STOP:
C     | - Only implemented for MPI multi-proc.
C     | - if some Proc do not call this S/R, MPI will hang.
C     *==========================================================*

C     !USES:
      IMPLICIT NONE

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

C     !INPUT/OUTPUT PARAMETERS:
C     myThid  :: my Thread Id number
      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
#ifdef ALLOW_USE_MPI
C     mpiRC        :: Error code reporting variable used with MPI.
      INTEGER mpiRC
#endif /* ALLOW_USE_MPI */

C--   Print message
      WRITE(msgBuf,'(A)') 'S/R ALL_PROC_DIE: ending the run'
      CALL PRINT_ERROR( msgBuf, myThid )

C--   Finishes
      eeEndError = .TRUE.
      fatalError = .TRUE.
#ifdef ALLOW_USE_MPI
#ifndef ALWAYS_USE_MPI
      IF ( usingMPI ) THEN
#endif
         CALL MPI_FINALIZE  ( mpiRC )
         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
          WRITE(msgBuf,'(A,I5)')
     &     'S/R FIN_PROCS: MPI_FINALIZE return code', mpiRC
          CALL PRINT_ERROR( msgBuf, myThid )
         ENDIF
#ifndef ALWAYS_USE_MPI
      ENDIF
#endif
#endif /* ALLOW_USE_MPI */

      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: ALL_PROC_DIE
8
9	C !INTERFACE:
10	SUBROUTINE ALL_PROC_DIE( myThid )
11
12	C !DESCRIPTION:
13	C ==========================================================
14	C \| SUBROUTINE ALL_PROC_DIE
15	C \| o when all process call this routine, die cleanly:
16	C \| set Error-Flag and call MPI finalise
17	C ==========================================================
18	C \| used before a STOP:
19	C \| - Only implemented for MPI multi-proc.
20	C \| - if some Proc do not call this S/R, MPI will hang.
21	C ==========================================================
22
23	C !USES:
24	IMPLICIT NONE
25
26	C == Global variables ==
27	#include "SIZE.h"
28	#include "EEPARAMS.h"
29	#include "EESUPPORT.h"
30
31	C !INPUT/OUTPUT PARAMETERS:
32	C myThid :: my Thread Id number
33	INTEGER myThid
34	CEOP
35
36	C !FUNCTIONS
37	INTEGER ILNBLNK
38	EXTERNAL ILNBLNK
39
40	C == Local variables ==
41	C msgBuf :: I/O Buffer
42	C errCount :: error counter
43	CHARACTER*(MAX_LEN_MBUF) msgBuf
44	INTEGER errCount
45	#ifdef ALLOW_USE_MPI
46	C mpiRC :: Error code reporting variable used with MPI.
47	INTEGER mpiRC
48	#endif /* ALLOW_USE_MPI */
49
50	C-- Print message
51	WRITE(msgBuf,'(A)') 'S/R ALL_PROC_DIE: ending the run'
52	CALL PRINT_ERROR( msgBuf, myThid )
53
54	C-- Finishes
55	eeEndError = .TRUE.
56	fatalError = .TRUE.
57	#ifdef ALLOW_USE_MPI
58	#ifndef ALWAYS_USE_MPI
59	IF ( usingMPI ) THEN
60	#endif
61	CALL MPI_FINALIZE ( mpiRC )
62	IF ( mpiRC .NE. MPI_SUCCESS ) THEN
63	WRITE(msgBuf,'(A,I5)')
64	& 'S/R FIN_PROCS: MPI_FINALIZE return code', mpiRC
65	CALL PRINT_ERROR( msgBuf, myThid )
66	ENDIF
67	#ifndef ALWAYS_USE_MPI
68	ENDIF
69	#endif
70	#endif /* ALLOW_USE_MPI */
71
72	RETURN
73	END