/[MITgcm]/MITgcm/eesupp/src/eedie.F
ViewVC logotype

Contents of /MITgcm/eesupp/src/eedie.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.13 - (show annotations) (download)
Thu Oct 11 19:15:18 2012 UTC (11 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.12: +7 -1 lines
- add S/R to flush IO unit (if intrinsic S/R flush is available)
- flush standard & error msg unit before MPI termination
- if debugMode, flush IO unit after printing msg

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

  ViewVC Help
Powered by ViewVC 1.1.22