/[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.2 by dimitri, Wed Dec 21 23:06:07 2011 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 40  C     == Local variables == Line 41  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 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
# Line 62  C     msgBuffer        :: Used to build Line 62  C     msgBuffer        :: Used to build
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.
# Line 88  C      forked within mpirun - now thats Line 91  C      forked within mpirun - now thats
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
# Line 98  C      ask for a communicator or pretend Line 101  C      ask for a communicator or pretend
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 )
# Line 115  C--    Ask coupler interface for a commu Line 126  C--    Ask coupler interface for a commu
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)
# Line 177  C     form ocean communicator Line 198  C     form ocean communicator
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
# Line 198  C--    Get my process number Line 221  C--    Get my process number
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
# Line 217  C--    Get number of MPI processes Line 245  C--    Get number of MPI processes
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
# Line 256  C      is an exact match makes things ea Line 284  C      is an exact match makes things ea
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)
# Line 271  c       OPEN(standardMessageUnit,FILE=fN Line 299  c       OPEN(standardMessageUnit,FILE=fN
299    
300        RETURN        RETURN
301        END        END
   

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

  ViewVC Help
Powered by ViewVC 1.1.22