Index: NEMO/trunk/src/OCE/LBC/lib_mpp.F90
===================================================================
--- NEMO/trunk/src/OCE/LBC/lib_mpp.F90	(revision 10982)
+++ NEMO/trunk/src/OCE/LBC/lib_mpp.F90	(revision 11536)
@@ -32,12 +32,7 @@
    !!   ctl_opn       : Open file and check if required file is available.
    !!   ctl_nam       : Prints informations when an error occurs while reading a namelist
-   !!   get_unit      : give the index of an unused logical unit
-   !!----------------------------------------------------------------------
-#if   defined key_mpp_mpi
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'             MPI massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   lib_mpp_alloc : allocate mpp arrays
-   !!   mynode        : indentify the processor unit
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   mpp_start     : get local communicator its size and rank
    !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
    !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb)
@@ -57,29 +52,12 @@
    !!----------------------------------------------------------------------
    USE dom_oce        ! ocean space and time domain
-   USE lbcnfd         ! north fold treatment
    USE in_out_manager ! I/O manager
 
    IMPLICIT NONE
    PRIVATE
-
-   INTERFACE mpp_nfd
-      MODULE PROCEDURE   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
-      MODULE PROCEDURE   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
-   END INTERFACE
-
-   ! Interface associated to the mpp_lnk_... routines is defined in lbclnk
-   PUBLIC   mpp_lnk_2d    , mpp_lnk_3d    , mpp_lnk_4d
-   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr
    !
-!!gm  this should be useless
-   PUBLIC   mpp_nfd_2d    , mpp_nfd_3d    , mpp_nfd_4d
-   PUBLIC   mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr
-!!gm end
-   !
-   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam
-   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   ctl_stop, ctl_warn, ctl_opn, ctl_nam
+   PUBLIC   mpp_start, mppstop, mppsync, mpp_comm_free
    PUBLIC   mpp_ini_north
-   PUBLIC   mpp_lnk_2d_icb
-   PUBLIC   mpp_lbc_north_icb
    PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
    PUBLIC   mpp_delay_max, mpp_delay_sum, mpp_delay_rcv
@@ -87,5 +65,9 @@
    PUBLIC   mpp_ini_znl
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
-   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d
+   PUBLIC   mpp_report
+   PUBLIC   tic_tac
+#if ! defined key_mpp_mpi
+   PUBLIC MPI_Wtime
+#endif
    
    !! * Interfaces
@@ -113,9 +95,14 @@
    !!  MPI  variable definition !!
    !! ========================= !!
+#if   defined key_mpp_mpi
 !$AGRIF_DO_NOT_TREAT
    INCLUDE 'mpif.h'
 !$AGRIF_END_DO_NOT_TREAT
-
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+#else   
+   INTEGER, PUBLIC, PARAMETER ::   MPI_STATUS_SIZE = 1
+   INTEGER, PUBLIC, PARAMETER ::   MPI_DOUBLE_PRECISION = 8
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.    !: mpp flag
+#endif
 
    INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
@@ -145,9 +132,4 @@
    INTEGER, PUBLIC ::   north_root        !: number (in the comm_opa) of proc 0 in the northern comm
    INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   !: dimension ndim_rank_north
-
-   ! Type of send : standard, buffered, immediate
-   CHARACTER(len=1), PUBLIC ::   cn_mpi_send        !: type od mpi send/recieve (S=standard, B=bsend, I=isend)
-   LOGICAL         , PUBLIC ::   l_isend = .FALSE.  !: isend use indicator (T if cn_mpi_send='I')
-   INTEGER         , PUBLIC ::   nn_buffer          !: size of the buffer in case of mpi_bsend
 
    ! Communications summary report
@@ -187,5 +169,5 @@
    LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms
    LOGICAL, PUBLIC ::   l_north_nogather = .FALSE.  !: internal control of northfold comms
-
+   
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -195,103 +177,30 @@
 CONTAINS
 
