Index: /trunk/NEMO/OFF_SRC/IOM/in_out_manager.F90
===================================================================
--- /trunk/NEMO/OFF_SRC/IOM/in_out_manager.F90	(revision 1323)
+++ /trunk/NEMO/OFF_SRC/IOM/in_out_manager.F90	(revision 1324)
@@ -5,6 +5,7 @@
    !!                 turbulent closure parameterization
    !!=====================================================================
-   !! History :   8.5  !  02-06  (G. Madec)  original code
-   !!             9.0  !  06-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !! History :   1.0  !  2002-06  (G. Madec)  original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             3.0  !  2008-06  (G. Madec)  add ctmp4 to ctmp10
    !!----------------------------------------------------------------------
 
@@ -12,8 +13,9 @@
    !!   ctl_stop   : update momentum and tracer Kz from a tke scheme
    !!   ctl_warn   : initialization, namelist read, and parameters control
+   !!   getunit    : give the index of an unused logical unit
    !!----------------------------------------------------------------------
-   USE par_kind
-   USE par_oce
-   USE lib_print         ! formated print library
+   USE par_kind        ! kind definition
+   USE par_oce         ! ocean parameter
+   USE lib_print       ! formated print library
 
    IMPLICIT NONE
@@ -23,21 +25,26 @@
    !!                   namrun namelist parameters
    !!----------------------------------------------------------------------
-   CHARACTER (len=16) ::   cexper     = "exp0"    !: experiment name used for output filename
-   LOGICAL            ::   ln_rstart  = .FALSE.   !: start from (F) rest or (T) a restart file
-   INTEGER            ::   no         = 0         !: job number
-   INTEGER            ::   nrstdt     = 0         !: control of the time step (0, 1 or 2)
-   INTEGER            ::   nn_rstssh  = 0         !: hand made initilization of ssh or not (1/0)
-   INTEGER            ::   nit000     = 1         !: index of the first time step
-   INTEGER            ::   nitend     = 10        !: index of the last time step
-   INTEGER            ::   ndate0     = 961115    !: initial calendar date aammjj
-   INTEGER            ::   nleapy     = 0         !: Leap year calendar flag (0/1 or 30)
-   INTEGER            ::   ninist     = 0         !: initial state output flag (0/1)
-   LOGICAL            ::   ln_dimgnnn = .FALSE.   !: type of dimgout. (F): 1 file for all proc
-                                                  !:                  (T): 1 file per proc
-   LOGICAL            ::   ln_mskland = .FALSE.   !: mask land points in NetCDF outputs (costly: + ~15%)
+   CHARACTER(len=16)  ::   cexper        = "exp0"      !: experiment name used for output filename
+   CHARACTER(len=32)  ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
+   CHARACTER(len=32)  ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
+   LOGICAL            ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
+   INTEGER            ::   no            = 0           !: job number
+   INTEGER            ::   nrstdt        = 0           !: control of the time step (0, 1 or 2)
+   INTEGER            ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
+   INTEGER            ::   nit000        = 1           !: index of the first time step
+   INTEGER            ::   nitend        = 10          !: index of the last time step
+   INTEGER            ::   ndate0        = 961115      !: initial calendar date aammjj
+   INTEGER            ::   nleapy        = 0           !: Leap year calendar flag (0/1 or 30)
+   INTEGER            ::   ninist        = 0           !: initial state output flag (0/1)
+   LOGICAL            ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
+                                                       !:                  (T): 1 file per proc
+   LOGICAL            ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
    !!----------------------------------------------------------------------
    !! was in restart but moved here because of the OFF line... better solution should be found...
    !!----------------------------------------------------------------------
    INTEGER            ::   nitrst                 !: time step at which restart file should be written
+#if defined key_zdftke2
+   INTEGER            ::   nitrst_tke2            !: time step at which restart file should be written
+#endif
    !!----------------------------------------------------------------------
    !!                    output monitoring
@@ -78,5 +85,8 @@
    INTEGER            ::   nstop = 0                !: error flag (=number of reason for a premature stop run)
    INTEGER            ::   nwarn = 0                !: warning flag (=number of warning found during the run)
-   CHARACTER(len=200) ::   ctmp1, ctmp2, ctmp3      !: temporary character
+   CHARACTER(len=200) ::   ctmp1, ctmp2, ctmp3      !: temporary characters 1 to 3
+   CHARACTER(len=200) ::   ctmp4, ctmp5, ctmp6      !: temporary characters 4 to 6
+   CHARACTER(len=200) ::   ctmp7, ctmp8, ctmp9      !: temporary characters 7 to 9
+   CHARACTER(len=200) ::   ctmp10                   !: temporary character 10
    CHARACTER (len=64) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
    CHARACTER (len=64) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
@@ -84,6 +94,6 @@
    LOGICAL            ::   lsp_area = .TRUE.        !: to make a control print over a specific area
    !!----------------------------------------------------------------------
-   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
+   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 
+   !! $Id$
    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -93,12 +103,13 @@
    SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5,   &
       &                 cd6, cd7, cd8, cd9, cd10 )
-      !!-----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       !!                  ***  ROUTINE  stop_opa  ***
       !!
-      !! ** Purpose : ??? blah blah....
-      !!-----------------------------------------------------------------------
+      !! ** Purpose :   print in ocean.outpput file a error message and 
+      !!                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
-      !!-----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       !
       nstop = nstop + 1 
@@ -123,12 +134,13 @@
    SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
       &                 cd6, cd7, cd8, cd9, cd10 )
-      !!-----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       !!                  ***  ROUTINE  stop_warn  ***
       !!
-      !! ** Purpose : ???  blah blah....
-      !!-----------------------------------------------------------------------
+      !! ** Purpose :   print in ocean.outpput file a error message and 
+      !!                increment the warning number (nwarn) by one.
+      !!----------------------------------------------------------------------
       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd1, cd2, cd3, cd4, cd5
       CHARACTER(len=*), INTENT(in), OPTIONAL ::  cd6, cd7, cd8, cd9, cd10
-      !!-----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       ! 
       nwarn = nwarn + 1 
@@ -152,24 +164,24 @@
 
    FUNCTION getunit()
