eesupp/src/eedie.F

924557e60a Chri*0001 #include "CPP_EEOPTIONS.h"
37e98ae200 Cons*0002 #ifdef USE_LIBHPM
                0003 # include "f_hpm.h"
                0004 #endif
924557e60a Chri*0005
0dbb1a9119 Jean*0006 CBOP
924557e60a Chri*0007       SUBROUTINE EEDIE
0dbb1a9119 Jean*0008 C     *==========================================================*
924557e60a Chri*0009 C     | SUBROUTINE EEDIE                                         |
                0010 C     | o Close execution "environment", particularly perform    |
                0011 C     |   steps to terminate parallel processing.                |
0dbb1a9119 Jean*0012 C     *==========================================================*
924557e60a Chri*0013 C     | Note: This routine can also be compiled with CPP         |
                0014 C     | directives set so that no multi-processing is initialised|
                0015 C     | This is OK and should work fine.                         |
0dbb1a9119 Jean*0016 C     *==========================================================*
e7ea7a463f Alis*0017       IMPLICIT NONE
924557e60a Chri*0018
                0019 C     == Global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "EESUPPORT.h"
0dbb1a9119 Jean*0023 CEOP
                0024
924557e60a Chri*0025 C     == Local variables ==
d1a155851d Jean*0026 C     msgBuf       :: I/O Buffer
                0027 C     nThreadsDone :: Used to count number of completed threads.
                0028 C     I            :: Loop counter.
924557e60a Chri*0029       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0030       INTEGER nThreadsDone
d1a155851d Jean*0031       INTEGER I
924557e60a Chri*0032 #ifdef ALLOW_USE_MPI
d1a155851d Jean*0033 C     mpiRC        :: Error code reporting variable used with MPI.
924557e60a Chri*0034       INTEGER mpiRC
                0035 #endif /* ALLOW_USE_MPI */
                0036
d1a155851d Jean*0037       IF ( eeBootError ) THEN
                0038 C--   Skip ended threads counting if earlier error was found
                0039         WRITE(msgBuf,'(2A)')
                0040      &   'EEDIE: earlier error in multi-proc/thread setting'
                0041         CALL PRINT_ERROR( msgBuf, 1 )
                0042         fatalError = .TRUE.
                0043
                0044       ELSE
924557e60a Chri*0045 C--   Check that all the threads have ended
                0046 C     No thread should reach this loop before all threads have set
                0047 C     threadIsComplete to TRUE. If they do then either there is a bug
d1a155851d Jean*0048 C     in the code or the behaviour of the parallel compiler directives
                0049 C     are not right for this code. In the latter case different
                0050 C     directives may be available or the compiler itself may have a
46dc4f419b Chri*0051 C     bug or you may need a different parallel compiler for main.F
d1a155851d Jean*0052         nThreadsDone = 0
                0053         DO I = 1, nThreads
                0054          IF ( threadIsComplete(I) ) nThreadsDone = nThreadsDone+1
                0055         ENDDO
                0056         IF ( nThreadsDone .LT. nThreads ) THEN
                0057          WRITE(msgBuf,'(A,I5,A)')
                0058      &    'S/R EEDIE: Only',nThreadsDone,' threads have completed,'
                0059          CALL PRINT_ERROR( msgBuf, 1 )
                0060          WRITE(msgBuf,'(A,I5,A)')
                0061      &    'S/R EEDIE:',nThreads,' are expected for this config !'
                0062          CALL PRINT_ERROR( msgBuf, 1 )
                0063          eeEndError = .TRUE.
                0064          fatalError = .TRUE.
                0065         ENDIF
                0066
                0067 C--   end if/else eebootError
924557e60a Chri*0068       ENDIF
                0069
37e98ae200 Cons*0070 #ifdef USE_LIBHPM
                0071       CALL F_HPMTERMINATE(myProcId)
                0072 #endif
98fff6c8ad Jean*0073
d44e11c489 Jean*0074 C--   Flush IO-unit before MPI termination
                0075       CALL MDS_FLUSH( errorMessageUnit, 1 )
                0076 c#ifdef ALLOW_USE_MPI
                0077       CALL MDS_FLUSH( standardMessageUnit, 1 )
                0078 c#endif /* ALLOW_USE_MPI */
                0079
924557e60a Chri*0080 #ifdef ALLOW_USE_MPI
98fff6c8ad Jean*0081 C- Note: since MPI_INIT is always called, better to also always terminate MPI
                0082 C        (even if usingMPI=F) --> comment out test on usingMPI
                0083 c     IF ( usingMPI ) THEN
                0084
924557e60a Chri*0085 C--   MPI style multiple-process termination
                0086 C--   ======================================
ed584e7d0c Jean*0087 #ifdef COMPONENT_MODULE
                0088        IF ( useCoupler) CALL MPI_BARRIER( MPI_COMM_WORLD, mpiRC )
                0089 #endif
696c4221e9 Mart*0090 #ifdef ALLOW_OASIS
                0091        IF ( useOASIS ) CALL OASIS_FINALIZE
                0092 #endif
924557e60a Chri*0093        CALL MPI_FINALIZE  ( mpiRC )
                0094        IF ( mpiRC .NE. MPI_SUCCESS ) THEN
                0095         eeEndError = .TRUE.
                0096         fatalError = .TRUE.
e7ea7a463f Alis*0097         WRITE(msgBuf,'(A,I5)')
924557e60a Chri*0098      &       'S/R FIN_PROCS: MPI_FINALIZE return code',
                0099      &       mpiRC
                0100         CALL PRINT_ERROR( msgBuf, 1 )
                0101        ENDIF
98fff6c8ad Jean*0102
                0103 c     ENDIF
924557e60a Chri*0104 #endif /* ALLOW_USE_MPI */
                0105
                0106       RETURN
                0107       END