-   FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mynode  ***
-      !!
-      !! ** Purpose :   Find processor unit
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt        !
-      CHARACTER(len=*)             , INTENT(in   ) ::   ldname       !
-      INTEGER                      , INTENT(in   ) ::   kumnam_ref   ! logical unit for reference namelist
-      INTEGER                      , INTENT(in   ) ::   kumnam_cfg   ! logical unit for configuration namelist
-      INTEGER                      , INTENT(inout) ::   kumond       ! logical unit for namelist output
-      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator
+   SUBROUTINE mpp_start( localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_start  ***
+      !!
+      !! ** Purpose :   get mpi_comm_oce, mpprank and mppsize
+      !!----------------------------------------------------------------------
       INTEGER         , OPTIONAL   , INTENT(in   ) ::   localComm    !
       !
-      INTEGER ::   mynode, ierr, code, ji, ii, ios
-      LOGICAL ::   mpi_was_called
-      !
-      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, ln_nnogather
-      !!----------------------------------------------------------------------
-      !
-      ii = 1
-      WRITE(ldtxt(ii),*)                                                                  ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                    ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) '~~~~~~ '                                                        ;   ii = ii + 1
-      !
-      REWIND( kumnam_ref )              ! Namelist nammpp in reference namelist: mpi variables
-      READ  ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901)
-901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp )
-      !
-      REWIND( kumnam_cfg )              ! Namelist nammpp in configuration namelist: mpi variables
-      READ  ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
-902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp )
-      !
-      !                              ! control print
-      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                             ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) '      mpi send type          cn_mpi_send = ', cn_mpi_send       ;   ii = ii + 1
-      WRITE(ldtxt(ii),*) '      size exported buffer   nn_buffer   = ', nn_buffer,' bytes';   ii = ii + 1
-      !
-      IF( jpni < 1 .OR. jpnj < 1  ) THEN
-         WRITE(ldtxt(ii),*) '      jpni and jpnj will be calculated automatically' ;   ii = ii + 1
-      ELSE
-         WRITE(ldtxt(ii),*) '      processor grid extent in i         jpni = ',jpni       ;   ii = ii + 1
-         WRITE(ldtxt(ii),*) '      processor grid extent in j         jpnj = ',jpnj       ;   ii = ii + 1
-      ENDIF
-
-      WRITE(ldtxt(ii),*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather  ; ii = ii + 1
-
-      CALL mpi_initialized ( mpi_was_called, code )
-      IF( code /= MPI_SUCCESS ) THEN
-         DO ji = 1, SIZE(ldtxt)
-            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
-         END DO
-         WRITE(*, cform_err)
-         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-
-      IF( mpi_was_called ) THEN
-         !
-         SELECT CASE ( cn_mpi_send )
-         CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
-         CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
-            IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr )
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
-            l_isend = .TRUE.
-         CASE DEFAULT
-            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
-            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
-            kstop = kstop + 1
-         END SELECT
-         !
-      ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN
-         WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
-         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '          ;   ii = ii + 1
-         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                ;   ii = ii + 1
-         kstop = kstop + 1
-      ELSE
-         SELECT CASE ( cn_mpi_send )
-         CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'             ;   ii = ii + 1
-            CALL mpi_init( ierr )
-         CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'              ;   ii = ii + 1
-            IF( Agrif_Root() )   CALL mpi_init_oce( ldtxt, ii, ierr )
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'           ;   ii = ii + 1
-            l_isend = .TRUE.
-            CALL mpi_init( ierr )
-         CASE DEFAULT
-            WRITE(ldtxt(ii),cform_err)                                                    ;   ii = ii + 1
-            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send     ;   ii = ii + 1
-            kstop = kstop + 1
-         END SELECT
-         !
-      ENDIF
-
+      INTEGER ::   ierr
+      LOGICAL ::   llmpi_init
+      !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+      !
+      CALL mpi_initialized ( llmpi_init, ierr )
+      IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_initialized' )
+
+      IF( .NOT. llmpi_init ) THEN
+         IF( PRESENT(localComm) ) THEN
+            WRITE(ctmp1,*) ' lib_mpp: You cannot provide a local communicator '
+            WRITE(ctmp2,*) '          without calling MPI_Init before ! '
+            CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
+         ENDIF
+         CALL mpi_init( ierr )
+         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_init' )
+      ENDIF
+       
       IF( PRESENT(localComm) ) THEN
          IF( Agrif_Root() ) THEN
@@ -299,16 +208,9 @@
          ENDIF
       ELSE
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code)
-         IF( code /= MPI_SUCCESS ) THEN
-            DO ji = 1, SIZE(ldtxt)
-               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
-            END DO
-            WRITE(*, cform_err)
-            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-
-#if defined key_agrif
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, ierr)
+         IF( ierr /= MPI_SUCCESS ) CALL ctl_stop( 'STOP', ' lib_mpp: Error in routine mpi_comm_dup' )
+      ENDIF
+
+# if defined key_agrif
       IF( Agrif_Root() ) THEN
          CALL Agrif_MPI_Init(mpi_comm_oce)
@@ -316,167 +218,17 @@
          CALL Agrif_MPI_set_grid_comm(mpi_comm_oce)
       ENDIF
-#endif
+# endif
 
       CALL mpi_comm_rank( mpi_comm_oce, mpprank, ierr )
       CALL mpi_comm_size( mpi_comm_oce, mppsize, ierr )
-      mynode = mpprank
-
-      IF( mynode == 0 ) THEN
-         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
-         WRITE(kumond, nammpp)      
-      ENDIF
       !
       CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
       !