-     !!-----------------------------------------------------------------------
-     !!                  ***  FUNCTION  getunit  ***
-     !!
-     !! ** Purpose : ???  blah blah....
-     !!-----------------------------------------------------------------------
-     INTEGER :: getunit
-     LOGICAL :: llopn 
-     !---------------------------------------------------------------------
-     getunit = 15   ! choose a unit that is big enough then it is
-                    !  not already used in OPA
-     llopn = .TRUE.
-     DO WHILE( (getunit < 998) .AND. llopn )
-        getunit = getunit + 1
-        INQUIRE( unit = getunit, opened = llopn )
-     END DO
-     IF( (getunit == 999) .AND. llopn ) THEN
-        CALL ctl_stop( 'getunit: All logical units until 999 are used...' )
-        getunit = -1
-     ENDIF
-
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  getunit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      INTEGER :: getunit
+      LOGICAL :: llopn 
+      !!----------------------------------------------------------------------
+      !
+      getunit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (getunit < 998) .AND. llopn )
+         getunit = getunit + 1
+         INQUIRE( unit = getunit, opened = llopn )
+      END DO
+      IF( (getunit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'getunit: All logical units until 999 are used...' )
+         getunit = -1
+      ENDIF
+      !
    END FUNCTION getunit
 
Index: /trunk/NEMO/OFF_SRC/IOM/iom.F90
===================================================================
--- /trunk/NEMO/OFF_SRC/IOM/iom.F90	(revision 1323)
+++ /trunk/NEMO/OFF_SRC/IOM/iom.F90	(revision 1324)
@@ -69,4 +69,5 @@
       LOGICAL               ::   llok      ! check the existence 
       LOGICAL               ::   llwrt     ! local definition of ldwrt
+      LOGICAL               ::   llnoov    ! local definition to read overlap
       LOGICAL               ::   llstop    ! local definition of ldstop
       INTEGER               ::   iolib     ! library do we use to open the file
@@ -104,9 +105,19 @@
       ELSE                         ;   iolib = jpnf90
       ENDIF
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+#if ! defined key_agrif
+      llnoov = (jpni * jpnj ) == jpnij
+#endif
       ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
       ! =============
       clname   = trim(cdname)
 #if defined key_agrif
-      if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      IF ( .NOT. Agrif_Root() ) THEN
+         iln    = INDEX(clname,'/') 
+         cltmpn = clname(1:iln)
+         clname = clname(iln+1:LEN_TRIM(clname))
+         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
+      ENDIF
 #endif    
       ! which suffix should we use?
@@ -149,6 +160,6 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !         idom = jpdom_local_noovlap   ! default definition
-         IF( jpni*jpnj == jpnij ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
-         ELSE                            ;   idom = jpdom_local_full      ! default definition
+         IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition
+         ELSE                ;   idom = jpdom_local_full      ! default definition
          ENDIF
          IF( PRESENT(kdom) )   idom = kdom
@@ -212,6 +223,7 @@
       !! ** Purpose : close an input file, or all files opened by iom
       !!--------------------------------------------------------------------
-      INTEGER, INTENT(in), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
-      !                                           ! No argument : all the files opened by iom are closed
+      INTEGER, INTENT(inout), OPTIONAL ::   kiomid   ! iom identifier of the file to be closed
+      !                                              ! return 0 when file is properly closed
+      !                                              ! No argument: all files opened by iom are closed
 
       INTEGER ::   jf         ! dummy loop indices
@@ -239,5 +251,6 @@
                   CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
                END SELECT
-               iom_file(jf)%nfid       = 0   ! free the id 
+               iom_file(jf)%nfid       = 0          ! free the id 
+               IF( PRESENT(kiomid) )   kiomid = 0   ! return 0 as id to specify that the file was closed
                IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
             ELSEIF( PRESENT(kiomid) ) THEN
@@ -409,4 +422,5 @@
       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis
       !
+      LOGICAL                        ::   llnoov      ! local definition to read overlap
       INTEGER                        ::   jl          ! loop on number of dimension 
       INTEGER                        ::   idom        ! type of domain
@@ -435,4 +449,9 @@
       ! local definition of the domain ?
       idom = kdom
+      ! do we read the overlap 
+      ! ugly patch SM+JMM+RB to overwrite global definition in some cases
+#if ! defined key_agrif
+      llnoov = (jpni * jpnj ) == jpnij
+#endif
       ! check kcount and kstart optionals parameters...
       IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
@@ -518,10 +537,10 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
-                  IF( jpni*jpnj == jpnij .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
+                  IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
                   ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
-                  IF( jpni*jpnj == jpnij ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
-                  ELSE                            ;   icnt(1:2) = (/ nlci           , nlcj            /)
+                  IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
+                  ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /)
                   ENDIF
                   IF( PRESENT(pv_r3d) ) THEN
@@ -556,6 +575,6 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)'
-               IF( jpni*jpnj == jpnij ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
-               ELSE                          ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
+               IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
+               ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)'
                ENDIF
             ENDIF
@@ -563,6 +582,6 @@
 ! JMM + SM: ugly patch before getting the new version of lib_mpp)
 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
-               IF( jpni*jpnj == jpnij ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
-               ELSE                          ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
+               IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
+               ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
                ENDIF
             ENDIF
@@ -585,5 +604,5 @@
 !         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
 !         ENDIF
-         IF( jpni*jpnj == jpnij ) THEN
+         IF( llnoov ) THEN
             IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej
             ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2)
@@ -607,6 +626,6 @@
 
          IF( istop == nstop ) THEN   ! no additional errors until this point...
-            IF(lwp) WRITE(numout,*) '           read '//TRIM(cdvar)//' in '//TRIM(iom_file(kiomid)%name)//' ok'
-            
+            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
+          
             !--- overlap areas and extra hallows (mpp)
             IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
Index: /trunk/NEMO/OFF_SRC/IOM/iom_def.F90
===================================================================
--- /trunk/NEMO/OFF_SRC/IOM/iom_def.F90	(revision 1323)
+++ /trunk/NEMO/OFF_SRC/IOM/iom_def.F90	(revision 1324)
@@ -43,5 +43,5 @@
    INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1)
 
-   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 20   !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 50   !: maximum number of simultaneously opened file
    INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 360  !: maximum number of variables in one file
    INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable
Index: /trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90
===================================================================
--- /trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90	(revision 1323)
+++ /trunk/NEMO/OFF_SRC/IOM/iom_ioipsl.F90	(revision 1324)
@@ -287,14 +287,14 @@
       !! ** Purpose : read the time axis cdvar in the file 
       !!--------------------------------------------------------------------
