/[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.2 by dimitri, Wed Dec 21 23:06:07 2011 UTC revision 1.5 by dimitri, Sat Oct 4 03:24:19 2014 UTC
# Line 38  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 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
# Line 73  C--   Default values set to single proce Line 72  C--   Default values set to single proce
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 100  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  #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    
# Line 117  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  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)
# Line 136  C--    Setup Nesting Execution Environme Line 150  C--    Setup Nesting Execution Environme
150         CALL NEST_EEINIT( mpiMyWId, color )         CALL NEST_EEINIT( mpiMyWId, color )
151  #endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */  #endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
152    
153  #ifdef ALLOW_CPL_MPMICE  #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 196  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-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
216    
# Line 204  C--    Get my process number Line 218  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
# Line 215  C--    Get my process number Line 228  C--    Get my process number
228         mpiPidIo = myProcId         mpiPidIo = myProcId
229         pidIO    = mpiPidIo         pidIO    = mpiPidIo
230         IF ( mpiPidIo .EQ. myProcId ) THEN         IF ( mpiPidIo .EQ. myProcId ) THEN
231          WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)  #ifdef SINGLE_DISK_IO
232          OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')          IF( myProcId .EQ. 0 ) THEN
233          WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)  #endif
234          OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')           WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
235             OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
236             WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
237             OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
238    #ifdef SINGLE_DISK_IO
239            ELSE
240             OPEN(errorMessageUnit,FILE='/dev/null',STATUS='unknown')
241             standardMessageUnit=errorMessageUnit
242            ENDIF
243            IF( myProcId .EQ. 0 ) THEN
244              WRITE(msgBuf,'(2A)') '** WARNING ** EEBOOT_MINIMAL: ',
245         &     'defined SINGLE_DISK_IO will result in losing'
246              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
247         &                        SQUEEZE_RIGHT, myThid )
248              WRITE(msgBuf,'(2A)') '** WARNING ** EEBOOT_MINIMAL: ',
249         &     'any message (error/warning) from any proc <> 0'
250              CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
251         &                        SQUEEZE_RIGHT, myThid )
252            ENDIF
253    #endif
254         ENDIF         ENDIF
255    
256  #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)  #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
# Line 232  C      find out about processes that did Line 264  C      find out about processes that did
264         CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )         CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )
265         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
266          eeBootError = .TRUE.          eeBootError = .TRUE.
267          WRITE(msgBuffer,'(A,I6)')          WRITE(msgBuf,'(A,I6)')
268       &        'S/R EEBOOT_MINIMAL: MPI_BARRIER return code',       &        'EEBOOT_MINIMAL: MPI_BARRIER return code', mpiRC
269       &        mpiRC          CALL PRINT_ERROR( msgBuf, myThid )
         CALL PRINT_ERROR( msgBuffer , myThid)  
270          GOTO 999          GOTO 999
271         ENDIF         ENDIF
272    
# Line 243  C--    Get number of MPI processes Line 274  C--    Get number of MPI processes
274         CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )         CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )
275         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
276          eeBootError = .TRUE.          eeBootError = .TRUE.
277          WRITE(msgBuffer,'(A,I6)')          WRITE(msgBuf,'(A,I6)')
278       &        'S/R EEBOOT_MINIMAL: MPI_COMM_SIZE return code',       &        'EEBOOT_MINIMAL: MPI_COMM_SIZE return code', mpiRC
279       &        mpiRC          CALL PRINT_ERROR( msgBuf, myThid )
         CALL PRINT_ERROR( msgBuffer , myThid)  
280          GOTO 999          GOTO 999
281         ENDIF         ENDIF
282         numberOfProcs = mpiNProcs         numberOfProcs = mpiNProcs
283    
284  C--    Can not have more processes than compile time MAX_NO_PROCS  #endif /* ALLOW_USE_MPI */
285         IF ( numberOfProcs .GT. MAX_NO_PROCS ) THEN        ENDIF
286          eeBootError = .TRUE.  
287          WRITE(msgBuffer,'(A,2I6)')  C--    Under MPI only allow same number of processes as proc grid size.
288       &    'S/R EEBOOT_MINIMAL: Nb. of processes exceeds MAX_NO_PROCS',  C      Strictly we are allowed more procs but knowing there
      &    numberOfProcs, MAX_NO_PROCS  
         CALL PRINT_ERROR( msgBuffer , myThid)  
         WRITE(msgBuffer,'(2A)')  
      &    ' Needs to increase MAX_NO_PROCS',  
      &    ' in file "EEPARAMS.h" and to re-compile'  
         CALL PRINT_ERROR( msgBuffer , myThid)  
         GOTO 999  
        ENDIF  
 C--    Under MPI only allow same number of processes as proc.  
 C--    grid size.  
 C      Strictly we are allowed more procs. but knowing there  
289  C      is an exact match makes things easier.  C      is an exact match makes things easier.
290         IF ( numberOfProcs .NE. nPx*nPy ) THEN         IF ( numberOfProcs .NE. nPx*nPy ) THEN
291          eeBootError = .TRUE.          eeBootError = .TRUE.
292          nptmp = nPx*nPy          WRITE(msgBuf,'(2(A,I6))')
293          WRITE(msgBuffer,'(A,2I6)')       &  'EEBOOT_MINIMAL: No. of procs=', numberOfProcs,
294       &  'S/R EEBOOT_MINIMAL: No. of processes not equal to nPx*nPy',       &  ' not equal to nPx*nPy=', nPx*nPy
295       &  numberOfProcs, nptmp          CALL PRINT_ERROR( msgBuf, myThid )
         CALL PRINT_ERROR( msgBuffer , myThid)  
296          GOTO 999          GOTO 999
297         ENDIF         ENDIF
298    
 #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 */  
299  #ifdef USE_LIBHPM  #ifdef USE_LIBHPM
300          CALL F_HPMINIT(myProcId, "mitgcmuv")         CALL F_HPMINIT(myProcId, "mitgcmuv")
301  #endif  #endif
302    
303   999  CONTINUE   999  CONTINUE
   
304        RETURN        RETURN
305        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22