eesupp/src/eeboot_minimal.F

0deb8b4619 Jean*0001 #include "PACKAGES_CONFIG.h"
924557e60a Chri*0002 #include "CPP_EEOPTIONS.h"
                0003
4c563c2ee9 Chri*0004 CBOP
                0005 C     !ROUTINE: EEBOOT_MINIMAL
                0006
                0007 C     !INTERFACE:
e4a86aa47e Jean*0008       SUBROUTINE EEBOOT_MINIMAL( myComm )
924557e60a Chri*0009
4c563c2ee9 Chri*0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
0deb8b4619 Jean*0012 C     | SUBROUTINE EEBOOT\_MINIMAL
                0013 C     | o Set an initial environment that is predictable i.e.
                0014 C     | behaves in a similar way on all machines and stable.
4c563c2ee9 Chri*0015 C     *==========================================================*
0deb8b4619 Jean*0016 C     | Under MPI this routine calls MPI\_INIT to setup the
                0017 C     | mpi environment ( on some systems the code is running as
                0018 C     | a single process prior to MPI\_INIT, on others the mpirun
                0019 C     | script has already created multiple processes). Until
                0020 C     | MPI\_Init is called it is unclear what state the
                0021 C     | application is in. Once this routine has been run it is
                0022 C     | "safe" to do things like I/O to report erros and to get
                0023 C     | run parameters.
                0024 C     | Note: This routine can also be compiled with CPP
                0025 C     | directives set so that no multi-processing is initialise.
                0026 C     | This is OK and will work fine.
4c563c2ee9 Chri*0027 C     *==========================================================*
                0028
                0029 C     !USES:
d4b59afc3a Jean*0030       IMPLICIT NONE
4c563c2ee9 Chri*0031 C     == Global data ==
924557e60a Chri*0032 #include "SIZE.h"
                0033 #include "EEPARAMS.h"
                0034 #include "EESUPPORT.h"
                0035
e4a86aa47e Jean*0036 C     !ROUTINE ARGUMENTS
                0037 C     == Routine arguments ==
                0038 C     myComm     :: Communicator that is passed down from
                0039 C                   upper level driver (if there is one).
                0040       INTEGER myComm
                0041
b9dadda204 Mart*0042 C     !FUNCTIONS:
                0043 c     INTEGER  IFNBLNK
                0044 c     EXTERNAL IFNBLNK
                0045       INTEGER  ILNBLNK
                0046       EXTERNAL ILNBLNK
                0047
4c563c2ee9 Chri*0048 C     !LOCAL VARIABLES:
                0049 C     == Local variables ==
ff2fa27afe Jean*0050 C     myThid     :: Temp. dummy thread number.
                0051 C     fNam       :: Used to build file name for standard and error output.
                0052 C     msgBuf     :: Used to build messages for printing.
0deb8b4619 Jean*0053       INTEGER myThid
5586314dc5 Mart*0054 #ifdef USE_PDAF
                0055       CHARACTER*18 fNam
                0056 #else
df63838d59 Jean*0057       CHARACTER*13 fNam
5586314dc5 Mart*0058 #endif /* USE_PDAF */
ff2fa27afe Jean*0059       CHARACTER*(MAX_LEN_MBUF) msgBuf
924557e60a Chri*0060 #ifdef ALLOW_USE_MPI
ff2fa27afe Jean*0061 C     mpiRC      :: Error code reporting variable used with MPI.
924557e60a Chri*0062       INTEGER mpiRC
e4a86aa47e Jean*0063       INTEGER mpiIsInitialized
ff2fa27afe Jean*0064       LOGICAL doReport
3777bbd57d Jean*0065 #if defined(ALLOW_OASIS) || defined(COMPONENT_MODULE)
6591b3fcc3 Jean*0066       INTEGER mpiMyWId
                0067 #elif defined(ALLOW_NEST2W_COMMON)
                0068       INTEGER mpiMyWId
98ddeeaedb Jean*0069 #endif
0deb8b4619 Jean*0070 #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
6591b3fcc3 Jean*0071       INTEGER mpiMyWId, color
0deb8b4619 Jean*0072 #endif
5586314dc5 Mart*0073 #ifdef USE_PDAF
                0074       INTEGER mpi_task_id