-      INTEGER                         , INTENT(in)           ::   kt       ! ocean time-step
-      INTEGER                         , INTENT(in)           ::   kwrite   ! writing time-step
-      INTEGER                         , INTENT(in)           ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! variable name
-      INTEGER                         , INTENT(in)           ::   kvid     ! variable id
-      INTEGER                         , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
-      REAL(wp)                        , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
-      REAL(wp), DIMENSION(        jpk), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
-      REAL(wp), DIMENSION(jpi,jpj    ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
       !
       INTEGER               :: idims                ! number of dimension
Index: /trunk/NEMO/OFF_SRC/IOM/iom_nf90.F90
===================================================================
--- /trunk/NEMO/OFF_SRC/IOM/iom_nf90.F90	(revision 1323)
+++ /trunk/NEMO/OFF_SRC/IOM/iom_nf90.F90	(revision 1324)
@@ -313,14 +313,14 @@
       !! ** Purpose : read the time axis cdvar in the file 
       !!--------------------------------------------------------------------
-      INTEGER                         , INTENT(in)           ::   kt       ! ocean time-step
-      INTEGER                         , INTENT(in)           ::   kwrite   ! writing time-step
-      INTEGER                         , INTENT(in)           ::   kiomid   ! Identifier of the file 
-      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! variable name
-      INTEGER                         , INTENT(in)           ::   kvid     ! variable id
-      INTEGER                         , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
-      REAL(wp)                        , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
-      REAL(wp), DIMENSION(        jpk), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
-      REAL(wp), DIMENSION(jpi,jpj    ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
+      INTEGER                     , INTENT(in)           ::   kt       ! ocean time-step
+      INTEGER                     , INTENT(in)           ::   kwrite   ! writing time-step
+      INTEGER                     , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)            , INTENT(in)           ::   cdvar    ! variable name
+      INTEGER                     , INTENT(in)           ::   kvid     ! variable id
+      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8)
+      REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field
+      REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field
+      REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field
+      REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field
       !
       INTEGER               :: idims                ! number of dimension
Index: /trunk/NEMO/OFF_SRC/lib_mpp.F90
===================================================================
--- /trunk/NEMO/OFF_SRC/lib_mpp.F90	(revision 1323)
+++ /trunk/NEMO/OFF_SRC/lib_mpp.F90	(revision 1324)
@@ -26,5 +26,5 @@
    !!                mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
    !!   mpp_max    : generic interface for :
-   !!                mppmax_real, mppmax_a_real
+   !!                mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
    !!   mpp_sum    : generic interface for :
    !!                mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
@@ -45,7 +45,8 @@
    !!        !  04  (R. Bourdalle Badie)  isend option in mpi
    !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
+   !! $Id$
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!---------------------------------------------------------------------
@@ -59,5 +60,8 @@
    PUBLIC  mynode, mpparent, mpp_isl, mpp_min, mpp_max, mpp_sum,  mpp_lbc_north
    PUBLIC  mpp_lbc_north_e, mpp_minloc, mpp_maxloc, mpp_lnk_3d, mpp_lnk_2d, mpp_lnk_3d_gather, mpp_lnk_2d_e, mpplnks
-   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync
+   PUBLIC  mpprecv, mppsend, mppscatter, mppgather, mppobc, mpp_ini_north, mppstop, mppsync, mpp_ini_ice, mpp_comm_free
+#if defined key_oasis3 || defined key_oasis4
+   PUBLIC  mppsize, mpprank
+#endif
 
    !! * Interfaces
@@ -73,5 +77,5 @@
    END INTERFACE
    INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_real, mppmax_real
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
    END INTERFACE
    INTERFACE mpp_sum
@@ -94,6 +98,5 @@
    !! The processor number is a required power of two : 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024,...
    INTEGER, PARAMETER ::   &
-      nprocmax = 2**10,    &  ! maximun dimension
-      ndim_mpp = jpnij        ! dimension for this simulation
+      nprocmax = 2**10     ! maximun dimension
 
 #if defined key_mpp_mpi
@@ -106,7 +109,16 @@
 
    INTEGER ::   &
-      size,     &  ! number of process
-      rank         ! process number  [ 0 - size-1 ]
-
+      mppsize,  &  ! number of process
+      mpprank,  &  ! process number  [ 0 - size-1 ]
+      mpi_comm_opa ! opa local communicator
+
+   ! variables used in case of sea-ice
+   INTEGER, PUBLIC ::  &       !
+      ngrp_ice,        &       ! group ID for the ice processors (to compute rheology)
+      ncomm_ice,       &       ! communicator made by the processors with sea-ice
+      ndim_rank_ice,   &       ! number of 'ice' processors
+      n_ice_root               ! number (in the comm_ice) of proc 0 in the ice comm
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   &
+      nrank_ice            ! dimension ndim_rank_north, number of the procs belonging to ncomm_north
    ! variables used in case of north fold condition in mpp_mpi with jpni > 1
    INTEGER ::      &       !
@@ -117,5 +129,5 @@
       njmppmax             ! value of njmpp for the processors of the northern line
    INTEGER ::      &       !
-      north_root           ! number (in the comm_world) of proc 0 in the northern comm
+      north_root           ! number (in the comm_opa) of proc 0 in the northern comm
    INTEGER, DIMENSION(:), ALLOCATABLE ::   &
       nrank_north          ! dimension ndim_rank_north, number of the procs belonging to ncomm_north
@@ -124,5 +136,7 @@
    LOGICAL  ::           &
       l_isend = .FALSE.    ! isend use indicator (T if c_mpi_send='I')
