Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 2715)
@@ -31,4 +31,5 @@
    USE lib_mpp        ! distributed memory computing library
    USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
 
    IMPLICIT NONE
@@ -43,14 +44,14 @@
    !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
    
-   !                                                              !!! profile of hdiv for some straits
-   REAL(wp), DIMENSION (jpk) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(172,101)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_139_102                     ! Gibraltar     strait, fixed part only            (i,j)=(139,102)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(141,102)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(161,88)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_161_87                      ! Bab-el-Mandeb strait, fixed part only            (i,j)=(161,87)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(160,89)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_172_94                      ! Hormuz        strait, fixed part only            (i,j)=(172, 94)
-
-   REAL(wp), DIMENSION (jpk) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in the Hormuz strait
+   !                                           !   fixed part  !  time evolving    !!! profile of hdiv for some straits
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     (i,j)=(172,101)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_102                     ! Gibraltar     (i,j)=(139,102)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     (i,j)=(141,102)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb (i,j)=(161,88)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_87                      ! Bab-el-Mandeb (i,j)=(161,87)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb (i,j)=(160,89)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_172_94                      ! Hormuz        (i,j)=(172, 94)
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in Hormuz strait
    
    !! * Substitutions
@@ -177,5 +178,6 @@
       !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
       !!---------------------------------------------------------------------
-      REAL(wp) ::   ztemp
+      REAL(wp) ::   ztemp   ! local scalar
+      INTEGER  ::   ierr    ! local integer
       !!---------------------------------------------------------------------
       !
@@ -184,9 +186,21 @@
       IF(lwp) WRITE(numout,*) '~~~~~~~~~'
       !
+      !                           ! Allocate arrays for this module
+      ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) ,     &    ! Gibraltar
+         &      hdiv_139_102(jpk) ,                            &
+         &      hdiv_141_102(jpk) , hdiv_141_102_kt(jpk) ,     &
+         &      hdiv_161_88 (jpk) , hdiv_161_88_kt (jpk) ,     &    ! Bab-el-Mandeb
+         &      hdiv_161_87 (jpk) ,                            &                     
+         &      hdiv_160_89 (jpk) , hdiv_160_89_kt (jpk) ,     &     ! Hormuz
+         &      hdiv_172_94 (jpk) ,                            &
+         &      t_171_94_hor(jpk) , s_171_94_hor   (jpk) , STAT=ierr )
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' )
+      !
       IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
       !
-      IF( lk_vvl    )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
-      !
-      IF( jpk /= 31 )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
+      IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
+      !
+      IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
       !
       !                                        _|_______|_______|_
@@ -723,5 +737,5 @@
    !!   Default key                                            Dummy module
    !!----------------------------------------------------------------------
-   USE in_out_manager ! I/O manager
+   USE lib_mpp, ONLY:   ctl_stop
 CONTAINS
    SUBROUTINE cla_init
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2715)
@@ -12,5 +12,4 @@
    !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
    !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers   
    USE dom_oce        ! ocean space and time domain 
    USE in_out_manager ! I/O manager
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2715)
@@ -18,4 +18,12 @@
    !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
    !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
+   !!            4.0  !  2011  (G. Madec)  move ctl_ routines from in_out_manager
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ctl_stop   : update momentum and tracer Kz from a tke scheme
+   !!   ctl_warn   : initialization, namelist read, and parameters control
+   !!   ctl_opn    : Open file and check if required file is available.
+   !!   get_unit    : give the index of an unused logical unit
    !!----------------------------------------------------------------------
 #if   defined key_mpp_mpi  
@@ -23,41 +31,33 @@
    !!   'key_mpp_mpi'             MPI massively parallel processing library
    !!----------------------------------------------------------------------
-   !!   mynode      : indentify the processor unit
-   !!   mpp_lnk     : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
+   !!   lib_mpp_alloc : allocate mpp arrays
+   !!   mynode        : indentify the processor unit
+   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
    !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
