38 |
|
|
39 |
C !LOCAL VARIABLES: |
C !LOCAL VARIABLES: |
40 |
C == Local variables == |
C == Local variables == |
41 |
C myThid :: Temp. dummy thread number. |
C myThid :: Temp. dummy thread number. |
42 |
C fNam :: Used to build name of file for standard |
C fNam :: Used to build file name for standard and error output. |
43 |
C output and error output. |
C msgBuf :: Used to build messages for printing. |
44 |
INTEGER myThid |
INTEGER myThid |
45 |
CHARACTER*13 fNam |
CHARACTER*13 fNam |
46 |
|
CHARACTER*(MAX_LEN_MBUF) msgBuf |
47 |
#ifdef ALLOW_USE_MPI |
#ifdef ALLOW_USE_MPI |
48 |
C mpiRC :: Error code reporting variable used with MPI. |
C mpiRC :: Error code reporting variable used with MPI. |
|
C msgBuffer :: Used to build messages for printing. |
|
|
CHARACTER*(MAX_LEN_MBUF) msgBuffer |
|
49 |
INTEGER mpiRC |
INTEGER mpiRC |
50 |
INTEGER nptmp |
LOGICAL doReport |
51 |
#ifdef COMPONENT_MODULE |
#ifdef COMPONENT_MODULE |
52 |
INTEGER mpiMyWid |
INTEGER mpiMyWid |
53 |
#endif |
#endif |
72 |
myProcId = 0 |
myProcId = 0 |
73 |
pidIO = myProcId |
pidIO = myProcId |
74 |
myProcessStr = '------' |
myProcessStr = '------' |
75 |
C Set a dummy value for myThid because we are not multi-threading |
C Set a dummy value for myThid because we are not multi-threading yet. |
|
C yet. |
|
76 |
myThid = 1 |
myThid = 1 |
77 |
|
|
78 |
|
C Annoyingly there is no universal way to have the usingMPI |
79 |
|
C parameter work as one might expect. This is because, on some |
80 |
|
C systems I/O does not work until MPI_Init has been called. |
81 |
|
C The solution for now is that the parameter below may need to |
82 |
|
C be changed manually! |
83 |
#ifdef ALLOW_USE_MPI |
#ifdef ALLOW_USE_MPI |
84 |
C-- |
usingMPI = .TRUE. |
85 |
|
#else |
86 |
|
usingMPI = .FALSE. |
87 |
|
#endif |
88 |
|
|
89 |
|
IF ( .NOT.usingMPI ) THEN |
90 |
|
|
91 |
|
WRITE(myProcessStr,'(I4.4)') myProcId |
92 |
|
WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4) |
93 |
|
OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown') |
94 |
|
c WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4) |
95 |
|
c OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown') |
96 |
|
|
97 |
|
#ifdef ALLOW_USE_MPI |
98 |
|
ELSE |
99 |
C-- MPI style multiple-process initialisation |
C-- MPI style multiple-process initialisation |
100 |
C-- ========================================= |
C-- ========================================= |
101 |
#ifndef ALWAYS_USE_MPI |
|
|
IF ( usingMPI ) THEN |
|
|
#endif |
|
102 |
C-- Initialise MPI multi-process parallel environment. |
C-- Initialise MPI multi-process parallel environment. |
103 |
C On some systems program forks at this point. Others have already |
C On some systems program forks at this point. Others have already |
104 |
C forked within mpirun - now thats an open standard! |
C forked within mpirun - now thats an open standard! |
105 |
CALL MPI_INIT( mpiRC ) |
CALL MPI_INIT( mpiRC ) |
106 |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
107 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
108 |
WRITE(msgBuffer,'(A,I5)') |
WRITE(msgBuf,'(A,I5)') |
109 |
& 'S/R EEBOOT_MINIMAL: MPI_INIT return code', |
& 'EEBOOT_MINIMAL: MPI_INIT return code', mpiRC |
110 |
& mpiRC |
CALL PRINT_ERROR( msgBuf, myThid ) |
|
CALL PRINT_ERROR( msgBuffer , myThid) |
|
111 |
GOTO 999 |
GOTO 999 |
112 |
ENDIF |
ENDIF |
113 |
|
|
115 |
C ask for a communicator or pretend that we have: |
C ask for a communicator or pretend that we have: |
116 |
C Pretend that we have asked for a communicator |
C Pretend that we have asked for a communicator |
117 |
MPI_COMM_MODEL = MPI_COMM_WORLD |
MPI_COMM_MODEL = MPI_COMM_WORLD |
118 |
|
doReport = .FALSE. |
119 |
|
|
120 |
#ifdef ALLOW_OASIS |
#ifdef ALLOW_OASIS |
121 |
C add a 1rst preliminary call EESET_PARAMS to set useOASIS |
C add a 1rst preliminary call EESET_PARAMS to set useOASIS |
122 |
C (needed to decide either to call OASIS_INIT or not) |
C (needed to decide either to call OASIS_INIT or not) |
123 |
CALL EESET_PARMS |
CALL EESET_PARMS ( doReport ) |
|
IF ( eeBootError ) GOTO 999 |
|
124 |
IF ( useOASIS ) CALL OASIS_INIT(MPI_COMM_MODEL) |
IF ( useOASIS ) CALL OASIS_INIT(MPI_COMM_MODEL) |
125 |
#endif /* ALLOW_OASIS */ |
#endif /* ALLOW_OASIS */ |
126 |
|
|
132 |
C- jmc: test: |
C- jmc: test: |
133 |
C add a 1rst preliminary call EESET_PARAMS to set useCoupler |
C add a 1rst preliminary call EESET_PARAMS to set useCoupler |
134 |
C (needed to decide either to call CPL_INIT or not) |
C (needed to decide either to call CPL_INIT or not) |
135 |
CALL EESET_PARMS |
CALL EESET_PARMS ( doReport ) |
|
IF ( eeBootError ) GOTO 999 |
|
136 |
C- jmc: test end ; otherwise, uncomment next line: |
C- jmc: test end ; otherwise, uncomment next line: |
137 |
c useCoupler = .TRUE. |
c useCoupler = .TRUE. |
138 |
|
|
139 |
C-- Ask coupler interface for a communicator |
C-- Ask coupler interface for a communicator |
140 |
IF ( useCoupler) CALL CPL_INIT |
IF ( useCoupler) CALL CPL_INIT |
141 |
#endif |
#endif /* COMPONENT_MODULE */ |
142 |
|
|
143 |
C-- Case with Nest(ing) |
C-- Case with Nest(ing) |
144 |
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD) |
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD) |
218 |
CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC ) |
CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC ) |
219 |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
220 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
221 |
WRITE(msgBuffer,'(A,I5)') |
WRITE(msgBuf,'(A,I5)') |
222 |
& 'S/R EEBOOT_MINIMAL: MPI_COMM_RANK return code', |
& 'EEBOOT_MINIMAL: MPI_COMM_RANK return code', mpiRC |
223 |
& mpiRC |
CALL PRINT_ERROR( msgBuf, myThid ) |
|
CALL PRINT_ERROR( msgBuffer , myThid) |
|
224 |
GOTO 999 |
GOTO 999 |
225 |
ENDIF |
ENDIF |
226 |
myProcId = mpiMyId |
myProcId = mpiMyId |
245 |
CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC ) |
CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC ) |
246 |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
247 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
248 |
WRITE(msgBuffer,'(A,I6)') |
WRITE(msgBuf,'(A,I6)') |
249 |
& 'S/R EEBOOT_MINIMAL: MPI_BARRIER return code', |
& 'EEBOOT_MINIMAL: MPI_BARRIER return code', mpiRC |
250 |
& mpiRC |
CALL PRINT_ERROR( msgBuf, myThid ) |
|
CALL PRINT_ERROR( msgBuffer , myThid) |
|
251 |
GOTO 999 |
GOTO 999 |
252 |
ENDIF |
ENDIF |
253 |
|
|
255 |
CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC ) |
CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC ) |
256 |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
257 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
258 |
WRITE(msgBuffer,'(A,I6)') |
WRITE(msgBuf,'(A,I6)') |
259 |
& 'S/R EEBOOT_MINIMAL: MPI_COMM_SIZE return code', |
& 'EEBOOT_MINIMAL: MPI_COMM_SIZE return code', mpiRC |
260 |
& mpiRC |
CALL PRINT_ERROR( msgBuf, myThid ) |
|
CALL PRINT_ERROR( msgBuffer , myThid) |
|
261 |
GOTO 999 |
GOTO 999 |
262 |
ENDIF |
ENDIF |
263 |
numberOfProcs = mpiNProcs |
numberOfProcs = mpiNProcs |
264 |
|
|
265 |
|
#endif /* ALLOW_USE_MPI */ |
266 |
|
ENDIF |
267 |
|
|
268 |
C-- Can not have more processes than compile time MAX_NO_PROCS |
C-- Can not have more processes than compile time MAX_NO_PROCS |
269 |
IF ( numberOfProcs .GT. MAX_NO_PROCS ) THEN |
IF ( numberOfProcs .GT. MAX_NO_PROCS ) THEN |
270 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
271 |
WRITE(msgBuffer,'(A,2I6)') |
WRITE(msgBuf,'(A,2I6)') |
272 |
& 'S/R EEBOOT_MINIMAL: Nb. of processes exceeds MAX_NO_PROCS', |
& 'EEBOOT_MINIMAL: Nb. of procs exceeds MAX_NO_PROCS', |
273 |
& numberOfProcs, MAX_NO_PROCS |
& numberOfProcs, MAX_NO_PROCS |
274 |
CALL PRINT_ERROR( msgBuffer , myThid) |
CALL PRINT_ERROR( msgBuf, myThid ) |
275 |
WRITE(msgBuffer,'(2A)') |
WRITE(msgBuf,'(2A)') |
276 |
& ' Needs to increase MAX_NO_PROCS', |
& ' Needs to increase MAX_NO_PROCS', |
277 |
& ' in file "EEPARAMS.h" and to re-compile' |
& ' in file "EEPARAMS.h" and to re-compile' |
278 |
CALL PRINT_ERROR( msgBuffer , myThid) |
CALL PRINT_ERROR( msgBuf, myThid ) |
279 |
GOTO 999 |
GOTO 999 |
280 |
ENDIF |
ENDIF |
281 |
C-- Under MPI only allow same number of processes as proc. |
C-- Under MPI only allow same number of processes as proc grid size. |
282 |
C-- grid size. |
C Strictly we are allowed more procs but knowing there |
|
C Strictly we are allowed more procs. but knowing there |
|
283 |
C is an exact match makes things easier. |
C is an exact match makes things easier. |
284 |
IF ( numberOfProcs .NE. nPx*nPy ) THEN |
IF ( numberOfProcs .NE. nPx*nPy ) THEN |
285 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
286 |
nptmp = nPx*nPy |
WRITE(msgBuf,'(2(A,I6))') |
287 |
WRITE(msgBuffer,'(A,2I6)') |
& 'EEBOOT_MINIMAL: No. of procs=', numberOfProcs, |
288 |
& 'S/R EEBOOT_MINIMAL: No. of processes not equal to nPx*nPy', |
& ' not equal to nPx*nPy=', nPx*nPy |
289 |
& numberOfProcs, nptmp |
CALL PRINT_ERROR( msgBuf, myThid ) |
|
CALL PRINT_ERROR( msgBuffer , myThid) |
|
290 |
GOTO 999 |
GOTO 999 |
291 |
ENDIF |
ENDIF |
292 |
|
|
|
#ifndef ALWAYS_USE_MPI |
|
|
ENDIF |
|
|
#endif |
|
|
|
|
|
#else /* ALLOW_USE_MPI */ |
|
|
|
|
|
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') |
|
|
|
|
|
#endif /* ALLOW_USE_MPI */ |
|
293 |
#ifdef USE_LIBHPM |
#ifdef USE_LIBHPM |
294 |
CALL F_HPMINIT(myProcId, "mitgcmuv") |
CALL F_HPMINIT(myProcId, "mitgcmuv") |
295 |
#endif |
#endif |
296 |
|
|
297 |
999 CONTINUE |
999 CONTINUE |
|
|
|
298 |
RETURN |
RETURN |
299 |
END |
END |