-
+   INTEGER ::            & ! size of the buffer in case of mpi_bsend 
+      nn_buffer = 0
+   REAL(kind=wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
 
 #elif defined key_mpp_shmem
@@ -266,5 +280,5 @@
    !!----------------------------------------------------------------------
    !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-   !! $Id$ 
+   !! $Id$
    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    !!---------------------------------------------------------------------
@@ -272,5 +286,5 @@
 CONTAINS
 
-   FUNCTION mynode()
+   FUNCTION mynode(localComm)
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
@@ -281,6 +295,8 @@
 #if defined key_mpp_mpi
       !! * Local variables   (MPI version)
-      INTEGER ::   mynode, ierr
-      NAMELIST/nammpp/ c_mpi_send
+      INTEGER ::   mynode, ierr, code
+      LOGICAL ::   mpi_was_called
+      INTEGER,OPTIONAL ::   localComm
+      NAMELIST/nammpp/ c_mpi_send, nn_buffer
       !!----------------------------------------------------------------------
 
@@ -300,27 +316,80 @@
       IF( Agrif_Root() ) THEN
 #endif
+!!bug RB : should be clean to use Agrif in coupled mode
+#if ! defined key_agrif
+         CALL mpi_initialized ( mpi_was_called, code )
+         IF( code /= MPI_SUCCESS ) THEN
+            CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+
+         IF( PRESENT(localComm) .and. mpi_was_called ) THEN
+            mpi_comm_opa = localComm
+            SELECT CASE ( c_mpi_send )
+            CASE ( 'S' )                ! Standard mpi send (blocking)
+               WRITE(numout,*) '           Standard blocking mpi send (send)'
+            CASE ( 'B' )                ! Buffer mpi send (blocking)
+               WRITE(numout,*) '           Buffer blocking mpi send (bsend)'
+               CALL mpi_init_opa( ierr ) 
+            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+               WRITE(numout,*) '           Immediate non-blocking send (isend)'
+               l_isend = .TRUE.
+            CASE DEFAULT
+               WRITE(numout,cform_err)
+               WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send
+               nstop = nstop + 1
+            END SELECT
+         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+            WRITE(numout,*) ' lib_mpp: You cannot provide a local communicator '
+            WRITE(numout,*) '          without calling MPI_Init before ! '
+         ELSE
+#endif
+            SELECT CASE ( c_mpi_send )
+            CASE ( 'S' )                ! Standard mpi send (blocking)
+               WRITE(numout,*) '           Standard blocking mpi send (send)'
+               CALL mpi_init( ierr )
+            CASE ( 'B' )                ! Buffer mpi send (blocking)
+               WRITE(numout,*) '           Buffer blocking mpi send (bsend)'
+               CALL mpi_init_opa( ierr )
+            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+               WRITE(numout,*) '           Immediate non-blocking send (isend)'
+               l_isend = .TRUE.
+               CALL mpi_init( ierr )
+            CASE DEFAULT
+               WRITE(ctmp1,*) '           bad value for c_mpi_send = ', c_mpi_send
+               CALL ctl_stop( ctmp1 )
+            END SELECT
+
+#if ! defined key_agrif
+            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
+            IF( code /= MPI_SUCCESS ) THEN
+               CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
+               CALL mpi_abort( mpi_comm_world, code, ierr )
+            ENDIF
+            !
+         ENDIF
+#endif
+#if defined key_agrif
+      ELSE
          SELECT CASE ( c_mpi_send )
          CASE ( 'S' )                ! Standard mpi send (blocking)
             WRITE(numout,*) '           Standard blocking mpi send (send)'
-            CALL mpi_init( ierr )
          CASE ( 'B' )                ! Buffer mpi send (blocking)
             WRITE(numout,*) '           Buffer blocking mpi send (bsend)'
-            CALL mpi_init_opa( ierr )
          CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
             WRITE(numout,*) '           Immediate non-blocking send (isend)'
             l_isend = .TRUE.
-            CALL mpi_init( ierr )
          CASE DEFAULT
-            WRITE(ctmp1,*) '           bad value for c_mpi_send = ', c_mpi_send
-            CALL ctl_stop( ctmp1 )
+            WRITE(numout,cform_err)
+            WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send
+            nstop = nstop + 1
          END SELECT
-
-#if defined key_agrif
       ENDIF
-#endif
-
-      CALL mpi_comm_rank( mpi_comm_world, rank, ierr )
-      CALL mpi_comm_size( mpi_comm_world, size, ierr )
-      mynode = rank
+
+      mpi_comm_opa = mpi_comm_world
+#endif
+        CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
+        CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
+      mynode = mpprank
 #else
       !! * Local variables   (SHMEM version)
@@ -356,10 +425,10 @@
             npvm_tids(0) = npvm_mytid
             npvm_me = 0
-            IF( ndim_mpp > nprocmax ) THEN
+            IF( jpnij > nprocmax ) THEN
                WRITE(ctmp1,*) 'npvm_mytid=', npvm_mytid, ' too great'
                CALL ctl_stop( ctmp1 )
 
             ELSE
-               npvm_nproc = ndim_mpp
+               npvm_nproc = jpnij
             ENDIF
 
@@ -476,9 +545,9 @@
          ENDIF
          !          --- END receive dimension ---
-         IF( ndim_mpp > nprocmax ) THEN
+         IF( jpnij > nprocmax ) THEN
             WRITE(ctmp1,*) 'mytid=',nt3d_mytid,' too great'
             CALL ctl_stop( ctmp1 )
          ELSE
-            nt3d_nproc =  ndim_mpp
+            nt3d_nproc =  jpnij
          ENDIF
          IF( mpparent_print /= 0 ) THEN
@@ -538,5 +607,5 @@
 #endif
 
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp )
+   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_3d  ***
@@ -573,10 +642,12 @@
       CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
          cd_mpp        ! fill the overlap area only 
+      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
 
       !! * Local variables
-      INTEGER ::   ji, jk, jl   ! dummy loop indices
+      INTEGER ::   ji, jj, jk, jl                        ! dummy loop indices
       INTEGER ::   imigr, iihom, ijhom, iloc, ijt, iju   ! temporary integers
       INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
       INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
+      REAL(wp) ::   zland
       !!----------------------------------------------------------------------
 
@@ -584,8 +655,17 @@
       ! ------------------------------
 
+      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
+         zland = pval
+      ELSE
+         zland = 0.e0
+      ENDIF
+
       IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill extra allows with 1.
-         ptab(     1:nlci, nlcj+1:jpj, :) = 1.e0
-         ptab(nlci+1:jpi ,       :   , :) = 1.e0
+         DO jj = nlcj+1, jpj   ! only fill extra allows last line
+            ptab(1:nlci, jj, :) = ptab(1:nlci, nlej, :)
+         END DO
+         DO ji = nlci+1, jpi   ! only fill extra allows last column
+            ptab(ji    , : , :) = ptab(nlei  , :   , :)
+         END DO
       ELSE      
 
@@ -600,8 +680,8 @@
             SELECT CASE ( cd_type )
             CASE ( 'T', 'U', 'V', 'W' )
-               ptab(     1       :jpreci,:,:) = 0.e0
-               ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+               ptab(     1       :jpreci,:,:) = zland
+               ptab(nlci-jpreci+1:jpi   ,:,:) = zland
             CASE ( 'F' )
-               ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+               ptab(nlci-jpreci+1:jpi   ,:,:) = zland
             END SELECT 
          ENDIF
@@ -611,8 +691,8 @@
          SELECT CASE ( cd_type )
          CASE ( 'T', 'U', 'V', 'W' )
-            ptab(:,     1       :jprecj,:) = 0.e0
-            ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+            ptab(:,     1       :jprecj,:) = zland
+            ptab(:,nlcj-jprecj+1:jpj   ,:) = zland
          CASE ( 'F' )
-            ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+            ptab(:,nlcj-jprecj+1:jpj   ,:) = zland
          END SELECT
      
@@ -791,5 +871,5 @@
 
       CASE ( 1 )  ! only one proc along I, no mpp exchange
-
+       
          SELECT CASE ( npolj )
   
@@ -810,5 +890,5 @@
                   END DO
                END DO
-          
+
             CASE ( 'U' )
                DO jk = 1, jpk
@@ -988,5 +1068,5 @@
 
 
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp )
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_lnk_2d  ***
@@ -1022,4 +1102,5 @@
       CHARACTER(len=3), INTENT( in ), OPTIONAL ::    &
          cd_mpp        ! fill the overlap area only 
+      REAL(wp)        , INTENT(in   ), OPTIONAL           ::   pval      ! background value (used at closed boundaries)
 
       !! * Local variables
@@ -1030,13 +1111,22 @@
       INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
       INTEGER  ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
+      REAL(wp) ::   zland
       !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN      ! set land value (zero by default)