-   END FUNCTION mynode
-
-   !!----------------------------------------------------------------------
-   !!                   ***  routine mpp_lnk_(2,3,4)d  ***
-   !!
-   !!   * Argument : dummy argument use in mpp_lnk_... routines
-   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
-   !!                cd_nat :   nature of array grid-points
-   !!                psgn   :   sign used across the north fold boundary
-   !!                kfld   :   optional, number of pt3d arrays
-   !!                cd_mpp :   optional, fill the overlap area only
-   !!                pval   :   optional, background value (used at closed boundaries)
-   !!----------------------------------------------------------------------
-   !
-   !                       !==  2D array and array of 2D pointer  ==!
-   !
-#  define DIM_2d
-#     define ROUTINE_LNK           mpp_lnk_2d
-#     include "mpp_lnk_generic.h90"
-#     undef ROUTINE_LNK
-#     define MULTI
-#     define ROUTINE_LNK           mpp_lnk_2d_ptr
-#     include "mpp_lnk_generic.h90"
-#     undef ROUTINE_LNK
-#     undef MULTI
-#  undef DIM_2d
-   !
-   !                       !==  3D array and array of 3D pointer  ==!
-   !
-#  define DIM_3d
-#     define ROUTINE_LNK           mpp_lnk_3d
-#     include "mpp_lnk_generic.h90"
-#     undef ROUTINE_LNK
-#     define MULTI
-#     define ROUTINE_LNK           mpp_lnk_3d_ptr
-#     include "mpp_lnk_generic.h90"
-#     undef ROUTINE_LNK
-#     undef MULTI
-#  undef DIM_3d
-   !
-   !                       !==  4D array and array of 4D pointer  ==!
-   !
-#  define DIM_4d
-#     define ROUTINE_LNK           mpp_lnk_4d
-#     include "mpp_lnk_generic.h90"
-#     undef ROUTINE_LNK
-#     define MULTI
-#     define ROUTINE_LNK           mpp_lnk_4d_ptr
-#     include "mpp_lnk_generic.h90"
-#     undef ROUTINE_LNK
-#     undef MULTI
-#  undef DIM_4d
-
-   !!----------------------------------------------------------------------
-   !!                   ***  routine mpp_nfd_(2,3,4)d  ***
-   !!
-   !!   * Argument : dummy argument use in mpp_nfd_... routines
-   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
-   !!                cd_nat :   nature of array grid-points
-   !!                psgn   :   sign used across the north fold boundary
-   !!                kfld   :   optional, number of pt3d arrays
-   !!                cd_mpp :   optional, fill the overlap area only
-   !!                pval   :   optional, background value (used at closed boundaries)
-   !!----------------------------------------------------------------------
-   !
-   !                       !==  2D array and array of 2D pointer  ==!
-   !
-#  define DIM_2d
-#     define ROUTINE_NFD           mpp_nfd_2d
-#     include "mpp_nfd_generic.h90"
-#     undef ROUTINE_NFD
-#     define MULTI
-#     define ROUTINE_NFD           mpp_nfd_2d_ptr
-#     include "mpp_nfd_generic.h90"
-#     undef ROUTINE_NFD
-#     undef MULTI
-#  undef DIM_2d
-   !
-   !                       !==  3D array and array of 3D pointer  ==!
-   !
-#  define DIM_3d
-#     define ROUTINE_NFD           mpp_nfd_3d
-#     include "mpp_nfd_generic.h90"
-#     undef ROUTINE_NFD
-#     define MULTI
-#     define ROUTINE_NFD           mpp_nfd_3d_ptr
-#     include "mpp_nfd_generic.h90"
-#     undef ROUTINE_NFD
-#     undef MULTI
-#  undef DIM_3d
-   !
-   !                       !==  4D array and array of 4D pointer  ==!
-   !
-#  define DIM_4d
-#     define ROUTINE_NFD           mpp_nfd_4d
-#     include "mpp_nfd_generic.h90"
-#     undef ROUTINE_NFD
-#     define MULTI
-#     define ROUTINE_NFD           mpp_nfd_4d_ptr
-#     include "mpp_nfd_generic.h90"
-#     undef ROUTINE_NFD
-#     undef MULTI
-#  undef DIM_4d
-
-
-   !!----------------------------------------------------------------------
-   !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  ***
-   !!
-   !!   * Argument : dummy argument use in mpp_lnk_... routines
-   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
-   !!                cd_nat :   nature of array grid-points
-   !!                psgn   :   sign used across the north fold boundary
-   !!                kb_bdy :   BDY boundary set
-   !!                kfld   :   optional, number of pt3d arrays
-   !!----------------------------------------------------------------------
-   !
-   !                       !==  2D array and array of 2D pointer  ==!
-   !
-#  define DIM_2d
-#     define ROUTINE_BDY           mpp_lnk_bdy_2d
-#     include "mpp_bdy_generic.h90"
-#     undef ROUTINE_BDY
-#  undef DIM_2d
-   !
-   !                       !==  3D array and array of 3D pointer  ==!
-   !
-#  define DIM_3d
-#     define ROUTINE_BDY           mpp_lnk_bdy_3d
-#     include "mpp_bdy_generic.h90"
-#     undef ROUTINE_BDY
-#  undef DIM_3d
-   !
-   !                       !==  4D array and array of 4D pointer  ==!
-   !
-#  define DIM_4d
-#     define ROUTINE_BDY           mpp_lnk_bdy_4d
-#     include "mpp_bdy_generic.h90"
-#     undef ROUTINE_BDY
-#  undef DIM_4d
-
-   !!----------------------------------------------------------------------
-   !!
-   !!   load_array  &   mpp_lnk_2d_9    à generaliser a 3D et 4D
-   
-   
-   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!!
-   
-   
-   !!----------------------------------------------------------------------
-
+#else
+      IF( PRESENT( localComm ) ) mpi_comm_oce = localComm
+      mppsize = 1
+      mpprank = 0
+#endif
+   END SUBROUTINE mpp_start
 
 
@@ -497,13 +249,7 @@
       !!----------------------------------------------------------------------
       !
-      SELECT CASE ( cn_mpi_send )
-      CASE ( 'S' )                ! Standard mpi send (blocking)
-         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag )
-      CASE ( 'B' )                ! Buffer mpi send (blocking)
-         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce        , iflag )
-      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-         ! be carefull, one more argument here : the mpi request identifier..
-         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag )
-      END SELECT
+#if defined key_mpp_mpi
+      CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_oce, md_req, iflag )
+#endif
       !
    END SUBROUTINE mppsend
@@ -527,4 +273,5 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       ! If a specific process number has been passed to the receive call,
       ! use that one. Default is to use mpi_any_source
@@ -533,4 +280,5 @@
       !
       CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag )
+#endif
       !
    END SUBROUTINE mpprecv
@@ -553,6 +301,10 @@
       !
       itaille = jpi * jpj
+#if defined key_mpp_mpi
       CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
          &                            mpi_double_precision, kp , mpi_comm_oce, ierror )
+#else
+      pio(:,:,1) = ptab(:,:)
+#endif
       !
    END SUBROUTINE mppgather
@@ -576,6 +328,10 @@
       itaille = jpi * jpj
       !
+#if defined key_mpp_mpi
       CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
          &                            mpi_double_precision, kp  , mpi_comm_oce, ierror )
+#else
+      ptab(:,:) = pio(:,:,1)
+#endif
       !
    END SUBROUTINE mppscatter
@@ -601,4 +357,5 @@
       COMPLEX(wp), ALLOCATABLE, DIMENSION(:) ::   ytmp
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       ilocalcomm = mpi_comm_oce
       IF( PRESENT(kcom) )   ilocalcomm = kcom
@@ -639,10 +396,13 @@
 
       ! send y_in into todelay(idvar)%y1d with a non-blocking communication
-#if defined key_mpi2
+# if defined key_mpi2
       IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
       CALL  mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+# else
+      CALL mpi_iallreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+# endif
 #else
-      CALL mpi_iallreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ndelayid(idvar), ierr )
+      pout(:) = REAL(y_in(:), wp)
 #endif
 