-   !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
-   !!   mpprecv     :
-   !!   mppsend     :   SUBROUTINE mpp_ini_znl
-   !!   mppscatter  :
-   !!   mppgather   :
-   !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
-   !!   mpp_max     : generic interface for 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
-   !!   mpp_minloc  :
-   !!   mpp_maxloc  :
-   !!   mppsync     :
-   !!   mppstop     :
-   !!   mppobc      : variant of mpp_lnk for open boundary condition
+   !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
+   !!   mpprecv         :
+   !!   mppsend       :   SUBROUTINE mpp_ini_znl
+   !!   mppscatter    :
+   !!   mppgather     :
+   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max       : generic interface for 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
+   !!   mpp_minloc    :
+   !!   mpp_maxloc    :
+   !!   mppsync       :
+   !!   mppstop       :
+   !!   mppobc        : variant of mpp_lnk for open boundary condition
    !!   mpp_ini_north : initialisation of north fold
    !!   mpp_lbc_north : north fold processors gathering
    !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
    !!----------------------------------------------------------------------
-   !! History :
-   !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!        !  97  (A.M. Treguier)  SHMEM additions
-   !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
-   !!        !  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
-   !!        !  09  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
-   !!----------------------------------------------------------------------
-   USE dom_oce                    ! ocean space and time domain 
-   USE in_out_manager             ! I/O manager
-   USE lbcnfd                     ! north fold treatment
+   USE dom_oce        ! ocean space and time domain 
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
 
    IMPLICIT NONE
    PRIVATE
    
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn
    PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
    PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
@@ -65,4 +65,6 @@
    PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
    PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
+   PUBLIC   mppsize
+   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90
 
    !! * Interfaces
@@ -120,5 +122,5 @@
    INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
    INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_ice     ! dimension ndim_rank_ice
 
    ! variables used for zonal integration
@@ -127,5 +129,5 @@
    INTEGER ::   ngrp_znl        ! group ID for the znl processors
    INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
    
    ! North fold condition in mpp_mpi with jpni > 1
@@ -137,5 +139,5 @@
    INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
    INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   ! dimension ndim_rank_north
 
    ! Type of send : standard, buffered, immediate
@@ -144,39 +146,91 @@
    INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
       
-   REAL(wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
 
    ! message passing arrays
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4p1, t4p2   ! 2 x 3d for north fold
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3ns, t3sn   ! 3d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2)   ::   t3ew, t3we   ! 3d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3p1, t3p2   ! 3d for north fold
-   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2ns, t2sn   ! 2d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,2)       ::   t2ew, t2we   ! 2d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2p1, t2p2   ! 2d for north fold
-   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo
-   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo
+   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
+   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
+   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4p1, t4p2   ! 2 x 3d for north fold
+   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ns, t3sn   ! 3d for north-south & south-north
+   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ew, t3we   ! 3d for east-west & west-east
+   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3p1, t3p2   ! 3d for north fold
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ns, t2sn   ! 2d for north-south & south-north
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo
+
+   ! Arrays used in mpp_lbc_north_3d()
+   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztab, znorthloc
+   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   znorthgloio
+
+   ! Arrays used in mpp_lbc_north_2d()
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_2d, znorthloc_2d
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_2d
+
+   ! Arrays used in mpp_lbc_north_e()
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_e, znorthloc_e
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_e
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-
 CONTAINS
 