+         zland = pval
+      ELSE
+         zland = 0.e0
+      ENDIF
 
       ! 1. standard boundary treatment
       ! ------------------------------
       IF (PRESENT(cd_mpp)) THEN
-         ! only fill extra allows with 1.
-         pt2d(     1:nlci, nlcj+1:jpj) = 1.e0
-         pt2d(nlci+1:jpi ,       :   ) = 1.e0
-     
+         DO jj = nlcj+1, jpj   ! only fill extra allows last line
+            pt2d(1:nlci, jj) = pt2d(1:nlci, nlej)
+         END DO
+         DO ji = nlci+1, jpi   ! only fill extra allows last column
+            pt2d(ji    , : ) = pt2d(nlei  , :   )
+         END DO     
       ELSE      
 
@@ -1051,8 +1141,8 @@
             SELECT CASE ( cd_type )
             CASE ( 'T', 'U', 'V', 'W' , 'I' )
-               pt2d(     1       :jpreci,:) = 0.e0
-               pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0
+               pt2d(     1       :jpreci,:) = zland
+               pt2d(nlci-jpreci+1:jpi   ,:) = zland
             CASE ( 'F' )
-               pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0
+               pt2d(nlci-jpreci+1:jpi   ,:) = zland
             END SELECT
          ENDIF
@@ -1062,8 +1152,8 @@
          SELECT CASE ( cd_type )
          CASE ( 'T', 'U', 'V', 'W' , 'I' )
-            pt2d(:,     1       :jprecj) = 0.e0
-            pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0
+            pt2d(:,     1       :jprecj) = zland
+            pt2d(:,nlcj-jprecj+1:jpj   ) = zland
          CASE ( 'F' )
-            pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0
+            pt2d(:,nlcj-jprecj+1:jpj   ) = zland
          END SELECT
 
@@ -1330,5 +1420,5 @@
   
             CASE ( 'I' )                                  ! ice U-V point
-               pt2d( 2 ,nlcj) = 0.e0
+               pt2d( 2 ,nlcj) = zland
                DO ji = 2 , nlci-1
                   ijt = iloc - ji + 2
@@ -2780,12 +2870,12 @@
       CASE ( 'S' )                ! Standard mpi send (blocking)
          CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
-            &                          mpi_comm_world, iflag )
+            &                          mpi_comm_opa, iflag )
       CASE ( 'B' )                ! Buffer mpi send (blocking)
          CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
-            &                          mpi_comm_world, iflag )
+            &                          mpi_comm_opa, 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_world, md_req, iflag )
+            &                          mpi_comm_opa, md_req, iflag )
       END SELECT
 #endif
@@ -2815,5 +2905,5 @@
 
       CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp,   &
-         &                          mpi_comm_world, istatus, iflag )
+         &                          mpi_comm_opa, istatus, iflag )
 #endif
 
@@ -2849,5 +2939,5 @@
       itaille=jpi*jpj
       CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille,   &
-         &                            mpi_double_precision, kp , mpi_comm_world, ierror ) 
+         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
 #endif
 
@@ -2883,5 +2973,5 @@
 
       CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille,   &
-         &                            mpi_double_precision, kp, mpi_comm_world, ierror )
+         &                            mpi_double_precision, kp, mpi_comm_opa, ierror )
 #endif
 
@@ -2944,5 +3034,5 @@
       CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror )
       CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer   &
-           , mpi_isl, mpi_comm_world, ierror )
+           , mpi_isl, mpi_comm_opa, ierror )
       ktab(:) = iwork(:)
 #endif
@@ -2998,5 +3088,5 @@
       CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
       CALL mpi_allreduce(ktab, iwork, 1,mpi_integer   &
-           ,mpi_isl,mpi_comm_world,ierror)
+           ,mpi_isl,mpi_comm_opa,ierror)
       ktab = iwork
 #endif
@@ -3005,5 +3095,115 @@
 
 
-   SUBROUTINE mppmin_a_int( ktab, kdim )
+   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_a_int  ***
+      !! 
+      !! ** Purpose :   Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+      INTEGER , INTENT(in)   , OPTIONAL        ::   kcom  
+  
+#if defined key_mpp_shmem
+      !! * Local declarations    (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+  
+      IF( kdim > jpmppsum ) CALL ctl_stop( 'mppmax_a_int routine : kdim is too big', &
+           &                               'change jpmppsum dimension in mpp.h' )
+  
+      DO ji = 1, kdim
+         niltab_shmem(ji) = ktab(ji)
+      END DO
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+      ELSE
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
+      ENDIF
+      CALL  barrier()
+      ibool=ibool+1
+      ibool=MOD( ibool,2)
+      DO ji = 1, kdim
+         ktab(ji) = niltab_shmem(ji)
+      END DO
+  
+#  elif defined key_mpp_mpi
+  
+      !! * Local variables   (MPI version)
+      INTEGER :: ierror
+      INTEGER :: localcomm
+      INTEGER, DIMENSION(kdim) ::   iwork
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+  
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
+           &                mpi_max, localcomm, ierror )
+  
+      ktab(:) = iwork(:)
+#endif
+
+   END SUBROUTINE mppmax_a_int
+
+
+   SUBROUTINE mppmax_int( ktab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_int  ***
+      !!
+      !! ** Purpose :
+      !!     Massively parallel processors
+      !!     Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(inout) ::   ktab      ! ???
+      INTEGER, INTENT(in), OPTIONAL ::   kcom      ! ???
+  
+      !! * Local declarations
+
+#if defined key_mpp_shmem
+
+      !! * Local variables   (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+  
+      niltab_shmem(1) = ktab
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+      ELSE
+         CALL shmem_int8_max_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+              ,N$PES,nil2wrk_shmem,nil2sync_shmem )
+      ENDIF
+      CALL  barrier()
+      ibool=ibool+1
+      ibool=MOD( ibool,2)
+      ktab = niltab_shmem(1)
+  
+#  elif defined key_mpp_mpi
+
+      !! * Local variables   (MPI version)
+      INTEGER ::  ierror, iwork
+      INTEGER :: localcomm
+
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
+           &              ,mpi_max,localcomm,ierror)
+  
+      ktab = iwork
+#endif
+
+   END SUBROUTINE mppmax_int
+
+
+   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
       !!----------------------------------------------------------------------
       !!                  ***  routine mppmin_a_int  ***
@@ -3015,4 +3215,5 @@
       INTEGER , INTENT( in  )                  ::   kdim        ! size of array
       INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
   
 #if defined key_mpp_shmem
@@ -3046,8 +3247,12 @@
       !! * Local variables   (MPI version)
       INTEGER :: ierror
+      INTEGER :: localcomm
       INTEGER, DIMENSION(kdim) ::   iwork
   
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
       CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