@@ -668,4 +428,5 @@
       INTEGER ::   ierr, ilocalcomm
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       ilocalcomm = mpi_comm_oce
       IF( PRESENT(kcom) )   ilocalcomm = kcom
@@ -702,10 +463,13 @@
 
       ! send p_in into todelay(idvar)%z1d with a non-blocking communication
-#if defined key_mpi2
+# if defined key_mpi2
       IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.)
       CALL  mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
       IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.)
+# else
+      CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+# endif
 #else
-      CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )
+      pout(:) = p_in(:)
 #endif
 
@@ -723,4 +487,5 @@
       INTEGER ::   ierr
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       IF( ndelayid(kid) /= -2 ) THEN  
 #if ! defined key_mpi2
@@ -732,4 +497,5 @@
          ndelayid(kid) = -2   ! add flag to know that mpi_wait was already called on kid
       ENDIF
+#endif
    END SUBROUTINE mpp_delay_rcv
 
@@ -890,10 +656,12 @@
       !!-----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       CALL mpi_barrier( mpi_comm_oce, ierror )
+#endif
       !
    END SUBROUTINE mppsync
 
 
-   SUBROUTINE mppstop( ldfinal, ld_force_abort ) 
+   SUBROUTINE mppstop( ld_abort ) 
       !!----------------------------------------------------------------------
       !!                  ***  routine mppstop  ***
@@ -902,15 +670,13 @@
       !!
       !!----------------------------------------------------------------------
-      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
-      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
-      LOGICAL ::   llfinal, ll_force_abort
+      LOGICAL, OPTIONAL, INTENT(in) :: ld_abort    ! source process number
+      LOGICAL ::   ll_abort
       INTEGER ::   info
       !!----------------------------------------------------------------------
-      llfinal = .FALSE.
-      IF( PRESENT(ldfinal) ) llfinal = ldfinal
-      ll_force_abort = .FALSE.
-      IF( PRESENT(ld_force_abort) ) ll_force_abort = ld_force_abort
-      !
-      IF(ll_force_abort) THEN
+      ll_abort = .FALSE.
+      IF( PRESENT(ld_abort) ) ll_abort = ld_abort
+      !
+#if defined key_mpp_mpi
+      IF(ll_abort) THEN
          CALL mpi_abort( MPI_COMM_WORLD )
       ELSE
@@ -918,5 +684,6 @@
          CALL mpi_finalize( info )
       ENDIF
-      IF( .NOT. llfinal ) STOP 123
+#endif
+      IF( ll_abort ) STOP 123
       !
    END SUBROUTINE mppstop
@@ -930,5 +697,7 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       CALL MPI_COMM_FREE(kcom, ierr)
+#endif
       !
    END SUBROUTINE mpp_comm_free
@@ -960,4 +729,5 @@
       INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
@@ -965,9 +735,5 @@
       !
       ALLOCATE( kwork(jpnij), STAT=ierr )
-      IF( ierr /= 0 ) THEN
-         WRITE(kumout, cform_err)
-         WRITE(kumout,*) 'mpp_ini_znl : failed to allocate 1D array of length jpnij'
-         CALL mppstop
-      ENDIF
+      IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_ini_znl : failed to allocate 1D array of length jpnij')
 
       IF( jpnj == 1 ) THEN
@@ -1031,4 +797,5 @@
 
       DEALLOCATE(kwork)
+#endif
 
    END SUBROUTINE mpp_ini_znl
@@ -1062,4 +829,5 @@
       !!----------------------------------------------------------------------
       !
+#if defined key_mpp_mpi
       njmppmax = MAXVAL( njmppt )
       !
@@ -1093,65 +861,6 @@
       CALL MPI_COMM_CREATE( mpi_comm_oce, ngrp_north, ncomm_north, ierr )
       !
+#endif
    END SUBROUTINE mpp_ini_north
