/[MITgcm]/MITgcm/eesupp/src/eeboot_minimal.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/eeboot_minimal.F

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

revision 1.5 by adcroft, Mon Mar 22 17:37:42 1999 UTC revision 1.12 by jmc, Tue Jan 27 15:59:23 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6  CStartOfInterface  CBOP
7    C     !ROUTINE: EEBOOT_MINIMAL
8    
9    C     !INTERFACE:
10        SUBROUTINE EEBOOT_MINIMAL        SUBROUTINE EEBOOT_MINIMAL
11  C     /==========================================================\        IMPLICIT NONE
12  C     | SUBROUTINE EEBOOT_MINIMAL                                |  
13  C     | o Set an initial environment that is predictable i.e.    |  C     !DESCRIPTION:
14  C     | behaves in a similar way on all machines and stable.     |  C     *==========================================================*
15  C     |==========================================================|  C     | SUBROUTINE EEBOOT_MINIMAL                                
16  C     | Under MPI this routine calls MPI_INIT to setup the       |  C     | o Set an initial environment that is predictable i.e.    
17  C     | mpi environment ( on some systems the code is running as |  C     | behaves in a similar way on all machines and stable.      
18  C     | a single process prior to MPI_INIT, on others the mpirun |  C     *==========================================================*
19  C     | script has already created multiple processes). Until    |  C     | Under MPI this routine calls MPI_INIT to setup the        
20  C     | MPI_Init is called it is unclear what state the          |  C     | mpi environment ( on some systems the code is running as  
21  C     | application is in. Once this routine has been run it is  |  C     | a single process prior to MPI_INIT, on others the mpirun  
22  C     | "safe" to do things like I/O to report erros and to get  |  C     | script has already created multiple processes). Until    
23  C     | run parameters.                                          |  C     | MPI_Init is called it is unclear what state the          
24  C     | Note: This routine can also be compiled with CPP         |  C     | application is in. Once this routine has been run it is  
25  C     | directives set so that no multi-processing is initialise.|  C     | "safe" to do things like I/O to report erros and to get  
26  C     | This is OK and should work fine.                         |  C     | run parameters.                                          
27  C     \==========================================================/  C     | Note: This routine can also be compiled with CPP          
28    C     | directives set so that no multi-processing is initialise.
29    C     | This is OK and will work fine.                          
30    C     *==========================================================*
31    
32  C     === Global data ===  C     !USES:
33    C     == Global data ==
34  #include "SIZE.h"  #include "SIZE.h"
35  #include "EEPARAMS.h"  #include "EEPARAMS.h"
36  #include "EESUPPORT.h"  #include "EESUPPORT.h"
37    
38  CEndOfInterface  C     !LOCAL VARIABLES:
39    C     == Local variables ==
40  C     === Local variables ===  C     myThid           :: Temp. dummy thread number.
41    C     fNam             :: Used to build name of file for standard
42    C                         output and error output.
43        INTEGER myThid            INTEGER myThid    
44          CHARACTER*13 fNam
45  #ifdef ALLOW_USE_MPI  #ifdef ALLOW_USE_MPI
46  C     mpiRC            - Error code reporting variable used  C     mpiRC            :: Error code reporting variable used
47  C                        with MPI.  C                         with MPI.
48  C     fNam             - Used to build name of file for standard  C     msgBuffer        :: Used to build messages for printing.
 C                        output and error output.  
 C     msgBuffer        - Used to build messages for printing.  
49        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuffer
50        INTEGER mpiRC        INTEGER mpiRC
51        CHARACTER*13 fNam        INTEGER nptmp
52  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
53    CEOP
54    
55  C--   Default values set to single processor case  C--   Default values set to single processor case
56        numberOfProcs = 1        numberOfProcs = 1
57        myProcId      = 0        myProcId      = 0
58        pidIO         = myProcId        pidIO         = myProcId
59        myProcessStr  = '??????'        myProcessStr  = '------'
60  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
61  C     yet.  C     yet.
62        myThid        = 1        myThid        = 1
# Line 63  C      forked within mpirun - now thats Line 73  C      forked within mpirun - now thats
73         CALL MPI_INIT( mpiRC )         CALL MPI_INIT( mpiRC )
74         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
75          eeBootError = .TRUE.          eeBootError = .TRUE.
76          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
77       &        'S/R INI_PROCS: MPI_INIT return code',       &        'S/R INI_PROCS: MPI_INIT return code',
78       &        mpiRC       &        mpiRC
79          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
80          GOTO 999          GOTO 999
81         ENDIF         ENDIF
82    
83  C--    MPI has now been initialized but now we need to either  C--    MPI has now been initialized but now we need to either
84  C      ask for a communicator or pretend that we have:  C      ask for a communicator or pretend that we have:
 C      Ask coupler interface for a communicator  
 c      call MITCOMPONENT_init( 'MITgcmUV', MPI_COMM_MODEL )  