-           &                mpi_min, mpi_comm_world, ierror )
+           &                mpi_min, localcomm, ierror )
   
       ktab(:) = iwork(:)
@@ -3097,5 +3302,5 @@
   
       CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
-           &              ,mpi_min,mpi_comm_world,ierror)
+           &              ,mpi_min,mpi_comm_opa,ierror)
   
       ktab = iwork
@@ -3151,5 +3356,5 @@
   
       CALL mpi_allreduce(ktab, iwork,kdim,mpi_integer   &
-           ,mpi_sum,mpi_comm_world,ierror)
+           ,mpi_sum,mpi_comm_opa,ierror)
   
       ktab(:) = iwork(:)
@@ -3194,5 +3399,5 @@
 
     CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
-         ,mpi_sum,mpi_comm_world,ierror)
+         ,mpi_sum,mpi_comm_opa,ierror)
 
     ktab = iwork
@@ -3262,5 +3467,5 @@
     CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
     CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         ,mpi_isl,mpi_comm_world,ierror)
+         ,mpi_isl,mpi_comm_opa,ierror)
     ptab(:) = zwork(:)
 
@@ -3320,5 +3525,5 @@
       CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror )
       CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision,   &
-         &                                mpi_isl  , mpi_comm_world, ierror )
+         &                                mpi_isl  , mpi_comm_opa, ierror )
       ptab = zwork
 
@@ -3328,5 +3533,5 @@
 
 
-  FUNCTION lc_isl( py, px, kdim, kdtatyp )
+  FUNCTION lc_isl( py, px, kdim )
     INTEGER :: kdim
     REAL(wp), DIMENSION(kdim) ::  px, py
@@ -3341,5 +3546,5 @@
 
 
-  SUBROUTINE mppmax_a_real( ptab, kdim )
+  SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
     !!----------------------------------------------------------------------
     !!                 ***  routine mppmax_a_real  ***
@@ -3351,4 +3556,5 @@
     INTEGER , INTENT( in  )                  ::   kdim
     REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom
 
 #if defined key_mpp_shmem
@@ -3383,8 +3589,12 @@
     !! * Local variables   (MPI version)
     INTEGER :: ierror
+    INTEGER :: localcomm
     REAL(wp), DIMENSION(kdim) ::  zwork
 
+    localcomm = mpi_comm_opa
+    IF( PRESENT(kcom) ) localcomm = kcom
+
     CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         ,mpi_max,mpi_comm_world,ierror)
+         ,mpi_max,localcomm,ierror)
     ptab(:) = zwork(:)
 
@@ -3394,5 +3604,5 @@
 
 
-  SUBROUTINE mppmax_real( ptab )
+  SUBROUTINE mppmax_real( ptab, kcom )
     !!----------------------------------------------------------------------
     !!                  ***  routine mppmax_real  ***
@@ -3403,4 +3613,5 @@
     !! * Arguments
     REAL(wp), INTENT(inout) ::   ptab      ! ???
+    INTEGER , INTENT( in  ), OPTIONAL ::   kcom      ! ???
 
 #if defined key_mpp_shmem
@@ -3427,8 +3638,12 @@
     !! * Local variables   (MPI version)
     INTEGER  ::   ierror
+    INTEGER  ::   localcomm
     REAL(wp) ::   zwork
 
+    localcomm = mpi_comm_opa 
+    IF( PRESENT(kcom) ) localcomm = kcom
+
     CALL mpi_allreduce( ptab, zwork  , 1             , mpi_double_precision,   &
-       &                      mpi_max, mpi_comm_world, ierror     )
+       &                      mpi_max, localcomm, ierror     )
     ptab = zwork
 
@@ -3438,5 +3653,5 @@
 
 
-  SUBROUTINE mppmin_a_real( ptab, kdim )
+  SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
     !!----------------------------------------------------------------------
     !!                 ***  routine mppmin_a_real  ***
@@ -3448,4 +3663,5 @@
     INTEGER , INTENT( in  )                  ::   kdim
     REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+    INTEGER , INTENT( in  ), OPTIONAL        ::   kcom
 
 #if defined key_mpp_shmem
@@ -3480,8 +3696,12 @@
     !! * Local variables   (MPI version)
     INTEGER :: ierror
+    INTEGER :: localcomm 
     REAL(wp), DIMENSION(kdim) ::   zwork
 
+    localcomm = mpi_comm_opa 
+    IF( PRESENT(kcom) ) localcomm = kcom
+
     CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         ,mpi_min,mpi_comm_world,ierror)
+         ,mpi_min,localcomm,ierror)
     ptab(:) = zwork(:)
 
@@ -3491,5 +3711,5 @@
 
 
-  SUBROUTINE mppmin_real( ptab )
+  SUBROUTINE mppmin_real( ptab, kcom )
     !!----------------------------------------------------------------------
     !!                  ***  routine mppmin_real  ***
@@ -3501,4 +3721,5 @@
     !! * Arguments
     REAL(wp), INTENT( inout ) ::   ptab        ! 
+    INTEGER , INTENT(  in   ), OPTIONAL :: kcom
 
 #if defined key_mpp_shmem
@@ -3526,7 +3747,11 @@
     INTEGER  ::   ierror
     REAL(wp) ::   zwork
+    INTEGER :: localcomm
+
+    localcomm = mpi_comm_opa 
+    IF( PRESENT(kcom) ) localcomm = kcom
 
     CALL mpi_allreduce( ptab, zwork, 1,mpi_double_precision   &
-         &               ,mpi_min,mpi_comm_world,ierror)
+         &               ,mpi_min,localcomm,ierror)
     ptab = zwork
 
@@ -3536,5 +3761,5 @@
 
 
-  SUBROUTINE mppsum_a_real( ptab, kdim )
+  SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
     !!----------------------------------------------------------------------
     !!                  ***  routine mppsum_a_real  ***
@@ -3546,4 +3771,5 @@
     INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
     REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
+    INTEGER , INTENT( in ), OPTIONAL           :: kcom
 
 #if defined key_mpp_shmem
@@ -3578,8 +3804,13 @@
     !! * Local variables   (MPI version)
     INTEGER                   ::   ierror    ! temporary integer
+    INTEGER                   ::   localcomm 
     REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
+    
+
+    localcomm = mpi_comm_opa 
+    IF( PRESENT(kcom) ) localcomm = kcom
 
     CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
-         &              ,mpi_sum,mpi_comm_world,ierror)
+         &              ,mpi_sum,localcomm,ierror)
     ptab(:) = zwork(:)
 
@@ -3589,5 +3820,5 @@
 
 
-  SUBROUTINE mppsum_real( ptab )
+  SUBROUTINE mppsum_real( ptab, kcom )
     !!----------------------------------------------------------------------
     !!                  ***  routine mppsum_real  ***