b9dadda204 Mart*0075       CHARACTER*(14) fmtStr
                0076 #else
                0077       CHARACTER*(6) fmtStr
5586314dc5 Mart*0078 #endif /* USE_PDAF */
b9dadda204 Mart*0079       INTEGER iTmp
d4b59afc3a Jean*0080 #endif /* ALLOW_USE_MPI */
4c563c2ee9 Chri*0081 CEOP
924557e60a Chri*0082
                0083 C--   Default values set to single processor case
                0084       numberOfProcs = 1
                0085       myProcId      = 0
0deb8b4619 Jean*0086       pidIO         = myProcId
e7ea7a463f Alis*0087       myProcessStr  = '------'
ff2fa27afe Jean*0088 C     Set a dummy value for myThid because we are not multi-threading yet.
924557e60a Chri*0089       myThid        = 1
ff2fa27afe Jean*0090
fae0c8fa99 Jean*0091 C     Annoyingly there is no universal way to have the usingMPI
                0092 C     parameter work as one might expect. This is because, on some
                0093 C     systems I/O does not work until MPI_Init has been called.
                0094 C     The solution for now is that the parameter below may need to
                0095 C     be changed manually!
                0096 #ifdef ALLOW_USE_MPI
                0097       usingMPI = .TRUE.
                0098 #else
                0099       usingMPI = .FALSE.
                0100 #endif
                0101
ff2fa27afe Jean*0102       IF ( .NOT.usingMPI ) THEN
                0103
                0104         WRITE(myProcessStr,'(I4.4)') myProcId
                0105         WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4)
                0106         OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
                0107 c       WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4)
                0108 c       OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
                0109
924557e60a Chri*0110 #ifdef ALLOW_USE_MPI
ff2fa27afe Jean*0111       ELSE
924557e60a Chri*0112 C--   MPI style multiple-process initialisation
                0113 C--   =========================================
ff2fa27afe Jean*0114
e4a86aa47e Jean*0115        CALL MPI_Initialized( mpiIsInitialized, mpiRC )
                0116
                0117        IF ( mpiIsInitialized .EQ. 0 ) THEN
                0118 C--     Initialise MPI multi-process parallel environment.
                0119 C       On some systems program forks at this point. Others have already
                0120 C       forked within mpirun - now thats an open standard!
                0121         CALL MPI_INIT( mpiRC )
                0122         IF ( mpiRC .NE. MPI_SUCCESS ) THEN
                0123          eeBootError = .TRUE.
                0124          WRITE(msgBuf,'(A,I5)')
ff2fa27afe Jean*0125      &        'EEBOOT_MINIMAL: MPI_INIT return code', mpiRC
e4a86aa47e Jean*0126          CALL PRINT_ERROR( msgBuf, myThid )
                0127          GOTO 999
                0128         ENDIF
                0129
                0130 C--     MPI has now been initialized ; now we need to either
                0131 C       ask for a communicator or pretend that we have:
                0132 C       Pretend that we have asked for a communicator
                0133         MPI_COMM_MODEL = MPI_COMM_WORLD
                0134
                0135        ELSE
                0136 C--     MPI was already initialized and communicator has been passed
                0137 C       down from upper level driver
                0138         MPI_COMM_MODEL = myComm
                0139
924557e60a Chri*0140        ENDIF
ed584e7d0c Jean*0141
ff2fa27afe Jean*0142        doReport = .FALSE.
5586314dc5 Mart*0143 #ifdef USE_PDAF
                0144 C     initialize PDAF
                0145 C     for more output increase second parameter from 1 to 2
                0146        CALL INIT_PARALLEL_PDAF(0, 1, MPI_COMM_MODEL, MPI_COMM_MODEL,
                0147      &      mpi_task_id)
                0148 #endif /* USE_PDAF */
                0149
696c4221e9 Mart*0150 #ifdef ALLOW_OASIS
9aa451bbe6 Mart*0151 C      add a 1rst preliminary call EESET_PARAMS to set useOASIS
                0152 C      (needed to decide either to call OASIS_INIT or not)
3777bbd57d Jean*0153        CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
                0154        CALL EESET_PARMS ( mpiMyWId, doReport )