-   FUNCTION mynode(ldtxt, localComm)
+   INTEGER FUNCTION lib_mpp_alloc( kumout )
+      !!----------------------------------------------------------------------
+      !!              ***  routine lib_mpp_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) ,                                            &
+         &      t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) ,                                            &
+         &      t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) ,                                            &
+         &      t3ns(jpi,jprecj,jpk,2)   , t3sn(jpi,jprecj,jpk,2)   ,                                            &
+         &      t3ew(jpj,jpreci,jpk,2)   , t3we(jpj,jpreci,jpk,2)   ,                                            &
+         &      t3p1(jpi,jprecj,jpk,2)   , t3p2(jpi,jprecj,jpk,2)   ,                                            &
+         &      t2ns(jpi,jprecj    ,2)   , t2sn(jpi,jprecj    ,2)   ,                                            &
+         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2)   ,                                            &
+         &      t2p1(jpi,jprecj    ,2)   , t2p2(jpi,jprecj    ,2)   ,                                            &
+         !
+         &      tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         &      tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         !
+         &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        &
+         !
+         &      ztab_2d(jpiglo,4)  , znorthloc_2d(jpi,4)  , znorthgloio_2d(jpi,4,jpni)  ,                        &
+         !
+         &      ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   &
+         !
+         &      STAT=lib_mpp_alloc )
+         !
+      IF( lib_mpp_alloc /= 0 ) THEN
+         WRITE(kumout,cform_war)
+         WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays'
+      ENDIF
+      !
+   END FUNCTION lib_mpp_alloc
+
+
+   FUNCTION mynode( ldtxt, kumnam, kstop, localComm )
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
       !!                    
       !! ** Purpose :   Find processor unit
-      !!
       !!----------------------------------------------------------------------
       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit 
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
       INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      !
       INTEGER ::   mynode, ierr, code, ji, ii
       LOGICAL ::   mpi_was_called
-      
-      NAMELIST/nammpp/ cn_mpi_send, nn_buffer
+      !
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer, jpni, jpnj, jpnij
       !!----------------------------------------------------------------------
       !
@@ -186,10 +240,25 @@
       WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1
       !
-      REWIND( numnam )               ! Namelist namrun : parameters of the run
-      READ  ( numnam, nammpp )
+      jpni = -1; jpnj = -1; jpnij = -1
+      REWIND( kumnam )               ! Namelist namrun : parameters of the run
+      READ  ( kumnam, nammpp )
       !                              ! 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 in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1
+
+      IF(jpnij < 1)THEN
+         ! If jpnij is not specified in namelist then we calculate it - this
+         ! means there will be no land cutting out.
+         jpnij = jpni * jpnj
+      END IF
+
+      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
+         WRITE(ldtxt(ii),*) '      jpni, jpnj and jpnij 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
+         WRITE(ldtxt(ii),*) '      number of local domains           jpnij = ',jpnij; ii = ii +1
+      END IF
 
       CALL mpi_initialized ( mpi_was_called, code )
@@ -217,10 +286,10 @@
             WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
             WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
-            nstop = nstop + 1
+            kstop = kstop + 1
          END SELECT
       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
          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
-         nstop = nstop + 1
+         kstop = kstop + 1
       ELSE
          SELECT CASE ( cn_mpi_send )
@@ -238,5 +307,5 @@
             WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
             WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
-            nstop = nstop + 1
+            kstop = kstop + 1
          END SELECT
          !
@@ -1650,5 +1719,5 @@
 
 
-   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
+   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout)
       !!----------------------------------------------------------------------
       !!                  ***  routine mppobc  ***
@@ -1670,4 +1739,7 @@
       !!
       !!----------------------------------------------------------------------
+      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
+      USE wrk_nemo, ONLY:   ztab => wrk_2d_1
+      !
       INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
       INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
@@ -1676,14 +1748,20 @@
       !                                                           !  = 1  north/south  ;  = 2  east/west
       INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
+      INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit
       REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
-      !! 
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  ::   iipt0, iipt1, ilpt1   ! temporary integers
-      INTEGER  ::   ijpt0, ijpt1          !    -          -
-      INTEGER  ::   imigr, iihom, ijhom   !    -          -
+      !
+      INTEGER ::   ji, jj, jk, jl        ! dummy loop indices
+      INTEGER ::   iipt0, iipt1, ilpt1   ! local integers
+      INTEGER ::   ijpt0, ijpt1          !   -       -
+      INTEGER ::   imigr, iihom, ijhom   !   -       -
       INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztab   ! temporary workspace