@@ -3598,4 +3829,5 @@
     !!-----------------------------------------------------------------------
     REAL(wp), INTENT(inout) ::   ptab        ! input scalar
+    INTEGER , INTENT( in  ), OPTIONAL :: kcom
 
 #if defined key_mpp_shmem
@@ -3622,8 +3854,12 @@
     !! * Local variables   (MPI version)
     INTEGER  ::   ierror
+    INTEGER  ::   localcomm 
     REAL(wp) ::   zwork
 
-    CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   &
-         &              ,mpi_sum,mpi_comm_world,ierror)
+   localcomm = mpi_comm_opa 
+   IF( PRESENT(kcom) ) localcomm = kcom
+ 
+   CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   &
+         &              ,mpi_sum,localcomm,ierror)
     ptab = zwork
 
@@ -3672,5 +3908,5 @@
     zain(2,:)=ki+10000.*kj
 
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,ierror)
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
 
     pmin=zaout(1,1)
@@ -3723,5 +3959,5 @@
     zain(2,:)=ki+10000.*kj+100000000.*kk
 
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,ierror)
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
 
     pmin=zaout(1,1)
@@ -3774,5 +4010,5 @@
     zain(2,:)=ki+10000.*kj
 
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,ierror)
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
 
     pmax=zaout(1,1)
@@ -3824,5 +4060,5 @@
     zain(2,:)=ki+10000.*kj+100000000.*kk
 
-    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,ierror)
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
 
     pmax=zaout(1,1)
@@ -3852,5 +4088,5 @@
     INTEGER :: ierror
 
-    CALL mpi_barrier(mpi_comm_world,ierror)
+    CALL mpi_barrier(mpi_comm_opa,ierror)
 
 #endif
@@ -4125,4 +4361,97 @@
   END SUBROUTINE mppobc
 
+  SUBROUTINE mpp_comm_free( kcom)
+
+     INTEGER, INTENT(in) :: kcom
+     INTEGER :: ierr
+
+     CALL MPI_COMM_FREE(kcom, ierr)
+
+  END SUBROUTINE mpp_comm_free
+
+
+  SUBROUTINE mpp_ini_ice(pindic)
+    !!----------------------------------------------------------------------
+    !!               ***  routine mpp_ini_ice  ***
+    !!
+    !! ** Purpose :   Initialize special communicator for ice areas
+    !!      condition together with global variables needed in the ddmpp folding
+    !!
+    !! ** Method  : - Look for ice processors in ice routines
+    !!              - Put their number in nrank_ice
+    !!              - Create groups for the world processors and the ice processors
+    !!              - Create a communicator for ice processors
+    !!
+    !! ** output
+    !!      njmppmax = njmpp for northern procs
+    !!      ndim_rank_ice = number of processors in the northern line
+    !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+    !!      ngrp_world = group ID for the world processors
+    !!      ngrp_ice = group ID for the ice processors
+    !!      ncomm_ice = communicator for the ice procs.
+    !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
+    !!
+    !! History :
+    !!        !  03-09 (J.M. Molines, MPI only )
+    !!----------------------------------------------------------------------
+#ifdef key_mpp_shmem
+    CALL ctl_stop( ' mpp_ini_ice not available in SHMEM' )
+# elif key_mpp_mpi
+    INTEGER, INTENT(in) :: pindic
+    INTEGER :: ierr
+    INTEGER :: jproc
+    INTEGER :: ii
+    INTEGER, DIMENSION(jpnij) :: kice
+    INTEGER, DIMENSION(jpnij) :: zwork
+    !!----------------------------------------------------------------------
+
+    ! Look for how many procs with sea-ice
+    !
+    kice = 0
+    DO jproc=1,jpnij
+       IF(jproc == narea .AND. pindic .GT. 0) THEN
+          kice(jproc) = 1    
+       ENDIF        
+    END DO
+
+    zwork = 0
+    CALL MPI_ALLREDUCE( kice, zwork,jpnij, mpi_integer,   &
+                       mpi_sum, mpi_comm_opa, ierr )
+    ndim_rank_ice = sum(zwork)          
+
+    ! Allocate the right size to nrank_north
+#if ! defined key_agrif
+    IF(ALLOCATED(nrank_ice)) DEALLOCATE(nrank_ice)
+#else
+    DEALLOCATE(nrank_ice)
+#endif
+
+    ALLOCATE(nrank_ice(ndim_rank_ice))
+
+    ii = 0     
+    nrank_ice = 0
+    DO jproc=1,jpnij
+       IF(zwork(jproc) == 1) THEN
+          ii = ii + 1
+          nrank_ice(ii) = jproc -1 
+       ENDIF        
+    END DO
+
+    ! Create the world group
+    CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_world,ierr)
+
+    ! Create the ice group from the world group
+    CALL MPI_GROUP_INCL(ngrp_world,ndim_rank_ice,nrank_ice,ngrp_ice,ierr)
+
+    ! Create the ice communicator , ie the pool of procs with sea-ice
+    CALL MPI_COMM_CREATE(mpi_comm_opa,ngrp_ice,ncomm_ice,ierr)
+
+    ! Find proc number in the world of proc 0 in the north
+    ! The following line seems to be useless, we just comment & keep it as reminder
+    ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
+#endif
+
+  END SUBROUTINE mpp_ini_ice
+
 
   SUBROUTINE mpp_ini_north
@@ -4186,5 +4515,5 @@
     ! create the world group
     !
-    CALL MPI_COMM_GROUP(mpi_comm_world,ngrp_world,ierr)
+    CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_world,ierr)
     !
     ! Create the North group from the world group
@@ -4193,5 +4522,5 @@
     ! Create the North communicator , ie the pool of procs in the north group
     !
-    CALL MPI_COMM_CREATE(mpi_comm_world,ngrp_north,ncomm_north,ierr)
+    CALL MPI_COMM_CREATE(mpi_comm_opa,ngrp_north,ncomm_north,ierr)
 
 
@@ -4957,76 +5286,44 @@
    END SUBROUTINE mpp_lbc_north_e
 
-
-   !!!!!
-
-
-   !! 
-   !!    This is valid on IBM machine ONLY. 
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -*- Mode: F90 -*- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! mpi_init_opa.f90 : Redefinition du point d'entree MPI_INIT de la bibliotheque
-   !!                MPI afin de faire, en plus de l'initialisation de
-   !!                l'environnement MPI, l'allocation d'une zone tampon
-   !!                qui sera ulterieurement utilisee automatiquement lors
-   !!                de tous les envois de messages par MPI_BSEND
-   !!
-   !! Auteur : CNRS/IDRIS
-   !! Date   : Tue Nov 13 12:02:14 2001
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
    SUBROUTINE mpi_init_opa(code)