-
-
-   SUBROUTINE mpi_init_oce( ldtxt, ksft, code )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_init.opa  ***
-      !!
-      !! ** Purpose :: export and attach a MPI buffer for bsend
-      !!
-      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
-      !!            but classical mpi_init
-      !!
-      !! History :: 01/11 :: IDRIS initial version for IBM only
-      !!            08/04 :: R. Benshila, generalisation
-      !!---------------------------------------------------------------------
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt
-      INTEGER                      , INTENT(inout) ::   ksft
-      INTEGER                      , INTENT(  out) ::   code
-      INTEGER                                      ::   ierr, ji
-      LOGICAL                                      ::   mpi_was_called
-      !!---------------------------------------------------------------------
-      !
-      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
-      IF ( code /= MPI_SUCCESS ) THEN
-         DO ji = 1, SIZE(ldtxt)
-            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
-         END DO
-         WRITE(*, cform_err)
-         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-      !
-      IF( .NOT. mpi_was_called ) THEN
-         CALL mpi_init( code )
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_oce, code )
-         IF ( code /= MPI_SUCCESS ) THEN
-            DO ji = 1, SIZE(ldtxt)
-               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
-            END DO
-            WRITE(*, cform_err)
-            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-      !
-      IF( nn_buffer > 0 ) THEN
-         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
-         ! Buffer allocation and attachment
-         ALLOCATE( tampon(nn_buffer), stat = ierr )
-         IF( ierr /= 0 ) THEN
-            DO ji = 1, SIZE(ldtxt)
-               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
-            END DO
-            WRITE(*, cform_err)
-            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         END IF
-         CALL mpi_buffer_attach( tampon, nn_buffer, code )
-      ENDIF
-      !
-   END SUBROUTINE mpi_init_oce
 
 
@@ -1187,286 +896,4 @@
 
 
-   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_icb  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition
-      !!              in mpp configuration in case of jpn1 > 1 and for 2d
-      !!              array with outer extra halo
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather
-      !!              the 4+kextj northern lines of the global domain on 1
-      !!              processor and apply lbc north-fold on this sub array.
-      !!              Then we scatter the north fold array back to the processors.
-      !!              This routine accounts for an extra halo with icebergs
-      !!              and assumes ghost rows and columns have been suppressed.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
-      !                                                     !   = T ,  U , V , F or W -points
-      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the
-      !!                                                    ! north fold, =  1. otherwise
-      INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold
-      !
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ipj, ij, iproc
-      !
-      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
-      !!----------------------------------------------------------------------
-      !
-      ipj=4
-      ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       &
-     &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       &
-     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni)    )
-      !
-      ztab_e(:,:)      = 0._wp
-      znorthloc_e(:,:) = 0._wp
-      !
-      ij = 1 - kextj
-      ! put the last ipj+2*kextj lines of pt2d into znorthloc_e 
-      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
-         znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj)
-         ij = ij + 1
-      END DO
-      !
-      itaille = jpimax * ( ipj + 2*kextj )
-      !
-      IF( ln_timing ) CALL tic_tac(.TRUE.)
-      CALL MPI_ALLGATHER( znorthloc_e(1,1-kextj)    , itaille, MPI_DOUBLE_PRECISION,    &
-         &                znorthgloio_e(1,1-kextj,1), itaille, MPI_DOUBLE_PRECISION,    &
-         &                ncomm_north, ierr )
-      !
-      IF( ln_timing ) CALL tic_tac(.FALSE.)
-      !
-      DO jr = 1, ndim_rank_north            ! recover the global north array
-         iproc = nrank_north(jr) + 1
-         ildi = nldit (iproc)
-         ilei = nleit (iproc)
-         iilb = nimppt(iproc)
-         DO jj = 1-kextj, ipj+kextj
-            DO ji = ildi, ilei
-               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
-            END DO
-         END DO
-      END DO
-
-      ! 2. North-Fold boundary conditions
-      ! ----------------------------------
-      CALL lbc_nfd( ztab_e(:,1-kextj:ipj+kextj), cd_type, psgn, kextj )
-
-      ij = 1 - kextj
-      !! Scatter back to pt2d
-      DO jj = jpj - ipj + 1 - kextj , jpj + kextj
-         DO ji= 1, jpi
-            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
-         END DO
-         ij  = ij +1
-      END DO
-      !
-      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
-      !
-   END SUBROUTINE mpp_lbc_north_icb
-
-
-   SUBROUTINE mpp_lnk_2d_icb( cdname, pt2d, cd_type, psgn, kexti, kextj )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_icb  ***
-      !!
-      !! ** Purpose :   Message passing management for 2d array (with extra halo for icebergs)
-      !!                This routine receives a (1-kexti:jpi+kexti,1-kexti:jpj+kextj)
-      !!                array (usually (0:jpi+1, 0:jpj+1)) from lbc_lnk_icb calls.
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    jpi    : first dimension of the local subdomain
-      !!                    jpj    : second dimension of the local subdomain
-      !!                    kexti  : number of columns for extra outer halo
-      !!                    kextj  : number of rows for extra outer halo
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*)                                        , INTENT(in   ) ::   cdname      ! name of the calling subroutine
-      REAL(wp), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                        , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      REAL(wp)                                                , INTENT(in   ) ::   psgn     ! sign used across the north fold
-      INTEGER                                                 , INTENT(in   ) ::   kexti    ! extra i-halo width
-      INTEGER                                                 , INTENT(in   ) ::   kextj    ! extra j-halo width
-      !
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! local integers
-      INTEGER  ::   ipreci, iprecj             !   -       -
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!
-      REAL(wp), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) ::   r2dns, r2dsn
-      REAL(wp), DIMENSION(1-kextj:jpj+kextj,nn_hls+kexti,2) ::   r2dwe, r2dew
-      !!----------------------------------------------------------------------
-
-      ipreci = nn_hls + kexti      ! take into account outer extra 2D overlap area
-      iprecj = nn_hls + kextj
-
-      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, 1, 1, 1, ld_lbc = .TRUE. )
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! Order matters Here !!!!
-      !
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( l_Iperio ) THEN
-         pt2d(1-kexti:     1   ,:) = pt2d(jpim1-kexti: jpim1 ,:)       ! east
-         pt2d(  jpi  :jpi+kexti,:) = pt2d(     2     :2+kexti,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-kexti   :nn_hls   ,:) = 0._wp    ! east except at F-point
-                                      pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp    ! west
-      ENDIF
-      !                                      ! North-South boundaries
-      IF( l_Jperio ) THEN                         !* cyclic (only with no mpp j-split)
-         pt2d(:,1-kextj:     1   ) = pt2d(:,jpjm1-kextj:  jpjm1)       ! north
-         pt2d(:,  jpj  :jpj+kextj) = pt2d(:,     2     :2+kextj)       ! south
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(:,  1-kextj   :nn_hls   ) = 0._wp    ! north except at F-point
-                                      pt2d(:,jpj-nn_hls+1:jpj+kextj) = 0._wp    ! south
-      ENDIF
-      !
-
-      ! north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-                   CASE ( 1 )     ;   CALL lbc_nfd          ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
-                   CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj )
-         END SELECT
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = jpi-nreci-kexti
-         DO jl = 1, ipreci
-            r2dew(:,jl,1) = pt2d(nn_hls+jl,:)
-            r2dwe(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = ipreci * ( jpj + 2*kextj )
-      !
-      IF( ln_timing ) CALL tic_tac(.TRUE.)
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea )
-         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      IF( ln_timing ) CALL tic_tac(.FALSE.)
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = jpi - nn_hls
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, ipreci
-            pt2d(iihom+jl,:) = r2dew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, ipreci
-            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
-            pt2d(iihom+jl,:) = r2dew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-kexti,:) = r2dwe(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = jpj-nrecj-kextj
-         DO jl = 1, iprecj
-            r2dsn(:,jl,1) = pt2d(:,ijhom +jl)
-            r2dns(:,jl,1) = pt2d(:,nn_hls+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = iprecj * ( jpi + 2*kexti )
-      !
-      IF( ln_timing ) CALL tic_tac(.TRUE.)
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono )
-         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      IF( ln_timing ) CALL tic_tac(.FALSE.)
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = jpj - nn_hls
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, iprecj
-            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
-            pt2d(:,ijhom+jl) = r2dns(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-kextj) = r2dsn(:,jl,2)
-         END DO
-      END SELECT
-      !
-   END SUBROUTINE mpp_lnk_2d_icb
-
-
    SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb, ld_dlg )
       !!----------------------------------------------------------------------