9aa451bbe6 Mart*0155        IF ( useOASIS ) CALL OASIS_INIT(MPI_COMM_MODEL)
696c4221e9 Mart*0156 #endif /* ALLOW_OASIS */
56e28927d9 Jean*0157
ed584e7d0c Jean*0158 #ifdef COMPONENT_MODULE
56e28927d9 Jean*0159 C--    Set the running directory
                0160        CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
                0161        CALL SETDIR( mpiMyWId )
                0162
ed584e7d0c Jean*0163 C- jmc: test:
                0164 C      add a 1rst preliminary call EESET_PARAMS to set useCoupler
                0165 C      (needed to decide either to call CPL_INIT or not)
3777bbd57d Jean*0166        CALL EESET_PARMS ( mpiMyWId, doReport )
ed584e7d0c Jean*0167 C- jmc: test end ; otherwise, uncomment next line:
                0168 c      useCoupler = .TRUE.
56e28927d9 Jean*0169
ed584e7d0c Jean*0170 C--    Ask coupler interface for a communicator
                0171        IF ( useCoupler) CALL CPL_INIT
ff2fa27afe Jean*0172 #endif /* COMPONENT_MODULE */
9d9b5e8eba Alis*0173
0deb8b4619 Jean*0174 C--    Case with Nest(ing)
                0175 #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
d4b59afc3a Jean*0176 C--    Set the running directory
                0177        CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
                0178        CALL SETDIR( mpiMyWId )
                0179
                0180 C--    Setup Nesting Execution Environment
                0181        CALL NEST_EEINIT( mpiMyWId, color )
75eb627fbd Jean*0182 #endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
0deb8b4619 Jean*0183
6591b3fcc3 Jean*0184 #ifdef ALLOW_NEST2W_COMMON
                0185 C--    Case with 2-Ways Nest(ing)
                0186 C-     Set the running directory
                0187        CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
                0188        CALL SETDIR( mpiMyWId )
                0189
                0190 C-     Setup Nesting Execution Environment
                0191        CALL NEST2W_EEINIT( mpiMyWId )
                0192        IF ( eeBootError ) GOTO 999
                0193 #endif /* ALLOW_NEST2W_COMMON */
                0194
0deb8b4619 Jean*0195 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0196
75eb627fbd Jean*0197 C--    Get my process number
                0198        CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC )
924557e60a Chri*0199        IF ( mpiRC .NE. MPI_SUCCESS ) THEN
                0200         eeBootError = .TRUE.
ff2fa27afe Jean*0201         WRITE(msgBuf,'(A,I5)')
                0202      &        'EEBOOT_MINIMAL: MPI_COMM_RANK return code', mpiRC
                0203         CALL PRINT_ERROR( msgBuf, myThid )
924557e60a Chri*0204         GOTO 999
                0205        ENDIF
                0206        myProcId = mpiMyId
b9dadda204 Mart*0207        iTmp = MAX(4,1 + INT(LOG10(DFLOAT(nPx*nPy))))
5586314dc5 Mart*0208 #ifdef USE_PDAF
b9dadda204 Mart*0209        WRITE(fmtStr,'(4(A,I1),A)')
                0210      &      '(I',iTmp,'.',iTmp,',A1,I',iTmp,'.',iTmp,')'
                0211        WRITE(myProcessStr,fmtStr) mpi_task_id,'.',myProcId
5586314dc5 Mart*0212 #else
b9dadda204 Mart*0213        WRITE(fmtStr,'(2(A,I1),A)') '(I',iTmp,'.',iTmp,')'
                0214        WRITE(myProcessStr,fmtStr) myProcId
5586314dc5 Mart*0215 #endif /* USE_PDAF */
b9dadda204 Mart*0216        iTmp = ILNBLNK( myProcessStr )
924557e60a Chri*0217        mpiPidIo = myProcId
                0218        pidIO    = mpiPidIo
                0219        IF ( mpiPidIo .EQ. myProcId ) THEN
c1aa24001b Dimi*0220 #ifdef SINGLE_DISK_IO
                0221         IF( myProcId .EQ. 0 ) THEN
                0222 #endif
