/[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.3 by dimitri, Thu Mar 8 21:52:27 2012 UTC revision 1.4 by dimitri, Thu Oct 3 18:37:48 2013 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 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 232  C      find out about processes that did Line 245  C      find out about processes that did
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 243  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.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.22