85  C      Pretend that we have asked for a communicator  C      Pretend that we have asked for a communicator
86         MPI_COMM_MODEL = MPI_COMM_WORLD         MPI_COMM_MODEL = MPI_COMM_WORLD
87    #ifdef COMPONENT_MODULE
88    C- jmc: test:
89    C      add a 1rst preliminary call EESET_PARAMS to set useCoupler
90    C      (needed to decide either to call CPL_INIT or not)
91           CALL EESET_PARMS
92           IF ( eeBootError ) GOTO 999
93    C- jmc: test end ; otherwise, uncomment next line:
94    c      useCoupler = .TRUE.
95    C--    Ask coupler interface for a communicator
96           IF ( useCoupler) CALL CPL_INIT
97    #endif
98    
99  C--    Get my process number  C--    Get my process number
100         CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC )         CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC )
101         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
102          eeBootError = .TRUE.          eeBootError = .TRUE.
103          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
104       &        'S/R INI_PROCS: MPI_COMM_RANK return code',       &        'S/R INI_PROCS: MPI_COMM_RANK return code',
105       &        mpiRC       &        mpiRC
106          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 103  C      find out about processes that did Line 123  C      find out about processes that did
123         CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )         CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )
124         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
125          eeBootError = .TRUE.          eeBootError = .TRUE.
126          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
127       &        'S/R INI_PROCS: MPI_BARRIER return code',       &        'S/R INI_PROCS: MPI_BARRIER return code',
128       &        mpiRC       &        mpiRC
129          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 114  C--    Get number of MPI processes Line 134  C--    Get number of MPI processes
134         CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )         CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )
135         IF ( mpiRC .NE. MPI_SUCCESS ) THEN         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
136          eeBootError = .TRUE.          eeBootError = .TRUE.
137          WRITE(msgBuffer,'(A,I)')          WRITE(msgBuffer,'(A,I5)')
138       &        'S/R INI_PROCS: MPI_COMM_SIZE return code',       &        'S/R INI_PROCS: MPI_COMM_SIZE return code',
139       &        mpiRC       &        mpiRC
140          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
# Line 136  C      Strictly we are allowed more proc Line 156  C      Strictly we are allowed more proc
156  C      is an exact match makes things easier.  C      is an exact match makes things easier.
157         IF ( numberOfProcs .NE. nPx*nPy ) THEN         IF ( numberOfProcs .NE. nPx*nPy ) THEN
158          eeBootError = .TRUE.          eeBootError = .TRUE.
159          WRITE(msgBuffer,'(A)')          nptmp = nPx*nPy
160       &  'S/R INI_PROCS: No. of processes not equal to nPx*nPy'          WRITE(msgBuffer,'(A,2I5)')
161         &  'S/R INI_PROCS: No. of processes not equal to nPx*nPy',
162         &  numberOfProcs, nptmp
163          CALL PRINT_ERROR( msgBuffer , myThid)          CALL PRINT_ERROR( msgBuffer , myThid)
164          GOTO 999          GOTO 999
165         ENDIF         ENDIF
# Line 145  C      is an exact match makes things ea Line 167  C      is an exact match makes things ea
167  #ifndef ALWAYS_USE_MPI  #ifndef ALWAYS_USE_MPI
168        ENDIF        ENDIF
169  #endif  #endif
170    
171    #else /* ALLOW_USE_MPI */
172    
173            WRITE(myProcessStr,'(I4.4)') myProcId
174            WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
175            OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
176    c       WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
177    c       OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
178    
179  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
180    
181   999  CONTINUE   999  CONTINUE
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22