Index: branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 5422)
+++ branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 5666)
@@ -71,4 +71,5 @@
    PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
    PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mpp_lnk_2d_9 
    PUBLIC   mppscatter, mppgather
    PUBLIC   mpp_ini_ice, mpp_ini_znl
@@ -78,4 +79,8 @@
    PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb
 
+   TYPE arrayptr
+      REAL , DIMENSION (:,:),  POINTER :: pt2d
+   END TYPE arrayptr
+   
    !! * Interfaces
    !! define generic interface for these routine as they are called sometimes
@@ -164,5 +169,5 @@
 
 
-   FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )
       !!----------------------------------------------------------------------
       !!                  ***  routine mynode  ***
@@ -171,4 +176,5 @@
       !!----------------------------------------------------------------------
       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt
+      CHARACTER(len=*)             , INTENT(in   ) ::   ldname
       INTEGER                      , INTENT(in   ) ::   kumnam_ref     ! logical unit for reference namelist
       INTEGER                      , INTENT(in   ) ::   kumnam_cfg     ! logical unit for configuration namelist
@@ -297,6 +303,6 @@
 
       IF( mynode == 0 ) THEN
-        CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
-        WRITE(kumond, nammpp)      
+         CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+         WRITE(kumond, nammpp)      
       ENDIF
       !
@@ -510,4 +516,290 @@
       !
    END SUBROUTINE mpp_lnk_3d
+
+   SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_multiple  ***
+      !!
+      !! ** Purpose :   Message passing management for multiple 2d arrays
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+
+      INTEGER :: num_fields
+      TYPE( arrayptr ), DIMENSION(:) :: pt2d_array
+      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points
+      !                                                               ! = T , U , V , F , W and I points
+      REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary
+      !                                                               ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL    , INTENT(in   ) ::   cd_mpp       ! fill the overlap area only
+      REAL(wp)        , OPTIONAL    , INTENT(in   ) ::   pval         ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields),  &
+         &      zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields)   )
+
+      !
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+            !
+            ! WARNING pt2d is defined only between nld and nle
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               pt2d_array(ii)%pt2d(nldi  :nlei  , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej)
+               pt2d_array(ii)%pt2d(1     :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi     , nlej)
+               pt2d_array(ii)%pt2d(nlei+1:nlci  , jj) = pt2d_array(ii)%pt2d(     nlei, nlej) 
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               pt2d_array(ii)%pt2d(ji, nldj  :nlej  ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej)
+               pt2d_array(ii)%pt2d(ji, 1     :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj     )
+               pt2d_array(ii)%pt2d(ji, nlej+1:jpj   ) = pt2d_array(ii)%pt2d(nlei,      nlej)
+            END DO
+            !
+         ELSE                              ! standard close or cyclic treatment
+            !
+            !                                   ! East-West boundaries
+            IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+               &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+               pt2d_array(ii)%pt2d(  1  , : ) = pt2d_array(ii)%pt2d( jpim1, : )                                    ! west
+               pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d(   2  , : )                                    ! east
+            ELSE                                     ! closed
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(            1 : jpreci,:) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi   ,:) = zland    ! north
+            ENDIF
+            !                                   ! North-South boundaries (always closed)
+               IF( .NOT. type_array(ii) == 'F' )   pt2d_array(ii)%pt2d(:,             1:jprecj ) = zland    ! south except F-point
+                                                   pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj    ) = zland    ! north
+            !
+         ENDIF
+      END DO
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity
+      !
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : )
+               zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : )
+            END DO
+         END SELECT
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+
+      DO ii = 1 , num_fields
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii)
+               pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii)
+            END DO
+         END SELECT
+      END DO
+      
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      !First Array
+      DO ii = 1 , num_fields
+         IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl )
+               zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl )
+            END DO
+         ENDIF
+      END DO
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+
+      DO ii = 1 , num_fields
+         !First Array
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii )
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii)
+               pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii )
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jprecj
+               pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii )
+            END DO
+         END SELECT
+      END DO
+      
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      DO ii = 1 , num_fields
+         !First Array
+         IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+            !
+            SELECT CASE ( jpni )
+            CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) )   ! only 1 northern proc, no mpp
+            CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) )   ! for all northern procs.
+            END SELECT
+            !
+         ENDIF
+         !
+      END DO
+      
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
+      !
+   END SUBROUTINE mpp_lnk_2d_multiple
+
+   
+   SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields)
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), TARGET   ,   INTENT(inout) ::   pt2d    ! Second 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type ! define the nature of ptab array grid-points
+      REAL(wp)                    , INTENT(in   ) ::   psgn    ! =-1 the sign change across the north fold boundary
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER                      , INTENT (inout):: num_fields 
+      !!---------------------------------------------------------------------
+      num_fields=num_fields+1
+      pt2d_array(num_fields)%pt2d=>pt2d
+      type_array(num_fields)=cd_type
+      psgn_array(num_fields)=psgn
+   END SUBROUTINE load_array
+   
+   
+   SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   &
+      &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   &
+      &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      ! Second 2D array on which the boundary condition is applied
+      REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA    
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE
+      REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
+      ! define the nature of ptab array grid-points
+      CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE
+      CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI
+      ! =-1 the sign change across the north fold boundary
+      REAL(wp)                                      , INTENT(in   ) ::   psgnA    
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI   
+      CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only
+      REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      TYPE(arrayptr)   , DIMENSION(9) ::   pt2d_array 
+      CHARACTER(len=1) , DIMENSION(9) ::   type_array    ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)         , DIMENSION(9) ::   psgn_array    ! =-1 the sign change across the north fold boundary
+      INTEGER :: num_fields
+      !!---------------------------------------------------------------------
+
+      num_fields = 0
+
+      !! Load the first array
+      CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields)
+
+      !! Look if more arrays are added
+      IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields)
+      IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields)
+      
+      CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval)
+   END SUBROUTINE mpp_lnk_2d_9
 
 
@@ -3184,4 +3476,5 @@
    LOGICAL, PUBLIC            ::   ln_nnogather          !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
    INTEGER :: ncomm_ice
+   INTEGER, PUBLIC            ::   mpi_comm_opa          ! opa local communicator
    !!----------------------------------------------------------------------
 CONTAINS
@@ -3192,11 +3485,13 @@
    END FUNCTION lib_mpp_alloc
 
-   FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
+   FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg,  kumond , kstop, localComm ) RESULT (function_value)
       INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
       CHARACTER(len=*),DIMENSION(:) ::   ldtxt
+      CHARACTER(len=*) ::   ldname
       INTEGER ::   kumnam_ref, knumnam_cfg , kumond , kstop
-      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
+      IF( PRESENT( localComm ) ) mpi_comm_opa = localComm
+      function_value = 0
       IF( .FALSE. )   ldtxt(:) = 'never done'
-      CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
+      CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )
    END FUNCTION mynode
 