@@ -1484,4 +911,5 @@
       INTEGER ::    ji,  jj,  jk,  jh, jf, jcount   ! dummy loop indices
       !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
       !
       ll_lbc = .FALSE.
@@ -1594,4 +1022,5 @@
          DEALLOCATE(crname_lbc)
       ENDIF
+#endif
    END SUBROUTINE mpp_report
 
@@ -1604,4 +1033,5 @@
     REAL(wp),               SAVE :: tic_ct = 0._wp
     INTEGER :: ii
+#if defined key_mpp_mpi
 
     IF( ncom_stp <= nit000 ) RETURN
@@ -1619,258 +1049,24 @@
        tic_ct = MPI_Wtime()                                                        ! start count tac->tic (waiting time)
     ENDIF
+#endif
     
    END SUBROUTINE tic_tac
 
+#if ! defined key_mpp_mpi
+   SUBROUTINE mpi_wait(request, status, ierror)
+      INTEGER                            , INTENT(in   ) ::   request
+      INTEGER, DIMENSION(MPI_STATUS_SIZE), INTENT(  out) ::   status
+      INTEGER                            , INTENT(  out) ::   ierror
+   END SUBROUTINE mpi_wait
+
    
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case:            Dummy module        share memory computing
-   !!----------------------------------------------------------------------
-   USE in_out_manager
-
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mppsum_int, mppsum_a_int, mppsum_real, mppsum_a_real, mppsum_realdd, mppsum_a_realdd
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-   END INTERFACE
-   INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-   END INTERFACE
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
-   LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
-   INTEGER, PUBLIC            ::   mpi_comm_oce          ! opa local communicator
-
-   INTEGER, PARAMETER, PUBLIC               ::   nbdelay = 0   ! make sure we don't enter loops: DO ji = 1, nbdelay
-   CHARACTER(len=32), DIMENSION(1), PUBLIC  ::   c_delaylist = 'empty'
-   CHARACTER(len=32), DIMENSION(1), PUBLIC  ::   c_delaycpnt = 'empty'
-   LOGICAL, PUBLIC                          ::   l_full_nf_update = .TRUE.
-   TYPE ::   DELAYARR
-      REAL(   wp), POINTER, DIMENSION(:) ::  z1d => NULL()
-      COMPLEX(wp), POINTER, DIMENSION(:) ::  y1d => NULL()
-   END TYPE DELAYARR
-   TYPE( DELAYARR ), DIMENSION(1), PUBLIC  ::   todelay              
-   INTEGER,  PUBLIC, DIMENSION(1)           ::   ndelayid = -1
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   INTEGER FUNCTION lib_mpp_alloc(kumout)          ! Dummy function
-      INTEGER, INTENT(in) ::   kumout
-      lib_mpp_alloc = 0
-   END FUNCTION lib_mpp_alloc
-
-   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
-      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
-      CHARACTER(len=*),DIMENSION(:) ::   ldtxt
-      CHARACTER(len=*) ::   ldname
-      INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop
-      IF( PRESENT( localComm ) ) mpi_comm_oce = localComm
-      function_value = 0
-      IF( .FALSE. )   ldtxt(:) = 'never done'
-      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
-   END FUNCTION mynode
-
-   SUBROUTINE mppsync                       ! Dummy routine
-   END SUBROUTINE mppsync
-
-   !!----------------------------------------------------------------------
-   !!    ***  mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real  ***
-   !!   
-   !!----------------------------------------------------------------------
-   !!
-#  define OPERATION_MAX
-#  define INTEGER_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppmax_int
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppmax_a_int
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef INTEGER_TYPE
-!
-#  define REAL_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppmax_real
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppmax_a_real
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef REAL_TYPE
-#  undef OPERATION_MAX
-   !!----------------------------------------------------------------------
-   !!    ***  mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real  ***
-   !!   
-   !!----------------------------------------------------------------------
-   !!
-#  define OPERATION_MIN
-#  define INTEGER_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppmin_int
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppmin_a_int
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef INTEGER_TYPE
-!
-#  define REAL_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppmin_real
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppmin_a_real
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef REAL_TYPE
-#  undef OPERATION_MIN
-
-   !!----------------------------------------------------------------------
-   !!    ***  mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real  ***
-   !!   
-   !!   Global sum of 1D array or a variable (integer, real or complex)
-   !!----------------------------------------------------------------------
-   !!
-#  define OPERATION_SUM
-#  define INTEGER_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppsum_int
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppsum_a_int
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef INTEGER_TYPE
-!
-#  define REAL_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppsum_real
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppsum_a_real
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef REAL_TYPE
-#  undef OPERATION_SUM
-
-#  define OPERATION_SUM_DD
-#  define COMPLEX_TYPE
-#  define DIM_0d
-#     define ROUTINE_ALLREDUCE           mppsum_realdd
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_0d
-#  define DIM_1d
-#     define ROUTINE_ALLREDUCE           mppsum_a_realdd
-#     include "mpp_allreduce_generic.h90"
-#     undef ROUTINE_ALLREDUCE
-#  undef DIM_1d
-#  undef COMPLEX_TYPE
-#  undef OPERATION_SUM_DD
-
-   !!----------------------------------------------------------------------
-   !!    ***  mpp_minloc2d, mpp_minloc3d, mpp_maxloc2d, mpp_maxloc3d
-   !!   
-   !!----------------------------------------------------------------------
-   !!
-#  define OPERATION_MINLOC
-#  define DIM_2d
-#     define ROUTINE_LOC           mpp_minloc2d
-#     include "mpp_loc_generic.h90"
-#     undef ROUTINE_LOC
-#  undef DIM_2d
-#  define DIM_3d
-#     define ROUTINE_LOC           mpp_minloc3d
-#     include "mpp_loc_generic.h90"
-#     undef ROUTINE_LOC
-#  undef DIM_3d
-#  undef OPERATION_MINLOC
-
-#  define OPERATION_MAXLOC
-#  define DIM_2d
-#     define ROUTINE_LOC           mpp_maxloc2d
-#     include "mpp_loc_generic.h90"
-#     undef ROUTINE_LOC
-#  undef DIM_2d
-#  define DIM_3d
-#     define ROUTINE_LOC           mpp_maxloc3d
-#     include "mpp_loc_generic.h90"
-#     undef ROUTINE_LOC
-#  undef DIM_3d
-#  undef OPERATION_MAXLOC
-
-   SUBROUTINE mpp_delay_sum( cdname, cdelay, y_in, pout, ldlast, kcom )
-      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
-      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
-      COMPLEX(wp),      INTENT(in   ), DIMENSION(:) ::   y_in
-      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
-      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
-      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
-      !
-      pout(:) = REAL(y_in(:), wp)
-   END SUBROUTINE mpp_delay_sum
-
-   SUBROUTINE mpp_delay_max( cdname, cdelay, p_in, pout, ldlast, kcom )
-      CHARACTER(len=*), INTENT(in   )               ::   cdname  ! name of the calling subroutine
-      CHARACTER(len=*), INTENT(in   )               ::   cdelay  ! name (used as id) of the delayed operation
-      REAL(wp),         INTENT(in   ), DIMENSION(:) ::   p_in
-      REAL(wp),         INTENT(  out), DIMENSION(:) ::   pout
-      LOGICAL,          INTENT(in   )               ::   ldlast  ! true if this is the last time we call this routine
-      INTEGER,          INTENT(in   ), OPTIONAL     ::   kcom
-      !
-      pout(:) = p_in(:)
-   END SUBROUTINE mpp_delay_max
-
-   SUBROUTINE mpp_delay_rcv( kid )
-      INTEGER,INTENT(in   )      ::  kid 
-      WRITE(*,*) 'mpp_delay_rcv: You should not have seen this print! error?', kid
-   END SUBROUTINE mpp_delay_rcv
-   
-   SUBROUTINE mppstop( ldfinal, ld_force_abort )
-      LOGICAL, OPTIONAL, INTENT(in) :: ldfinal    ! source process number
-      LOGICAL, OPTIONAL, INTENT(in) :: ld_force_abort    ! source process number
-      STOP      ! non MPP case, just stop the run
-   END SUBROUTINE mppstop
-
-   SUBROUTINE mpp_ini_znl( knum )
-      INTEGER :: knum
-      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?', knum
-   END SUBROUTINE mpp_ini_znl
-
-   SUBROUTINE mpp_comm_free( kcom )
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
-   END SUBROUTINE mpp_comm_free
-   
-#endif
-
-   !!----------------------------------------------------------------------
-   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
+   FUNCTION MPI_Wtime()
+      REAL(wp) ::  MPI_Wtime
+      MPI_Wtime = -1.
+   END FUNCTION MPI_Wtime
+#endif
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam   routines
    !!----------------------------------------------------------------------
 