-      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+
+      IF( wrk_in_use(2, 1) ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mppobc : requested workspace array unavailable'
+         CALL mppstop
+      ENDIF
 
       ! boundary condition initialization
@@ -1704,5 +1782,7 @@
          ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
       ELSE
-         CALL ctl_stop( 'mppobc: bad ktype' )
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mppobc : bad ktype'
+         CALL mppstop
       ENDIF
       
@@ -1834,4 +1914,10 @@
       END DO
       !
+      IF( wrk_not_released(2, 1) ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mppobc : failed to release workspace array'
+         CALL mppstop
+      ENDIF
+      !
    END SUBROUTINE mppobc
    
@@ -1850,5 +1936,5 @@
 
 
-   SUBROUTINE mpp_ini_ice( pindic )
+   SUBROUTINE mpp_ini_ice( pindic, kumout )
       !!----------------------------------------------------------------------
       !!               ***  routine mpp_ini_ice  ***
@@ -1872,13 +1958,22 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: pindic
-      !!
-      INTEGER :: ierr
+      INTEGER, INTENT(in) ::   pindic
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit
+      !!
       INTEGER :: jjproc
-      INTEGER :: ii
-      INTEGER, DIMENSION(jpnij) :: kice
-      INTEGER, DIMENSION(jpnij) :: zwork
-      !!----------------------------------------------------------------------
-      !
+      INTEGER :: ii, ierr
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kice
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      ! Since this is just an init routine and these arrays are of length jpnij
+      ! then don't use wrk_nemo module - just allocate and deallocate.
+      ALLOCATE( kice(jpnij), zwork(jpnij), STAT=ierr )
+      IF( ierr /= 0 ) THEN
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mpp_ini_ice : failed to allocate 2, 1D arrays (jpnij in length)'
+         CALL mppstop
+      ENDIF
+
       ! Look for how many procs with sea-ice
       !
@@ -1893,9 +1988,5 @@
 
       ! Allocate the right size to nrank_north
-#if ! defined key_agrif
       IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
-#else
-      IF( ASSOCIATED( nrank_ice ) )   DEALLOCATE( nrank_ice )
-#endif
       ALLOCATE( nrank_ice(ndim_rank_ice) )
       !
@@ -1922,8 +2013,10 @@
       ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
       !
+      DEALLOCATE(kice, zwork)
+      !
    END SUBROUTINE mpp_ini_ice
 
 
-   SUBROUTINE mpp_ini_znl
+   SUBROUTINE mpp_ini_znl( kumout )
       !!----------------------------------------------------------------------
       !!               ***  routine mpp_ini_znl  ***
@@ -1944,14 +2037,22 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER :: ierr
-      INTEGER :: jproc
-      INTEGER :: ii
-      INTEGER, DIMENSION(jpnij) :: kwork
-      !
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical units
+      !
+      INTEGER :: jproc      ! dummy loop integer
+      INTEGER :: ierr, ii   ! local integer
+      INTEGER, ALLOCATABLE, DIMENSION(:) ::   kwork
+      !!----------------------------------------------------------------------
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
       !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
       !
-      IF ( jpnj == 1 ) THEN
+      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( jpnj == 1 ) THEN
          ngrp_znl  = ngrp_world
          ncomm_znl = mpi_comm_opa
@@ -1972,9 +2073,5 @@
          !-$$        CALL flush(numout)
          ! Allocate the right size to nrank_znl
-#if ! defined key_agrif
          IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
-#else
-         IF (ASSOCIATED(nrank_znl)) DEALLOCATE(nrank_znl)
-#endif
          ALLOCATE(nrank_znl(ndim_rank_znl))
          ii = 0     
@@ -2016,4 +2113,6 @@
       END IF
 
+      DEALLOCATE(kwork)
+
    END SUBROUTINE mpp_ini_znl
 
@@ -2055,9 +2154,5 @@
       !
       ! Allocate the right size to nrank_north
-#if ! defined key_agrif
       IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
-#else
-      IF (ASSOCIATED(nrank_north)) DEALLOCATE(nrank_north)
-#endif
       ALLOCATE( nrank_north(ndim_rank_north) )
 
@@ -2106,7 +2201,4 @@
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ijpjm1, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4,jpk)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4,jpk)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4,jpk,jpni) ::   znorthgloio
       !!----------------------------------------------------------------------
       !   