b9dadda204 Mart*0223          WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:iTmp)
c1aa24001b Dimi*0224          OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown')
b9dadda204 Mart*0225          WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:iTmp)
c1aa24001b Dimi*0226          OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown')
                0227 #ifdef SINGLE_DISK_IO
                0228         ELSE
                0229          OPEN(errorMessageUnit,FILE='/dev/null',STATUS='unknown')
                0230          standardMessageUnit=errorMessageUnit
                0231         ENDIF
98bf5297a0 Jean*0232         IF( myProcId .EQ. 0 ) THEN
                0233           WRITE(msgBuf,'(2A)') '** WARNING ** EEBOOT_MINIMAL: ',
                0234      &     'defined SINGLE_DISK_IO will result in losing'
                0235           CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0236      &                        SQUEEZE_RIGHT, myThid )
                0237           WRITE(msgBuf,'(2A)') '** WARNING ** EEBOOT_MINIMAL: ',
                0238      &     'any message (error/warning) from any proc <> 0'
                0239           CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0240      &                        SQUEEZE_RIGHT, myThid )
                0241         ENDIF
c1aa24001b Dimi*0242 #endif
924557e60a Chri*0243        ENDIF
                0244
d4b59afc3a Jean*0245 #if defined(ALLOW_NEST_PARENT) || defined(ALLOW_NEST_CHILD)
                0246        WRITE(standardMessageUnit,'(2(A,I6))')
                0247      &           ' mpiMyWId =', mpiMyWId, ' , color =',color
                0248 #endif /* ALLOW_NEST_PARENT | ALLOW_NEST_CHILD */
                0249
924557e60a Chri*0250 C--    Synchronise all processes
0deb8b4619 Jean*0251 C      Strictly this is superfluous, but by using it we can guarantee to
46dc4f419b Chri*0252 C      find out about processes that did not start up.
9d9b5e8eba Alis*0253        CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC )
924557e60a Chri*0254        IF ( mpiRC .NE. MPI_SUCCESS ) THEN
                0255         eeBootError = .TRUE.
ff2fa27afe Jean*0256         WRITE(msgBuf,'(A,I6)')
                0257      &        'EEBOOT_MINIMAL: MPI_BARRIER return code', mpiRC
                0258         CALL PRINT_ERROR( msgBuf, myThid )
924557e60a Chri*0259         GOTO 999
                0260        ENDIF
                0261
                0262 C--    Get number of MPI processes
9d9b5e8eba Alis*0263        CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC )
924557e60a Chri*0264        IF ( mpiRC .NE. MPI_SUCCESS ) THEN
                0265         eeBootError = .TRUE.
ff2fa27afe Jean*0266         WRITE(msgBuf,'(A,I6)')
                0267      &        'EEBOOT_MINIMAL: MPI_COMM_SIZE return code', mpiRC
                0268         CALL PRINT_ERROR( msgBuf, myThid )
924557e60a Chri*0269         GOTO 999
                0270        ENDIF
                0271        numberOfProcs = mpiNProcs
                0272
ff2fa27afe Jean*0273 #endif /* ALLOW_USE_MPI */
                0274       ENDIF
                0275
                0276 C--    Under MPI only allow same number of processes as proc grid size.
                0277 C      Strictly we are allowed more procs but knowing there
924557e60a Chri*0278 C      is an exact match makes things easier.
                0279        IF ( numberOfProcs .NE. nPx*nPy ) THEN
                0280         eeBootError = .TRUE.
ff2fa27afe Jean*0281         WRITE(msgBuf,'(2(A,I6))')
                0282      &  'EEBOOT_MINIMAL: No. of procs=', numberOfProcs,
                0283      &  ' not equal to nPx*nPy=', nPx*nPy
                0284         CALL PRINT_ERROR( msgBuf, myThid )
924557e60a Chri*0285         GOTO 999
                0286        ENDIF
                0287
37e98ae200 Cons*0288 #ifdef USE_LIBHPM
ff2fa27afe Jean*0289        CALL F_HPMINIT(myProcId, "mitgcmuv")
37e98ae200 Cons*0290 #endif
924557e60a Chri*0291
                0292  999  CONTINUE
                0293       RETURN
                0294       END