@@ -1883,15 +1079,20 @@
       !!                increment the error number (nstop) by one.
       !!----------------------------------------------------------------------
-      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
-      CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
+      CHARACTER(len=*), INTENT(in   )           ::   cd1
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::        cd2, cd3, cd4, cd5
+      CHARACTER(len=*), INTENT(in   ), OPTIONAL ::   cd6, cd7, cd8, cd9, cd10
       !!----------------------------------------------------------------------
       !
       nstop = nstop + 1
-
-      ! force to open ocean.output file
+      !
+      ! force to open ocean.output file if not already opened
       IF( numout == 6 ) CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
-       
-      WRITE(numout,cform_err)
-      IF( PRESENT(cd1 ) )   WRITE(numout,*) TRIM(cd1)
+      !
+                            WRITE(numout,*)
+                            WRITE(numout,*) ' ===>>> : E R R O R'
+                            WRITE(numout,*)
+                            WRITE(numout,*) '         ==========='
+                            WRITE(numout,*)
+                            WRITE(numout,*) TRIM(cd1)
       IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2)
       IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3)
@@ -1903,5 +1104,6 @@
       IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9)
       IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10)
-
+                            WRITE(numout,*)
+      !
                                CALL FLUSH(numout    )
       IF( numstp     /= -1 )   CALL FLUSH(numstp    )
@@ -1910,6 +1112,8 @@
       !
       IF( cd1 == 'STOP' ) THEN
+         WRITE(numout,*)  
          WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
-         CALL mppstop(ld_force_abort = .true.)
+         WRITE(numout,*)  
+         CALL mppstop( ld_abort = .true. )
       ENDIF
       !
@@ -1930,16 +1134,22 @@
       !
       nwarn = nwarn + 1
+      !
       IF(lwp) THEN