@@ -2172,22 +2264,19 @@
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ijpjm1, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4,jpni) ::   znorthgloio
       !!----------------------------------------------------------------------
       !
       ijpj   = 4
       ijpjm1 = 3
-      ztab(:,:) = 0.e0
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
+      ztab_2d(:,:) = 0.e0
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc_2d the last 4 jlines of pt2d
          ij = jj - nlcj + ijpj
-         znorthloc(:,ij) = pt2d(:,jj)
+         znorthloc_2d(:,ij) = pt2d(:,jj)
       END DO
 
-      !                                     ! Build in procs of ncomm_north the znorthgloio
+      !                                     ! Build in procs of ncomm_north the znorthgloio_2d
       itaille = jpi * ijpj
-      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
-         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
+         &                znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
       !
       DO jr = 1, ndim_rank_north            ! recover the global north array
@@ -2198,10 +2287,10 @@
          DO jj = 1, 4
             DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
+               ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)
             END DO
          END DO
       END DO
       !
-      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      CALL lbc_nfd( ztab_2d, cd_type, psgn )   ! North fold boundary condition
       !
       !
@@ -2209,5 +2298,5 @@
          ij = jj - nlcj + ijpj
          DO ji = 1, nlci
-            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
+            pt2d(ji,jj) = ztab_2d(ji+nimpp-1,ij)
          END DO
       END DO
@@ -2239,24 +2328,21 @@
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4+2*jpr2dj)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj,jpni) ::   znorthgloio
       !!----------------------------------------------------------------------
       !
       ijpj=4
-      ztab(:,:) = 0.e0
+      ztab_e(:,:) = 0.e0
 
       ij=0
-      ! put in znorthloc the last 4 jlines of pt2d
+      ! put in znorthloc_e the last 4 jlines of pt2d
       DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
          ij = ij + 1
          DO ji = 1, jpi