-      IMPLICIT NONE
-
-!$AGRIF_DO_NOT_TREAT
-#     include <mpif.h>
-!$AGRIF_END_DO_NOT_TREAT
-
-      INTEGER                                 :: code,rang
+     !!---------------------------------------------------------------------
+     !!                   ***  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
+     !!
+     !!---------------------------------------------------------------------
+
+      INTEGER                                 :: code, ierr
+      LOGICAL                                 :: mpi_was_called
  
-      ! La valeur suivante doit etre au moins egale a la taille
-      ! du plus grand message qui sera transfere dans le programme
-      ! (de toute facon, il y aura un message d'erreur si cette
-      ! valeur s'avere trop petite)
-      INTEGER                                 :: taille_tampon
-      CHARACTER(len=9)                        :: taille_tampon_alphanum
-      REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: tampon
- 
-      ! Le point d'entree dans la bibliotheque MPI elle-meme
-      CALL mpi_init(code)
-
-      ! La definition de la zone tampon pour les futurs envois
-      ! par MPI_BSEND (on alloue une fois pour toute cette zone
-      ! tampon, qui sera automatiquement utilisee lors de chaque
-      ! appel  a MPI_BSEND).
-      ! La desallocation sera implicite quand on sortira de
-      ! l'environnement MPI.
-
-      ! Recuperation de la valeur de la variable d'environnement
-      ! BUFFER_LENGTH
-      ! qui, si elle est definie, doit contenir une valeur superieure
-      ! a  la taille en octets du plus gros message
-      CALL getenv('BUFFER_LENGTH',taille_tampon_alphanum)
-  
-      ! Si la variable BUFFER_LENGTH n'est pas positionnee, on lui met par
-      ! defaut la plus grande valeur de la variable MP_EAGER_LIMIT, soit
-      ! 65 536 octets
-      IF (taille_tampon_alphanum == ' ') THEN
-         taille_tampon = 65536
-      ELSE
-         READ(taille_tampon_alphanum,'(i9)') taille_tampon
-      END IF
-
-      ! On est limite en mode d'adressage 32 bits a  1750 Mo pour la zone
-      ! "data" soit 7 segments, c.-a -d. 1750/8 = 210 Mo
-      IF (taille_tampon > 210000000) THEN
-         PRINT *,'Attention la valeur BUFFER_LENGTH doit etre <= 210000000'
-         CALL mpi_abort(MPI_COMM_WORLD,2,code)
-      END IF
-
-      CALL mpi_comm_rank(MPI_COMM_WORLD,rang,code)
-      IF (rang == 0 ) PRINT *,'Taille du buffer alloue : ',taille_tampon
-
-      ! Allocation du tampon et attachement
-      ALLOCATE(tampon(taille_tampon))
-      CALL mpi_buffer_attach(tampon,taille_tampon,code)
+      ! MPI initialization
+      CALL mpi_initialized(mpi_was_called, code)
+      IF ( code /= MPI_SUCCESS ) THEN
+        CALL ctl_stop( ' 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_opa, code)
+         IF ( code /= MPI_SUCCESS ) THEN
+            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+
+      IF( nn_buffer > 0 ) THEN
+         IF ( lwp ) WRITE(numout,*) 'mpi_bsend, buffer allocation of  : ', nn_buffer
+
+         ! Buffer allocation and attachment
+         ALLOCATE(tampon(nn_buffer))
+         CALL mpi_buffer_attach(tampon,nn_buffer,code)
+      ENDIF
 
    END SUBROUTINE mpi_init_opa
@@ -5040,5 +5337,5 @@
    END INTERFACE
    INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_real, mppmax_real
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
    END INTERFACE
    INTERFACE mpp_min
@@ -5060,8 +5357,10 @@
 
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   INTEGER :: ncomm_ice
 
 CONTAINS
 
-   FUNCTION mynode() RESULT (function_value)
+   FUNCTION mynode(localComm) RESULT (function_value)
+      INTEGER, OPTIONAL :: localComm
       function_value = 0
    END FUNCTION mynode
@@ -5070,63 +5369,87 @@
    END SUBROUTINE mppsync
 
-   SUBROUTINE mpp_sum_as( parr, kdim )      ! Dummy routine
+   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
       REAL   , DIMENSION(:) :: parr
       INTEGER               :: kdim
-      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1)
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
    END SUBROUTINE mpp_sum_as
 
-   SUBROUTINE mpp_sum_a2s( parr, kdim )      ! Dummy routine
+   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
       REAL   , DIMENSION(:,:) :: parr
       INTEGER               :: kdim
-      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1)
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
    END SUBROUTINE mpp_sum_a2s
 
-   SUBROUTINE mpp_sum_ai( karr, kdim )      ! Dummy routine
+   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
       INTEGER, DIMENSION(:) :: karr
       INTEGER               :: kdim
-      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1)
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
    END SUBROUTINE mpp_sum_ai
 
-   SUBROUTINE mpp_sum_s( psca )            ! Dummy routine
+   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
       REAL                  :: psca
-      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
    END SUBROUTINE mpp_sum_s
 
-   SUBROUTINE mpp_sum_i( kint )            ! Dummy routine
+   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
       integer               :: kint
-      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
    END SUBROUTINE mpp_sum_i
 
-   SUBROUTINE mppmax_a_real( parr, kdim )
+   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
       REAL   , DIMENSION(:) :: parr
       INTEGER               :: kdim
-      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1)
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
    END SUBROUTINE mppmax_a_real
 
-   SUBROUTINE mppmax_real( psca )
+   SUBROUTINE mppmax_real( psca, kcom )
       REAL                  :: psca
-      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
    END SUBROUTINE mppmax_real
 
-   SUBROUTINE mppmin_a_real( parr, kdim )
+   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
       REAL   , DIMENSION(:) :: parr
       INTEGER               :: kdim
-      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1)
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
    END SUBROUTINE mppmin_a_real
 
-   SUBROUTINE mppmin_real( psca )
+   SUBROUTINE mppmin_real( psca, kcom )
       REAL                  :: psca
-      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
    END SUBROUTINE mppmin_real
 
-   SUBROUTINE mppmin_a_int( karr, kdim )
+   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
       INTEGER, DIMENSION(:) :: karr
       INTEGER               :: kdim
-      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1)
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmax_a_int
+
+   SUBROUTINE mppmax_int( kint, kcom)
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmax_int
+
+   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
    END SUBROUTINE mppmin_a_int
 
-   SUBROUTINE mppmin_int( kint )
+   SUBROUTINE mppmin_int( kint, kcom )
       INTEGER               :: kint
-      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
    END SUBROUTINE mppmin_int
 
@@ -5223,4 +5546,14 @@
    END SUBROUTINE mppstop
 
+   SUBROUTINE mpp_ini_ice(kcom)
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?',kcom
+   END SUBROUTINE mpp_ini_ice
+
+   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
    !!----------------------------------------------------------------------
