C $Header: /home/ubuntu/mnt/e9_copy/MITgcm_contrib/sannino/OASIS_3.0_Coupler/code/eeboot_minimal.F,v 1.1 2006/07/20 21:08:15 sannino Exp $ C $Name: $ #include "CPP_EEOPTIONS.h" CBOP C !ROUTINE: EEBOOT_MINIMAL C !INTERFACE: SUBROUTINE EEBOOT_MINIMAL IMPLICIT NONE C !DESCRIPTION: C *==========================================================* C | SUBROUTINE EEBOOT\_MINIMAL C | o Set an initial environment that is predictable i.e. C | behaves in a similar way on all machines and stable. C *==========================================================* C | Under MPI this routine calls MPI\_INIT to setup the C | mpi environment ( on some systems the code is running as C | a single process prior to MPI\_INIT, on others the mpirun C | script has already created multiple processes). Until C | MPI\_Init is called it is unclear what state the C | application is in. Once this routine has been run it is C | "safe" to do things like I/O to report erros and to get C | run parameters. C | Note: This routine can also be compiled with CPP C | directives set so that no multi-processing is initialise. C | This is OK and will work fine. C *==========================================================* C !USES: C == Global data == #include "SIZE.h" #include "EEPARAMS.h" #include "EESUPPORT.h" cgmNESTING( #ifdef ALLOW_NESTING_FATHER #include "NESTING_FATHER.h" #endif c #ifdef ALLOW_NESTING_SON #include "NESTING_SON.h" #endif #if defined(ALLOW_NESTING_FATHER) || defined(ALLOW_NESTING_SON) INTEGER color INTEGER mpiMyWid INTEGER Count_Lev INTEGER istatus #endif cgmNESTING) cgmOASIS( #ifdef ALLOW_OASIS INTEGER MPI_COMM_OASIS #endif cgmOASIS) C !LOCAL VARIABLES: C == Local variables == C myThid :: Temp. dummy thread number. C fNam :: Used to build name of file for standard C output and error output. INTEGER myThid CHARACTER*13 fNam #ifdef ALLOW_USE_MPI C mpiRC :: Error code reporting variable used C with MPI. C msgBuffer :: Used to build messages for printing. CHARACTER*(MAX_LEN_MBUF) msgBuffer INTEGER mpiRC INTEGER nptmp #ifdef COMPONENT_MODULE INTEGER mpiMyWid #endif #endif /* ALLOW_USE_MPI */ CEOP C-- Default values set to single processor case numberOfProcs = 1 myProcId = 0 pidIO = myProcId myProcessStr = '------' C Set a dummy value for myThid because we are not multi-threading C yet. myThid = 1 #ifdef ALLOW_USE_MPI C-- C-- MPI style multiple-process initialisation C-- ========================================= #ifndef ALWAYS_USE_MPI IF ( usingMPI ) THEN #endif C-- Initialise MPI multi-process parallel environment. C On some systems program forks at this point. Others have already C forked within mpirun - now thats an open standard! CALL MPI_INIT( mpiRC ) IF ( mpiRC .NE. MPI_SUCCESS ) THEN eeBootError = .TRUE. WRITE(msgBuffer,'(A,I5)') & 'S/R INI_PROCS: MPI_INIT return code', & mpiRC CALL PRINT_ERROR( msgBuffer , myThid) GOTO 999 ENDIF C-- MPI has now been initialized but now we need to either C ask for a communicator or pretend that we have: C Pretend that we have asked for a communicator cgmOASIS( #ifdef ALLOW_OASIS CALL OASIS_INIT (MPI_COMM_OASIS) #endif cgmOASIS) cgmNESTING( #ifndef ALLOW_NESTING_FATHER #ifndef ALLOW_NESTING_SON cgmOASIS( #ifndef ALLOW_OASIS MPI_COMM_MODEL = MPI_COMM_WORLD #else MPI_COMM_MODEL = MPI_COMM_OASIS #endif cgmOASIS) #endif #endif cgmNESTING) #ifdef COMPONENT_MODULE C-- Set the running directory CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC ) CALL SETDIR( mpiMyWId ) C- jmc: test: C add a 1rst preliminary call EESET_PARAMS to set useCoupler C (needed to decide either to call CPL_INIT or not) CALL EESET_PARMS IF ( eeBootError ) GOTO 999 C- jmc: test end ; otherwise, uncomment next line: c useCoupler = .TRUE. C-- Ask coupler interface for a communicator IF ( useCoupler) CALL CPL_INIT #endif C-- Get my process number cgmNESTING( #ifndef ALLOW_NESTING_FATHER #ifndef ALLOW_NESTING_SON CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC ) #endif #endif cgmNESTING) cgmNESTING( #ifdef ALLOW_NESTING_FATHER CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC ) MSTR_DRV_F(1) = 0 MSTR_FTH_F(1) = 1 MSTR_SON_F(1) = NCPUs_FTH_F + 1 DO Count_Lev = 2, NST_LEV_TOT_F MSTR_DRV_F(Count_Lev) = MSTR_SON_F(Count_Lev-1) + NCPUs_SON_F(Count_Lev - 1) MSTR_SON_F(Count_Lev) = MSTR_DRV_F(Count_Lev) + 1 MSTR_FTH_F(Count_Lev) = MSTR_SON_F(Count_Lev-1) ENDDO IF (NST_LEV_F.EQ.1) THEN IF (mpiMyWId.GE.MSTR_FTH_F(1).AND.mpiMyWId.LT.MSTR_SON_F(1)) color = 1 IF (mpiMyWId.GE.MSTR_SON_F(1)) color = 2 ENDIF IF (NST_LEV_F.GT.1) THEN IF (mpiMyWId.GE.MSTR_SON_F(NST_LEV_F).AND. & mpiMyWId.LT.MSTR_SON_F(NST_LEV_F)+NCPUs_SON_F(NST_LEV_F)) & color = (NST_LEV_F + 1) ENDIF #endif /* ALLOW_NESTING_FATHER */ c========================================================================== #ifdef ALLOW_NESTING_SON CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC ) MSTR_DRV_S(1) = 0 MSTR_FTH_S(1) = 1 MSTR_SON_S(1) = NCPUs_FTH_S + 1 DO Count_Lev = 2, NST_LEV_TOT_S MSTR_DRV_S(Count_Lev) = MSTR_SON_S(Count_Lev-1) + NCPUs_SON_S(Count_Lev - 1) MSTR_SON_S(Count_Lev) = MSTR_DRV_S(Count_Lev) + 1 MSTR_FTH_S(Count_Lev) = MSTR_SON_S(Count_Lev-1) ENDDO IF (NST_LEV_S.EQ.1) THEN IF (mpiMyWId.GE.MSTR_FTH_S(1).AND.mpiMyWId.LT.MSTR_SON_S(1)) color = 1 IF (mpiMyWId.GE.MSTR_SON_S(1)) color = 2 ENDIF IF (NST_LEV_S.GT.1) THEN IF (mpiMyWId.GE.MSTR_SON_S(NST_LEV_S).AND. & mpiMyWId.LT.MSTR_SON_S(NST_LEV_S)+NCPUs_SON_S(NST_LEV_S)) & color = (NST_LEV_S + 1) ENDIF write(*,*) 'mpiMyWId=',mpiMyWId,'color=',color #endif /* ALLOW_NESTING_SON */ #if defined(ALLOW_NESTING_FATHER) || defined(ALLOW_NESTING_SON) call MPI_COMM_SPLIT (MPI_COMM_WORLD, color, 0, & MPI_COMM_MODEL,mpiRC) IF ( mpiRC .NE. MPI_SUCCESS ) THEN write(*,*) 'errore SPLIT' ENDIF C-- Get my process number CALL MPI_COMM_RANK( MPI_COMM_MODEL, mpiMyId, mpiRC ) #endif /* ALLOW_NESTING_FATHER */ cgmNESTING) IF ( mpiRC .NE. MPI_SUCCESS ) THEN eeBootError = .TRUE. WRITE(msgBuffer,'(A,I5)') & 'S/R INI_PROCS: MPI_COMM_RANK return code', & mpiRC CALL PRINT_ERROR( msgBuffer , myThid) GOTO 999 ENDIF myProcId = mpiMyId WRITE(myProcessStr,'(I4.4)') myProcId mpiPidIo = myProcId pidIO = mpiPidIo IF ( mpiPidIo .EQ. myProcId ) THEN WRITE(fNam,'(A,A)') 'STDERR.', myProcessStr(1:4) OPEN(errorMessageUnit,FILE=fNam,STATUS='unknown') WRITE(fNam,'(A,A)') 'STDOUT.', myProcessStr(1:4) cgmCASPUR OPEN(standardMessageUnit,FILE=fNam,STATUS='unknown') ENDIF C-- Synchronise all processes C Strictly this is superfluous, but by using it we can guarantee to C find out about processes that did not start up. CALL MPI_BARRIER( MPI_COMM_MODEL, mpiRC ) IF ( mpiRC .NE. MPI_SUCCESS ) THEN eeBootError = .TRUE. WRITE(msgBuffer,'(A,I5)') & 'S/R INI_PROCS: MPI_BARRIER return code', & mpiRC CALL PRINT_ERROR( msgBuffer , myThid) GOTO 999 ENDIF C-- Get number of MPI processes CALL MPI_COMM_SIZE ( MPI_COMM_MODEL, mpiNProcs, mpiRC ) IF ( mpiRC .NE. MPI_SUCCESS ) THEN eeBootError = .TRUE. WRITE(msgBuffer,'(A,I5)') & 'S/R INI_PROCS: MPI_COMM_SIZE return code', & mpiRC CALL PRINT_ERROR( msgBuffer , myThid) GOTO 999 ENDIF numberOfProcs = mpiNProcs C-- Can not have more processes than compile time MAX_NO_PROCS IF ( numberOfProcs .GT. MAX_NO_PROCS ) THEN eeBootError = .TRUE. WRITE(msgBuffer,'(A)') & 'S/R INI_PROCS: No. of processes too large' 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 C is an exact match makes things easier. IF ( numberOfProcs .NE. nPx*nPy ) THEN eeBootError = .TRUE. nptmp = nPx*nPy WRITE(msgBuffer,'(A,2I5)') & 'S/R INI_PROCS: No. of processes not equal to nPx*nPy', & numberOfProcs, nptmp CALL PRINT_ERROR( msgBuffer , myThid) GOTO 999 ENDIF #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 */ #ifdef USE_LIBHPM CALL F_HPMINIT(myProcId, "mitgcmuv") #endif 999 CONTINUE RETURN END