/[MITgcm]/MITgcm_contrib/MPMice/beaufort/code/eeboot_minimal.F
ViewVC logotype

Diff of /MITgcm_contrib/MPMice/beaufort/code/eeboot_minimal.F

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

revision 1.1 by dimitri, Sun May 31 03:41:36 2009 UTC revision 1.4 by dimitri, Thu Oct 3 18:37:48 2013 UTC
# Line 1  Line 1 
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
# Line 8  C     !ROUTINE: EEBOOT_MINIMAL Line 9  C     !ROUTINE: EEBOOT_MINIMAL
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"
# Line 37  C     == Global data == Line 38  C     == Global data ==
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  C     mpiRC      :: Error code reporting variable used with MPI.
 C                         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
# Line 62  C     msgBuffer        :: Used to build Line 61  C     msgBuffer        :: Used to build
61        integer, dimension(:), allocatable :: components        integer, dimension(:), allocatable :: components
62        integer, dimension(:), allocatable :: icegroup, oceangroup        integer, dimension(:), allocatable :: icegroup, oceangroup
63  #endif /* ALLOW_CPL_MPMICE */  #endif /* ALLOW_CPL_MPMICE */
64    #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
65          INTEGER mpiMyWid, color
66    #endif
67  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
68  CEOP  CEOP
69    
70  C--   Default values set to single processor case  C--   Default values set to single processor case
71        numberOfProcs = 1        numberOfProcs = 1
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    
# Line 97  C--    MPI has now been initialized but Line 115  C--    MPI has now been initialized but
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
121    C      add a 1rst preliminary call EESET_PARAMS to set useOASIS
122    C      (needed to decide either to call OASIS_INIT or not)
123           CALL EESET_PARMS ( doReport )
124           IF ( useOASIS ) CALL OASIS_INIT(MPI_COMM_MODEL)
125    #endif /* ALLOW_OASIS */
126    
127  #ifdef COMPONENT_MODULE  #ifdef COMPONENT_MODULE
128  C--    Set the running directory  C--    Set the running directory
# Line 106  C--    Set the running directory Line 132  C--    Set the running directory
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  #ifdef ALLOW_CPL_MPMICE  C--    Case with Nest(ing)
144    #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
145    C--    Set the running directory
146           CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
147           CALL SETDIR( mpiMyWId )
148    
149    C--    Setup Nesting Execution Environment
150           CALL NEST_EEINIT( mpiMyWId, color )
151    #endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
152    
153    #if defined(ALLOW_CPL_MPMICE) && !defined(CPL_DEBUG)
154         CALL SETDIR_OCEAN( )         CALL SETDIR_OCEAN( )
155         call MPI_comm_rank(MPI_COMM_WORLD, myworldid, ierr)         call MPI_comm_rank(MPI_COMM_WORLD, myworldid, ierr)
156         call MPI_comm_size(MPI_COMM_WORLD, numprocsworld, ierr)         call MPI_comm_size(MPI_COMM_WORLD, numprocsworld, ierr)
# Line 175  C     form ocean communicator Line 210  C     form ocean communicator
210       &      MPI_COMM_MODEL,ierr)       &      MPI_COMM_MODEL,ierr)
211         call MPI_comm_rank(MPI_COMM_MODEL,myid,ierr)         call MPI_comm_rank(MPI_COMM_MODEL,myid,ierr)
212         call MPI_comm_size(MPI_COMM_MODEL,numprocs,ierr)         call MPI_comm_size(MPI_COMM_MODEL,numprocs,ierr)
213  #endif /* ALLOW_CPL_MPMICE */  #endif /* defined(ALLOW_CPL_MPMICE) && !defined(CPL_DEBUG) */
214    
215    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
216    
217  C--    Get my process number  C--    Get my process number
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
227         WRITE(myProcessStr,'(I4.4)') myProcId         WRITE(myProcessStr,'(I4.4)') myProcId
228         mpiPidIo = myProcId         mpiPidIo = myProcId
229         pidIO    = mpiPidIo         pidIO    = mpiPidIo
230         IF ( mpiPidIo .EQ. myProcId ) THEN         IF ( mpiPidIo .EQ. myProcId ) THEN
# Line 198  C--    Get my process number Line 234  C--    Get my process number
234          OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')          OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
235         ENDIF         ENDIF
236    
237    #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
238           WRITE(standardMessageUnit,'(2(A,I6))')
239         &           ' mpiMyWId =', mpiMyWId, ' , color =',color
240    #endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
241    
242  C--    Synchronise all processes  C--    Synchronise all processes
243  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
244  C      find out about processes that did not start up.  C      find out about processes that did not start up.
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    
# Line 215  C--    Get number of MPI processes Line 255  C--    Get number of MPI processes
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
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22