eesupp/src/all_proc_die.F

618f34e4a1 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: ALL_PROC_DIE
                0005
                0006 C     !INTERFACE:
a79317be23 Jean*0007       SUBROUTINE ALL_PROC_DIE( myThArg )
618f34e4a1 Jean*0008
                0009 C     !DESCRIPTION:
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE ALL_PROC_DIE
                0012 C     | o when all process call this routine, die cleanly:
                0013 C     |   set Error-Flag and call MPI finalise
                0014 C     *==========================================================*
                0015 C     | used before a STOP:
                0016 C     | - Only implemented for MPI multi-proc.
                0017 C     | - if some Proc do not call this S/R, MPI will hang.
                0018 C     *==========================================================*
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 C     == Global variables ==
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "EESUPPORT.h"
                0027
                0028 C     !INPUT/OUTPUT PARAMETERS:
a79317be23 Jean*0029 C     myThArg      :: thread argument (= my Thread Id number
                0030 C                  :: or = 0 if called within single-thread section)
                0031       INTEGER myThArg
618f34e4a1 Jean*0032 CEOP
                0033
                0034 C     !FUNCTIONS
                0035       INTEGER  ILNBLNK
                0036       EXTERNAL ILNBLNK
                0037
                0038 C     == Local variables ==
                0039 C     msgBuf       :: I/O Buffer
a79317be23 Jean*0040 C     myThid       :: my Thread Id number
618f34e4a1 Jean*0041       CHARACTER*(MAX_LEN_MBUF) msgBuf
a79317be23 Jean*0042       INTEGER myThid
618f34e4a1 Jean*0043 #ifdef ALLOW_USE_MPI
                0044 C     mpiRC        :: Error code reporting variable used with MPI.
                0045       INTEGER mpiRC
                0046 #endif /* ALLOW_USE_MPI */
                0047
a79317be23 Jean*0048       myThid = MAX(myThArg,1)
618f34e4a1 Jean*0049 C--   Print message
                0050       WRITE(msgBuf,'(A)') 'S/R ALL_PROC_DIE: ending the run'
                0051       CALL PRINT_ERROR( msgBuf, myThid )
                0052
a79317be23 Jean*0053       _BEGIN_MASTER(myThid)
                0054
618f34e4a1 Jean*0055 C--   Finishes
                0056       eeEndError = .TRUE.
                0057       fatalError = .TRUE.
d44e11c489 Jean*0058
                0059 C-    Flush IO-unit before MPI termination
                0060       CALL MDS_FLUSH( errorMessageUnit, myThid )
                0061 c#ifdef ALLOW_USE_MPI
                0062       CALL MDS_FLUSH( standardMessageUnit, myThid )
                0063 c#endif /* ALLOW_USE_MPI */
                0064
618f34e4a1 Jean*0065 #ifdef ALLOW_USE_MPI
98fff6c8ad Jean*0066 C- Note: since MPI_INIT is always called, better to also always terminate MPI
                0067 C        (even if usingMPI=F) --> comment out test on usingMPI
                0068 c     IF ( usingMPI ) THEN
e0cd1908f4 Jean*0069 C     better to avoid this call if multi-components set-up ; otherwise will
                0070 C     hang here since procs of other comp. are not calling MPI_finalize now.
6591b3fcc3 Jean*0071        IF ( .NOT.( useCoupler .OR.
                0072      &             useNEST_PARENT .OR. useNEST_CHILD .OR.
                0073      &             useNest2W_parent .OR. useNest2W_child )
e0cd1908f4 Jean*0074      &    ) THEN
696c4221e9 Mart*0075 #ifdef ALLOW_OASIS
                0076          IF ( useOASIS ) CALL OASIS_ABORT
e048daeea5 Jean*0077 #endif /* ALLOW_OASIS */
618f34e4a1 Jean*0078          CALL MPI_FINALIZE  ( mpiRC )
                0079          IF ( mpiRC .NE. MPI_SUCCESS ) THEN
                0080           WRITE(msgBuf,'(A,I5)')
                0081      &     'S/R FIN_PROCS: MPI_FINALIZE return code', mpiRC
                0082           CALL PRINT_ERROR( msgBuf, myThid )
                0083          ENDIF
e0cd1908f4 Jean*0084        ENDIF
98fff6c8ad Jean*0085 c     ENDIF
618f34e4a1 Jean*0086 #endif /* ALLOW_USE_MPI */
                0087
a79317be23 Jean*0088 C-    Some systems do not always flush the IO buffer to disk.
                0089 C     To fix this, can either close these files (implies not to write
d44e11c489 Jean*0090 C     anything after) or flush the io-unit (done above).
a79317be23 Jean*0091 c       CLOSE( errorMessageUnit )
98fff6c8ad Jean*0092 #ifdef ALLOW_USE_MPI
                0093 C- Note: comment out if usingMPI ... since we always open standardMessageUnit
                0094 C        when ALLOW_USE_MPI is defined, better to flush/close also if usingMPI=F
                0095 cc    IF ( usingMPI ) THEN
a79317be23 Jean*0096 c       CLOSE( standardMessageUnit )
98fff6c8ad Jean*0097 cc    ENDIF
                0098 #endif /* ALLOW_USE_MPI */
a79317be23 Jean*0099
                0100       _END_MASTER(myThid)
                0101
                0102       IF ( myThArg.GE.1 ) THEN
                0103         _BARRIER
                0104       ENDIF
                0105
618f34e4a1 Jean*0106       RETURN
                0107       END