-            znorthloc(ji,ij)=pt2d(ji,jj)
+            znorthloc_e(ji,ij)=pt2d(ji,jj)
          END DO
       END DO
       !
       itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( znorthloc(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
-         &                znorthgloio(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
       !
       DO jr = 1, ndim_rank_north            ! recover the global north array
@@ -2267,5 +2353,5 @@
          DO jj = 1, ijpj+2*jpr2dj
             DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
             END DO
          END DO
@@ -2275,5 +2361,5 @@
       ! 2. North-Fold boundary conditions
       ! ----------------------------------
-      CALL lbc_nfd( ztab(:,:), cd_type, psgn, pr2dj = jpr2dj )
+      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
 
       ij = jpr2dj
@@ -2282,5 +2368,5 @@
       ij  = ij +1 
          DO ji= 1, nlci
-            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
          END DO
       END DO
@@ -2335,5 +2421,5 @@
          ! Buffer allocation and attachment
          ALLOCATE( tampon(nn_buffer), stat = ierr )
-         IF (ierr /= 0) THEN 
+         IF( ierr /= 0 ) THEN 
             DO ji = 1, SIZE(ldtxt) 
                IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
@@ -2383,4 +2469,5 @@
    !!   Default case:            Dummy module        share memory computing
    !!----------------------------------------------------------------------
+   USE in_out_manager
 
    INTERFACE mpp_sum
@@ -2403,13 +2490,18 @@
    END INTERFACE
 
-
    LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
    INTEGER :: ncomm_ice
-
+   !!----------------------------------------------------------------------
 CONTAINS
 
-   FUNCTION mynode( ldtxt, localComm ) RESULT (function_value)
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+   INTEGER FUNCTION lib_mpp_alloc(kumout)          ! Dummy function
+      INTEGER, INTENT(in) ::   kumout
+      lib_mpp_alloc = 0
+   END FUNCTION lib_mpp_alloc
+
+   FUNCTION mynode( ldtxt, kumnam, kstop, localComm ) RESULT (function_value)
       INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
+      INTEGER ::   kumnam, kstop
       IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
       IF( .FALSE. )   ldtxt(:) = 'never done'
@@ -2504,26 +2596,26 @@
    END SUBROUTINE mppmin_int
 
-   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
       REAL, DIMENSION(:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum
    END SUBROUTINE mppobc_1d
 
-   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
       REAL, DIMENSION(:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum
    END SUBROUTINE mppobc_2d
 
-   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
       REAL, DIMENSION(:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum
    END SUBROUTINE mppobc_3d
 
-   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
       REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum
    END SUBROUTINE mppobc_4d
 
@@ -2560,11 +2652,12 @@
    END SUBROUTINE mppstop
 
-   SUBROUTINE mpp_ini_ice( kcom )
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom
+   SUBROUTINE mpp_ini_ice( kcom, knum )
+      INTEGER :: kcom, knum
+      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom, knum
    END SUBROUTINE mpp_ini_ice
 
-   SUBROUTINE mpp_ini_znl
-      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?'
+   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
 
@@ -2574,4 +2667,172 @@
    END SUBROUTINE mpp_comm_free
 #endif
+
+   !!----------------------------------------------------------------------
+   !!   All cases:         ctl_stop, ctl_warn, get_unit, ctl_opn   routines
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ctl_stop( cd1, cd2, cd3, cd4, cd5 ,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_opa  ***
+      !!
+      !! ** 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 
+      IF(lwp) THEN
+         WRITE(numout,cform_err)
+         IF( PRESENT(cd1 ) )   WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) )   WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) )   WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) )   WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) )   WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) )   WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) )   WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) )   WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) )   WRITE(numout,*) cd9
+         IF( PRESENT(cd10) )   WRITE(numout,*) cd10
+      ENDIF
+                               CALL FLUSH(numout    )
+      IF( numstp     /= -1 )   CALL FLUSH(numstp    )
+      IF( numsol     /= -1 )   CALL FLUSH(numsol    )
+      IF( numevo_ice /= -1 )   CALL FLUSH(numevo_ice)
+      !
+      IF( cd1 == 'STOP' ) THEN
+         IF(lwp) WRITE(numout,*)  'huge E-R-R-O-R : immediate stop'
+         CALL mppstop()
+      ENDIF
+      !
+   END SUBROUTINE ctl_stop
+
+
+   SUBROUTINE ctl_warn( cd1, cd2, cd3, cd4, cd5,   &
+      &                 cd6, cd7, cd8, cd9, cd10 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE  stop_warn  ***
+      !!
+      !! ** 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 
+      IF(lwp) THEN
+         WRITE(numout,cform_war)
+         IF( PRESENT(cd1 ) ) WRITE(numout,*) cd1
+         IF( PRESENT(cd2 ) ) WRITE(numout,*) cd2
+         IF( PRESENT(cd3 ) ) WRITE(numout,*) cd3
+         IF( PRESENT(cd4 ) ) WRITE(numout,*) cd4
+         IF( PRESENT(cd5 ) ) WRITE(numout,*) cd5
+         IF( PRESENT(cd6 ) ) WRITE(numout,*) cd6
+         IF( PRESENT(cd7 ) ) WRITE(numout,*) cd7
+         IF( PRESENT(cd8 ) ) WRITE(numout,*) cd8
+         IF( PRESENT(cd9 ) ) WRITE(numout,*) cd9
+         IF( PRESENT(cd10) ) WRITE(numout,*) cd10
+      ENDIF
+      CALL FLUSH(numout)
+      !
+   END SUBROUTINE ctl_warn
+
+
+   SUBROUTINE ctl_opn( knum, cdfile, cdstat, cdform, cdacce, klengh, kout, ldwp, karea )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctl_opn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!----------------------------------------------------------------------
+      INTEGER          , INTENT(  out) ::   knum      ! logical unit to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdfile    ! file name to open
+      CHARACTER(len=*) , INTENT(in   ) ::   cdstat    ! disposition specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdform    ! formatting specifier
+      CHARACTER(len=*) , INTENT(in   ) ::   cdacce    ! access specifier
+      INTEGER          , INTENT(in   ) ::   klengh    ! record length
+      INTEGER          , INTENT(in   ) ::   kout      ! number of logical units for write
+      LOGICAL          , INTENT(in   ) ::   ldwp      ! boolean term for print
+      INTEGER, OPTIONAL, INTENT(in   ) ::   karea     ! proc number
+      !!
+      CHARACTER(len=80) ::   clfile
+      INTEGER           ::   iost
+      !!----------------------------------------------------------------------
+
+      ! adapt filename
+      ! ----------------
+      clfile = TRIM(cdfile)
+      IF( PRESENT( karea ) ) THEN
+         IF( karea > 1 )   WRITE(clfile, "(a,'_',i4.4)") TRIM(clfile), karea-1
+      ENDIF
+#if defined key_agrif
+      IF( .NOT. Agrif_Root() )   clfile = TRIM(Agrif_CFixed())//'_'//TRIM(clfile)
+      knum=Agrif_Get_Unit()
+#else
+      knum=get_unit()
+#endif
+
+      iost=0
+      IF( cdacce(1:6) == 'DIRECT' )  THEN
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+      ELSE
+         OPEN( UNIT=knum, FILE=clfile, FORM=cdform, ACCESS=cdacce, STATUS=cdstat             , ERR=100, IOSTAT=iost )
+      ENDIF
+      IF( iost == 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*) '     file   : ', clfile,' open ok'
+            WRITE(kout,*) '     unit   = ', knum
+            WRITE(kout,*) '     status = ', cdstat
+            WRITE(kout,*) '     form   = ', cdform
+            WRITE(kout,*) '     access = ', cdacce
+            WRITE(kout,*)
+         ENDIF
+      ENDIF
+100   CONTINUE
+      IF( iost /= 0 ) THEN
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ===>>>> : bad opening file: ', 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,*)
+         ENDIF
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      
+   END SUBROUTINE ctl_opn
+
+
+   INTEGER FUNCTION get_unit()
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  get_unit  ***
+      !!
+      !! ** Purpose :   return the index of an unused logical unit
+      !!----------------------------------------------------------------------
+      LOGICAL :: llopn 
+      !!----------------------------------------------------------------------
+      !
+      get_unit = 15   ! choose a unit that is big enough then it is not already used in NEMO
+      llopn = .TRUE.
+      DO WHILE( (get_unit < 998) .AND. llopn )
+         get_unit = get_unit + 1
+         INQUIRE( unit = get_unit, opened = llopn )
+      END DO
+      IF( (get_unit == 999) .AND. llopn ) THEN
+         CALL ctl_stop( 'get_unit: All logical units until 999 are used...' )
+         get_unit = -1
+      ENDIF
+      !
+   END FUNCTION get_unit
+
    !!----------------------------------------------------------------------
 END MODULE lib_mpp
Index: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 2528)
+++ trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 2715)
@@ -20,5 +20,4 @@
    PRIVATE
 
-   !! * Routine accessibility
    PUBLIC mpp_init       ! called by opa.F90
    PUBLIC mpp_init2      ! called by opa.F90
@@ -29,7 +28,6 @@
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
    !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -128,14 +126,9 @@
       !!   8.5  !  02-08  (G. Madec)  F90 : free form
       !!----------------------------------------------------------------------
-      !! * Local variables
-      INTEGER ::   ji, jj, jn               ! dummy loop indices
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,        &  ! temporary integers
-         iresti, irestj, ijm1, imil,     &  !    "          "
-         inum                               ! temporary logical unit
-
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers
+      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      -
+      REAL(wp) ::   zidom, zjdom                       ! local scalars
+      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace
       !!----------------------------------------------------------------------
 
@@ -451,8 +444,5 @@
       !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
       !!----------------------------------------------------------------------
-      !! Local declarations
-
-      INTEGER, DIMENSION(2) ::   &
-         iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
       !!----------------------------------------------------------------------
 
@@ -482,7 +472,7 @@
           WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
       ENDIF
-
+      !
       CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
-
+      !
    END SUBROUTINE mpp_init_ioipsl  
 