-         WRITE(numout,cform_war)
-         IF( PRESENT(cd1 ) ) WRITE(numout,*) TRIM(cd1)
-         IF( PRESENT(cd2 ) ) WRITE(numout,*) TRIM(cd2)
-         IF( PRESENT(cd3 ) ) WRITE(numout,*) TRIM(cd3)
-         IF( PRESENT(cd4 ) ) WRITE(numout,*) TRIM(cd4)
-         IF( PRESENT(cd5 ) ) WRITE(numout,*) TRIM(cd5)
-         IF( PRESENT(cd6 ) ) WRITE(numout,*) TRIM(cd6)
-         IF( PRESENT(cd7 ) ) WRITE(numout,*) TRIM(cd7)
-         IF( PRESENT(cd8 ) ) WRITE(numout,*) TRIM(cd8)
-         IF( PRESENT(cd9 ) ) WRITE(numout,*) TRIM(cd9)
-         IF( PRESENT(cd10) ) WRITE(numout,*) TRIM(cd10)
+                               WRITE(numout,*)
+                               WRITE(numout,*) ' ===>>> : W A R N I N G'
+                               WRITE(numout,*)
+                               WRITE(numout,*) '         ==============='
+                               WRITE(numout,*)
+         IF( PRESENT(cd1 ) )   WRITE(numout,*) TRIM(cd1)
+         IF( PRESENT(cd2 ) )   WRITE(numout,*) TRIM(cd2)
+         IF( PRESENT(cd3 ) )   WRITE(numout,*) TRIM(cd3)
+         IF( PRESENT(cd4 ) )   WRITE(numout,*) TRIM(cd4)
+         IF( PRESENT(cd5 ) )   WRITE(numout,*) TRIM(cd5)
+         IF( PRESENT(cd6 ) )   WRITE(numout,*) TRIM(cd6)
+         IF( PRESENT(cd7 ) )   WRITE(numout,*) TRIM(cd7)
+         IF( PRESENT(cd8 ) )   WRITE(numout,*) TRIM(cd8)
+         IF( PRESENT(cd9 ) )   WRITE(numout,*) TRIM(cd9)
+         IF( PRESENT(cd10) )   WRITE(numout,*) TRIM(cd10)
+                               WRITE(numout,*)
       ENDIF
       CALL FLUSH(numout)
@@ -1984,6 +1194,5 @@
       IF( TRIM(cdfile) == '/dev/null' )   clfile = TRIM(cdfile)   ! force the use of /dev/null
       !
-      iost=0
-      IF( cdacce(1:6) == 'DIRECT' )  THEN         ! cdacce has always more than 6 characters
+      IF(       cdacce(1:6) == 'DIRECT' )  THEN   ! cdacce has always more than 6 characters
          OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh         , ERR=100, IOSTAT=iost )
       ELSE IF( TRIM(cdstat) == 'APPEND' )  THEN   ! cdstat can have less than 6 characters
@@ -2006,29 +1215,13 @@
 100   CONTINUE
       IF( iost /= 0 ) THEN
-         IF(ldwp) THEN
-            WRITE(kout,*)
-            WRITE(kout,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
-            WRITE(kout,*) ' =======   ===  '
-            WRITE(kout,*) '           unit   = ', knum
-            WRITE(kout,*) '           status = ', cdstat
-            WRITE(kout,*) '           form   = ', cdform
-            WRITE(kout,*) '           access = ', cdacce
-            WRITE(kout,*) '           iostat = ', iost
-            WRITE(kout,*) '           we stop. verify the file '
-            WRITE(kout,*)
-         ELSE  !!! Force writing to make sure we get the information - at least once - in this violent STOP!!
-            WRITE(*,*)
-            WRITE(*,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
-            WRITE(*,*) ' =======   ===  '
-            WRITE(*,*) '           unit   = ', knum
-            WRITE(*,*) '           status = ', cdstat
-            WRITE(*,*) '           form   = ', cdform
-            WRITE(*,*) '           access = ', cdacce
-            WRITE(*,*) '           iostat = ', iost
-            WRITE(*,*) '           we stop. verify the file '
-            WRITE(*,*)
-         ENDIF
-         CALL FLUSH( kout ) 
-         STOP 'ctl_opn bad opening'
+         WRITE(ctmp1,*) ' ===>>>> : bad opening file: ', TRIM(clfile)
+         WRITE(ctmp2,*) ' =======   ===  '
+         WRITE(ctmp3,*) '           unit   = ', knum
+         WRITE(ctmp4,*) '           status = ', cdstat
+         WRITE(ctmp5,*) '           form   = ', cdform
+         WRITE(ctmp6,*) '           access = ', cdacce
+         WRITE(ctmp7,*) '           iostat = ', iost
+         WRITE(ctmp8,*) '           we stop. verify the file '
+         CALL ctl_stop( 'STOP', ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7, ctmp8 )
       ENDIF
       !
@@ -2036,5 +1229,5 @@
 
 
-   SUBROUTINE ctl_nam ( kios, cdnam, ldwp )
+   SUBROUTINE ctl_nam ( kios, cdnam )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE ctl_nam  ***
@@ -2044,8 +1237,8 @@
       !! ** Method  :   Fortan open
       !!----------------------------------------------------------------------
-      INTEGER         , INTENT(inout) ::   kios    ! IO status after reading the namelist
-      CHARACTER(len=*), INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
-      CHARACTER(len=5)                ::   clios   ! string to convert iostat in character for print
-      LOGICAL         , INTENT(in   ) ::   ldwp    ! boolean term for print
+      INTEGER                                , INTENT(inout) ::   kios    ! IO status after reading the namelist
+      CHARACTER(len=*)                       , INTENT(in   ) ::   cdnam   ! group name of namelist for which error occurs
+      !
+      CHARACTER(len=5) ::   clios   ! string to convert iostat in character for print
       !!----------------------------------------------------------------------
       !
@@ -2061,5 +1254,4 @@
       ENDIF
       kios = 0
-      RETURN
       !
    END SUBROUTINE ctl_nam
@@ -2082,6 +1274,5 @@
       END DO
       IF( (get_unit == 999) .AND. llopn ) THEN
-         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
-         get_unit = -1
+         CALL ctl_stop( 'STOP', 'get_unit: All logical units until 999 are used...' )
       ENDIF
       !
