forked from altMITgcm/MITgcm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
eeboot_minimal.F
275 lines (242 loc) · 9.15 KB
/
eeboot_minimal.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
C $Header: /u/gcmpack/MITgcm/eesupp/src/eeboot_minimal.F,v 1.31 2017/07/26 21:23:07 jmc Exp $
C $Name: $
#include "PACKAGES_CONFIG.h"
#include "CPP_EEOPTIONS.h"
CBOP
C !ROUTINE: EEBOOT_MINIMAL
C !INTERFACE:
SUBROUTINE EEBOOT_MINIMAL( myComm )
C !DESCRIPTION:
C *==========================================================*
C | SUBROUTINE EEBOOT\_MINIMAL
C | o Set an initial environment that is predictable i.e.
C | behaves in a similar way on all machines and stable.
C *==========================================================*
C | Under MPI this routine calls MPI\_INIT to setup the
C | mpi environment ( on some systems the code is running as
C | a single process prior to MPI\_INIT, on others the mpirun
C | script has already created multiple processes). Until
C | MPI\_Init is called it is unclear what state the
C | application is in. Once this routine has been run it is
C | "safe" to do things like I/O to report erros and to get
C | run parameters.
C | Note: This routine can also be compiled with CPP
C | directives set so that no multi-processing is initialise.
C | This is OK and will work fine.
C *==========================================================*
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "EESUPPORT.h"
C !ROUTINE ARGUMENTS
C == Routine arguments ==
C myComm :: Communicator that is passed down from
C upper level driver (if there is one).
INTEGER myComm
C !LOCAL VARIABLES:
C == Local variables ==
C myThid :: Temp. dummy thread number.
C fNam :: Used to build file name for standard and error output.
C msgBuf :: Used to build messages for printing.
INTEGER myThid
#ifdef USE_PDAF
CHARACTER*18 fNam
#else
CHARACTER*13 fNam
#endif /* USE_PDAF */
CHARACTER*(MAX_LEN_MBUF) msgBuf
#ifdef ALLOW_USE_MPI
C mpiRC :: Error code reporting variable used with MPI.
INTEGER mpiRC
INTEGER mpiIsInitialized
LOGICAL doReport
#if defined(ALLOW_OASIS) || defined(COMPONENT_MODULE)
INTEGER mpiMyWid
#endif
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
INTEGER mpiMyWid, color
#endif
#ifdef USE_PDAF
INTEGER mpi_task_id
#endif /* USE_PDAF */
#endif /* ALLOW_USE_MPI */
CEOP
C-- Default values set to single processor case
numberOfProcs = 1
myProcId = 0
pidIO = myProcId
myProcessStr = '------'
C Set a dummy value for myThid because we are not multi-threading yet.
myThid = 1
C Annoyingly there is no universal way to have the usingMPI
C parameter work as one might expect. This is because, on some
C systems I/O does not work until MPI_Init has been called.
C The solution for now is that the parameter below may need to
C be changed manually!
#ifdef ALLOW_USE_MPI
usingMPI = .TRUE.
#else
usingMPI = .FALSE.
#endif
IF ( .NOT.usingMPI ) THEN
WRITE(myProcessStr,'(I4.4)') myProcId
WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
c WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
c OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
#ifdef ALLOW_USE_MPI
ELSE
C-- MPI style multiple-process initialisation
C-- =========================================
CALL MPI_Initialized( mpiIsInitialized, mpiRC )
IF ( mpiIsInitialized .EQ. 0 ) THEN
C-- Initialise MPI multi-process parallel environment.
C On some systems program forks at this point. Others have already
C forked within mpirun - now thats an open standard!
CALL MPI_INIT( mpiRC )
IF ( mpiRC .NE. MPI_SUCCESS ) THEN
eeBootError = .TRUE.
WRITE(msgBuf,'(A,I5)')
& 'EEBOOT_MINIMAL: MPI_INIT return code', mpiRC
CALL PRINT_ERROR( msgBuf, myThid )
GOTO 999
ENDIF
C-- MPI has now been initialized ; now we need to either
C ask for a communicator or pretend that we have:
C Pretend that we have asked for a communicator
MPI_COMM_MODEL = MPI_COMM_WORLD
ELSE
C-- MPI was already initialized and communicator has been passed
C down from upper level driver
MPI_COMM_MODEL = myComm
ENDIF
doReport = .FALSE.
#ifdef USE_PDAF
C initialize PDAF
C for more output increase second parameter from 1 to 2
CALL INIT_PARALLEL_PDAF(0, 1, MPI_COMM_MODEL, MPI_COMM_MODEL,
& mpi_task_id)
#endif /* USE_PDAF */
#ifdef ALLOW_OASIS
C add a 1rst preliminary call EESET_PARAMS to set useOASIS
C (needed to decide either to call OASIS_INIT or not)
CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
CALL EESET_PARMS ( mpiMyWId, doReport )
IF ( useOASIS ) CALL OASIS_INIT(MPI_COMM_MODEL)
#endif /* ALLOW_OASIS */
#ifdef COMPONENT_MODULE
C-- Set the running directory
CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
CALL SETDIR( mpiMyWId )
C- jmc: test:
C add a 1rst preliminary call EESET_PARAMS to set useCoupler
C (needed to decide either to call CPL_INIT or not)
CALL EESET_PARMS ( mpiMyWId, doReport )
C- jmc: test end ; otherwise, uncomment next line:
c useCoupler = .TRUE.
C-- Ask coupler interface for a communicator
IF ( useCoupler) CALL CPL_INIT
#endif /* COMPONENT_MODULE */
C-- Case with Nest(ing)
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
C-- Set the running directory
CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
CALL SETDIR( mpiMyWId )
C-- Setup Nesting Execution Environment
CALL NEST_EEINIT( mpiMyWId, color )
#endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-- Get my process number
CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC )
IF ( mpiRC .NE. MPI_SUCCESS ) THEN
eeBootError = .TRUE.
WRITE(msgBuf,'(A,I5)')
& 'EEBOOT_MINIMAL: MPI_COMM_RANK return code', mpiRC
CALL PRINT_ERROR( msgBuf, myThid )
GOTO 999
ENDIF
myProcId = mpiMyId
#ifdef USE_PDAF
WRITE(myProcessStr,'(I4.4,A1,I4.4)') mpi_task_id,'.',myProcId
#else
WRITE(myProcessStr,'(I4.4)') myProcId
#endif /* USE_PDAF */
mpiPidIo = myProcId
pidIO = mpiPidIo
IF ( mpiPidIo .EQ. myProcId ) THEN
#ifdef SINGLE_DISK_IO
IF( myProcId .EQ. 0 ) THEN
#endif
WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
#ifdef USE_PDAF
WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:9)
#endif
OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
#ifdef USE_PDAF
WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:9)
#endif
OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
#ifdef SINGLE_DISK_IO
ELSE
OPEN(errorMessageUnit,FILE='/dev/null',STATUS='unknown')
standardMessageUnit=errorMessageUnit
ENDIF
IF( myProcId .EQ. 0 ) THEN
WRITE(msgBuf,'(2A)') '** WARNING ** EEBOOT_MINIMAL: ',
& 'defined SINGLE_DISK_IO will result in losing'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE(msgBuf,'(2A)') '** WARNING ** EEBOOT_MINIMAL: ',
& 'any message (error/warning) from any proc <> 0'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
#endif
ENDIF
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
WRITE(standardMessageUnit,'(2(A,I6))')
& ' mpiMyWId =', mpiMyWId, ' , color =',color
#endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
C-- Synchronise all processes
C Strictly this is superfluous, but by using it we can guarantee to
C find out about processes that did not start up.
CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )
IF ( mpiRC .NE. MPI_SUCCESS ) THEN
eeBootError = .TRUE.
WRITE(msgBuf,'(A,I6)')
& 'EEBOOT_MINIMAL: MPI_BARRIER return code', mpiRC
CALL PRINT_ERROR( msgBuf, myThid )
GOTO 999
ENDIF
C-- Get number of MPI processes
CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )
IF ( mpiRC .NE. MPI_SUCCESS ) THEN
eeBootError = .TRUE.
WRITE(msgBuf,'(A,I6)')
& 'EEBOOT_MINIMAL: MPI_COMM_SIZE return code', mpiRC
CALL PRINT_ERROR( msgBuf, myThid )
GOTO 999
ENDIF
numberOfProcs = mpiNProcs
#endif /* ALLOW_USE_MPI */
ENDIF
C-- Under MPI only allow same number of processes as proc grid size.
C Strictly we are allowed more procs but knowing there
C is an exact match makes things easier.
IF ( numberOfProcs .NE. nPx*nPy ) THEN
eeBootError = .TRUE.
WRITE(msgBuf,'(2(A,I6))')
& 'EEBOOT_MINIMAL: No. of procs=', numberOfProcs,
& ' not equal to nPx*nPy=', nPx*nPy
CALL PRINT_ERROR( msgBuf, myThid )
GOTO 999
ENDIF
#ifdef USE_LIBHPM
CALL F_HPMINIT(myProcId, "mitgcmuv")
#endif
999 CONTINUE
RETURN
END