/[MITgcm]/MITgcm_contrib/llc_hires/llc_90/code-async/eedie.F
ViewVC logotype

Annotation of /MITgcm_contrib/llc_hires/llc_90/code-async/eedie.F

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


Revision 1.1 - (hide annotations) (download)
Tue Oct 3 00:09:12 2017 UTC (7 years, 9 months ago) by dimitri
Branch: MAIN
CVS Tags: HEAD
Small test case with set-up as similar as possible
to llc_4320 for testing asyncio and coupling to GEOS-5.

1 dimitri 1.1 C $Header: /u/gcmpack/MITgcm_contrib/llc_hires/llc_4320/code-async/eedie.F,v 1.2 2014/03/06 02:45:05 dimitri 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     COMMON /ICOUNTER_COMM/ ICOUNTER
29     INTEGER ICOUNTER
30    
31     C == Local variables ==
32     C msgBuf :: I/O Buffer
33     C nThreadsDone :: Used to count number of completed threads.
34     C I :: Loop counter.
35     CHARACTER*(MAX_LEN_MBUF) msgBuf
36     INTEGER nThreadsDone
37     INTEGER I
38     #ifdef ALLOW_USE_MPI
39     C mpiRC :: Error code reporting variable used with MPI.
40     INTEGER mpiRC
41     #endif /* ALLOW_USE_MPI */
42    
43     IF ( eeBootError ) THEN
44     C-- Skip ended threads counting if earlier error was found
45     WRITE(msgBuf,'(2A)')
46     & 'EEDIE: earlier error in multi-proc/thread setting'
47     CALL PRINT_ERROR( msgBuf, 1 )
48     fatalError = .TRUE.
49    
50     ELSE
51     C-- Check that all the threads have ended
52     C No thread should reach this loop before all threads have set
53     C threadIsComplete to TRUE. If they do then either there is a bug
54     C in the code or the behaviour of the parallel compiler directives
55     C are not right for this code. In the latter case different
56     C directives may be available or the compiler itself may have a
57     C bug or you may need a different parallel compiler for main.F
58     nThreadsDone = 0
59     DO I = 1, nThreads
60     IF ( threadIsComplete(I) ) nThreadsDone = nThreadsDone+1
61     ENDDO
62     IF ( nThreadsDone .LT. nThreads ) THEN
63     WRITE(msgBuf,'(A,I5,A)')
64     & 'S/R EEDIE: Only',nThreadsDone,' threads have completed,'
65     CALL PRINT_ERROR( msgBuf, 1 )
66     WRITE(msgBuf,'(A,I5,A)')
67     & 'S/R EEDIE:',nThreads,' are expected for this config !'
68     CALL PRINT_ERROR( msgBuf, 1 )
69     eeEndError = .TRUE.
70     fatalError = .TRUE.
71     ENDIF
72    
73     C-- end if/else eebootError
74     ENDIF
75    
76     #ifdef USE_LIBHPM
77     CALL F_HPMTERMINATE(myProcId)
78     #endif
79    
80     C-- Flush IO-unit before MPI termination
81     CALL MDS_FLUSH( errorMessageUnit, 1 )
82     c#ifdef ALLOW_USE_MPI
83     CALL MDS_FLUSH( standardMessageUnit, 1 )
84     c#endif /* ALLOW_USE_MPI */
85    
86     #ifdef ALLOW_USE_MPI
87     C- Note: since MPI_INIT is always called, better to also always terminate MPI
88     C (even if usingMPI=F) --> comment out test on usingMPI
89     c IF ( usingMPI ) THEN
90    
91     C-- MPI style multiple-process termination
92     C-- ======================================
93     #ifdef COMPONENT_MODULE
94     IF ( useCoupler) CALL MPI_BARRIER( MPI_COMM_WORLD, mpiRC )
95     #endif
96     #ifdef ALLOW_ASYNCIO
97     IF ( myPid .EQ. 0 ) THEN
98     ICOUNTER = ICOUNTER + 1
99     CALL ASYNCIO_BRON_F_F4( ICOUNTER )
100     ENDIF
101     C! CALL MPI_BARRIER( MPI_COMM_WORLD, mpiRC )
102     #endif
103     #ifdef ALLOW_OASIS
104     IF ( useOASIS ) CALL OASIS_FINALIZE
105     #endif
106     CALL MPI_FINALIZE ( mpiRC )
107     IF ( mpiRC .NE. MPI_SUCCESS ) THEN
108     eeEndError = .TRUE.
109     fatalError = .TRUE.
110     WRITE(msgBuf,'(A,I5)')
111     & 'S/R FIN_PROCS: MPI_FINALIZE return code',
112     & mpiRC
113     CALL PRINT_ERROR( msgBuf, 1 )
114     ENDIF
115    
116     c ENDIF
117     #endif /* ALLOW_USE_MPI */
118    
119     RETURN
120     END

  ViewVC Help
Powered by ViewVC 1.1.22