| 1 | C $Header: /u/gcmpack/MITgcm/eesupp/src/eedie.F,v 1.12 2012/09/01 22:43:55 jmc Exp $ | 
| 2 | C $Name:  $ | 
| 3 |  | 
| 4 | #include "CPP_EEOPTIONS.h" | 
| 5 | #ifdef USE_LIBHPM | 
| 6 | # include "f_hpm.h" | 
| 7 | #endif | 
| 8 |  | 
| 9 | CBOP | 
| 10 | SUBROUTINE EEDIE | 
| 11 | C     *==========================================================* | 
| 12 | C     | SUBROUTINE EEDIE                                         | | 
| 13 | C     | o Close execution "environment", particularly perform    | | 
| 14 | C     |   steps to terminate parallel processing.                | | 
| 15 | C     *==========================================================* | 
| 16 | C     | Note: This routine can also be compiled with CPP         | | 
| 17 | C     | directives set so that no multi-processing is initialised| | 
| 18 | C     | This is OK and should work fine.                         | | 
| 19 | C     *==========================================================* | 
| 20 | IMPLICIT NONE | 
| 21 |  | 
| 22 | C     == Global variables == | 
| 23 | #include "SIZE.h" | 
| 24 | #include "EEPARAMS.h" | 
| 25 | #include "EESUPPORT.h" | 
| 26 | CEOP | 
| 27 |  | 
| 28 | C     == Local variables == | 
| 29 | C     msgBuf       :: I/O Buffer | 
| 30 | C     nThreadsDone :: Used to count number of completed threads. | 
| 31 | C     I            :: Loop counter. | 
| 32 | CHARACTER*(MAX_LEN_MBUF) msgBuf | 
| 33 | INTEGER nThreadsDone | 
| 34 | INTEGER I | 
| 35 | #ifdef ALLOW_USE_MPI | 
| 36 | C     mpiRC        :: Error code reporting variable used with MPI. | 
| 37 | INTEGER mpiRC | 
| 38 | #endif /* ALLOW_USE_MPI */ | 
| 39 |  | 
| 40 | IF ( eeBootError ) THEN | 
| 41 | C--   Skip ended threads counting if earlier error was found | 
| 42 | WRITE(msgBuf,'(2A)') | 
| 43 | &   'EEDIE: earlier error in multi-proc/thread setting' | 
| 44 | CALL PRINT_ERROR( msgBuf, 1 ) | 
| 45 | fatalError = .TRUE. | 
| 46 |  | 
| 47 | ELSE | 
| 48 | C--   Check that all the threads have ended | 
| 49 | C     No thread should reach this loop before all threads have set | 
| 50 | C     threadIsComplete to TRUE. If they do then either there is a bug | 
| 51 | C     in the code or the behaviour of the parallel compiler directives | 
| 52 | C     are not right for this code. In the latter case different | 
| 53 | C     directives may be available or the compiler itself may have a | 
| 54 | C     bug or you may need a different parallel compiler for main.F | 
| 55 | nThreadsDone = 0 | 
| 56 | DO I = 1, nThreads | 
| 57 | IF ( threadIsComplete(I) ) nThreadsDone = nThreadsDone+1 | 
| 58 | ENDDO | 
| 59 | IF ( nThreadsDone .LT. nThreads ) THEN | 
| 60 | WRITE(msgBuf,'(A,I5,A)') | 
| 61 | &    'S/R EEDIE: Only',nThreadsDone,' threads have completed,' | 
| 62 | CALL PRINT_ERROR( msgBuf, 1 ) | 
| 63 | WRITE(msgBuf,'(A,I5,A)') | 
| 64 | &    'S/R EEDIE:',nThreads,' are expected for this config !' | 
| 65 | CALL PRINT_ERROR( msgBuf, 1 ) | 
| 66 | eeEndError = .TRUE. | 
| 67 | fatalError = .TRUE. | 
| 68 | ENDIF | 
| 69 |  | 
| 70 | C--   end if/else eebootError | 
| 71 | ENDIF | 
| 72 |  | 
| 73 | #ifdef USE_LIBHPM | 
| 74 | CALL F_HPMTERMINATE(myProcId) | 
| 75 | #endif | 
| 76 |  | 
| 77 | C--   Flush IO-unit before MPI termination | 
| 78 | CALL MDS_FLUSH( errorMessageUnit, 1 ) | 
| 79 | c#ifdef ALLOW_USE_MPI | 
| 80 | CALL MDS_FLUSH( standardMessageUnit, 1 ) | 
| 81 | c#endif /* ALLOW_USE_MPI */ | 
| 82 |  | 
| 83 | #ifdef ALLOW_USE_MPI | 
| 84 | C- Note: since MPI_INIT is always called, better to also always terminate MPI | 
| 85 | C        (even if usingMPI=F) --> comment out test on usingMPI | 
| 86 | c     IF ( usingMPI ) THEN | 
| 87 |  | 
| 88 | C--   MPI style multiple-process termination | 
| 89 | C--   ====================================== | 
| 90 | #ifdef COMPONENT_MODULE | 
| 91 | IF ( useCoupler) CALL MPI_BARRIER( MPI_COMM_WORLD, mpiRC ) | 
| 92 | #endif | 
| 93 | #ifdef ALLOW_OASIS | 
| 94 | IF ( useOASIS ) CALL OASIS_FINALIZE | 
| 95 | #endif | 
| 96 | CALL MPI_FINALIZE  ( mpiRC ) | 
| 97 | IF ( mpiRC .NE. MPI_SUCCESS ) THEN | 
| 98 | eeEndError = .TRUE. | 
| 99 | fatalError = .TRUE. | 
| 100 | WRITE(msgBuf,'(A,I5)') | 
| 101 | &       'S/R FIN_PROCS: MPI_FINALIZE return code', | 
| 102 | &       mpiRC | 
| 103 | CALL PRINT_ERROR( msgBuf, 1 ) | 
| 104 | ENDIF | 
| 105 |  | 
| 106 | c     ENDIF | 
| 107 | #endif /* ALLOW_USE_MPI */ | 
| 108 |  | 
| 109 | RETURN | 
| 110 | END |