1 |
C $Header$ |
C $Header$ |
2 |
C $Name$ |
C $Name$ |
3 |
|
|
4 |
|
#include "PACKAGES_CONFIG.h" |
5 |
#include "CPP_EEOPTIONS.h" |
#include "CPP_EEOPTIONS.h" |
6 |
|
|
7 |
CBOP |
CBOP |
9 |
|
|
10 |
C !INTERFACE: |
C !INTERFACE: |
11 |
SUBROUTINE EEBOOT_MINIMAL |
SUBROUTINE EEBOOT_MINIMAL |
|
IMPLICIT NONE |
|
12 |
|
|
13 |
C !DESCRIPTION: |
C !DESCRIPTION: |
14 |
C *==========================================================* |
C *==========================================================* |
15 |
C | SUBROUTINE EEBOOT\_MINIMAL |
C | SUBROUTINE EEBOOT\_MINIMAL |
16 |
C | o Set an initial environment that is predictable i.e. |
C | o Set an initial environment that is predictable i.e. |
17 |
C | behaves in a similar way on all machines and stable. |
C | behaves in a similar way on all machines and stable. |
18 |
C *==========================================================* |
C *==========================================================* |
19 |
C | Under MPI this routine calls MPI\_INIT to setup the |
C | Under MPI this routine calls MPI\_INIT to setup the |
20 |
C | mpi environment ( on some systems the code is running as |
C | mpi environment ( on some systems the code is running as |
21 |
C | a single process prior to MPI\_INIT, on others the mpirun |
C | a single process prior to MPI\_INIT, on others the mpirun |
22 |
C | script has already created multiple processes). Until |
C | script has already created multiple processes). Until |
23 |
C | MPI\_Init is called it is unclear what state the |
C | MPI\_Init is called it is unclear what state the |
24 |
C | application is in. Once this routine has been run it is |
C | application is in. Once this routine has been run it is |
25 |
C | "safe" to do things like I/O to report erros and to get |
C | "safe" to do things like I/O to report erros and to get |
26 |
C | run parameters. |
C | run parameters. |
27 |
C | Note: This routine can also be compiled with CPP |
C | Note: This routine can also be compiled with CPP |
28 |
C | directives set so that no multi-processing is initialise. |
C | directives set so that no multi-processing is initialise. |
29 |
C | This is OK and will work fine. |
C | This is OK and will work fine. |
30 |
C *==========================================================* |
C *==========================================================* |
31 |
|
|
32 |
C !USES: |
C !USES: |
33 |
|
IMPLICIT NONE |
34 |
C == Global data == |
C == Global data == |
35 |
#include "SIZE.h" |
#include "SIZE.h" |
36 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
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 name of file for standard |
43 |
C output and error output. |
C output and error output. |
44 |
INTEGER myThid |
INTEGER myThid |
45 |
CHARACTER*13 fNam |
CHARACTER*13 fNam |
46 |
#ifdef ALLOW_USE_MPI |
#ifdef ALLOW_USE_MPI |
47 |
C mpiRC :: Error code reporting variable used |
C mpiRC :: Error code reporting variable used with MPI. |
|
C with MPI. |
|
48 |
C msgBuffer :: Used to build messages for printing. |
C msgBuffer :: Used to build messages for printing. |
49 |
CHARACTER*(MAX_LEN_MBUF) msgBuffer |
CHARACTER*(MAX_LEN_MBUF) msgBuffer |
50 |
INTEGER mpiRC |
INTEGER mpiRC |
62 |
integer, dimension(:), allocatable :: components |
integer, dimension(:), allocatable :: components |
63 |
integer, dimension(:), allocatable :: icegroup, oceangroup |
integer, dimension(:), allocatable :: icegroup, oceangroup |
64 |
#endif /* ALLOW_CPL_MPMICE */ |
#endif /* ALLOW_CPL_MPMICE */ |
65 |
|
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD) |
66 |
|
INTEGER mpiMyWid, color |
67 |
|
#endif |
68 |
#endif /* ALLOW_USE_MPI */ |
#endif /* ALLOW_USE_MPI */ |
69 |
CEOP |
CEOP |
70 |
|
|
71 |
C-- Default values set to single processor case |
C-- Default values set to single processor case |
72 |
numberOfProcs = 1 |
numberOfProcs = 1 |
73 |
myProcId = 0 |
myProcId = 0 |
74 |
pidIO = myProcId |
pidIO = myProcId |
75 |
myProcessStr = '------' |
myProcessStr = '------' |
76 |
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 |
77 |
C yet. |
C yet. |
91 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
92 |
WRITE(msgBuffer,'(A,I5)') |
WRITE(msgBuffer,'(A,I5)') |
93 |
& 'S/R EEBOOT_MINIMAL: MPI_INIT return code', |
& 'S/R EEBOOT_MINIMAL: MPI_INIT return code', |
94 |
& mpiRC |
& mpiRC |
95 |
CALL PRINT_ERROR( msgBuffer , myThid) |
CALL PRINT_ERROR( msgBuffer , myThid) |
96 |
GOTO 999 |
GOTO 999 |
97 |
ENDIF |
ENDIF |
101 |
C Pretend that we have asked for a communicator |
C Pretend that we have asked for a communicator |
102 |
MPI_COMM_MODEL = MPI_COMM_WORLD |
MPI_COMM_MODEL = MPI_COMM_WORLD |
103 |
|
|
104 |
|
#ifdef ALLOW_OASIS |
105 |
|
C add a 1rst preliminary call EESET_PARAMS to set useOASIS |
106 |
|
C (needed to decide either to call OASIS_INIT or not) |
107 |
|
CALL EESET_PARMS |
108 |
|
IF ( eeBootError ) GOTO 999 |
109 |
|
IF ( useOASIS ) CALL OASIS_INIT(MPI_COMM_MODEL) |
110 |
|
#endif /* ALLOW_OASIS */ |
111 |
|
|
112 |
#ifdef COMPONENT_MODULE |
#ifdef COMPONENT_MODULE |
113 |
C-- Set the running directory |
C-- Set the running directory |
114 |
CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC ) |
CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC ) |
126 |
IF ( useCoupler) CALL CPL_INIT |
IF ( useCoupler) CALL CPL_INIT |
127 |
#endif |
#endif |
128 |
|
|
129 |
|
C-- Case with Nest(ing) |
130 |
|
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD) |
131 |
|
C-- Set the running directory |
132 |
|
CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC ) |
133 |
|
CALL SETDIR( mpiMyWId ) |
134 |
|
|
135 |
|
C-- Setup Nesting Execution Environment |
136 |
|
CALL NEST_EEINIT( mpiMyWId, color ) |
137 |
|
#endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */ |
138 |
|
|
139 |
#ifdef ALLOW_CPL_MPMICE |
#ifdef ALLOW_CPL_MPMICE |
140 |
CALL SETDIR_OCEAN( ) |
CALL SETDIR_OCEAN( ) |
141 |
call MPI_comm_rank(MPI_COMM_WORLD, myworldid, ierr) |
call MPI_comm_rank(MPI_COMM_WORLD, myworldid, ierr) |
198 |
call MPI_comm_size(MPI_COMM_MODEL,numprocs,ierr) |
call MPI_comm_size(MPI_COMM_MODEL,numprocs,ierr) |
199 |
#endif /* ALLOW_CPL_MPMICE */ |
#endif /* ALLOW_CPL_MPMICE */ |
200 |
|
|
201 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
202 |
|
|
203 |
C-- Get my process number |
C-- Get my process number |
204 |
CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC ) |
CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC ) |
205 |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
206 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
207 |
WRITE(msgBuffer,'(A,I5)') |
WRITE(msgBuffer,'(A,I5)') |
208 |
& 'S/R EEBOOT_MINIMAL: MPI_COMM_RANK return code', |
& 'S/R EEBOOT_MINIMAL: MPI_COMM_RANK return code', |
209 |
& mpiRC |
& mpiRC |
210 |
CALL PRINT_ERROR( msgBuffer , myThid) |
CALL PRINT_ERROR( msgBuffer , myThid) |
211 |
GOTO 999 |
GOTO 999 |
212 |
ENDIF |
ENDIF |
213 |
myProcId = mpiMyId |
myProcId = mpiMyId |
214 |
WRITE(myProcessStr,'(I4.4)') myProcId |
WRITE(myProcessStr,'(I4.4)') myProcId |
215 |
mpiPidIo = myProcId |
mpiPidIo = myProcId |
216 |
pidIO = mpiPidIo |
pidIO = mpiPidIo |
217 |
IF ( mpiPidIo .EQ. myProcId ) THEN |
IF ( mpiPidIo .EQ. myProcId ) THEN |
221 |
OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown') |
OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown') |
222 |
ENDIF |
ENDIF |
223 |
|
|
224 |
|
#if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD) |
225 |
|
WRITE(standardMessageUnit,'(2(A,I6))') |
226 |
|
& ' mpiMyWId =', mpiMyWId, ' , color =',color |
227 |
|
#endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */ |
228 |
|
|
229 |
C-- Synchronise all processes |
C-- Synchronise all processes |
230 |
C Strictly this is superfluous, but by using it we can guarantee to |
C Strictly this is superfluous, but by using it we can guarantee to |
231 |
C find out about processes that did not start up. |
C find out about processes that did not start up. |
232 |
CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC ) |
CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC ) |
233 |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
IF ( mpiRC .NE. MPI_SUCCESS ) THEN |
234 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
235 |
WRITE(msgBuffer,'(A,I6)') |
WRITE(msgBuffer,'(A,I6)') |
236 |
& 'S/R EEBOOT_MINIMAL: MPI_BARRIER return code', |
& 'S/R EEBOOT_MINIMAL: MPI_BARRIER return code', |
237 |
& mpiRC |
& mpiRC |
238 |
CALL PRINT_ERROR( msgBuffer , myThid) |
CALL PRINT_ERROR( msgBuffer , myThid) |
239 |
GOTO 999 |
GOTO 999 |
240 |
ENDIF |
ENDIF |
245 |
eeBootError = .TRUE. |
eeBootError = .TRUE. |
246 |
WRITE(msgBuffer,'(A,I6)') |
WRITE(msgBuffer,'(A,I6)') |
247 |
& 'S/R EEBOOT_MINIMAL: MPI_COMM_SIZE return code', |
& 'S/R EEBOOT_MINIMAL: MPI_COMM_SIZE return code', |
248 |
& mpiRC |
& mpiRC |
249 |
CALL PRINT_ERROR( msgBuffer , myThid) |
CALL PRINT_ERROR( msgBuffer , myThid) |
250 |
GOTO 999 |
GOTO 999 |
251 |
ENDIF |
ENDIF |
284 |
|
|
285 |
#else /* ALLOW_USE_MPI */ |
#else /* ALLOW_USE_MPI */ |
286 |
|
|
287 |
WRITE(myProcessStr,'(I4.4)') myProcId |
WRITE(myProcessStr,'(I4.4)') myProcId |
288 |
WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4) |
WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4) |
289 |
OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown') |
OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown') |
290 |
c WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4) |
c WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4) |
299 |
|
|
300 |
RETURN |
RETURN |
301 |
END |
END |
|
|
|