Index: trunk/NEMO/OFF_SRC/DIA/dianam.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DIA/dianam.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DIA/dianam.F90	(revision 325)
@@ -0,0 +1,330 @@
+MODULE dianam
+   !!======================================================================
+   !!                       ***  MODULE  dianam  ***
+   !! Ocean diagnostics:  Builds output file name
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dia_nam       : Builds output file name
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dia_nam   ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_nam( cdfnam, kfreq, cdsuff )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_nam  ***
+      !!                   
+      !! ** Purpose :   Builds output file name
+      !!
+      !! ** Method  :   File name is a function of date and output frequency
+      !!      cdfnam=<cexper>_<clave>_<idtbeg>_<idtend>_grid_<cdsuff>
+      !!      <clave> = averaging frequency (DA, MO, etc...)
+      !!      <idtbeg>,<idtend> date of beginning and end of run
+      !!
+      !! History :
+      !!        !  99-02  (E. Guilyardi)  Creation for 30 days/month
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER (len=*), INTENT( out ) ::   cdfnam   ! file name
+      CHARACTER (len=*), INTENT( in  ) ::   cdsuff   ! ???
+      INTEGER,           INTENT( in  ) ::   kfreq    ! ???
+
+      !! * Local declarations
+      CHARACTER (len=8) ::   clexper
+      CHARACTER (len=2) ::   clave
+      CHARACTER (len=5) ::   clout
+      CHARACTER (len=6) ::   clsuff
+      INTEGER :: jt, jc, jd, je            ! dummy loop indices
+      INTEGER ::   &
+         ic, id, ie, ig, ijjmm, iout,   &  ! temporary integers
+         iyear1, imonth1, iday1,        &  !    "          "
+         iyear2, imonth2, iday2            !    "          "
+      REAL(wp) ::   &
+         z5j, znbsec, zdate1, zdate2, zdrun, zdt   ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' dia_nam: building output file name'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      ! 0. Initialisation
+      ! -----------------
+
+      cdfnam = ''
+
+      !    number of seconds of the run
+
+      z5j = 5*rjjss
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+      zdrun = FLOAT( nitend - nit000 ) * zdt
+
+      !  date of beginning of run
+
+      iyear1  = ndastp/10000
+      imonth1 = ndastp/100 - iyear1*100
+      iday1   = ndastp - imonth1*100 - iyear1*10000
+      IF( nleapy == 1) THEN 
+         ijjmm=0
+         IF( MOD( iyear1, 4 ) == 0 ) THEN
+            DO jt = 1, imonth1-1
+               ijjmm = ijjmm + nbiss(jt)
+            END DO
+         ELSE
+            DO jt = 1, imonth1-1
+               ijjmm = ijjmm + nobis(jt)
+            END DO
+         ENDIF
+         ijjmm = ijjmm + (iyear1-1)/4
+         zdate1 = ( (iyear1-1)*365 + ijjmm +iday1-1 ) * rjjss   
+      ELSE IF( nleapy == 0 ) THEN
+         ijjmm = 0
+         DO jt = 1, imonth1-1
+            ijjmm = ijjmm + nobis(jt)
+         END DO
+         zdate1 = ( (iyear1-1)*raajj + ijjmm + iday1-1)* rjjss
+      ELSE 
+         zdate1 = ( (iyear1-1)*nleapy*raamo + (imonth1-1)*nleapy + iday1-1)* rjjss
+      ENDIF
+
+      !  date of end of run (= date of beginning of next run)
+
+      zdate2 = zdate1 + zdrun
+      IF( nleapy == 1 ) THEN 
+         iyear2 = zdate2/(365.25*rjjss)+1
+         ijjmm = INT(zdate2/rjjss)-365*(iyear2-1)-(iyear2-1)/4
+         IF( ijjmm < 0 ) THEN
+            iyear2 = iyear2-1
+            ijjmm = zdate2/rjjss-365.*(iyear2-1)-(iyear2-1)/4
+         ENDIF
+         IF( MOD( iyear2, 4 ) == 0 ) THEN
+            DO jt = 1, 12
+               ijjmm = ijjmm - nbiss(jt)
+               IF( ijjmm <= 0 ) go to 10
+            END DO
+            jt = 12
+10          CONTINUE
+            imonth2 = jt
+            ijjmm = 0
+            DO jt = 1, jt-1
+               ijjmm = ijjmm + nbiss(jt)
+            END DO
+         ELSE
+            DO jt = 1, 12
+               ijjmm = ijjmm - nobis(jt)
+               IF( ijjmm <= 0 ) go to 15
+            END DO
+            jt = 12
+15          CONTINUE
+            imonth2 = jt
+            ijjmm = 0
+            DO jt = 1, jt-1
+               ijjmm = ijjmm + nobis(jt)
+            END DO
+         ENDIF
+         iday2 = zdate2/rjjss-365.*(iyear2-1)-ijjmm+1-(iyear2-1)/4     
+      ELSE IF( nleapy == 0 ) THEN
+         iyear2 = zdate2/raass+1
+         ijjmm  = zdate2/rjjss-raajj*(iyear2-1)
+         DO jt = 1, 12
+            ijjmm = ijjmm - nobis(jt)
+            IF(ijjmm <= 0) go to 20
+         END DO
+         jt = 12
+20       CONTINUE
+         imonth2 = jt
+         ijjmm = 0
+         DO jt = 1, jt-1
+            ijjmm = ijjmm + nobis(jt)
+         END DO
+         iday2 = zdate2/rjjss-raajj*(iyear2-1)-ijjmm+1          
+      ELSE 
+         zdate2 = zdate2 / rjjss
+         imonth2 = zdate2/FLOAT(nleapy)
+         iday2 = zdate2 - imonth2*FLOAT(nleapy) + 1.
+         iyear2 = imonth2/12
+         imonth2 = imonth2 - iyear2*12
+         imonth2 = imonth2 + 1
+         iyear2 = iyear2 + 1
+         IF( iday2 == 0 ) THEN
+            iday2 = nleapy
+            imonth2 = imonth2 - 1
+            IF( imonth2 == 0 ) THEN
+               imonth2 = 12
+               iyear2 = iyear2 - 1
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+      ! 1. Define time averaging period <nn><type>
+      !    ---------------------------------------
+
+      iout = 0
+#if defined key_diainstant
+      clave = 'IN'
+      IF( iyear2 <= 99 ) THEN 
+         WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ELSE IF( iyear2 <= 999 ) THEN 
+         WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ELSE IF( iyear2 <= 9999 ) THEN 
+         WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ELSE
+         WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ENDIF
+#else
+
+      znbsec=kfreq*zdt
+      ! daily output
+      IF( znbsec == rjjss ) THEN
+         clave = '1d'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+         ! 5 day output 
+      ELSE IF( znbsec == z5j ) THEN
+         clave='5d'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+         ! monthly ouput 
+      ELSE IF( (znbsec == rmoss .AND. nleapy > 1) .OR.   &
+               (znbsec >= 28*rjjss .AND. znbsec <= 31*rjjss .AND. nleapy <= 1) ) THEN
+         clave = '1m'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+         ! annual output
+      ELSE IF( (znbsec == raass .AND. nleapy > 1) .OR.   &
+               (znbsec >= 365*rjjss .AND. znbsec <= 366*rjjss .AND. nleapy <= 1) ) THEN
+         clave = '1y'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+      ELSE
+         ! others
+         iout = kfreq
+         ig = 0
+         clout = ''
+         IF( iout <= 9 ) THEN 
+            ig = 1
+            WRITE(clout,'(i1.1)') iout
+         ELSE IF( iout <= 99 ) THEN 
+            ig = 2
+            WRITE(clout,'(i2.2)') iout
+         ELSE IF( iout <= 999 ) THEN 
+            ig = 3
+            WRITE(clout,'(i3.3)') iout
+         ELSE IF( iout <= 9999 ) THEN 
+            ig = 4
+            WRITE(clout,'(i4.4)') iout
+         ELSE
+            ig = 5
+            WRITE(clout,'(i5.5)') iout
+         ENDIF
+         clave = 'CU'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+      ENDIF
+#endif
+      DO jc = 1, 8
+         IF( cexper(jc:jc)==' ' ) go to 120
+      END DO
+120   CONTINUE
+      ic = jc
+      clexper = cexper
+      IF( jc-1 == 0 ) THEN
+         clexper = 'orcafile'
+         ic = 9
+      ENDIF
+      DO jd = 1, 6
+         IF( cdsuff(jd:jd) == ' ' ) go to 130
+      END DO
+130   CONTINUE
+      id = jd
+      clsuff = cdsuff
+      IF( jd-1 == 0 ) THEN
+          clsuff = 'output'
+          id = 7
+      ENDIF
+      DO je = 1, 45
+        IF( cdfnam(je:je) == ' ' ) go to 140
+      END DO
+140   CONTINUE
+      ie = je
+      IF( iout == 0 ) THEN 
+         cdfnam=clexper(1:ic-1)//"_"//clave//cdfnam(1:ie-1)//clsuff(1:id-1)
+      ELSE 
+         cdfnam=clexper(1:ic-1)//"_"//clave//clout(1:ig)//cdfnam(1:ie-1)//clsuff(1:id-1)
+      ENDIF
+      IF(lwp) WRITE(numout,*) cdfnam     
+      IF(lwp) WRITE(numout,*)          
+
+      ! FORMATS
+
+ 9001 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")
+ 9002 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")
+ 9003 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")
+ 9004 FORMAT("_",I6.6,2I2.2,"_",I6.6,2I2.2,"_")
+ 9011 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")
+ 9012 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")
+ 9013 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")
+ 9014 FORMAT("_",I6.6,I2.2,"_",I6.6,I2.2,"_")
+ 9021 FORMAT("_",I4.4,"_",I4.4,"_")
+ 9022 FORMAT("_",I4.4,"_",I4.4,"_")
+ 9023 FORMAT("_",I4.4,"_",I4.4,"_")
+ 9024 FORMAT("_",I6.6,"_",I6.6,"_")
+
+   END SUBROUTINE dia_nam
+
+   !!======================================================================
+END MODULE dianam
Index: trunk/NEMO/OFF_SRC/DOM/dom_oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/dom_oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/dom_oce.F90	(revision 325)
@@ -0,0 +1,180 @@
+MODULE dom_oce
+   !!----------------------------------------------------------------------
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC           ! allows the acces to par_oce when dom_oce is used
+   !                ! exception to coding rules... to be suppressed ???
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !! -----------------------
+   LOGICAL, PUBLIC ::   &   !:
+      lzoom      =  .FALSE. ,   &  !: zoom flag
+      lzoom_e    =  .FALSE. ,   &  !: East  zoom type flag
+      lzoom_w    =  .FALSE. ,   &  !: West  zoom type flag
+      lzoom_s    =  .FALSE. ,   &  !: South zoom type flag
+      lzoom_n    =  .FALSE. ,   &  !: North zoom type flag
+      lzoom_arct =  .FALSE. ,   &  !: ORCA    arctic zoom flag
+      lzoom_anta =  .FALSE.        !: ORCA antarctic zoom flag
+
+   INTEGER, PUBLIC ::           & !!: namdom : space domain (bathymetry, mesh)
+      nmsh    =  0                 !: = 1 create a mesh-mask file
+
+   INTEGER, PUBLIC ::         &   !:
+      ! domain parameters linked to mpp
+      nperio,          &  !: type of lateral boundary condition
+      nimpp, njmpp,    &  !: i- & j-indexes for mpp-subdomain left bottom
+      nreci, nrecj,    &  !: overlap region in i and j
+      nproc,           &  !: number for local processor
+      narea,           &  !: number for local area
+      nbondi, nbondj,  &  !: mark of i- and j-direction local boundaries
+      npolj,           &  !: north fold mark (0, 3 or 4)
+      nlci, nlcj,      &  !: i- & j-dimensions of the local subdomain
+      nldi, nlei,      &  !: first and last indoor i- and j-indexes
+      nldj, nlej,      &  !:
+      noea, nowe,      &  !: index of the local neighboring processors in
+      noso, nono,      &  !: east, west, south and north directions
+      npne, npnw,      &  !: index of north east and north west processor
+      npse, npsw,      &  !: index of south east and south west processor
+      nbne, nbnw,      &  !: logical of north east & north west processor
+      nbse, nbsw          !: logical of south east & south west processor
+
+   INTEGER, PUBLIC, DIMENSION(jpi) ::   &   !:
+      mig                 !: local  ==> global  domain i-indice
+   INTEGER, PUBLIC, DIMENSION(jpj) ::   &   !:
+      mjg                 !: local  ==> global  domain j-indice
+   INTEGER, PUBLIC, DIMENSION( jpidta ) ::   &  !:  !!bug ==> other solution?
+      mi0, mi1            !: global ==> local domain i-indice
+      !                   !  (mi0=1 and mi1=0 if the global indice is not in the local domain)
+   INTEGER, PUBLIC, DIMENSION( jpjdta ) ::   &  !:
+      mj0, mj1            !: global ==> local domain j-indice
+      !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain)
+
+   INTEGER, PUBLIC, DIMENSION(jpnij) ::   &  !:
+      nimppt, njmppt,  &  !: i-, j-indexes for each processor
+      ibonit, ibonjt,  &  !: i-, j- processor neighbour existence
+      nlcit, nlcjt,    &  !: dimensions of every subdomain
+      nldit, nldjt,    &  !: first, last indoor index for each i-domain
+      nleit, nlejt        !: first, last indoor index for each j-domain
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      glamt, glamu,    &  !: longitude of t-, u-, v- and f-points (degre)
+      glamv, glamf,    &  !:
+      gphit, gphiu,    &  !: latitude  of t-, u-, v- and f-points (degre)
+      gphiv, gphif,    &  !:
+      e1t, e2t,        &  !: horizontal scale factors at t-point (m)
+      e1u, e2u,        &  !: horizontal scale factors at u-point (m)
+      e1v, e2v,        &  !: horizontal scale factors at v-point (m)
+      ff                  !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! --------------------------------------
+
+   REAL(wp), PUBLIC ::   & !!: * namelist namdom *
+      e3zps_min = 5.0,   &  !: miminum thickness for partial steps (meters)
+      e3zps_rat = 0.1       !: minimum thickness ration for partial steps
+
+   !! z-coordinate (default option) (also used in the other cases
+   !! -----------------------------  as reference z-coordinate)
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !:
+      gdept, gdepw,    &  !: reference depth of t- and w-points (m)
+      e3t, e3w            !: reference vertical scale factors at T- and W-pts (m)
+
+#if defined key_partial_steps
+   !! Partial steps ('key_partial_steps')
+   !! -----------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .TRUE.   !: partial steps flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .FALSE.  !: s-coordinate flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.  !: z-coordinate flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
+      gdep3w,                 &  !: ???
+      gdept_ps, gdepw_ps,     &  !: depth of t- and w-points (m)
+      e3t_ps, e3u_ps, e3v_ps, &  !: vertical scale factors at t-, u-, w-,
+      e3w_ps, e3f_ps,         &  !: w- and f- points (m)
+      e3uw_ps, e3vw_ps           !: uw- and vw- points (m)
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      hdept, hdepw, e3tp, e3wp   !: ???
+
+#elif defined key_s_coord
+   !! s-coordinate ('key_s_coord')
+   !! ----------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .FALSE.   !: partial steps flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .TRUE.    !: s-coordinate flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .FALSE.   !: z-coordinate flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
+      hbatt, hbatu,    &  !: ocean depth at the vertical of  t-, u-, v-
+      hbatv               !: and f-point (m)
+
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !:
+      gsigt, gsigw ,   &  !: model level depth coefficient at t-, w-levels
+      gsi3w,           &  !: model level depth coefficient at w-level
+                          !  defined as the sum of e3w scale factors
+      esigt, esigw        !: vertical scale factor coef. at t-, w-levels
+
+#else
+   !! z-coordinate (Default option)
+   !! -----------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zps = .FALSE.   !: partial steps flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sco = .FALSE.   !: s-coordinate flag
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: s-coordinate flag
+#endif
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! -----------------
+
+   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
+      mbathy         !: number of ocean level (=0, 1, ... , jpk-1)
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
+      tmask_i           !: interior domain T-point mask
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
+      tmask, umask,    &  !: land/ocean mask at T-, U-, V- and F-points
+      vmask, fmask        !:
+
+   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   &   !:
+      tpol                !: north fold mask (nperio= 3 or 4)
+
+   !!----------------------------------------------------------------------
+   !! time domain
+   !!----------------------------------------------------------------------
+   INTEGER, PUBLIC ::    & !!: * Namelist * ???
+      nacc   = 0 ,       &  !: = 0/1 use of the acceleration of convergence technique
+      neuler                !: restart euler forward option (0=Euler)
+
+
+   REAL(wp), PUBLIC ::       & !!: * Namelist ??? *
+      rdt    = 3600._wp ,    &  !: time step for the dynamics (and tracer if nacc=0)
+      rdtmin = 3600._wp ,    &  !: minimum time step on tracers
+      rdtmax = 3600._wp ,    &  !: maximum time step on tracers
+      rdth   =  800._wp ,    &  !: depth variation of tracer step
+      atfp   = 0.1_wp   ,    &  !: asselin time filter parameter
+      atfp1                     !: asselin time filter coeff. (atfp1= 1-2*atfp)
+
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !:
+      rdttra                    !: vertical profile of tracer time step
+
+   !!----------------------------------------------------------------------
+   !! cross land advection
+   !!----------------------------------------------------------------------
+
+   INTEGER, PUBLIC ::       & !!: namelist ???
+      n_cla                    !: flag (0/1) for cross land advection to
+      !                        ! parameterize exchanges through straits
+
+   !!----------------------------------------------------------------------
+END MODULE dom_oce
Index: trunk/NEMO/OFF_SRC/DOM/domain.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domain.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domain.F90	(revision 325)
@@ -0,0 +1,353 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE lib_mpp         ! distributed memory computing library
+   USE flxrnf          ! runoffs
+
+   USE domstp          ! domain: set the time-step
+   USE domrea          ! domain: write the meshmask file
+   USE dommsk          ! domain : mask
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_init       ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!      required to create the arrays which define the space and time
+      !!      domain of the ocean model.
+      !!
+      !! ** Method  :
+      !!      - dom_stp: defined the model time step
+      !!      - dom_rea: read the meshmask file if nmsh=1
+      !!
+      !! History :
+      !!        !  90-10  (C. Levy - G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-01  (M. Imbard) insert time step initialization
+      !!        !  96-06  (G. Madec) generalized vertical coordinate 
+      !!        !  97-02  (G. Madec) creation of domwri.F
+      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+
+      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
+
+      CALL dom_stp                        ! Time step
+
+      CALL dom_rea      ! Create a domain file
+
+      CALL dom_msk      ! Masks
+
+      CALL dom_ctl    ! Domain control
+
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namcla namelist
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,          &
+         &             nitend, ndate0   , nleapy   , ninist , nstock,           &
+         &             nprint, nwrite   , nrunoff  , ln_ctl , nictls, nictle,   &
+         &             njctls, njctle   , nbench   , isplt  , jsplt
+
+      NAMELIST/namdom/ e3zps_min, e3zps_rat, nmsh  ,   &
+         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
+         &             rdth 
+
+      NAMELIST/namcla/ n_cla
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! Namelist namrun : parameters of the run
+      REWIND( numnam )
+      READ  ( numnam, namrun )
+
+      IF(lwp) THEN
+         WRITE(numout,*) '        Namelist namrun'
+         WRITE(numout,*) '           job number                      no        = ', no
+         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
+         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
+         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
+         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
+         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
+         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
+         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
+         WRITE(numout,*) '           initial state output            ninist    = ', ninist
+         WRITE(numout,*) '           level of print                  nprint    = ', nprint
+         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
+         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
+         WRITE(numout,*) '           runoff option                   nrunoff   = ', nrunoff
+         WRITE(numout,*) '           run control (for debugging)     ln_ctl    = ', ln_ctl
+         WRITE(numout,*) '           Start i indice for SUM control  nictls    = ', nictls
+         WRITE(numout,*) '           End i indice for SUM control    nictle    = ', nictle
+         WRITE(numout,*) '           Start j indice for SUM control  njctls    = ', njctls
+         WRITE(numout,*) '           End j indice for SUM control    njctle    = ', njctle
+         WRITE(numout,*) '           number of proc. following i     isplt     = ', isplt
+         WRITE(numout,*) '           number of proc. following j     jsplt     = ', jsplt
+         WRITE(numout,*) '           benchmark parameter (0/1)       nbench    = ', nbench
+      ENDIF
+
+      ndastp = ndate0                ! Assign initial date to current date
+
+! ... Control the sub-domain area indices for the print control
+      IF(ln_ctl)   THEN
+         IF( lk_mpp ) THEN
+            ! the domain is forced to the real splitted domain in MPI
+            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               IF(lwp) WRITE(numout,cform_war)
+               IF(lwp) WRITE(numout,*)'          - isplt & jsplt are equal to 1'
+               IF(lwp) WRITE(numout,*)'          - the print control will be done over the whole domain'
+               IF(lwp) WRITE(numout,*)
+            ENDIF
+
+            ! compute the total number of processors ijsplt
+            ijsplt = isplt*jsplt
+         ENDIF
+
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+
+         ! Control the indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN
+            ! the print control is done over the default area
+            lsp_area = .FALSE.
+         ELSE
+            ! the print control is done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               IF(lwp) WRITE(numout,cform_war)
+               IF(lwp) WRITE(numout,*)'          - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
+               IF(lwp) WRITE(numout,*)
+               nwarn = nwarn + 1
+               nictls = 1
+            ENDIF
+
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               IF(lwp) WRITE(numout,cform_war)
+               IF(lwp) WRITE(numout,*)'          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
+               IF(lwp) WRITE(numout,*)
+               nwarn = nwarn + 1
+               nictle = jpjglo
+            ENDIF
+
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               IF(lwp) WRITE(numout,cform_war)
+               IF(lwp) WRITE(numout,*)'          - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
+               IF(lwp) WRITE(numout,*)
+               nwarn = nwarn + 1
+               njctls = 1
+            ENDIF
+
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               IF(lwp) WRITE(numout,cform_war)
+               IF(lwp) WRITE(numout,*)'          - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
+               IF(lwp) WRITE(numout,*)
+               nwarn = nwarn + 1
+               njctle = jpjglo
+            ENDIF
+
+         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
+       ENDIF            ! IF(ln_ctl)
+
+! ... Control of output frequency
+      IF ( nstock == 0 ) THEN
+          IF(lwp)WRITE(numout,cform_war)
+          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
+          nstock = nitend
+          nwarn = nwarn + 1
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+          IF(lwp)WRITE(numout,cform_war)
+          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
+          nwrite = nitend
+          nwarn = nwarn + 1
+      ENDIF
+
+      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+
+      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
+      CASE ( 1 )
+         raajj = 365.25
+         raass = raajj * rjjss
+         rmoss = raass/raamo
+      CASE ( 0 )
+         raajj = 365.
+         raass = raajj * rjjss
+         rmoss = raass/raamo
+      CASE DEFAULT
+         raajj = FLOAT( nleapy ) * raamo
+         raass =        raajj    * rjjss
+         rmoss = FLOAT( nleapy ) * rjjss
+      END SELECT
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
+         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
+         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
+      ENDIF
+
+      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
+      REWIND( numnam )
+      READ  ( numnam, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '        Namelist namdom'
+         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
+         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
+         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
+         WRITE(numout,*) '                = 0   no file created                 '
+         WRITE(numout,*) '                = 1   mesh_mask                       '
+         WRITE(numout,*) '                = 2   mesh and mask                   '
+         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
+         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
+         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
+         WRITE(numout,*) '           time step                      rdt       = ', rdt
+         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
+         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
+         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
+      ENDIF
+
+
+
+      ! Default values
+      n_cla = 0
+
+      ! Namelist cross land advection
+      REWIND( numnam )
+      READ  ( numnam, namcla )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '        Namelist namcla'
+         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
+      ENDIF
+
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)    Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc      ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+
+      ! Extrema of the scale factors
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+      IF(lwp)WRITE(numout,*) '~~~~~~~'
+
+      IF (lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+
+   END SUBROUTINE dom_ctl
+
+   !!======================================================================
+END MODULE domain
Index: trunk/NEMO/OFF_SRC/DOM/domcfg.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domcfg.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domcfg.F90	(revision 325)
@@ -0,0 +1,223 @@
+MODULE domcfg
+   !!==============================================================================
+   !!                       ***  MODULE domcfg   ***
+   !! Ocean initialization : domain configuration initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_cfg        : initialize the domain configuration
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_cfg        ! called by opa.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_cfg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_cfg  ***
+      !!                    
+      !! ** Purpose :   set the domain configuration
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
+         WRITE(numout,*) '~~~~~~~      ocean model configuration used :',   &
+            &                             ' cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
+      ENDIF
+
+      ! Global domain boundary conditions
+      ! ---------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) '          global domain lateral boundaries'
+
+         IF( jperio == 0 ) WRITE(numout,*) '             jperio= 0, closed'
+         IF( jperio == 1 ) WRITE(numout,*) '             jperio= 1, cyclic east-west'
+         IF( jperio == 2 ) WRITE(numout,*) '             jperio= 2, equatorial symmetric'
+         IF( jperio == 3 ) WRITE(numout,*) '             jperio= 3, north fold with T-point pivot'
+         IF( jperio == 4 ) WRITE(numout,*) '             jperio= 4, cyclic east-west and',   &
+                                                                  ' north fold with T-point pivot'
+         IF( jperio == 5 ) WRITE(numout,*) '             jperio= 5, north fold with F-point pivot'
+         IF( jperio == 6 ) WRITE(numout,*) '             jperio= 6, cyclic east-west and',   &
+                                                                  ' north fold with F-point pivot'
+      ENDIF
+      IF( jperio <  0 .OR. jperio > 6 ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) 'jperio is out of range'
+          nstop = nstop + 1
+      ENDIF
+
+
+      ! global domain versus zoom and/or local domain
+      ! ---------------------------------------------
+
+      CALL dom_glo 
+
+   END SUBROUTINE dom_cfg
+
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization for global domain, zoom and local domain
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig  , mjg : 
+      !!              - mi0  , mi1   :
+      !!              - mj0, , mj1   :
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)    Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj            ! dummy loop argument
+      !!----------------------------------------------------------------------
+
+      ! Local domain 
+      ! ============
+
+      ! local domain indices ==> data domain indices
+      DO ji = 1, jpi
+        mig(ji) = ji + jpizoom - 1 + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
+      END DO
+
+      ! data domain indices ==> local domain indices
+      ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 
+      ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 
+      DO ji = 1, jpidta
+        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) )
+        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
+      END DO
+      DO jj = 1, jpjdta
+        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj+1 ) )
+        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
+      END DO
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: data / local '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
+            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
+         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
+            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
+         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
+            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
+            &                                           ' jpjzoom = ', jpjzoom
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion local  ==> data i-index domain'
+         WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion data   ==> local  i-index domain'
+         WRITE(numout,*) '             starting index'
+         WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
+         WRITE(numout,*) '             ending index'
+         WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion local  ==> data i-index domain'
+         WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion data  ==> local i-index domain'
+         WRITE(numout,*) '             starting index'
+         WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
+         WRITE(numout,*) '             ending index'
+         WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+
+      ! Zoom domain
+      ! ===========
+
+      ! zoom control
+      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   &
+          jpjglo + jpjzoom - 1  >  jpjdta      ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' global or zoom domain exceed the data domain ! '
+         nstop = nstop + 1
+      ENDIF
+
+      ! set zoom flag
+      IF ( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
+
+      ! set zoom type flags
+      IF( lzoom .AND. jpizoom /= 1 )   lzoom_w = .TRUE.                     ! 
+      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
+      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_e = .TRUE.
+      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          zoom flags : '
+         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
+         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
+         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
+         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
+         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
+      ENDIF
+      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with east-west cyclic boundary condition'
+         nstop = nstop + 1
+      ENDIF
+      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with North fold boundary condition'
+         nstop = nstop + 1
+      ENDIF
+
+      ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
+      IF( cp_cfg == "orca" ) THEN
+         SELECT CASE ( jp_cfg )
+         !                                        ! =======================
+         CASE ( 2 )                               !  ORCA_R2 configuration
+            !                                     ! =======================
+            IF(  jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
+               & jpizoom ==  21    .AND. jpjzoom ==  97         )   lzoom_arct = .TRUE.
+            IF(  jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
+            !                                     ! =======================
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            !                                     ! =======================
+            IF(  jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
+               & jpizoom ==  81    .AND. jpjzoom == 301         )   lzoom_arct = .TRUE.
+            IF(  jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
+         END SELECT
+         !
+         IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic/arctic zoom flags : '
+         IF(lwp) WRITE(numout,*) '             lzoom_arct = ', lzoom_arct, ' (T=   arctic zoom, F=global)'
+         IF(lwp) WRITE(numout,*) '             lzoom_anta = ', lzoom_anta, ' (T=antarctic zoom, F=global)'
+         !
+      ENDIF
+         
+   END SUBROUTINE dom_glo
+
+   !!======================================================================
+END MODULE domcfg
Index: trunk/NEMO/OFF_SRC/DOM/dommsk.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/dommsk.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/dommsk.F90	(revision 325)
@@ -0,0 +1,176 @@
+MODULE dommsk
+   !!==============================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask 
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk        : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_msk        ! routine called by inidom.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) and baro-
+      !!      tropic stream function  points (b).
+      !!        Set mbathy to the number of non-zero w-levels of a water column
+      !!      (if island in the domain (lk_isl=T), this is done latter in
+      !!      routine solver_init)
+      !!
+      !! ** Method  :   The ocean/land mask is computed from the basin bathy-
+      !!      metry in level (mbathy) which is defined or read in dommba.
+      !!      mbathy equals 0 over continental T-point, -n over the nth 
+      !!      island T-point, and the number of ocean level over the ocean.
+      !!
+      !!      At a given position (ji,jj,jk) the ocean/land mask is given by:
+      !!      t-point : 0. IF mbathy( ji ,jj) =< 0
+      !!                1. IF mbathy( ji ,jj) >= jk
+      !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
+      !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
+      !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1)
+      !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
+      !!                and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
+      !!      b-point : the same definition as for f-point of the first ocean
+      !!                level (surface level) but with 0 along coastlines.
+      !!
+      !!        The lateral friction is set through the value of fmask along
+      !!      the coast and topography. This value is defined by shlat, a
+      !!      namelist parameter:
+      !!         shlat = 0, free slip  (no shear along the coast)
+      !!         shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays
+      !!      are defined with the proper value at lateral domain boundaries,
+      !!      but bmask. indeed, bmask defined the domain over which the
+      !!      barotropic stream function is computed. this domain cannot
+      !!      contain identical columns because the matrix associated with
+      !!      the barotropic stream function equation is then no more inverti-
+      !!      ble. therefore bmask is set to 0 along lateral domain boundaries
+      !!      even IF nperio is not zero.
+      !!
+      !!      In case of open boundaries (lk_obc=T):
+      !!        - tmask is set to 1 on the points to be computed bay the open
+      !!          boundaries routines.
+      !!        - bmask is  set to 0 on the open boundaries.
+      !!
+      !!      Set mbathy to the number of non-zero w-levels of a water column
+      !!                  mbathy = min( mbathy, 1 ) + 1
+      !!      (note that the minimum value of mbathy is 2).
+      !!
+      !! ** Action :
+      !!                     tmask    : land/ocean mask at t-point (=0. or 1.)
+      !!                     umask    : land/ocean mask at u-point (=0. or 1.)
+      !!                     vmask    : land/ocean mask at v-point (=0. or 1.)
+      !!                     fmask    : land/ocean mask at f-point (=0. or 1.)
+      !!                          =shlat along lateral boundaries
+      !!                     bmask    : land/ocean mask at barotropic stream
+      !!                          function point (=0. or 1.) and set to
+      !!                          0 along lateral boundaries
+      !!                   mbathy   : number of non-zero w-levels 
+      !!
+      !! History :
+      !!        !  87-07  (G. Madec)  Original code
+      !!        !  91-12  (G. Madec)
+      !!        !  92-06  (M. Imbard)
+      !!        !  93-03  (M. Guyon)  symetrical conditions (M. Guyon)
+      !!        !  96-01  (G. Madec)  suppression of common work arrays
+      !!        !  96-05  (G. Madec)  mask computed from tmask and sup-
+      !!                 pression of the double computation of bmask
+      !!        !  97-02  (G. Madec)  mesh information put in domhgr.F
+      !!        !  97-07  (G. Madec)  modification of mbathy and fmask
+      !!        !  98-05  (G. Roullet)  free surface
+      !!        !  00-03  (G. Madec)  no slip accurate
+      !!        !  01-09  (J.-M. Molines)  Open boundaries
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! *Local declarations
+      INTEGER  ::   ji, jk     ! dummy loop indices
+      INTEGER  ::   iif, iil, ijf, ijl
+      INTEGER, DIMENSION(jpi,jpj) ::  imsk
+
+      !!---------------------------------------------------------------------
+      
+
+
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+
+      tmask_i(:,:) = tmask(:,:,1)
+      iif = jpreci                         ! ???
+      iil = nlci - jpreci + 1
+      ijf = jprecj                         ! ???
+      ijl = nlcj - jprecj + 1
+
+      tmask_i( 1 :iif,   :   ) = 0.e0      ! first columns
+      tmask_i(iil:jpi,   :   ) = 0.e0      ! last  columns (including mpp extra columns)
+      tmask_i(   :   , 1 :ijf) = 0.e0      ! first rows
+      tmask_i(   :   ,ijl:jpj) = 0.e0      ! last  rows (including mpp extra rows)
+
+
+      ! north fold mask
+      tpol(1:jpiglo) = 1.e0 
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
+         tpol(jpiglo/2+1:jpiglo) = 0.e0
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0.e0
+      ENDIF
+
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
+         if (mjg(ijl-1) == jpjglo-1) then
+         DO ji = iif+1, iil-1
+            tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
+         END DO
+         endif
+      ENDIF 
+
+      ! Control print
+      ! -------------
+      IF( nprint == 1 .AND. lwp ) THEN
+         imsk(:,:) = INT( tmask_i(:,:) )
+         WRITE(numout,*) ' tmask_i : '
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                           1, jpj, 1, 1, numout)
+         WRITE (numout,*)
+         WRITE (numout,*) ' dommsk: tmask for each level'
+         WRITE (numout,*) ' ----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( tmask(:,:,jk) )
+
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout)
+         END DO
+      ENDIF
+
+   END SUBROUTINE dom_msk
+
+END MODULE dommsk
Index: trunk/NEMO/OFF_SRC/DOM/domrea.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domrea.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domrea.F90	(revision 325)
@@ -0,0 +1,510 @@
+MODULE domrea
+   !!======================================================================
+   !!                       ***  MODULE domrea  ***
+   !! Ocean initialization : read the ocean domain meshmask file(s)
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_rea        : read mesh and mask file(s)
+   !!                    nmsh = 1  :   mesh_mask file
+   !!                         = 2  :   mesh and mask file
+   !!                         = 3  :   mesh_hgr, mesh_zgr and mask
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dom_rea        ! routine called by inidom.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir' :                                     direct access file
+   !!----------------------------------------------------------------------
+#  include "domrea_fdir.h90"
+
+#elif ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'     OR
+   !!   'key_mpp_shmem'
+   !!   'key_dimgout' :         each processor makes its own direct access file 
+   !!                      use build_nc_meshmask off line to retrieve 
+   !!                      a ioipsl compliant meshmask file
+   !!----------------------------------------------------------------------
+#  include "domrea_dimg.h90"
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                        NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dom_rea
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_rea  ***
+      !!                   
+      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   Read in a file all the arrays generated in routines
+      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
+      !!      the vertical coord. used (z-coord, partial steps, s-coord)
+      !!                    nmsh = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your 
+      !!      vertical coordinate.
+      !!
+      !! ** input file : 
+      !!      meshmask.nc  : domain size, horizontal grid-point position,
+      !!                     masks, depth and vertical scale factors
+      !!
+      !! History :
+      !!        !  97-02  (G. Madec)  Original code
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+      !!   9.0  !  02-08  (G. Madec)  F90 and several file
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      LOGICAL ::   llog
+      INTEGER  ::   ji, jj, jk, ik
+      INTEGER  ::                & !!! * temprary units for :
+         inum0 ,                 &  ! 'mesh_mask.nc' file
+         inum1 ,                 &  ! 'mesh.nc'      file
+         inum2 ,                 &  ! 'mask.nc'      file
+         inum3 ,                 &  ! 'mesh_hgr.nc'  file
+         inum4                      ! 'mesh_zgr.nc'  file
+      INTEGER  ::   itime           !  output from restini ???
+      REAL(wp) ::   zdate0, zdepwp, ze3tp, ze3wp
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         zta       ! dummy array for bathymetry 
+      REAL(wp) , DIMENSION(jpidta,jpjdta,jpk) :: &
+         zt3a      ! dummy array for bathymetry 
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         zprt = 0.
+
+      CHARACTER (len=21) ::      &
+         clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations)
+         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
+         clnam2 = 'mask'     ,   &  ! filename (mask informations)
+         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
+         clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations)
+      !!----------------------------------------------------------------------
+
+       IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)'
+       IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      llog  = .FALSE.
+      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization
+
+!       note that mbathy has been modified in dommsk or in solver.
+!       it is the number of non-zero "w" levels in the water, and the minimum 
+!       value (on land) is 2. We define zprt as the number of "T" points in the ocean 
+!       at any location, and zero on land. 
+!
+
+      SELECT CASE (nmsh)
+         !                                     ! ============================
+         CASE ( 1 )                            !  create 'mesh_mask.nc' file
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
+            CALL restini( clnam0, jpidta   , jpjdta   , glamt, gphit,  &   ! create 'mesh_mask.nc' file
+            &             jpk   , gdept , trim(clnam0)        ,  &   ! in unit inum0
+            &             itime , zdate0, rdt   , inum0          )
+            inum2 = inum0                                            ! put all the informations
+            inum3 = inum0                                            ! in unit inum0
+            inum4 = inum0
+
+            !                                  ! ============================
+         CASE ( 2 )                            !  create 'mesh.nc' and 
+            !                                  !         'mask.nc' files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
+            CALL restini( clnam1, jpidta   , jpjdta   , glamt, gphit,  &   ! create 'mesh.nc' file 
+            &             jpk   , gdept , trim(clnam1)        ,  &   ! in unit inum1 
+            &             itime , zdate0, rdt   , inum1          )
+            CALL restini( clnam2, jpidta   , jpjdta   , glamt, gphit,  &   ! create 'mask.nc' file 
+            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2 
+            &             itime , zdate0, rdt   , inum2          )
+            inum3 = inum1                                            ! put mesh informations 
+            inum4 = inum1                                            ! in unit inum1 
+
+            !                                  ! ============================
+         CASE ( 3 )                            !  create 'mesh_hgr.nc'
+            !                                  !         'mesh_zgr.nc' and
+            !                                  !         'mask.nc'     files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" '
+            CALL restini( clnam3, jpidta   , jpjdta   , glamt, gphit,  &   ! create 'mesh_hgr.nc' file
+            &             jpk   , gdept , trim(clnam3)        ,  &   ! in unit inum3
+            &             itime , zdate0, rdt   , inum3          )
+            CALL restini( clnam4, jpidta   , jpjdta   , glamt, gphit,  &   ! create 'mesh_zgr.nc' file
+            &             jpk   , gdept , trim(clnam4)        ,  &   ! in unit inum4
+            &             itime , zdate0, rdt   , inum4          )
+            CALL restini( clnam2, jpidta   , jpjdta   , glamt, gphit,  &   ! create 'mask.nc' file
+            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2
+            &             itime , zdate0, rdt   , inum2          ) 
+
+         END SELECT
+
+         !                                                         ! masks (inum2) 
+         CALL restget( inum2, 'tmask', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               tmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+         CALL restget( inum2, 'umask', jpidta, jpjdta, jpk, 0, llog, zt3a )
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               umask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+         CALL restget( inum2, 'vmask', jpidta, jpjdta, jpk, 0, llog, zt3a )
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               vmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+         CALL restget( inum2, 'fmask', jpidta, jpjdta, jpk, 0, llog, zt3a )
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               fmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+
+         !                                                         ! horizontal mesh (inum3)
+         CALL restget( inum3, 'glamt', jpidta, jpjdta, 1, 0, llog, zta )     !    ! latitude
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               glamt(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'glamu', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               glamu(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'glamv', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               glamv(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'glamf', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               glamf(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+
+         CALL restget( inum3, 'gphit', jpidta, jpjdta, 1, 0, llog, zta )     !    ! longitude
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               gphit(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'gphiu', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               gphiu(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'gphiv', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               gphiv(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'gphif', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               gphif(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+
+         CALL restget( inum3, 'e1t', jpidta, jpjdta, 1, 0, llog, zta )         !    ! e1 scale factors
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e1t(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'e1u', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e1u(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'e1v', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e1v(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'e2t', jpidta, jpjdta, 1, 0, llog, zta )         !    ! e2 scale factors
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e2t(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'e2u', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e2u(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'e2v', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e2v(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum3, 'ff', jpidta, jpjdta, 1, 0, llog, zta )           !    ! coriolis factor
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               ff(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+
+         CALL restget( inum4, 'mbathy', jpidta, jpjdta, 1, 0, llog, zta )
+! Bathymetry
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               zprt(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+
+         mbathy(:,:)=zprt(:,:)*tmask(:,:,1)+1
+
+# if defined key_s_coord
+         !                                                         ! s-coordinate
+         CALL restget( inum4, 'hbatt', jpidta, jpjdta, 1, 0, llog, zta )      !    ! depth
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               hbatt(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum4, 'hbatu', jpidta, jpjdta, 1, 0, llog, zta ) 
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               hbatu(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum4, 'hbatv', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               hbatv(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum4, 'hbatf', jpidta, jpjdta, 1, 0, llog, zta )
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               hbatf(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+
+         CALL restget( inum4, 'gsigt', 1, 1, jpk, 0, llog, gsigt )        !    ! scaling coef.
+         CALL restget( inum4, 'gsigw', 1, 1, jpk, 0, llog, gsigw )  
+         CALL restget( inum4, 'gsi3w', 1, 1, jpk, 0, llog, gsi3w )
+         CALL restget( inum4, 'esigt', 1, 1, jpk, 0, llog, esigt )
+         CALL restget( inum4, 'esigw', 1, 1, jpk, 0, llog, esigw )
+
+# elif defined key_partial_steps
+         !                                                          ! z-coordinate with partial steps
+         CALL restget( inum4, 'hdept' , jpidta, jpjdta, 1, 0, llog, zta  )    !    ! depth
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               hdept(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+         CALL restget( inum4, 'hdepw' , jpidta, jpjdta, 1, 0, llog, zta  ) 
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               hdepw(ji,jj) = zta(mig(ji),mjg(jj))
+             END DO
+           END DO
+
+         CALL restget( inum4, 'e3t_ps', jpidta, jpjdta, jpk, 0, llog, zt3a )  !    ! scale factors
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e3t_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+         CALL restget( inum4, 'e3u_ps', jpidta, jpjdta, jpk, 0, llog, zt3a )
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e3u_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+         CALL restget( inum4, 'e3v_ps', jpidta, jpjdta, jpk, 0, llog, zt3a )
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e3v_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+         CALL restget( inum4, 'e3w_ps', jpidta, jpjdta, jpk, 0, llog, zt3a )
+         DO jk = 1, jpk
+           DO jj = 1, nlcj
+             DO ji = 1, nlci
+               e3w_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk)
+             END DO
+           END DO
+         END DO
+
+         CALL restget( inum4, 'gdept' , 1, 1, jpk, 0, llog, gdept )       !    ! reference z-coord.
+         CALL restget( inum4, 'gdepw' , 1, 1, jpk, 0, llog, gdepw )
+         CALL restget( inum4, 'e3t'   , 1, 1, jpk, 0, llog, e3t   )
+         CALL restget( inum4, 'e3w'   , 1, 1, jpk, 0, llog, e3w   )
+
+         do jk=1,jpk
+        gdept_ps(:,:,jk) = gdept(jk)
+        gdepw_ps(:,:,jk) = gdepw(jk)
+         end do
+
+     DO jj = 1, jpj
+        DO ji = 1, jpi
+           ik = mbathy(ji,jj) 
+           ! ocean point only 
+           IF( ik > 0 ) THEN
+              ! max ocean level case
+              IF( ik == jpkm1 ) THEN
+                 zdepwp = mbathy(ji,jj)
+                 ze3tp  = mbathy(ji,jj) - gdepw(ik)
+                 ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) )
+                 gdepw_ps(ji,jj,ik+1) = zdepwp
+                 gdept_ps(ji,jj,ik  ) = gdept(ik-1) + ze3wp
+                 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + ze3tp
+                 ! standard case
+              ELSE
+!!alex
+                 IF( mbathy(ji,jj) <= gdepw(ik+1) ) THEN
+                    gdepw_ps(ji,jj,ik+1) = mbathy(ji,jj)
+                 ELSE
+                    gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                 ENDIF
+!!Alex
+!!Alex           gdepw_ps(ji,jj,ik+1) = mbathy(ji,jj)
+                 gdept_ps(ji,jj,ik  ) =  gdepw(ik) + ( gdepw_ps(ji,jj,ik+1) - gdepw(ik))   &
+                                      * ((gdept   (      ik  ) - gdepw(ik))   &
+                                      / ( gdepw   (      ik+1) - gdepw(ik)))
+                 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + e3t_ps  (ji,jj,ik)
+              ENDIF
+           ENDIF
+        END DO
+     END DO
+
+
+# else
+         !                                                          ! z-coordinate 
+         CALL restget( inum4, 'gdept', 1, 1, jpk, 0, llog, gdept )        !    ! depth
+         CALL restget( inum4, 'gdepw', 1, 1, jpk, 0, llog, gdepw )
+         CALL restget( inum4, 'e3t'  , 1, 1, jpk, 0, llog, e3t   )        !    ! scale factors
+         CALL restget( inum4, 'e3w'  , 1, 1, jpk, 0, llog, e3w   )
+# endif
+
+      ! Control printing : Grid informations (if not restart)
+      ! ----------------
+
+      IF(lwp .AND. .NOT.ln_rstart ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), ji = 1, jpi,10)
+9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
+            f19.10, 1x, f19.10, 1x, f19.10 )
+
+         WRITE(numout,*)
+         WRITE(numout,*) '          latitude and e2 scale factors'
+         WRITE(numout,*) '          -----------------------------'
+         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
+            &                     gphiv(1,jj), gphif(1,jj),   &
+            &                     e2t  (1,jj), e2u  (1,jj),   &
+            &                     e2v  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+
+      IF( nprint == 1 .AND. lwp ) THEN
+         WRITE(numout,*) '          e1u e2u '
+         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1v e2v  '
+         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept(jk), gdepw(jk), e3t(jk), e3w(jk), jk = 1, jpk )
+      ENDIF
+
+      DO jk = 1, jpk
+         IF( e3w(jk) <= 0. .OR. e3t(jk) <= 0. ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' e3w or e3t =< 0 '
+            nstop = nstop + 1
+         ENDIF
+         IF( gdepw(jk) < 0. .OR. gdept(jk) < 0.) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' gdepw or gdept < 0 '
+            nstop = nstop + 1
+         ENDIF
+      END DO
+
+         !                                     ! ============================
+         !                                     !        close the files 
+         !                                     ! ============================
+         SELECT CASE ( nmsh )
+            CASE ( 1 )                
+               CALL restclo( inum0 )
+            CASE ( 2 )
+               CALL restclo( inum1 )
+               CALL restclo( inum2 )
+            CASE ( 3 )
+               CALL restclo( inum2 )
+               CALL restclo( inum3 )
+               CALL restclo( inum4 )
+         END SELECT
+
+   END SUBROUTINE dom_rea
+
+#endif
+
+   !!======================================================================
+END MODULE domrea
Index: trunk/NEMO/OFF_SRC/DOM/domrea_dimg.h90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domrea_dimg.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domrea_dimg.h90	(revision 325)
@@ -0,0 +1,390 @@
+   SUBROUTINE dom_rea
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_rea  ***   'key_mpp'
+      !!
+      !! ** Purpose :   READ the direct access files which contains all the
+      !!      ocean domain informations (mesh and mask arrays). These
+      !!      files are used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   READ in a file all the arrays generated in routines
+      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
+      !!      the vertical coord. used (z-coord, partial steps, s-coord)
+      !!    For mpp output direct access files are used and each processor
+      !!    uses a record range. Off line program (build_nc_meshmask) can be used
+      !!    to reconstruct the Netcdf files
+      !!                    nmsh = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your
+      !!      vertical coordinate.
+      !!
+      !! ** output file :
+      !!      meshmask.nc  : domain size, horizontal grid-point position,
+      !!                     masks, depth and vertical scale factors
+      !!
+      !! History :
+      !!        !  97-02  (G. Madec)  Original code
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+      !!   9.0  !  02-08  (G. Madec)  F90 and several file
+      !!        !  04-01  (J.M. Molines) MPP i/o
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE lib_mpp
+      USE daymod
+
+      !! * Local declarations
+      !! * Local declarations
+      INTEGER  ::                & !!! * temprary units for :
+         inum0 ,                 &  ! 'mesh_mask.nc' file
+         inum1 ,                 &  ! 'mesh.nc'      file
+         inum2 ,                 &  ! 'mask.nc'      file
+         inum3 ,                 &  ! 'mesh_hgr.nc'  file
+         inum4                      ! 'mesh_zgr.nc'  file
+      INTEGER  ::   itime           !  output from restini ???
+      INTEGER  ::   irecl8, irec    ! Record length (bytes) for output file 
+      INTEGER  ::   jk              ! loop index
+      INTEGER  ::   ios1, ios2
+      INTEGER, DIMENSION(11:15)  :: irecv ! index of this array will be inumxxx
+      REAL(wp) ::   zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zprt                       ! temporary array for bathymetry
+
+      CHARACTER (len=21) ::      &
+         clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations)
+         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
+         clnam2 = 'mask'     ,   &  ! filename (mask informations)
+         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
+         clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations)
+      !!----------------------------------------------------------------------
+
+       IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) 'dom_rea : read direct access  mesh and mask information files'
+       IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+       inum0 = 11
+       irecl8 = jpi*jpj*wp
+       ios1 = 0 ; ios2 = 0
+       IF (lk_zps ) ios1= 1 
+       IF (lk_sco ) ios2= 1
+   
+       SELECT CASE (nmsh )
+          !                                    !==============================
+          CASE ( 1 )                           !  read 'mesh_mask' file
+             !                                 !==============================
+             IF (lwp) WRITE(numout,*) '          one file in "mesh_mask.dimgproc '
+             OPEN(inum0,FILE=trim(clnam0)//'.mpp', &
+                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
+             IF (lwp )READ(inum0,REC=1 ) irecl8, nmsh, ios1,ios2 , &
+            &  ndastp, adatrj, jpi,jpj,jpk,  &
+            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
+            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+
+             inum2 = inum0
+             inum3 = inum0
+             inum4 = inum0
+
+            !                                  ! ============================
+         CASE ( 2 )                            !  read 'mesh' and
+            !                                  !         'mask' files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          two files in "mesh" and "mask" '
+            inum1 = 12
+            inum2 = 13
+            OPEN(inum1,FILE=trim(clnam1)//'.mpp', &
+                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
+             IF (lwp) READ(inum1,REC=1 ) irecl8, nmsh, ios1,ios2 , &
+            &  ndastp, adatrj, jpi,jpj,jpk,  &
+            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
+            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+
+             inum3 = inum1
+             inum4 = inum1
+            OPEN(inum2,FILE=trim(clnam2)//'.mpp', &
+                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
+             IF (lwp) READ(inum2,REC=1 ) irecl8, nmsh, ios1,ios2 , &
+            &  ndastp, adatrj, jpi,jpj,jpk,  &
+            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
+            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+
+            !                                  ! ============================
+         CASE ( 3 )                            !  read 'mesh_hgr'
+            !                                  !         'mesh_zgr' and
+            !                                  !         'mask'     files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr" , mesh_zgr" and "mask" '
+            inum3 = 14
+            inum2 = 13
+            inum4 = 15
+
+            OPEN(inum3,FILE=trim(clnam3)//'.mpp', &
+                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
+             IF (lwp) READ(inum3,REC=1 ) irecl8, nmsh, ios1,ios2 , &
+            &  ndastp, adatrj, jpi,jpj,jpk,  &
+            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
+            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+
+            OPEN(inum2,FILE=trim(clnam2)//'.mpp', &
+                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
+             IF (lwp) READ(inum2,REC=1 ) irecl8, nmsh, ios1,ios2 , &
+            &  ndastp, adatrj, jpi,jpj,jpk,  &
+            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
+            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+
+            OPEN(inum4,FILE=trim(clnam4)//'.mpp', &
+                & FORM='UNFORMATTED', ACCESS='DIRECT', RECL = irecl8 )
+             IF (lwp) READ(inum4,REC=1 ) irecl8, nmsh, ios1,ios2 , &
+            &  ndastp, adatrj, jpi,jpj,jpk,  &
+            &  jpni,jpnj,jpnij,jpiglo,jpjglo, &
+            &  nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+         
+         END SELECT
+       
+         irecv(:) = 2
+         ! tmask
+         DO jk=1,jpk
+             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum2,REC=irec) tmask(:,:,jk)
+         END DO
+         irecv(inum2) = irecv(inum2) + jpk * jpnij 
+         !
+         ! umask
+         DO jk=1,jpk
+             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum2,REC=irec) umask(:,:,jk)
+         END DO
+         irecv(inum2) = irecv(inum2) + jpk * jpnij 
+         !
+         ! vmask
+         DO jk=1,jpk
+             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum2,REC=irec) vmask(:,:,jk)
+         END DO
+         irecv(inum2) = irecv(inum2) + jpk * jpnij 
+         !
+         ! fmask
+         DO jk=1,jpk
+             irec=irecv(inum2) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum2,REC=irec) fmask(:,:,jk)
+         END DO
+         irecv(inum2) = irecv(inum2) + jpk * jpnij 
+         !
+         ! glam
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) glamt(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+       
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) glamu(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) glamv(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) glamf(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+         !
+         ! gphi
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) gphit(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+       
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) gphiu(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) gphiv(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) gphif(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+         !
+         ! e1
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e1t(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+       
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e1u(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e1v(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e1f(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+         !
+         ! e2
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e2t(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+       
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e2u(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e2v(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) e2f(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+         !
+         ! ff
+         irec = irecv(inum3) + (narea - 1 )
+         READ(inum3,REC=irec) ff(:,:)
+         irecv(inum3) = irecv(inum3) + jpnij 
+         !
+         ! mbathy
+         !       note that mbathy has been modified in dommsk or in solver.
+         !       it is the number of non-zero "w" levels in the water, and the minimum
+         !       value (on land) is 2. We define zprt as the number of "T" points in the ocean
+         !       at any location, and zero on land.
+         !
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) zprt(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+          mbathy=zprt*tmask(:,:,1)+1
+
+#if defined key_s_coord
+         !
+         ! hbat
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) hbatt(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+       
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) hbatu(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) hbatv(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) hbatf(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+         !
+         ! gsig and esig ( as vectors of jpk per record )
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gsigt(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gsigw(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gsi3w(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) esigt(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) esigw(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+# elif defined key_partial_steps
+         !
+         ! hdep
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) hdept(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+       
+         irec = irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) hdepw(:,:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+         !
+         ! e3t_ps (3D)
+         DO jk=1,jpk
+             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum4,REC=irec) e3t_ps(:,:,jk)
+         END DO
+         irecv(inum4) = irecv(inum4) + jpk * jpnij 
+
+         ! e3u_ps e3v_ps e3w_ps (3D)
+         DO jk=1,jpk
+             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum4,REC=irec) e3u_ps(:,:,jk)
+         END DO
+         irecv(inum4) = irecv(inum4) + jpk * jpnij 
+         
+         DO jk=1,jpk
+             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum4,REC=irec) e3v_ps(:,:,jk)
+         END DO
+         irecv(inum4) = irecv(inum4) + jpk * jpnij 
+
+         DO jk=1,jpk
+             irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 )
+             READ(inum4,REC=irec) e3w_ps(:,:,jk)
+         END DO
+         irecv(inum4) = irecv(inum4) + jpk * jpnij 
+         ! 
+         ! 
+         ! gdep
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gdept(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gdepw(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+         !
+         ! e3
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) e3t(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) e3w(:)
+#else
+         !
+         ! gdep
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gdept(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) gdepw(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+         !
+         ! e3
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) e3t(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+
+         irec =  irecv(inum4) + (narea - 1 )
+         READ(inum4,REC=irec) e3w(:)
+         irecv(inum4) = irecv(inum4) + jpnij 
+         !
+#endif
+         !                                     ! ============================
+         !                                     !        close the files
+         !                                     ! ============================
+         SELECT CASE ( nmsh )
+            CASE ( 1 )
+               CLOSE ( inum0 )
+            CASE ( 2 )
+               CLOSE ( inum1 )
+               CLOSE ( inum2 )
+            CASE ( 3 )
+               CLOSE ( inum2 )
+               CLOSE ( inum3 )
+               CLOSE ( inum4 )
+         END SELECT
+
+   END SUBROUTINE dom_rea
Index: trunk/NEMO/OFF_SRC/DOM/domrea_fdir.h90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domrea_fdir.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domrea_fdir.h90	(revision 325)
@@ -0,0 +1,96 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  domrea_fdir.h90  ***
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dom_rea
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_rea  ***
+      !!                   
+      !! ** Purpose :   Read a direct access file named meshmask
+      !!        This file contains all ocean domain informations (mesh and
+      !!      mask arrays). It is used for visualisation (SAXO software)
+      !!      and diagnostic computation.
+      !!        Caution, this file is not assigned so that diagnostics can
+      !!      be computed with a 64 bits precision.
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      CHARACTER (len=5) ::   clfield  ! field name
+      INTEGER ::   inum = 11          ! logical unit used for meshmask file
+      INTEGER :: iimlu,ijmlu,ikmlu
+      !!----------------------------------------------------------------------
+
+       IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) 'dom_rea : read a direct acces mesh_mask file'
+       IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+       ! open meshmask file
+       CALL ctlopn( inum, 'mesh_mask','UNKNOWN', 'UNFORMATTED', 'SEQUENTIAL',   &
+                    1 , numout, lwp, 1 )
+
+
+      ! 0. Domain size
+      ! --------------
+      read(inum) iimlu, ijmlu, ikmlu
+
+
+      ! 1. Horzontal grid-point position
+      ! --------------------------------
+      clfield='GLAMT'   ;    READ(inum) clfield, glamt
+      clfield='GLAMU'   ;    READ(inum) clfield, glamu
+      clfield='GLAMV'   ;    READ(inum) clfield, glamv
+      clfield='GLAMF'   ;    READ(inum) clfield, glamf
+
+      clfield='GPHIT'   ;    READ(inum) clfield, gphit
+      clfield='GPHIU'   ;    READ(inum) clfield, gphiu
+      clfield='GPHIV'   ;    READ(inum) clfield, gphiv
+      clfield='GPHIF'   ;    READ(inum) clfield, gphif
+
+
+      ! 2. Horizontal scale factors
+      ! ---------------------------
+      clfield='E1T  '   ;    READ(inum) clfield, e1t
+      clfield='E1U  '   ;    READ(inum) clfield, e1u
+      clfield='E1V  '   ;    READ(inum) clfield, e1v
+      clfield='E1F  '   ;    READ(inum) clfield, e1f
+
+      clfield='E2T  '   ;    READ(inum) clfield, e2t
+      clfield='E2U  '   ;    READ(inum) clfield, e2u
+      clfield='E2V  '   ;    READ(inum) clfield, e2v
+      clfield='E2F  '   ;    READ(inum) clfield, e2f
+
+
+      ! 3. masks
+      ! --------
+      clfield='TMASK'   ;    READ(inum) clfield, tmask
+      clfield='UMASK'   ;    READ(inum) clfield, umask
+      clfield='VMASK'   ;    READ(inum) clfield, vmask
+      clfield='FMASK'   ;    READ(inum) clfield, fmask
+      clfield='FF   '   ;    READ(inum) clfield, ff
+
+      ! 4. depth and vertical scale factors
+      ! -----------------------------------
+#if defined key_s_coord
+      clfield='HBATT'   ;    READ(inum) clfield, hbatt
+      clfield='HBATU'   ;    READ(inum) clfield, hbatu
+      clfield='HBATV'   ;    READ(inum) clfield, hbatv
+      clfield='HBATF'   ;    READ(inum) clfield, hbatf
+      clfield='GSIGT'   ;    READ(inum) clfield, gsigt
+      clfield='GSIGW'   ;    READ(inum) clfield, gsigw
+      clfield='GSI3W'   ;    READ(inum) clfield, gsi3w
+      clfield='ESIGT'   ;    READ(inum) clfield, esigt
+      clfield='ESIGW'   ;    READ(inum) clfield, esigw
+#else
+      clfield='GDEPT'   ;    READ(inum) clfield, gdept
+      clfield='GDEPW'   ;    READ(inum) clfield, gdepw
+      clfield='E3T  '   ;    READ(inum) clfield, e3t
+      clfield='E3W  '   ;    READ(inum) clfield,  e3w
+#endif
+
+      CLOSE( inum )
+
+   END SUBROUTINE dom_read
Index: trunk/NEMO/OFF_SRC/DOM/domstp.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domstp.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domstp.F90	(revision 325)
@@ -0,0 +1,131 @@
+MODULE domstp
+   !!==============================================================================
+   !!                       ***  MODULE domstp   ***
+   !! Ocean initialization : time domain
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_stp        : ocean time domain initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * routine accessibility
+   PUBLIC dom_stp        ! routine called by inidom.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_stp
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_stp  ***
+      !!          
+      !! ** Purpose :   Intialize ocean time step for the run
+      !!
+      !! ** Method  : - Initialization of a coef. use in the Asselin time
+      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
+      !!      filter parameter read in namelist
+      !!              - Model time step:
+      !!      nacc = 0 : synchronous time intergration. 
+      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
+      !!      nacc = 1 : accelerating the convergence. There is 2 different
+      !!      time steps for dynamics and tracers:
+      !!        rdt      : dynamical part
+      !!        rdttra(k): temperature and salinity
+      !!      The tracer time step is a function of vertical level. the model
+      !!      reference time step ( i.e. for wind stress, surface heat and
+      !!      salt fluxes) is the surface tracer time step is rdttra(1).
+      !!         N.B. depth dependent acceleration of convergence is not im-
+      !!      plemented for s-coordinate.
+      !!
+      !! ** Action  : - rdttra   : vertical profile of tracer time step
+      !!              - atfp1    : = 1 - 2*atfp
+      !!
+      !! References :
+      !!      Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
+      !!
+      !! History :
+      !!        !  90-10  (O. Marti)  Original code
+      !!        !  96-01  (G. Madec)  terrain following coordinates
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   jk              ! dummy loop indice
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stp : time stepping setting'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! 0. Asselin Time filter
+      ! ----------------------
+      
+      atfp1 = 1. - 2. * atfp
+
+
+      SELECT CASE ( nacc )
+
+         CASE ( 0 )                ! Synchronous time stepping
+            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
+            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
+
+            rdttra(:) = rdt
+
+         CASE ( 1 )                ! Accelerating the convergence
+            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
+            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
+            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
+#if defined key_s_coord
+            IF( rdtmin /= rdtmax ) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*)' depth dependent acceleration of &
+                                      &convergence not implemented in s-coordinates'
+               nstop = nstop + 1
+            ENDIF
+#endif
+#if defined key_partial_steps
+            IF( rdtmin /= rdtmax ) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*)' depth dependent acceleration of &
+                                      &convergence not implemented for partial steps case'
+               nstop = nstop + 1
+            ENDIF
+#endif
+            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
+
+            DO jk = 1, jpk
+               IF( fsdept(1,1,jk) <= rdth ) rdttra(jk) = rdtmin
+               IF( fsdept(1,1,jk) >  rdth ) THEN
+                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
+                                      * ( EXP( ( fsdept(1,1,jk ) - rdth ) / rdth ) - 1. )   &
+                                      / ( EXP( ( fsdept(1,1,jpk) - rdth ) / rdth ) - 1. )
+               ENDIF
+               IF(lwp) WRITE(numout,9200) rdttra(jk)/3600., jk
+            END DO  
+ 9200       FORMAT(36x,f5.2,'     ',i3)
+
+         CASE DEFAULT              ! E R R O R 
+
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' nacc value e r r o r, nacc= ',nacc
+            IF(lwp) WRITE(numout,*) ' we stop'
+            nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE dom_stp
+
+   !!======================================================================
+END MODULE domstp
Index: trunk/NEMO/OFF_SRC/DOM/domzgr_substitute.h90
===================================================================
--- trunk/NEMO/OFF_SRC/DOM/domzgr_substitute.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DOM/domzgr_substitute.h90	(revision 325)
@@ -0,0 +1,57 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  domzgr_substitute.h90   ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsdep. and fse.., the vert. depth and scale
+   !!      factors depending on the vertical coord. used, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_s_coord
+   !! s-coord:  substitution  fsdep.(,,) ==>  hbat.(,) * gsig.()
+   !!                         fse3.(,,)  ==>  hbat.(,) * esig.()
+#   define  fsdept(i,j,k)   hbatt(i,j)*gsigt(k)
+#   define  fsdepu(i,j,k)   hbatu(i,j)*gsigt(k)
+#   define  fsdepv(i,j,k)   hbatv(i,j)*gsigt(k)
+#   define  fsdepf(i,j,k)   hbatf(i,j)*gsigt(k)
+#   define  fsdepw(i,j,k)   hbatt(i,j)*gsigw(k)
+#   define  fsdepuw(i,j,k)  hbatu(i,j)*gsi3w(k)
+#   define  fsdepvw(i,j,k)  hbatv(i,j)*gsi3w(k)
+#   define  fsde3w(i,j,k)   hbatt(i,j)*gsi3w(k)
+#   define  fse3t(i,j,k)    hbatt(i,j)*esigt(k)
+#   define  fse3u(i,j,k)    hbatu(i,j)*esigt(k)
+#   define  fse3v(i,j,k)    hbatv(i,j)*esigt(k)
+#   define  fse3f(i,j,k)    hbatf(i,j)*esigt(k)
+#   define  fse3w(i,j,k)    hbatt(i,j)*esigw(k)
+#   define  fse3uw(i,j,k)   hbatu(i,j)*esigw(k)
+#   define  fse3vw(i,j,k)   hbatv(i,j)*esigw(k)
+#elif defined key_partial_steps
+   !! z-coord:  substitution  fsdep.(,,) ==>  gdep._ps()
+   !!                         fse3.(,,)  ==>  e3._ps()
+#   define  fsdept(i,j,k)   gdept_ps(i,j,k)
+#   define  fsdepw(i,j,k)   gdepw_ps(i,j,k)
+#   define  fsde3w(i,j,k)   gdep3w(i,j,k)
+#   define  fsdepuw(i,j,k)  gdepw(k)
+#   define  fsdepvw(i,j,k)  gdepw(k)
+#   define  fse3t(i,j,k)    e3t_ps(i,j,k)
+#   define  fse3u(i,j,k)    e3u_ps(i,j,k)
+#   define  fse3v(i,j,k)    e3v_ps(i,j,k)
+#   define  fse3f(i,j,k)    e3f_ps(i,j,k)
+#   define  fse3w(i,j,k)    e3w_ps(i,j,k)
+#   define  fse3uw(i,j,k)   e3uw_ps(i,j,k)
+#   define  fse3vw(i,j,k)   e3vw_ps(i,j,k)
+#else
+   !! z-coord:  substitution  fsdep.(,,) ==>  gdep()
+   !!                         fse3.(,,)  ==>  e3.()
+#   define  fsdept(i,j,k)   gdept(k)
+#   define  fsdepu(i,j,k)   gdept(k)
+#   define  fsdepv(i,j,k)   gdept(k)
+#   define  fsdepf(i,j,k)   gdept(k)
+#   define  fsdepw(i,j,k)   gdepw(k)
+#   define  fsdepuw(i,j,k)  gdepw(k)
+#   define  fsdepvw(i,j,k)  gdepw(k)
+#   define  fse3t(i,j,k)   e3t(k)
+#   define  fse3u(i,j,k)   e3t(k)
+#   define  fse3v(i,j,k)   e3t(k)
+#   define  fse3f(i,j,k)   e3t(k)
+#   define  fse3w(i,j,k)   e3w(k)
+#   define  fse3uw(i,j,k)  e3w(k)
+#   define  fse3vw(i,j,k)  e3w(k)
+#endif
Index: trunk/NEMO/OFF_SRC/DYN/dynspg_fsc.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DYN/dynspg_fsc.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DYN/dynspg_fsc.F90	(revision 325)
@@ -0,0 +1,34 @@
+MODULE dynspg_fsc
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_fsc  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+#if ( defined key_dynspg_fsc && ! defined key_autotasking ) ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_fsc'                       free surface cst volume
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_fsc  : update the momentum trend with the surface pressure
+   !!                  gradient in the free surface constant volume case
+   !!                  with vector optimization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc = .TRUE.    !: free surface constant volume flag
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module   No standart free surface cst volume
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc = .FALSE.   !: free surface constant volume flag
+#endif
+   
+   !!======================================================================
+END MODULE dynspg_fsc
Index: trunk/NEMO/OFF_SRC/DYN/dynspg_fsc_atsk.F90
===================================================================
--- trunk/NEMO/OFF_SRC/DYN/dynspg_fsc_atsk.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/DYN/dynspg_fsc_atsk.F90	(revision 325)
@@ -0,0 +1,28 @@
+MODULE dynspg_fsc_atsk
+   !!======================================================================
+   !!                  ***  MODULE  dynspg_fsc_atsk  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+#if ( defined key_dynspg_fsc && defined key_autotasking )   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_fsc' & 'key_autotasking'   free surface cst volume
+   !!                                                   j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Shares module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc_tsk = .TRUE.    !: free surf. cst vol. flag
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc_tsk = .FALSE.   !: free surf. cst vol. flag
+#endif   
+   !!======================================================================
+END MODULE dynspg_fsc_atsk
Index: trunk/NEMO/OFF_SRC/LDF/ldfeiv_substitute.h90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldfeiv_substitute.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldfeiv_substitute.h90	(revision 325)
@@ -0,0 +1,34 @@
+#if defined key_traldf_eiv   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!                   ***  ldfeiv_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaei. the eddy induced velocity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#  if defined key_traldf_c3d
+!   'traldf_c3d' :                           eiv: 3D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(i,j,k)
+#    define   fsaeiv(i,j,k)   aeiv(i,j,k)
+#    define   fsaeiw(i,j,k)   aeiw(i,j,k)
+#  elif defined key_traldf_c2d
+!   'traldf_c2d' :                           eiv: 2D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(i,j)
+#    define   fsaeiv(i,j,k)   aeiv(i,j)
+#    define   fsaeiw(i,j,k)   aeiw(i,j)
+#  elif defined key_traldf_c1d
+!   'traldf_c1d' :                           eiv: 1D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(k)
+#    define   fsaeiv(i,j,k)   aeiv(k)
+#    define   fsaeiw(i,j,k)   aeiw(k)
+#  else
+!   Default option :                          eiv: Constant coefficient
+#    define   fsaeiu(i,j,k)   aeiv0
+#    define   fsaeiv(i,j,k)   aeiv0
+#    define   fsaeiw(i,j,k)   aeiv0
+#  endif
+#else
+!   Default option :                         eiv: dummy variables
+#    define   fsaeiu(i,j,k)   aeiv0
+#    define   fsaeiv(i,j,k)   aeiv0
+#    define   fsaeiw(i,j,k)   aeiv0
+#endif
Index: trunk/NEMO/OFF_SRC/LDF/ldfslp.F90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldfslp.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldfslp.F90	(revision 325)
@@ -0,0 +1,825 @@
+MODULE ldfslp
+   !!======================================================================
+   !!                       ***  MODULE  ldfslp  ***
+   !! Ocean physics: slopes of neutral surfaces
+   !!======================================================================
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   ldf_slp      : compute the slopes of neutral surface
+   !!   ldf_slp_mxl  : compute the slopes of iso-neutral surface
+   !!   ldf_slp_init : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer depth
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC ldf_slp        ! routine called by step.F90
+
+   !! * Share module variables
+   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
+      uslp, wslpi,         &  !: i_slope at U- and W-points
+      vslp, wslpj             !: j-slope at V- and W-points
+   
+   !! * Module variables
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      omlmask                 ! mask of the surface mixed layer at T-pt
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      uslpml, wslpiml,     &  ! i_slope at U- and W-points just below
+   !                          ! the surface mixed layer
+      vslpml, wslpjml         ! j_slope at V- and W-points just below
+   !                          ! the surface mixed layer
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ldf_slp( kt, prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp  ***
+      !! 
+      !! ** Purpose :   Compute the slopes of neutral surface (slope of iso-
+      !!      pycnal surfaces referenced locally) ('key_traldfiso').
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at U- and 
+      !!      W-points (uslp, wslpi) and the slope in the j-direction is 
+      !!      computed at V- and W-points (vslp, wslpj).
+      !!      They are bounded by 1/100 over the whole ocean, and within the
+      !!      surface layer they are bounded by the distance to the surface
+      !!      ( slope<= depth/l  where l is the length scale of horizontal
+      !!      diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!      of 10cm/s)
+      !!        A horizontal shapiro filter is applied to the slopes
+      !!        'key_s_coord' defined: add to the previously computed slopes
+      !!      the slope of the model level surface.
+      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1)
+      !!      [slopes already set to zero at level 1, and to zero or the ocean
+      !!      bottom slope ('key_s_coord' defined) at level jpk in inildf]
+      !!
+      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes 
+      !!               of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!
+      !! History :
+      !!   7.0  !  94-12  (G. Madec, M. Imbard)  Original code
+      !!   8.0  !  97-06  (G. Madec)  optimization, lbc
+      !!   8.1  !  99-10  (A. Jouzeau)  NEW profile
+      !!   8.5  !  99-10  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce            , zgru  => ua,  &  ! use ua as workspace
+                           zgrv  => va,  &  ! use va as workspace
+                           zwy   => ta,  &  ! use ta as workspace
+                           zwz   => sa      ! use sa as workspace
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         prd,                            &  ! in situ density
+         pn2                                ! Brunt-Vaisala frequency (locally ref.)
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk              ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integer
+#if defined key_partial_steps
+      INTEGER  ::   iku, ikv  ! temporary integers
+#endif
+      REAL(wp) ::   &
+         zeps, zmg, zm05g, zcoef1, zcoef2,   &  ! temporary scalars
+         zau, zbu, zav, zbv,                 &
+         zai, zbi, zaj, zbj,                &
+         zcofu, zcofv, zcofw,                &
+         z1u, z1v, z1wu, z1wv,               &
+         zalpha
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww
+      !!----------------------------------------------------------------------
+
+      
+      ! 0. Initialization (first time-step only)
+      !    --------------
+      
+      IF( kt == nit000 ) CALL ldf_slp_init
+      
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      
+      zeps  =  1.e-20
+      zmg   = -1.0 / grav
+      zm05g = -0.5 / grav
+
+      zww(:,:,:) = 0.e0
+      zwz(:,:,:) = 0.e0
+
+      ! horizontal density gradient computation
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
+               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+#if defined key_partial_steps
+      ! partial steps correction at the bottom ocean level (zps_hde routine)
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ! last ocean level
+            iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1
+            ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1
+            zgru(ji,jj,iku) = gru(ji,jj) 
+            zgrv(ji,jj,ikv) = grv(ji,jj)               
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+#endif
+
+      ! Slopes of isopycnal surfaces just below the mixed layer
+      ! -------------------------------------------------------
+      
+      CALL ldf_slp_mxl( prd, pn2 )
+      
+      !-------------------synchro---------------------------------------------
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! I.  slopes at u and v point
+         ! ===========================
+         
+         
+         ! I.1. Slopes of isopycnal surfaces
+         ! ---------------------------------
+         ! uslp = d/di( prd ) / d/dz( prd )
+         ! vslp = d/dj( prd ) / d/dz( prd )
+         
+         ! Local vertical density gradient evaluated from N^2
+         ! zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwy(ji,jj,jk) = zmg * ( prd(ji,jj,jk) + 1. )                &
+                  &          * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) )       &
+                  &          / MAX( tmask(ji,jj,jk) + tmask (ji,jj,jk+1), 1. )
+            END DO
+         END DO
+         
+         ! Slope at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! horizontal and vertical density gradient at u- and v-points
+               zau = 1. / e1u(ji,jj) * zgru(ji,jj,jk)
+               zav = 1. / e2v(ji,jj) * zgrv(ji,jj,jk)
+               zbu = 0.5 * ( zwy(ji,jj,jk) + zwy(ji+1,jj  ,jk) )
+               zbv = 0.5 * ( zwy(ji,jj,jk) + zwy(ji  ,jj+1,jk) )
+               ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN( zbu, -100.*ABS( zau ), -7.e+3/fse3u(ji,jj,jk)*ABS( zau ) )
+               zbv = MIN( zbv, -100.*ABS( zav ), -7.e+3/fse3v(ji,jj,jk)*ABS( zav ) )
+               ! uslp and vslp output in zwz and zww, resp.
+               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+#if defined key_s_coord 
+               zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha)   &
+                  &        + zalpha * uslpml(ji,jj)   &
+                  &        * ( fsdepu(ji,jj,jk) - .5*fse3u(ji,jj,1) )   &
+                  &        / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) )   &
+                  &        * umask(ji,jj,jk)
+               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha)   &
+                  &        + zalpha * vslpml(ji,jj)   &
+                  &        * ( fsdepv(ji,jj,jk) - .5*fse3v(ji,jj,1) )   &
+                  &         / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) )   &
+                  &        * vmask(ji,jj,jk)
+#else
+               ! z-coord and partial steps slope computed in the same way
+               zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha)    &
+                  &        + zalpha * uslpml(ji,jj)    &
+                  &        * ( fsdept(ji,jj,jk) - .5*fse3u(ji,jj,1))    &
+                  &        / MAX (hmlpt(ji,jj),hmlpt(ji+1,jj),5.) )    &
+                  &        * umask (ji,jj,jk)
+               zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj+1,jk))
+               zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha)    &
+                  &        + zalpha * vslpml(ji,jj)    &
+                  &        * ( fsdept(ji,jj,jk) - .5*fse3v(ji,jj,1))    &
+                  &        / MAX(hmlpt(ji,jj),hmlpt(ji,jj+1),5.) )    &
+                  &        * vmask (ji,jj,jk)
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   end of slab
+      !                                                ! ===============
+
+
+         ! lateral boundary conditions on zww and zwz
+         CALL lbc_lnk( zwz, 'U', -1. )
+         CALL lbc_lnk( zww, 'V', -1. )
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         
+         ! Shapiro filter applied in the horizontal direction
+         zcofu = 1. / 16.
+         zcofv = 1. / 16.
+         DO jj = 2, jpjm1, jpj-3   ! row jj=2 and =jpjm1 only
+            DO ji = 2, jpim1  
+               !uslop
+               uslp(ji,jj,jk) = zcofu * (       zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +     zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*(zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +     zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.* zwz(ji  ,jj  ,jk)                       )
+               ! vslop
+               vslp(ji,jj,jk) = zcofv * (       zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +     zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*(zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +     zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.* zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+
+         DO jj = 3, jpj-2
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! uslop
+               uslp(ji,jj,jk) = zcofu * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               ! vslop
+               vslp(ji,jj,jk) = zcofv * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+
+         ! decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1u  = ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk) )*.5
+               z1v  = ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk) )*.5
+               z1wu = ( umask(ji,jj,jk)   + umask(ji,jj,jk+1) )*.5
+               z1wv = ( vmask(ji,jj,jk)   + vmask(ji,jj,jk+1) )*.5
+               uslp(ji,jj,jk) = uslp(ji,jj,jk) * z1u * z1wu
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * z1v * z1wv
+            END DO
+         END DO
+
+
+         IF( lk_sco ) THEN
+            ! Add the slope of level surfaces
+            ! -----------------------------------
+            ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done
+            ! in inildf, ldfslp never called
+            ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces
+            ! is added to the slope of isopycnal surfaces.
+            ! c a u t i o n : minus sign as fsdep has positive value 
+         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  uslp(ji,jj,jk) = uslp(ji,jj,jk) - 1. / e1u(ji,jj)   &
+                     &           * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )
+                  vslp(ji,jj,jk) = vslp(ji,jj,jk) - 1. / e2v(ji,jj)   &
+                     &           * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )
+               END DO
+            END DO
+         ENDIF
+
+
+         ! II. Computation of slopes at w point
+         ! ====================================
+         
+         
+         ! II.1 Slopes of isopycnal surfaces
+         ! ---------------------------------
+         ! wslpi = mij( d/di( prd ) / d/dz( prd )
+         ! wslpj = mij( d/dj( prd ) / d/dz( prd )
+         
+         
+         ! Local vertical density gradient evaluated from N^2
+         !     zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwy (ji,jj,jk) = zm05g * pn2 (ji,jj,jk) *   &
+                  &                     ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+            END DO
+         END DO
+         
+         ! Slope at w point
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! horizontal density i-gradient at w-points
+               zcoef1 = MAX( zeps, umask(ji-1,jj,jk  )+umask(ji,jj,jk  )    &
+                  &               +umask(ji-1,jj,jk-1)+umask(ji,jj,jk-1) )
+               zcoef1 = 1. / ( zcoef1 * e1t (ji,jj) )
+               zai = zcoef1 * (  zgru(ji  ,jj,jk  ) + zgru(ji  ,jj,jk-1)   &
+                  &            + zgru(ji-1,jj,jk-1) + zgru(ji-1,jj,jk  ) ) * tmask (ji,jj,jk)
+               ! horizontal density j-gradient at w-points
+               zcoef2 = MAX( zeps, vmask(ji,jj-1,jk  )+vmask(ji,jj,jk-1)   &
+                  &               +vmask(ji,jj-1,jk-1)+vmask(ji,jj,jk  ) )
+               zcoef2 = 1.0 / ( zcoef2 *  e2t (ji,jj) )
+               zaj = zcoef2 * (  zgrv(ji,jj  ,jk  ) + zgrv(ji,jj  ,jk-1)   &
+                  &            + zgrv(ji,jj-1,jk-1) + zgrv(ji,jj-1,jk  ) ) * tmask (ji,jj,jk)
+               ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                   static instability:
+               !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zwy (ji,jj,jk),- 100.*ABS(zai), -7.e+3/fse3w(ji,jj,jk)*ABS(zai) )
+               zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) )
+               ! wslpi and wslpj output in zwz and zww, resp.
+               zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj,jk-1))
+               zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha )   &
+                  &            + zalpha * wslpiml(ji,jj)   &
+                  &            * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) )   &
+                  &            * tmask (ji,jj,jk)
+               zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha )   &
+                  &            + zalpha * wslpjml(ji,jj)   &
+                  &            * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) )   &
+                  &            * tmask (ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   end of slab
+      !                                                ! ===============
+
+
+      ! lateral boundary conditions on zwz and zww
+      CALL lbc_lnk( zwz, 'T', -1. )
+      CALL lbc_lnk( zww, 'T', -1. )
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! Shapiro filter applied in the horizontal direction
+
+         DO jj = 2, jpjm1, jpj-3   ! row jj=2 and =jpjm1
+            DO ji = 2, jpim1
+               zcofw = tmask(ji,jj,jk)/16.
+               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                  &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                  &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                  &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zwz(ji  ,jj  ,jk)                        ) * zcofw
+
+               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                  &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                  &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                  &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zww(ji  ,jj  ,jk)                        ) * zcofw
+            END DO
+         END DO
+         
+         DO jj = 3, jpj-2
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = tmask(ji,jj,jk)/16.
+               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                  &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                  &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                  &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zwz(ji  ,jj  ,jk)                        ) * zcofw
+
+               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                  &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                  &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                  &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zww(ji  ,jj  ,jk)                        ) * zcofw
+            END DO
+         END DO
+         
+         ! decrease the slope along the boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1u = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) *.5
+               z1v = ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) *.5
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * z1u * z1v
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * z1u * z1v
+            END DO
+         END DO
+         
+         IF( lk_sco ) THEN
+         
+            ! Slope of level surfaces
+            ! -----------------------
+            ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done
+            ! in inildf, ldfslp never called
+            ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces
+            ! is added to the slope of isopycnal surfaces.
+         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) - 1. / e1t(ji,jj)   &
+                     &                                   * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )
+                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) - 1. / e2t(ji,jj)   &
+                     &                                   * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )
+               END DO
+            END DO
+         ENDIF
+         
+         ! III. Specific grid points
+         ! -------------------------
+
+         IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+            !                                        ! =======================
+            ! Horizontal diffusion in                !  ORCA_R4 configuration 
+            ! specific area                          ! =======================
+            !
+            !                                             ! Gibraltar Strait
+            ij0 =  50   ;   ij1 =  53
+            ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+            ij0 =  51   ;   ij1 =  53
+            ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+            ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+            ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+
+            !                                             ! Mediterrannean Sea
+            ij0 =  49   ;   ij1 =  56
+            ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+            ij0 =  50   ;   ij1 =  56
+            ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+            ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+            ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , jk ) = 0.e0
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   end of slab
+      !                                                ! ===============       
+
+      
+      ! III Lateral boundary conditions on all slopes (uslp , vslp, 
+      ! -------------------------------                wslpi, wslpj )
+      CALL lbc_lnk( uslp , 'U', -1. )
+      CALL lbc_lnk( vslp , 'V', -1. )
+      CALL lbc_lnk( wslpi, 'W', -1. )
+      CALL lbc_lnk( wslpj, 'W', -1. )
+
+   END SUBROUTINE ldf_slp
+
+
+   SUBROUTINE ldf_slp_mxl( prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_mxl  ***
+      !! ** Purpose :
+      !!     Compute the slopes of iso-neutral surface (slope of isopycnal
+      !!   surfaces referenced locally) just above the mixed layer.
+      !!
+      !! ** Method :
+      !!      The slope in the i-direction is computed at u- and w-points
+      !!   (uslp, wslpi) and the slope in the j-direction is computed at
+      !!   v- and w-points (vslp, wslpj).
+      !!   They are bounded by 1/100 over the whole ocean, and within the
+      !!   surface layer they are bounded by the distance to the surface
+      !!   ( slope<= depth/l  where l is the length scale of horizontal
+      !!   diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!   of 10cm/s)
+      !!
+      !! ** Action :
+      !!      Compute uslp, wslpi, and vslp, wslpj, the i- and  j-slopes
+      !!   of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!
+      !! History :
+      !!   8.1  !  99-10  (A. Jouzeau)  Original code
+      !!   8.5  !  99-10  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce           , zgru  => ua,  &  ! ua, va used as workspace and set to hor. 
+                          zgrv  => va      ! density gradient in ldf_slp
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         prd,                           &  ! in situ density
+         pn2                              ! Brunt-Vaisala frequency (locally ref.)
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ik, ikm1               ! temporary integers
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zwy                               ! temporary workspace
+      REAL(wp) ::   &
+         zeps, zmg, zm05g,              &  ! temporary scalars
+         zcoef1, zcoef2,                &  !    "         "
+         zau, zbu, zav, zbv,            &  !    "         "
+         zai, zbi, zaj, zbj                !    "         "
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      zeps  =  1.e-20
+      zmg   = -1.0 / grav
+      zm05g = -0.5 / grav
+
+
+      uslpml (1,:) = 0.e0      ;      uslpml (jpi,:) = 0.e0
+      vslpml (1,:) = 0.e0      ;      vslpml (jpi,:) = 0.e0
+      wslpiml(1,:) = 0.e0      ;      wslpiml(jpi,:) = 0.e0
+      wslpjml(1,:) = 0.e0      ;      wslpjml(jpi,:) = 0.e0
+
+      ! surface mixed layer mask
+
+      ! mask for mixed layer
+      DO jk = 1, jpk
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = 1, jpij   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# endif
+               ! mixed layer interior (mask = 1) and exterior (mask = 0)
+               ik = nmln(ji,jj) - 1
+               IF( jk <= ik ) THEN
+                  omlmask(ji,jj,jk) = 1.e0
+               ELSE
+                  omlmask(ji,jj,jk) = 0.e0
+               ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+            END DO
+# endif
+         END DO
+      END DO
+
+
+      ! Slopes of isopycnal surfaces just before bottom of mixed layer
+      ! --------------------------------------------------------------
+      ! uslpml = d/di( prd ) / d/dz( prd )
+      ! vslpml = d/dj( prd ) / d/dz( prd )
+
+      ! Local vertical density gradient evaluated from N^2
+      ! zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+
+      !-----------------------------------------------------------------------
+      zwy(:,jpj) = 0.e0
+      zwy(jpi,:) = 0.e0
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) )
+            ! if ik = jpk take jpkm1 values
+            ik = MIN( ik,jpkm1 )
+            zwy(ji,jj) = zmg * ( prd(ji,jj,ik) + 1. )   &
+               &             * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) )   &
+               &             / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. )
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+      ! lateral boundary conditions on zwy
+      CALL lbc_lnk( zwy, 'U', -1. )
+
+      ! Slope at u points
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ! horizontal and vertical density gradient at u-points
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) )
+            ik = MIN( ik,jpkm1 )
+            zau = 1./ e1u(ji,jj) * zgru(ji,jj,ik)
+            zbu = 0.5*( zwy(ji,jj) + zwy(ji+1,jj) )
+            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                         kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN( zbu, -100.*ABS(zau), -7.e+3/fse3u(ji,jj,ik)*ABS(zau) )
+            ! uslpml
+            uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on uslpml
+      CALL lbc_lnk( uslpml, 'U', -1. )
+
+      ! Local vertical density gradient evaluated from N^2
+      !     zwy = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point
+      zwy ( :, jpj) = 0.e0
+      zwy ( jpi, :) = 0.e0
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) )
+            ik = MIN( ik,jpkm1 )
+            zwy(ji,jj) = zmg * ( prd(ji,jj,ik) + 1. )   &
+               &             * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) )   &
+               &             / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. )
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on zwy
+      CALL lbc_lnk( zwy, 'V', -1. )
+
+      ! Slope at v points
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ! horizontal and vertical density gradient at v-points
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) )
+            ik = MIN( ik,jpkm1 )
+            zav = 1./ e2v(ji,jj) * zgrv(ji,jj,ik)
+            zbv = 0.5*( zwy(ji,jj) + zwy(ji,jj+1) )
+            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                         kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbv = MIN( zbv, -100.*ABS(zav), -7.e+3/fse3v(ji,jj,ik)*ABS( zav ) )
+            ! vslpml
+            vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on vslpml
+      CALL lbc_lnk( vslpml, 'V', -1. )
+
+      ! wslpiml = mij( d/di( prd ) / d/dz( prd )
+      ! wslpjml = mij( d/dj( prd ) / d/dz( prd )
+
+
+      ! Local vertical density gradient evaluated from N^2
+      ! zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+# endif
+            ik = nmln(ji,jj)+1
+            ik = MIN( ik,jpk )
+            ikm1 = MAX ( 1, ik-1)
+            zwy (ji,jj) = zm05g * pn2 (ji,jj,ik) *     &
+               &             ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! Slope at w point
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ik = nmln(ji,jj)+1
+            ik = MIN( ik,jpk )
+            ikm1 = MAX ( 1, ik-1)
+            ! horizontal density i-gradient at w-points
+            zcoef1 = MAX( zeps, umask(ji-1,jj,ik  )+umask(ji,jj,ik  )   &
+               &               +umask(ji-1,jj,ikm1)+umask(ji,jj,ikm1) )
+            zcoef1 = 1. / ( zcoef1 * e1t (ji,jj) )
+            zai = zcoef1 * (  zgru(ji  ,jj,ik  ) + zgru(ji  ,jj,ikm1)   &
+               &            + zgru(ji-1,jj,ikm1) + zgru(ji-1,jj,ik  ) ) * tmask (ji,jj,ik)
+            ! horizontal density j-gradient at w-points
+            zcoef2 = MAX( zeps, vmask(ji,jj-1,ik  )+vmask(ji,jj,ikm1)    &
+               &               +vmask(ji,jj-1,ikm1)+vmask(ji,jj,ik  ) )
+            zcoef2 = 1.0 / ( zcoef2 *  e2t (ji,jj) )
+            zaj = zcoef2 * (  zgrv(ji,jj  ,ik  ) + zgrv(ji,jj  ,ikm1)   &
+               &            + zgrv(ji,jj-1,ikm1) + zgrv(ji,jj-1,ik  ) ) * tmask (ji,jj,ik)
+            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+            !                   static instability:
+            !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbi = MIN ( zwy (ji,jj),- 100.*ABS(zai), -7.e+3/fse3w(ji,jj,ik)*ABS(zai) )
+            zbj = MIN ( zwy (ji,jj), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,ik)*ABS(zaj) )
+            ! wslpiml and wslpjml
+            wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik)
+            wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on wslpiml and wslpjml
+      CALL lbc_lnk( wslpiml, 'W', -1. )
+      CALL lbc_lnk( wslpjml, 'W', -1. )
+
+   END SUBROUTINE ldf_slp_mxl
+
+
+   SUBROUTINE ldf_slp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the isopycnal slopes computation
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameter 
+      !!      values called by tra_dmp at the first timestep (nit000)
+      !!
+      !! History :
+      !!  8.5  ! 02-06 (G. Madec) original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      
+      
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_slp : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Direction of lateral diffusion (tracers and/or momentum)
+      ! ------------------------------
+      ! set the slope to zero (even in s-coordinates)
+
+      uslp (:,:,:) = 0.e0
+      vslp (:,:,:) = 0.e0
+      wslpi(:,:,:) = 0.e0
+      wslpj(:,:,:) = 0.e0
+
+      uslpml (:,:) = 0.e0
+      vslpml (:,:) = 0.e0
+      wslpiml(:,:) = 0.e0
+      wslpjml(:,:) = 0.e0
+
+      IF( ln_traldf_hor ) THEN
+
+         ! geopotential diffusion in s-coordinates on tracers and/or momentum
+         ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+         ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+
+         ! set the slope of diffusion to the slope of s-surfaces
+         !      ( c a u t i o n : minus sign as fsdep has positive value )
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  uslp (ji,jj,jk) = -1. / e1u(ji,jj) * umask(ji,jj,jk)   &
+                     &                               * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )
+                  vslp (ji,jj,jk) = -1. / e2v(ji,jj) * vmask(ji,jj,jk)   &
+                     &                               * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )
+                  wslpi(ji,jj,jk) = -1. / e1t(ji,jj) * tmask(ji,jj,jk)   &
+                     &                               * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )
+                  wslpj(ji,jj,jk) = -1. / e2t(ji,jj) * tmask(ji,jj,jk)   &
+                     &                               * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+
+         ! Lateral boundary conditions on the slopes
+         CALL lbc_lnk( uslp , 'U', -1. )
+         CALL lbc_lnk( vslp , 'V', -1. )
+         CALL lbc_lnk( wslpi, 'W', -1. )
+         CALL lbc_lnk( wslpj, 'W', -1. )
+      ENDIF
+
+   END SUBROUTINE ldf_slp_init
+
+#else
+   !!------------------------------------------------------------------------
+   !!   Dummy module :                 NO Rotation of lateral mixing tensor
+   !!------------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag
+CONTAINS
+   SUBROUTINE ldf_slp( kt, prd, pn2 )        ! Dummy routine
+      INTEGER, INTENT(in) :: kt 
+      REAL,DIMENSION(:,:,:), INTENT(in) :: prd, pn2
+      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
+   END SUBROUTINE ldf_slp
+#endif
+
+   !!======================================================================
+END MODULE ldfslp
Index: trunk/NEMO/OFF_SRC/LDF/ldftra.F90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldftra.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldftra.F90	(revision 325)
@@ -0,0 +1,274 @@
+MODULE ldftra
+   !!======================================================================
+   !!                       ***  MODULE  ldftra  ***
+   !! Ocean physics:  lateral diffusivity coefficient 
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   ldf_tra_init : initialization, namelist read, and parameters control
+   !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization
+   !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization
+   !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfslp          ! ???
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC ldf_tra_init   ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ldf_tra_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra_init  ***
+      !! 
+      !! ** Purpose :   initializations of the horizontal ocean tracer physics
+      !!
+      !! ** Method :
+      !!      Direction of lateral diffusion (tracers and/or momentum)
+      !!        ln_traldf_iso  = T : initialize the slope arrays to zero
+      !!        ln_traldf_geop = T : initialise the slope arrays to the i- and
+      !!                            j-slopes of s-surfaces
+      !!      Eddy diffusivity and eddy induced velocity cefficients:
+      !!         default option   : constant coef. aht0, aeiv0 (namelist)
+      !!        'key_traldf_c1d': depth dependent coef. defined in 
+      !!                            in ldf_tra_c1d routine
+      !!        'key_traldf_c2d': latitude and longitude dependent coef.
+      !!                            defined in ldf_tra_c2d routine
+      !!        'key_traldf_c3d': latitude, longitude, depth dependent coef.
+      !!                            defined in ldf_tra_c3d routine
+      !!
+      !!      N.B. User defined include files.  By default, 3d and 2d coef.
+      !!      are set to a constant value given in the namelist and the 1d
+      !!      coefficients are initialized to a hyperbolic tangent vertical
+      !!      profile.
+      !!
+      !! Reference :
+      !!      Madec, G. and M. Imbard, 1996, A global ocean mesh to overcome
+      !!      the North Pole singularity, Climate Dynamics, 12, 381-388.
+      !!
+      !! History :
+      !!        !  07-97  (G. Madec)  from inimix.F split in 2 routines
+      !!        !  08-97  (G. Madec)  multi dimensional coefficients
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      INTEGER ::   ioptio               ! ???
+      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout
+       
+      NAMELIST/nam_traldf/ ln_traldf_lap  , ln_traldf_bilap,                &
+         &                 ln_traldf_level, ln_traldf_hor, ln_traldf_iso,   &
+         &                 aht0, ahtb0, aeiv0
+      !!----------------------------------------------------------------------
+
+      !  Define the lateral tracer physics parameters
+      ! =============================================
+    
+      ! Read Namelist nam_traldf : Lateral physics on tracers
+      REWIND( numnam )
+      READ  ( numnam, nam_traldf )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_tra : lateral tracer physics'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist nam_traldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '             laplacian operator          ln_traldf_lap   = ', ln_traldf_lap
+         WRITE(numout,*) '             bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap
+         WRITE(numout,*) '             iso-level                   ln_traldf_level = ', ln_traldf_level
+         WRITE(numout,*) '             horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '             iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '             lateral eddy diffusivity             aht0   = ', aht0
+         WRITE(numout,*) '             background hor. diffusivity          ahtb0  = ', ahtb0
+         WRITE(numout,*) '             eddy induced velocity coef.          aeiv0  = ', aeiv0
+         WRITE(numout,*)
+      ENDIF
+
+      ! Parameter control
+
+      ! control the input
+      ioptio = 0
+      IF( ln_traldf_lap   )   ioptio = ioptio + 1
+      IF( ln_traldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) '          use ONE of the 2 lap/bilap operator type on tracer'
+          nstop = nstop + 1
+      ENDIF
+      ioptio = 0
+      IF( ln_traldf_level )   ioptio = ioptio + 1
+      IF( ln_traldf_hor   )   ioptio = ioptio + 1
+      IF( ln_traldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          use only ONE direction (level/hor/iso)'
+         nstop = nstop + 1
+      ENDIF
+
+      ! ... Choice of the lateral scheme used
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*) '          eddy induced velocity on tracers'
+            IF( .NOT.ln_traldf_iso .OR. ln_traldf_bilap ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      IF( lk_sco ) THEN          ! s-coordinates: rotation required for horizontal or isopycnal mixing
+         IF( ( ln_traldf_iso .OR. ln_traldf_hor ) .AND. .NOT.lk_ldfslp ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          the rotation of the diffusive tensor require key_ldfslp'
+            IF( .NOT.lk_esopa )   nstop = nstop + 1
+         ENDIF
+      ELSE                       ! z-coordinates with/without partial step:
+         ln_traldf_level = ln_traldf_level .OR. ln_traldf_hor      ! level diffusion = horizontal diffusion
+         ln_traldf_hor   = .FALSE.
+         IF(lwp) WRITE(numout,*) '          horizontal mixing in z-coord or partial steps: force ln_traldf_level = T'
+         IF(lwp) WRITE(numout,*) '                                                  and    force ln_traldf_hor   = F'
+         IF( ln_traldf_iso .AND. .NOT.lk_ldfslp ) THEN             ! rotation required for isopycnal mixing
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          the rotation of the diffusive tensor require key_ldfslp'
+            IF( .NOT.lk_esopa )   nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      l_traldf_lap     =       ln_traldf_lap   .AND. ln_traldf_level     ! iso-level   laplacian operator
+      l_traldf_bilap   =       ln_traldf_bilap .AND. ln_traldf_level     ! iso-level bilaplacian operator
+      l_traldf_bilapg  =       ln_traldf_bilap .AND. ln_traldf_hor       ! geopotential bilap. (s-coord)
+      l_traldf_iso     =       ln_traldf_lap   .AND.                  &  ! laplacian operator
+         &                   ( ln_traldf_iso   .OR.  ln_traldf_hor )  &  ! iso-neutral (z-coord) or horizontal (s-coord)
+         &                                     .AND. .NOT.lk_zps
+      l_traldf_iso_zps =       ln_traldf_lap   .AND.                  &  ! laplacian operator
+         &                   ( ln_traldf_iso   .OR.  ln_traldf_hor )  &  ! iso-neutral (partial steps)
+         &                                     .AND. lk_zps              ! or geopotential in mixed partial steps/s-coord
+      l_trazdf_iso    = .FALSE.
+      l_trazdf_iso_vo = .FALSE.
+      IF( l_traldf_iso     )   l_trazdf_iso = .TRUE.
+      IF( l_traldf_iso_zps )   l_trazdf_iso = .TRUE.
+#if defined key_vectopt_memory
+      IF( l_trazdf_iso ) THEN
+         l_trazdf_iso    = .FALSE.
+         l_trazdf_iso_vo = .TRUE.
+      ENDIF
+#endif
+
+      ioptio = 0
+      IF( l_traldf_lap     )   ioptio = ioptio + 1
+      IF( l_traldf_bilap   )   ioptio = ioptio + 1
+      IF( l_traldf_bilapg  )   ioptio = ioptio + 1
+      IF( l_traldf_iso     )   ioptio = ioptio + 1
+      IF( l_traldf_iso_zps )   ioptio = ioptio + 1
+      IF( ioptio /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          this combination of operator and direction has not been implemented'
+         nstop = nstop + 1
+      ENDIF
+      IF( lk_esopa ) THEN
+         l_traldf_lap = .TRUE.   ;   l_traldf_bilap   = .TRUE.   ;   l_traldf_bilapg  = .TRUE.
+         l_traldf_iso = .TRUE.   ;   l_traldf_iso_zps = .TRUE.
+         l_trazdf_iso = .TRUE.   ;   l_trazdf_iso_vo  = .TRUE.
+         IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options'
+      ENDIF
+
+
+      ! ... Space variation of eddy coefficients
+      ioptio = 0
+#if defined key_traldf_c3d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)'
+      ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c2d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)'
+      ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c1d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
+      ioptio = ioptio + 1
+      IF( lk_sco ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          key_traldf_c1d cannot be used in s-coordinate (key_s_coord)'
+         nstop = nstop + 1
+      ENDIF
+#endif
+      IF( ioptio == 0 ) THEN
+          IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)'
+        ELSEIF( ioptio > 1 ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) '          use only one of the following keys:',   &
+             &                    ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d'
+          nstop = nstop + 1
+      ENDIF
+
+      IF( l_traldf_bilap .OR. l_traldf_bilapg ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
+         IF( aht0 > 0 .AND. .NOT. lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          The horizontal diffusivity coef. aht0 must be negative'
+            nstop = nstop + 1
+         ENDIF
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
+         IF( aht0 < 0 .AND. .NOT. lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          The horizontal diffusivity coef. aht0 must be positive'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+
+      !  Lateral eddy diffusivity and eddy induced velocity coefficients
+      ! ================================================================
+
+#if defined key_traldf_c3d
+      CALL ldf_tra_c3d( ll_print )           ! aht = 3D coef. = F( longitude, latitude, depth )
+#elif defined key_traldf_c2d
+      CALL ldf_tra_c2d( ll_print )           ! aht = 2D coef. = F( longitude, latitude )
+#elif defined key_traldf_c1d
+      CALL ldf_tra_c1d( ll_print )           ! aht = 1D coef. = F( depth )
+#else
+                                     ! Constant coefficients
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) ' inildf: constant eddy diffusivity coef.'
+      IF(lwp)WRITE(numout,*) ' ~~~~~~'
+      IF(lwp)WRITE(numout,*) '        ahtu = ahtv = ahtw = aht0 = ', aht0
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) ' inildf: constant eddy induced velocity coef.'
+         IF(lwp)WRITE(numout,*) ' ~~~~~~  '
+         IF(lwp)WRITE(numout,*) '         aeiu = aeiv = aeiw = aeiv0 = ', aeiv0
+      ENDIF
+#endif
+
+   END SUBROUTINE ldf_tra_init
+
+#if defined key_traldf_c3d
+#   include "ldftra_c3d.h90"
+#elif defined key_traldf_c2d
+#   include "ldftra_c2d.h90"
+#elif defined key_traldf_c1d
+#   include "ldftra_c1d.h90"
+#endif
+
+   !!======================================================================
+END MODULE ldftra
Index: trunk/NEMO/OFF_SRC/LDF/ldftra_c1d.h90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldftra_c1d.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldftra_c1d.h90	(revision 325)
@@ -0,0 +1,131 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldftra_c1d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c1d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldftra_c1d  ***
+      !!              
+      !! ** Purpose :   1D eddy diffusivity coefficient
+      !!
+      !! ** Method  :   1D eddy diffusivity coefficients ( depth )
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!
+      !!       harmonic operator      : ahtt never used
+      !!          -1-  iso-model level: ahtu = ahtv defined at T-level
+      !!                                ahtw never used
+      !!          -2-  isopycnal or   : ahtu = ahtv defined at T-level
+      !!               geopotential     ahtw defined at w-level
+      !!
+      !!       eddy induced velocity
+      !!         always harmonic      : aeiu = aeiv defined at T-level
+      !!				  aeiw defined at w-level
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout
+
+      !! * Local variables
+      INTEGER ::   jk                  ! dummy loop indices
+      REAL(wp) ::   &
+         zkah, zahr, za00 , za01,   &  ! temporary scalars
+         zahf, zahs, zahtf, zahts
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity and eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- ' 
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity coefficient '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! initialization of the profile
+
+      ! ahts, ahtf: surface and bottom values
+      zahts = aht0
+      zahtf = aht0/4. 
+      ! zkah, zahr: depth of the inflection pt and width of inflection
+      zkah =  -300.
+      zahr =   300.
+      ! computation coefficients
+      za00 = TANH( ( -fsdept(1,1,1  ) - zkah ) / zahr )
+      za01 = TANH( ( -fsdept(1,1,jpk) - zkah ) / zahr )
+      zahf = ( zahts-zahtf ) / ( za00 - za01 )
+      zahs = zahts - zahf * za00
+
+      ! biharmonic operator : (T-point)
+      ! ==================== 
+
+      ! set ahtt at T-level
+      DO jk = 1, jpk
+         ahtt(jk) = zahs + zahf * TANH( (-fsdept(1,1,jk)-zkah) / zahr )
+      END DO
+
+      ! control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         aht profile at T-level : '
+         WRITE(numout,*)
+         WRITE(numout,*) ' level    aht          depth t-level '
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4)') jk, ahtt(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+
+      ! harmonic operator : (U-, V-, W-points)
+      ! ================== 
+
+      ! set ahtu = ahtv at T-level, and ahtw at w-level
+      DO jk = 1, jpk
+         ahtu(jk) = zahs + zahf * TANH( ( -fsdept(1,1,jk) - zkah ) / zahr )
+         ahtv(jk) = ahtu(jk)
+         ahtw(jk) = zahs + zahf * TANH( ( -fsdepw(1,1,jk) - zkah ) / zahr )
+      END DO
+
+      ! control print
+      IF(lwp .AND. ld_print ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aht profile at T-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' level    aht          depth t-level '
+         DO jk = 1, jpk
+            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, ahtu(jk), fsdept(1,1,jk)
+         END DO
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aht profile at W-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  jk      aht          depth w-level '
+         DO jk = 1, jpk
+            IF(lwp)WRITE(numout,"(i6,2f12.4)") jk, ahtw(jk), fsdepw(1,1,jk)
+         END DO
+      ENDIF
+
+# if defined key_traldf_eiv
+      ! set aeiu = aeiv and set aeiw (here same profile as on aht)
+      aeiu(:) = ahtu(:)
+      aeiv(:) = aeiu(:)
+      aeiw(:) = ahtw(:)
+      
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aeiv profile at T-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  jk      aeiv           depth t-level '
+         DO jk = 1, jpk
+            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, aeiu(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+#endif
+
+   END SUBROUTINE ldf_tra_c1d
Index: trunk/NEMO/OFF_SRC/LDF/ldftra_c2d.h90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldftra_c2d.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldftra_c2d.h90	(revision 325)
@@ -0,0 +1,144 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldftra_c2d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c2d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldftra_c2d  ***
+      !!              
+      !! ** Purpose :   initializations of horizontally non uniform eddy 
+      !!      diffusivity coefficients
+      !!
+      !! ** Method :
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!       harmonic operator (ahtt never used)
+      !!           iso-model level   : ahtu, ahtv defined at u-, v-points
+      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
+      !!         or geopotential   
+      !!       eddy induced velocity
+      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout
+
+      !! * Local variables
+# if defined key_traldf_eiv && defined key_orca_r4
+      INTEGER ::   ji, jj                  ! dummy loop indices
+# endif
+# if defined key_orca_r4
+      INTEGER :: i1, i2, j1, j2
+# endif
+      REAL(wp) ::   za00, zdx_max
+      
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 2D eddy diffusivity and eddy'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   --  induced velocity coefficients'
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 2D eddy diffusivity coefficient'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   --'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! harmonic operator : (U-, V-, W-points)
+      ! ==================
+      IF( ln_traldf_lap ) THEN
+
+         ahtu(:,:) = aht0                ! set ahtu = ahtv at u- and v-points,
+         ahtv(:,:) = aht0                ! and ahtw at w-point (idem T-point)
+         ahtw(:,:) = aht0                ! 
+
+         CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( ahtv, 'V', 1. )   ! (no change of sign)
+         CALL lbc_lnk( ahtw, 'W', 1. )
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahtu array'
+            CALL prihre( ahtu, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahtv array'
+            CALL prihre( ahtv, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahtw array'
+            CALL prihre( ahtw, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+         ENDIF
+      ENDIF
+      
+      ! biharmonic operator : (T-point)
+      ! ====================
+      IF( ln_traldf_bilap ) THEN
+         ! (USER: modify ahtt following your desiderata)
+         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
+         !       in the to horizontal direction
+
+         zdx_max = MAXVAL( e1t(:,:) )
+         IF( lk_mpp )   CALL mpp_max( zdx_max )   ! max over the global domain
+
+         za00 = aht0 / ( zdx_max * zdx_max * zdx_max )
+         ahtt(:,:) = za00 * e1t(:,:) * e1t(:,:) *e1t(:,:)      ! set ahtt at T-point 
+
+         CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: 2D ahtt array'
+            CALL prihre( ahtt, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+         ENDIF
+      ENDIF
+
+# if defined key_traldf_eiv
+      ! set aeiu = aeiv at u- and v-points, and aeiw at w-point (idem T-point)
+      ! (here no space variation)
+      aeiu(:,:) = aeiv0
+      aeiv(:,:) = aeiv0
+      aeiw(:,:) = aeiv0
+      
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+         !                                 ! Cancel eiv in Gibraltar strait
+         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         !                                 ! Cancel eiv in Mediterrannean sea
+         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+      ENDIF
+
+      ! Lateral boundary conditions on ( aeiu, aeiv, aeiw )
+      CALL lbc_lnk( aeiu, 'U', 1. )
+      CALL lbc_lnk( aeiv, 'V', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiu array'
+         CALL prihre(aeiu,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiv array'
+         CALL prihre(aeiv,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiw array'
+         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+# endif
+
+   END SUBROUTINE ldf_tra_c2d
Index: trunk/NEMO/OFF_SRC/LDF/ldftra_c3d.h90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldftra_c3d.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldftra_c3d.h90	(revision 325)
@@ -0,0 +1,128 @@
+   !!----------------------------------------------------------------------
+   !!                        ***  ldftra_c3d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c3d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldftra_c3d  ***
+      !!                
+      !! ** Purpose :
+      !!     initializations of non uniform horizontal eddy diffusivity coef.
+      !!
+      !! ** Method :
+      !!      3D eddy diffusivity coefficients ( longitude, latitude, depth )
+      !!
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!
+      !!       harmonic operator (ahtt never used)
+      !!         iso-model level   : ahtu, ahtv defined at u-, v-points
+      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
+      !!         or geopotential
+      !!
+      !!       eddy induced velocity
+      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 3D eddy diffusivity and eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   --  '
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 3D eddy diffusivity coefficient'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+
+      ! biharmonic operator   (T-point)
+      ! -------------------
+
+      ahtt(:,:,:) = aht0              ! set ahtt at T-point (here no space variation)
+
+      CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
+
+      IF(lwp .AND. ld_print ) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtt at k = 1'
+         CALL prihre( ahtt(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+
+      ! harmonic operator   (U-, V-, W-points)
+      ! ----------------- 
+
+      ahtu(:,:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
+      ahtv(:,:,:) = aht0              ! and ahtw at w-point
+      ahtw(:,:,:) = aht0              ! (here example: no space variation)
+      
+      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
+      CALL lbc_lnk( ahtv, 'V', 1. )
+      CALL lbc_lnk( ahtw, 'W', 1. )
+
+      IF(lwp .AND. ld_print ) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtu at k = 1'
+         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtv at k = 1'
+         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtw at k = 1'
+         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+# if defined key_traldf_eiv
+      aeiu(:,:,:) = aeiv0            ! set aeiu = aeiv at u- and v-points,
+      aeiv(:,:,:) = aeiv0            ! and aeiw at w-point
+      aeiw(:,:,:) = aeiv0            ! (here example: no space variation)
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+         !                                 ! Cancel eiv in Gibraltar strait
+         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         !                                 ! Cancel eiv in Mediterrannean sea
+         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+      ENDIF
+
+      CALL lbc_lnk( aeiu, 'U', 1. )   ! Lateral boundary conditions 
+      CALL lbc_lnk( aeiv, 'V', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )
+# endif
+
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiu at k = 1'
+         CALL prihre(aeiu(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiv at k = 1'
+         CALL prihre(aeiv(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiw at k = 1'
+         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+END SUBROUTINE ldf_tra_c3d
Index: trunk/NEMO/OFF_SRC/LDF/ldftra_oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldftra_oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldftra_oce.F90	(revision 325)
@@ -0,0 +1,88 @@
+MODULE ldftra_oce
+   !!=====================================================================
+   !!                      ***  MODULE  ldftra_oce  ***
+   !! Ocean physics :  lateral tracer mixing coefficient defined in memory 
+   !!=====================================================================
+   !!
+   !! ** Purpose : - Define in memory lateral tracer mixing coefficients
+   !!
+   !! History :
+   !!   9.0  !  02-11  (G. Madec)  Original code (from common.h)
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 ,  LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !!----------------------------------------------------------------------
+   !! Lateral eddy diffusivity coefficients (tracers)
+   !!----------------------------------------------------------------------
+
+   LOGICAL , PUBLIC ::              & !!: ** lateral mixing namelist (nam_traldf) **
+      ln_traldf_lap   = .TRUE.  ,   &  !: laplacian operator
+      ln_traldf_bilap = .FALSE. ,   &  !: bilaplacian operator
+      ln_traldf_level = .FALSE. ,   &  !: iso-level direction
+      ln_traldf_hor   = .FALSE. ,   &  !: horizontal (geopotential) direction
+      ln_traldf_iso   = .TRUE.         !: iso-neutral direction
+
+   REAL(wp), PUBLIC ::              & !!: ** lateral mixing namelist (namldf) **
+      aht0  = 2000._wp     ,        &  !: lateral eddy diffusivity (m2/s)
+      ahtb0 =    0._wp     ,        &  !: lateral background eddy diffusivity (m2/s)
+      aeiv0 = 2000._wp                 !: eddy induced velocity coefficient (m2/s)
+
+   LOGICAL , PUBLIC ::              &  !: flag of the lateral diff. scheme used 
+      l_traldf_lap         ,        &  !: iso-level laplacian operator
+      l_traldf_bilap       ,        &  !: iso-level bilaplacian operator
+      l_traldf_bilapg      ,        &  !: geopotential bilap. (s-coord)
+      l_traldf_iso         ,        &  !: iso-neutral laplacian or horizontal lapacian (s-coord)
+      l_trazdf_iso         ,        &  !: idem for the vertical component
+      l_trazdf_iso_vo      ,        &  !: idem with vectopt_memory
+      l_traldf_iso_zps                 !: iso-neutral laplacian (partial steps)
+
+#if defined key_traldf_c3d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients **
+#elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: ** 2D coefficients **
+#elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  !: ** 1D coefficients **
+#else
+   REAL(wp), PUBLIC                         ::   &  !: ** 0D coefficients **
+#endif
+      ahtt, ahtu, ahtv, ahtw                !: T-, U-, V-, W-points coefficients
+
+
+#if defined key_traldf_eiv
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_eiv'                              eddy induced velocity
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
+      
+# if defined key_traldf_c3d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients **
+# elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: ** 2D coefficients **
+# elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  !: ** 1D coefficients **
+# else
+   REAL(wp), PUBLIC                         ::   &  !: ** 0D coefficients **
+# endif
+      aeiu, aeiv, aeiw                              !: U-, V-, W-points  induced velocity coef. (m2/s)
+
+# if defined key_diaeiv
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    &  !:
+      u_eiv, v_eiv, w_eiv     !: The three component of the eddy induced velocity (m/s)
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                           NO eddy induced velocity
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   !: eddy induced velocity flag
+   REAL(wp), PUBLIC ::   aeiu, aeiv, aeiw
+#endif
+
+   !!----------------------------------------------------------------------
+END MODULE ldftra_oce
Index: trunk/NEMO/OFF_SRC/LDF/ldftra_substitute.h90
===================================================================
--- trunk/NEMO/OFF_SRC/LDF/ldftra_substitute.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/LDF/ldftra_substitute.h90	(revision 325)
@@ -0,0 +1,31 @@
+   !!----------------------------------------------------------------------
+   !!                    *** ldftra_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_traldf_c3d
+!   'key_traldf_c3d' :                 aht: 3D coefficient
+#       define   fsahtt(i,j,k)   ahtt(i,j,k)
+#       define   fsahtu(i,j,k)   ahtu(i,j,k)
+#       define   fsahtv(i,j,k)   ahtv(i,j,k)
+#       define   fsahtw(i,j,k)   ahtw(i,j,k)
+#elif defined key_traldf_c2d
+!   'key_traldf_c2d' :                 aht: 2D coefficient
+#       define   fsahtt(i,j,k)   ahtt(i,j)
+#       define   fsahtu(i,j,k)   ahtu(i,j)
+#       define   fsahtv(i,j,k)   ahtv(i,j)
+#       define   fsahtw(i,j,k)   ahtw(i,j)
+#elif defined key_traldf_c1d
+!   'key_traldf_c1d' :                aht: 1D coefficient
+#       define   fsahtt(i,j,k)   ahtt(k)
+#       define   fsahtu(i,j,k)   ahtu(k)
+#       define   fsahtv(i,j,k)   ahtv(k)
+#       define   fsahtw(i,j,k)   ahtw(k)
+#else
+!   Default option :             aht: Constant coefficient
+#      define   fsahtt(i,j,k)   aht0
+#      define   fsahtu(i,j,k)   aht0
+#      define   fsahtv(i,j,k)   aht0
+#      define   fsahtw(i,j,k)   aht0
+#endif
Index: trunk/NEMO/OFF_SRC/SBC/blk_oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/blk_oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/blk_oce.F90	(revision 325)
@@ -0,0 +1,38 @@
+MODULE blk_oce
+   !!======================================================================
+   !!                 ***  MODULE  blk_oce  ***
+   !! Bulk   :  bulk parameter and  variables defined in memory 
+   !!======================================================================
+   !! History :
+   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+   !!----------------------------------------------------------------------
+   !! ' key_flx_bulk_monthly or defined key_flx_bulk_daily             bulk
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce          ! ocean parameters
+
+   IMPLICIT NONE
+
+   LOGICAL, PUBLIC ::   l_bulk = .TRUE.   !: 
+   
+   !!----------------------------------------------------------------------
+   !! bulk common variables
+   !!----------------------------------------------------------------------
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      vatm     ,      &  !: wind speed
+      catm               !: percent of cloud cover
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   l_bulk = .FALSE.  !:
+#endif
+   
+   !!----------------------------------------------------------------------
+END MODULE blk_oce
Index: trunk/NEMO/OFF_SRC/SBC/flxrnf.F90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/flxrnf.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/flxrnf.F90	(revision 325)
@@ -0,0 +1,373 @@
+MODULE flxrnf
+   !!======================================================================
+   !!                       ***  MODULE  flxrnf  ***
+   !! Ocean forcing:  runoff
+   !!=====================================================================
+#if defined key_orca_r05
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r05'                               ORCA R05 configuration
+   !!----------------------------------------------------------------------
+#  include "flxrnf_ORCA_R05.h90"
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                     Standard runoffs
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   flx_rnf      : monthly runoff read in a NetCDF file
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE ioipsl          ! NetCDF IPSL library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC flx_rnf          ! routine call in step module
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      runoff,           &  !: monthly runoff (kg/m2/s)
+      upsadv,           &  !: mixed adv scheme in straits vicinity (hori.)
+      upsrnfh              !: mixed adv scheme in runoffs vicinity (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !:
+      upsrnfz              !: mixed adv scheme in runoffs vicinity (vert.)
+   INTEGER, PUBLIC ::   &  !:
+      nrunoff =  0 ,    &  !: runoff option (namelist)
+      nrnf1, nrnf2         !: first and second record used
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpi,jpj,2) ::   &  !:
+      rnfdta               !: monthly runoff data array (kg/m2/s)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx_rnf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE flx_rnf  ***
+      !!       
+      !! ** Purpose :   Introduce a climatological run off forcing
+      !!
+      !! ** Method :
+      !!      Initialze each mouth of river with a monthly climatology 
+      !!      provided from different data.
+      !!     C a u t i o n : upward water flux, runoff is negative
+      !!                     set at the last loop of the routine
+      !!
+      !! ** Action :
+      !!
+      !! References : 
+      !!       J. D. Milliman and R. H. Meade, 1983 : world-wide delivery
+      !!          of river sediment to the oceans, journal of geology vol 91
+      !!          pp 1-21.
+      !!       G. L. Russell and J. R. Miller, 1990 : global river runoff
+      !!          calculated from a global atmospheric general circulation
+      !!          model, journal of hydrology, 117(1990), pp 241-254.
+      !!       F. Van Der Leeden, Troise F. L., Todd D. K. : the water
+      !!          encyclopedia, second edition, lewis publishers.
+      !!       J. W. Weatherly, J. E. Walsh : The effects of precipitation
+      !!          and river runoff in a coupled ice-ocean model of Arctic
+      !!          Climate dynamics 1996 12:785,798
+      !!       Jacobs et al. 1992. J. Glaciol. 38 (130) 375-387.
+      !!
+      !! History :
+      !!        !  94-10  (G.Madec, M. Pontaud, M. Imbard)  Original code
+      !!        !  97-03  (G.Madec)  time dependent version
+      !!        !  98-06  (J.M. Molines)  exact computation of zxy 
+      !!                         for months that are not 30 days
+      !!        !  98-07  (M. Imbard)  ORCA and mpp option
+      !!        !  99-08  (J.P. Boulanger H.L.Ayina)  New rivers and 
+      !!                         values given in m3/s 
+      !!        !  00-04  (G. Madec, K. Roberts) add antarctica ice discharge.
+      !!        !  00-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt       ! ocean time step
+
+      !! * Local declarations
+# if ! defined key_coupled
+      INTEGER  ::   ji, jj                 ! dummy loop indices
+      INTEGER ::   &
+         i15 , imois , iman,            &  ! temporary integers
+         idbd, idmeom                      !    "          "
+      REAL(wp) ::   zxy
+# endif
+      CHARACTER (len=32) ::   &
+         clname = 'runoff_1m_nomask'       ! monthly runoff filename
+      INTEGER, PARAMETER :: jpmois = 12
+      INTEGER  ::   ipi, ipj, ipk          ! temporary integers
+      INTEGER  ::   ii0, ii1, ij0, ij1     !    "          "
+      INTEGER, DIMENSION(jpmois) ::     &
+         istep                             ! temporary workspace
+      REAL(wp) ::   zdate0, zdt            ! temporary scalars
+      REAL(wp), DIMENSION(jpk) ::       &
+         zlev                              ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zlon, zlat,                    &  ! temporary workspace
+         zcoefr                            ! coeff of advection link to runoff
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+
+         SELECT CASE ( nrunoff )
+
+         CASE ( 0 )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flx_rnf : No runoff in this simulation (nrunoff=0)'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+            
+         CASE ( 1 )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flx_rnf : monthly runoff (nrunoff=1)'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+         CASE ( 2 )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flx_rnf : monthly runoff with upsteam advection'
+            IF(lwp) WRITE(numout,*) '~~~~~~~   in the vicinity of river mouths (nrunoff=2)'
+
+         CASE DEFAULT
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' Error nrunoff = ', nrunoff, ' /= 0, 1 or 2'
+            nstop = nstop + 1
+
+         END SELECT
+
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0 
+         upsadv (:,:) = 0.e0
+
+      ENDIF
+
+
+      ! 1. Initialization
+      ! -----------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2 ) THEN
+# if ! defined key_coupled
+
+         ! year, month, day
+
+         iman  = jpmois
+         i15   = nday / 16
+         imois = nmonth + i15 - 1
+         IF( imois == 0 )   imois = iman
+         ! Number of days in the month
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         ENDIF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+# endif
+         ipi = jpiglo
+         ipj = jpjglo
+         ipk = jpk
+         zdt = rdt
+         
+         ! Open file
+
+         IF( kt == nit000 ) THEN
+            CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,    &
+               &           .false., ipi, ipj, ipk, zlon,        &
+               &           zlat, zlev, jpmois, istep, zdate0,   &
+               &           zdt, numrnf )
+            !   Title, dimensions and tests
+# if ! defined key_coupled
+            IF( iman /= jpmois ) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'problem with time coordinates'
+               IF(lwp) WRITE(numout,*) ' iman ', iman, ' jpmois ', jpmois
+               nstop = nstop + 1
+            ENDIF
+            IF(lwp) WRITE(numout,*) iman, istep, zdate0, rdt, numrnf
+            IF(lwp) WRITE(numout,*) 'numrnf=', numrnf
+            IF(lwp) WRITE(numout,*) 'jpmois=', jpmois
+            IF(lwp) WRITE(numout,*) 'zdt=', zdt
+# endif
+            IF(ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN
+               IF(lwp)WRITE(numout,*) ' '
+               IF(lwp)WRITE(numout,*) 'problem with dimensions'
+               IF(lwp)WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta
+               IF(lwp)WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta
+               IF(lwp)WRITE(numout,*) ' ipk ', ipk, ' =? 1'
+               nstop = nstop + 1
+            ENDIF
+            IF(lwp)WRITE(numout,*) 'ipi=', ipi, ' ipj=', ipj, ' ipk=', ipk
+         ENDIF
+         
+# if ! defined key_coupled
+
+         ! 2. Read monthly file of runoff
+         ! ------------------------------
+
+         IF( kt == nit000 .OR. imois /= nrnf1 ) THEN
+
+            ! Calendar computation for interpolation
+            !     nrnf1 number of the first array record used in the simulation
+            !     nrnf2 number of the last  array record
+
+            nrnf1 = imois
+            nrnf2 = nrnf1 + 1
+            nrnf1 = MOD( nrnf1, iman )
+            IF( nrnf1 == 0 ) nrnf1 = iman
+            nrnf2 = MOD( nrnf2, iman )
+            IF( nrnf2 == 0 ) nrnf2 = iman
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' runoff monthly field'
+               WRITE(numout,*) ' --------------------'
+               WRITE(numout,*) ' NetCDF format'
+               WRITE(numout,*)
+               WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+               WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+               WRITE(numout,*)
+            ENDIF
+            
+            ! Read monthly runoff data in kg/m2/s
+!ibug
+            IF( kt == nit000 )   rnfdta(:,:,:) = 0.e0
+!ibug
+            CALL flinget( numrnf, 'sorunoff', jpidta, jpjdta, 1, jpmois   &
+               &        , nrnf1, nrnf1, mig(1), nlci, mjg(1), nlcj, rnfdta(1:nlci,1:nlcj,1) )
+            CALL flinget( numrnf, 'sorunoff', jpidta, jpjdta, 1, jpmois   &
+               &        , nrnf2, nrnf2, mig(1), nlci, mjg(1), nlcj, rnfdta(1:nlci,1:nlcj,2) )
+
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' read runoff field ok'
+            IF(lwp) WRITE(numout,*)
+
+         ENDIF
+
+         ! Linear interpolation and conversion in upward water flux
+         ! C a u t i o n : runoff is negative and in kg/m2/s 
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+         runoff(:,:) = -( ( 1.e0 - zxy ) * rnfdta(:,:,1) + zxy * rnfdta(:,:,2) )
+
+         ! Runoff reduction
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   runoff(ji,jj) = 0.85 * runoff(ji,jj)
+            END DO
+         END DO
+         
+# endif
+
+      ENDIF
+
+
+      ! 3. Mixed advection scheme 
+      ! -------------------------
+
+      IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+         ! Upstream and centered scheme in the vicinity of river mouths
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+!ibug
+         zcoefr(:,:) = 0.e0
+!ibug
+
+         CALL flinget( numrnf, 'socoefr', jpidta, jpjdta, 1, jpmois, nrnf1,   &
+            &          nrnf1, mig(1), nlci, mjg(1), nlcj, zcoefr(1:nlci,1:nlcj) )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' read coefr for advection ok'
+         IF(lwp) WRITE(numout,*)
+         
+         upsrnfh(:,:) = zcoefr(:,:)
+         upsrnfz(:)   = 0.e0
+         upsrnfz(1)   = 1.0
+         upsrnfz(2)   = 1.0
+         upsrnfz(3)   = 0.5
+         upsrnfz(4)   = 0.25
+         upsrnfz(5)   = 0.125
+         
+         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
+            ! ORCA_R2 configuration : upstream scheme in the Sound Strait
+            ij0 = 116   ;   ij1 = 116
+            ii0 = 144   ;   ii1 = 144   ;   upsrnfh( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+            ii0 = 145   ;   ii1 = 147   ;   upsrnfh( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+            ii0 = 148   ;   ii1 = 148   ;   upsrnfh( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         ENDIF
+
+      ENDIF
+
+      ! Upstream and centered scheme in the vicinity of some straits
+
+      IF( kt == nit000 ) THEN 
+
+         IF( cp_cfg == "orca" ) THEN
+
+            SELECT CASE ( jp_cfg )
+            !                                        ! =======================
+            CASE ( 4 )                               !  ORCA_R4 configuration 
+               !                                     ! =======================
+
+               !                                          ! Gibraltar Strait
+               ii0 =  70   ;   ii1 =  71
+               ij0 =  52   ;   ij1 =  53   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         
+               !                                     ! =======================
+            CASE ( 2 )                               !  ORCA_R2 configuration 
+               !                                     ! =======================
+
+               !                                          ! Gibraltar Strait
+               ij0 = 102   ;   ij1 = 102
+               ii0 = 138   ;   ii1 = 138   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
+               ii0 = 139   ;   ii1 = 139   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+               ii0 = 140   ;   ii1 = 140   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+               ij0 = 101   ;   ij1 = 102
+               ii0 = 141   ;   ii1 = 141   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+
+               !                                          ! Bab el Mandeb Strait
+               ij0 =  87   ;   ij1 =  88
+               ii0 = 164   ;   ii1 = 164   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
+               ij0 =  88   ;   ij1 =  88
+               ii0 = 163   ;   ii1 = 163   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+               ii0 = 162   ;   ii1 = 162   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+               ii0 = 160   ;   ii1 = 161   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+               ij0 =  89   ;   ij1 =  89
+               ii0 = 158   ;   ii1 = 160   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+               ij0 =  90   ;   ij1 =  90
+               ii0 = 160   ;   ii1 = 160   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+
+               !                                          ! Sound Strait
+               ij0 = 116   ;   ij1 = 116
+               ii0 = 145   ;   ii1 = 147   ;   upsadv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         
+            END SELECT 
+
+         ENDIF
+
+      ENDIF
+     
+      ! 4. Closing all files
+      ! --------------------
+
+      IF( kt == nitend .AND. nrunoff >= 1 )   CALL flinclo( numrnf )
+
+   END SUBROUTINE flx_rnf
+
+#endif
+   !!======================================================================
+END MODULE flxrnf
Index: trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R05.h90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R05.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R05.h90	(revision 325)
@@ -0,0 +1,1176 @@
+   !!----------------------------------------------------------------------
+   !!                  *** flxrnf_ORCA_R05.h90  ***
+   !!----------------------------------------------------------------------
+   !!   flx_rnf      : update ocean runoffs for ORCA_R05 configuration
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC flx_rnf         ! routine call by step.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      runoff,            &  !: monthly runoff (kg/m2/s)
+      upsadv,            &  !: mixed adv scheme in straits vicinity (hori.)
+      upsrnfh               !: mixed adv scheme in runoffs vicinity (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !:
+      upsrnfz               !: mixed adv scheme in runoffs vicinity (vert.)
+   INTEGER , PUBLIC ::   &  !:
+      numrof  = 48 ,     &  !: logical unit for runoff data
+      nrunoff =  0 ,     &  !: runoff option (namelist)
+      nrnf1, nrnf2          !: first and second record used
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpi,jpj,2) ::   &  !:
+      rnfdta                !: monthly runoff data array (kg/m2/s)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx_rnf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE flx_rnf  ***
+      !!       
+      !! ** Purpose :   Introduce a climatological run off forcing
+      !!
+      !! ** Method  :   ORCA R05 configuration
+      !!      Initialze each mouth of river with a monthly climatology 
+      !!      provided from different data.
+      !!     C a u t i o n : upward water flux, runoff is negative
+      !!                     set at the last loop of the routine
+      !!
+      !! ** Action :
+      !!
+      !! References : 
+      !!       J. D. Milliman and R. H. Meade, 1983 : world-wide delivery
+      !!          of river sediment to the oceans, journal of geology vol 91
+      !!          pp 1-21.
+      !!       G. L. Russell and J. R. Miller, 1990 : global river runoff
+      !!          calculated from a global atmospheric general circulation
+      !!          model, journal of hydrology, 117(1990), pp 241-254.
+      !!       F. Van Der Leeden, Troise F. L., Todd D. K. : the water
+      !!          encyclopedia, second edition, lewis publishers.
+      !!       J. W. Weatherly, J. E. Walsh : The effects of precipitation
+      !!          and river runoff in a coupled ice-ocean model of Arctic
+      !!          Climate dynamics 1996 12:785,798
+      !!       Jacobs et al. 1992. J. Glaciol. 38 (130) 375-387.
+      !!
+      !! History :
+      !!        !  94-10  (G.Madec, M. Pontaud, M. Imbard)  Original code
+      !!        !  97-03  (G.Madec)  time dependent version
+      !!        !  98-06  (J.M. Molines)  exact computation of zxy 
+      !!                         for months that are not 30 days
+      !!        !  98-07  (M. Imbard)  ORCA and mpp option
+      !!        !  99-08  (J.P. Boulanger H.L.Ayina)  New rivers and 
+      !!                         values given in m3/s 
+      !!        !  00-04  (G. Madec, K. Roberts) add antarctica ice discharge.
+      !!        !  00-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+#if defined key_coupled
+      runoff(:,:) = 0.0e0
+#else
+      !!----------------------------------------------------------------------
+      !!  ORCA_R05
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER, PARAMETER ::   &
+         jpmois=12,   &  ! number of month in the year !
+         jpriv=120,   &  ! maximum number of rivers
+         jpcoef=20       ! maximum number of gridpoints for mouth rivers
+
+      INTEGER  ::   ji, jj, jl, jm, jn, jr, jc
+      INTEGER  ::   i15, imois, iman
+      INTEGER  ::   inbp, idbd, idmeom
+      INTEGER  ::   iirnf(jpcoef,jpriv),ijrnf(jpcoef,jpriv)
+      INTEGER  ::   inb(jpriv)
+
+      REAL(wp) ::   zconv, zxy
+      REAL(wp) ::   zrup1,zrup2,zrup3
+      REAL(wp) ::   zrnfm(jpmois, jpriv)
+      REAL(wp) ::   zcoefr(jpi, jpj, 5)
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      ! ====
+      ! DATA
+      ! ====
+
+      ! I NORTH AMERICA
+      ! ---------------
+
+      ! 1-Saint Lawrence (Canada) 49N30 67W00               R2
+      ! Old=447 km3/year=14165m3/s; CLIPPER=12430m3/s; ratio=1.14
+      ! --> 13975.249m3/s
+      DATA inb(1)/3/
+      DATA (iirnf(jc,1),jc=1,jpcoef)/ 444, 444, 444, 17*0 /
+      DATA (ijrnf(jc,1),jc=1,jpcoef)/ 367, 368, 369, 17*0 /
+      DATA (zrnfm(jm,1),jm=1,jpmois)/   &
+          11718.,  11971.,  12466.,  14980.,  19257.,  16913.,   &
+          14211.,  13119.,  13367.,  13644.,  13463.,  12594./
+      ! 2-Hudson River (USA) 41N00 77W00                    R1
+      ! Old=12 km3/year=380m3/s; UNESCO(64-83,p255)=408m3/s
+      ! --> 407.416687m3/s
+      DATA inb(2)/1/
+      DATA (iirnf(jc,2),jc=1,jpcoef)/ 426, 19*0 /
+      DATA (ijrnf(jc,2),jc=1,jpcoef)/ 336, 19*0 /
+      DATA (zrnfm(jm,2),jm=1,jpmois)/   &
+          364.,    404.,    648.,    873.,    593.,    301.,   &
+          205.,    171.,    205.,    290.,    379.,    456./
+      ! 3-Missisipi and Atchafalaya (USA) 29N 90W           R1 
+      ! Old=580 km3/year=18380m3/s; CLIPPER=17599m3/s
+      ! --> 17599.334m3/s
+      DATA inb(3)/2/
+      DATA (iirnf(jc,3),jc=1,jpcoef)/ 397, 398, 18*0 /
+      DATA (ijrnf(jc,3),jc=1,jpcoef)/ 312, 313, 18*0 /
+      DATA (zrnfm(jm,3),jm=1,jpmois)/   &
+          19260.,  20813.,  23026.,  28160.,  26510.,  19650.,   &
+          14181.,  10676.,   9578.,  10167.,  11699.,  17472./
+      ! 4-Brazos (USA) 29N58 95W53                          R1
+      ! Old=7 km3/year=222m3/s; UNESCO(65-84, p298)=200m3/s
+      ! --> 199.666656m3/s
+      DATA inb(4)/1/
+      DATA (iirnf(jc,4),jc=1,jpcoef)/ 386, 19*0 /
+      DATA (ijrnf(jc,4),jc=1,jpcoef)/ 311, 19*0 /
+      DATA (zrnfm(jm,4),jm=1,jpmois)/   &
+          165.,    224.,    200.,    266.,    457.,    327.,   &
+          143.,     69.,    102.,    132.,    160.,    151./
+      ! 5-Colorado (Mexico) 31N54 114W57                    R5
+      ! Old=20 km3/year=634m3/s
+      ! --> 634.m3/s
+      DATA inb(5)/2/
+      DATA (iirnf(jc,5),jc=1,jpcoef)/ 347, 348, 18*0 /
+      DATA (ijrnf(jc,5),jc=1,jpcoef)/ 316, 316, 18*0 /
+      DATA (zrnfm(jm,5),jm=1,jpmois)/12*634./ 
+      ! 6-Columbia (USA) 45N60 121W17                       R1
+      ! Old=251 km3/year=7954m3/s; UNESCO(65-84, p312)=5368m3/s
+      ! --> 5368.41602m3/s
+      DATA inb(6)/2/
+      DATA (iirnf(jc,6),jc=1,jpcoef)/ 326, 326, 18*0 /
+      DATA (ijrnf(jc,6),jc=1,jpcoef)/ 360, 361, 18*0 /
+      DATA (zrnfm(jm,6),jm=1,jpmois)/   &
+          4752.,    5077.,    5633.,    6075.,    8422.,    9822.,   &
+          6350.,    4112.,    3273.,    3251.,    3548.,    4106./ 
+      ! 7-Fraser (USA)                                      R5
+      ! Old=112 km3/year=3550m3/s;not found in UNESCO
+      ! --> 3549.99976m3/s
+      DATA inb(7)/2/
+      DATA (iirnf(jc,7),jc=1,jpcoef)/ 317, 317, 18*0 /
+      DATA (ijrnf(jc,7),jc=1,jpcoef)/ 378, 379, 18*0 /
+      DATA (zrnfm(jm,7),jm=1,jpmois)/12*3550./ 
+      ! 8-Yukon (USA) 63N00 165W00                          R3
+      ! Old=195 km3/year=6179m3/s; UNESCO(65-77+80-84, p321)=4245; ratio=1.46
+      ! --> 6017.24951m3/s
+      DATA inb(8)/2/
+      DATA (iirnf(jc,8),jc=1,jpcoef)/ 244, 244, 18*0 /
+      DATA (ijrnf(jc,8),jc=1,jpcoef)/ 413, 414, 18*0 /
+      DATA (zrnfm(jm,8),jm=1,jpmois)/   &
+           1459.,    1213.,    1065.,    1100.,    9067.,   17675.,   &
+          10680.,   11271.,    8658.,    5453.,    2649.,    1917./ 
+      ! 9-Copper (USA) 61N47 144W45                         R2
+      ! Old=39 km3/year=1236m3/s; UNESCO(65-84, p317)=1052m3/s; ratio=1.18
+      ! --> 1236.25m3/s
+      DATA inb(9)/1/
+      DATA (iirnf(jc,9),jc=1,jpcoef)/ 274, 19*0 /
+      DATA (ijrnf(jc,9),jc=1,jpcoef)/ 409, 19*0 /
+      DATA (zrnfm(jm,9),jm=1,jpmois)/   &
+           219.,    195.,    181.,    214.,    904.,   2532.,   &
+          4026.,   3627.,   1632.,    697.,    354.,    254./ 
+      ! 10-Susitna (USA)                                    R5
+      ! Old=40 km3/year=1268m3/s
+      ! --> 1268.m3/s
+      DATA inb(10)/2/
+      DATA (iirnf(jc,10),jc=1,jpcoef)/ 263, 264, 18*0 /
+      DATA (ijrnf(jc,10),jc=1,jpcoef)/ 405, 405, 18*0 /
+      DATA (zrnfm(jm,10),jm=1,jpmois)/12*1268./ 
+      ! 11-McKenzie (Canada) 70N00 135W00                   R3
+      ! Old=306 km3/year=9697m3/s; UNESCO(67+72+7479+82-84, p168)=8343m3/s;
+      ! ratio=1.16
+      ! --> 9606.66797m3/s
+      DATA inb(11)/3/
+      DATA (iirnf(jc,11),jc=1,jpcoef)/ 272, 272, 272, 17*0 /
+      DATA (ijrnf(jc,11),jc=1,jpcoef)/ 451, 452, 453, 17*0 /
+      DATA (zrnfm(jm,11),jm=1,jpmois)/   &
+           3644.,    3400.,    3258.,    3546.,   14188.,   21544.,   &
+          18954.,   15487.,   11284.,   10169.,    5901.,    3905./
+      ! 12-Kuksokwim (USA) 60N00 ~162W30                    R4
+      ! UNESCO(65-84, p318)=1112m3/s (61N87 158E10, Crooked Creek, inland)
+      ! --> 1111.99988m3/s
+      DATA inb(12)/2/
+      DATA (iirnf(jc,12),jc=1,jpcoef)/ 244, 245, 18*0 /
+      DATA (ijrnf(jc,12),jc=1,jpcoef)/ 413, 414, 18*0 /
+      DATA (zrnfm(jm,12),jm=1,jpmois)/   &
+          335.,     308.,     295.,     407.,    2415.,    2027.,   &
+          1917.,   2049.,    1585.,    1072.,     545.,     389./     
+
+      DATA inb(13)/0/
+      DATA inb(14)/0/
+      DATA inb(15)/0/
+
+      ! Total run-offs(I)=60974.2539m3/s
+
+      ! II SOUTH AMERICA
+      ! -----------------
+      ! 16-Chira (Peru) 4s54 81w08                          R2
+      ! Old=5 km3/year=158m3/s; UNESCO (65-68, p357)=80.9; ratio=1.95
+      ! --> 158.000015m3/s
+      DATA inb(16)/1/
+      DATA (iirnf(jc,16),jc=1,jpcoef)/ 414, 19*0 /
+      DATA (ijrnf(jc,16),jc=1,jpcoef)/ 244, 19*0 /
+      DATA (zrnfm(jm,16),jm=1,jpmois)/   &
+          70.,     105.,     564.,     582.,     230.,      94.,   &
+          87.,      47.,      35.,      32.,      29.,      21./
+      ! 17-Magdalena (Colombia) 11N06 74W51                 R2
+      ! Old=237 km3/year=7510m3/s; UNESCO(71-73+76-79, p348)=6973m3/s;
+      ! ratio=1.08
+      ! --> 7451.58301m3/s
+      DATA inb(17)/2/
+      DATA (iirnf(jc,17),jc=1,jpcoef)/ 424, 424, 18*0 /
+      DATA (ijrnf(jc,17),jc=1,jpcoef)/ 270, 271, 18*0 /
+      DATA (zrnfm(jm,17),jm=1,jpmois)/   &
+          6598.,    4441.,    4087.,    5445.,    7380.,    8067.,   &
+          8509.,    7428.,    7631.,    9296.,   10588.,    9949./
+      ! 18-Orinoco (Venezuela) 8N37 62W15!                  R1
+      ! Old=1100 km3/year=34857m3/s; UNESCO(73-75, p364)=28736m3/s;
+      ! HLA=26371m3/s
+      ! Data from HLA: 8.1N - 63.3W   1925/89
+      ! --> 26371.416
+      DATA inb(18)/5/
+      DATA (iirnf(jc,18),jc=1,jpcoef)/ 451, 451, 452, 452, 452, 15*0 /
+      DATA (ijrnf(jc,18),jc=1,jpcoef)/ 271, 272, 271, 272, 272, 15*0 /
+      DATA (zrnfm(jm,18),jm=1,jpmois)/   &
+          10670.,    7513.,    6344.,    6887.,   13086.,   26699.,   &
+          43938.,   59957.,   57435.,   39951.,   27410.,   16567./ 
+      ! 19-Amazon (Brazil) 0S05 50W00                       R1
+      ! Old=6300 km3/year=199634m3/s; CLIPPER=166192m3/s~UNESCO;
+      ! HLA=184806m3/s
+      ! UNESCO data are at Obidos which is far inland and therefore does not
+      ! fully represent the actual discharge
+      ! Data from HLA: 1.5N - 55.3W   1970/96
+      ! --> 184845.484m3/s
+      DATA inb(19)/14/
+      DATA (iirnf(jc,19),jc=1,jpcoef)/ 475, 476, 476, 476, 476,  &
+                                       477, 477, 477, 477, 477,  &
+                                       478, 478, 478, 478, 6*0 /
+      DATA (ijrnf(jc,19),jc=1,jpcoef)/ 254, 251, 252, 253, 254,  &
+                                       250, 251, 252, 253, 254,  &
+                                       250, 251, 252, 253, 6*0 /
+      DATA (zrnfm(jm,19),jm=1,jpmois)/   &
+          152233., 176415., 199941., 225565., 244016., 244861.,   &
+          230711., 203128., 164531., 128486., 118214., 130045. /
+      ! 20-Sao Francisco (Brazil) 10S30 36W24               R1
+      ! Old=97 km3/year=3074m3/s; UNESCO(77-79, p338)=2645m3/s
+      ! --> 2645.3335m3/s
+      DATA inb(20)/1/
+      DATA (iirnf(jc,20),jc=1,jpcoef)/ 498, 19*0 /
+      DATA (ijrnf(jc,20),jc=1,jpcoef)/ 223, 19*0 /
+      DATA (zrnfm(jm,20),jm=1,jpmois)/   &
+          3244.,   4116.,   5139.,   4330.,   2323.,   1800.,     &
+          1587.,   1511.,   1593.,   1740.,   2190.,   2171. /
+      ! 21-Parana+Uruguay(Arg./Uru.) 34S12 58W18            R1 
+      ! Old=470 km3/year=14893m3/s; UNESCO(p323/324)=22263m3/s
+      ! --> 22203.168m3/s 
+      DATA inb(21)/5/
+      DATA (iirnf(jc,21),jc=1,jpcoef)/ 462, 462, 462, 462, 463, 15*0 /
+      DATA (ijrnf(jc,21),jc=1,jpcoef)/ 172, 173, 174, 175, 175, 15*0 /
+      DATA (zrnfm(jm,21),jm=1,jpmois)/   &
+          24803.,   26836.,   24585.,   21358.,   20041.,   21689.,   &
+          22647.,   20403.,   19627.,   21400.,   21126.,   21923./
+      ! 22-Negro (Argentina)  41S02  62W47                  R2
+      ! Old=30 km3/year=951m3/s; UNESCO(65-79,p330)=765m3/s; ratio=1.24
+      ! --> 907.666687m3/s
+      DATA inb(22)/2/
+      DATA (iirnf(jc,22),jc=1,jpcoef)/ 446, 447, 18*0 /
+      DATA (ijrnf(jc,22),jc=1,jpcoef)/ 160, 160, 18*0 /
+      DATA (zrnfm(jm,22),jm=1,jpmois)/   &
+          882.,     587.,     519.,     482.,     623.,     984.,   &
+          1120.,   1294.,    1092.,    1166.,    1105.,    1038./
+      ! 23- Tocantins :  ~48W00 ~0.5S                       R4
+      ! UNESCO(76-77+80-81, p335)=12167m3/s (station far inland!)
+      ! --> 12173.082m3/s
+      DATA inb(23)/4/
+      DATA (iirnf(jc,23),jc=1,jpcoef)/ 479, 480, 481, 482, 16*0 /
+      DATA (ijrnf(jc,23),jc=1,jpcoef)/ 249, 249, 249, 249, 16*0 /
+      DATA (zrnfm(jm,23),jm=1,jpmois)/   &
+          15507.,  24855.,  27854.,  24257.,  15860.,   7861.,   &
+          4440.,   3082.,   2728.,   3417.,   5511.,  10705. /
+
+      DATA inb(24)/0/
+      DATA inb(25)/0/
+
+      ! Total run-offs(II)=256755.75
+      ! Total run-offs(I+II)=317730
+
+      ! III EUROPE
+      ! ----------
+      ! 26-Rhone (France) 43N20 4E50                        R1 
+      ! Old=49 km3/year=1553m3/s; UNESCO(65-83, p512)=1229
+      ! --> 1217.16663m3/s
+      DATA inb(26)/1/
+      DATA (iirnf(jc,26),jc=1,jpcoef)/ 584, 19*0 /
+      DATA (ijrnf(jc,26),jc=1,jpcoef)/ 347, 19*0 /
+      DATA (zrnfm(jm,26),jm=1,jpmois)/   &
+          1385.,    1848.,    1568.,    1311.,    1420.,    1191.,   &
+           937.,     796.,     794.,     962.,    1161.,    1233./
+      ! 27-Po (Italy) 11N10 1W09                            R1 
+      ! Old=46 km3/year=1458m3/s; UNESCO(65-84, p527)=1550m3/s
+      ! --> 1550.08337m3/s
+      DATA inb(27)/1/
+      DATA (iirnf(jc,27),jc=1,jpcoef)/ 599, 19*0 /
+      DATA (ijrnf(jc,27),jc=1,jpcoef)/ 355, 19*0 /
+      DATA (zrnfm(jm,27),jm=1,jpmois)/   &
+          1304.,    1605.,    1856.,    1549.,    1958.,    1760.,   &
+          1040.,    1007.,    1615.,    1907.,    1772.,    1228./
+      ! 28-Danube (Roumania) 45N20 29E40                    R1 
+      ! Old=206 km3/year=6527m3/s; UNESCO(65-84, p544)=7011m3/s
+      ! --> 7011.8335m3/s
+      DATA inb(28)/2/
+      DATA (iirnf(jc,28),jc=1,jpcoef)/ 632, 632, 18*0 /
+      DATA (ijrnf(jc,28),jc=1,jpcoef)/ 356, 357, 18*0 /
+      DATA (zrnfm(jm,28),jm=1,jpmois)/   &
+          6625.,    7352.,    7986.,    9279.,    9482.,    8618.,   &
+          7586.,    6001.,    5210.,    4989.,    4921.,    6093./
+
+      DATA inb(29)/0/
+      DATA inb(30)/0/
+
+      ! Total run-offs(III)=9779.08301m3/s
+      ! Total run-offs(I+II+III)=327509.094m3/s
+      
+      ! IV EURASIAN ARCTIC
+      ! ------------------
+      ! 31-Iana (Russia)                                    R1
+      ! Old=29 km3/year=919m3/s; UNESCO(65-72+74+76-84, p463)=936m3/s
+      ! --> 0m3/s
+      DATA inb(31)/0/
+      DATA (iirnf(jc,31),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,31),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,31),jm=1,jpmois)/   &
+             2.,       1.,       0.,       0.,     917.,    3514.,   &
+          2968.,    2329.,    1322.,     178.,      36.,       8./ 
+      ! 32-Ob (Russia) 66N45 69E30                          R1 
+      ! Old=385 km3/year=12200m3/s; UNESCO(65-84, p478)=12862m3/s
+      ! --> 12861.5m3/s
+      DATA inb(32)/8/
+      DATA (iirnf(jc,32),jc=1,jpcoef)/ 635, 635, 636, 636, 636,637, 637,637,12*0 /
+      DATA (ijrnf(jc,32),jc=1,jpcoef)/ 508, 509, 509, 508, 507,509, 508,507,12*0 /
+      DATA (zrnfm(jm,32),jm=1,jpmois)/   &
+           4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   &
+          30773.,   22785.,   14701.,    9705.,    6078.,    5879./
+      ! 33-Yenesei (Russia) 71N50 82E40                     R1 
+      ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s
+      ! --> 17461.666m3/s
+      DATA inb(33)/9/
+      DATA (iirnf(jc,33),jc=1,jpcoef)/ 114,115,115,116, 117,117,117,118,118,11*0 /
+      DATA (ijrnf(jc,33),jc=1,jpcoef)/ 504,504,503,503, 501,502,503,502,501,11*0 /
+      DATA (zrnfm(jm,33),jm=1,jpmois)/   &
+           6659.,    7007.,    6895.,    7089.,   24183.,   74965.,   &
+          25325.,   15940.,   16050.,   12678.,    6741.,    6008./
+      ! 34-Severnaya Dvina(Russia)64N32 40E30               R5 
+      ! Old=106 km3/year=3359m3/s; not in UNESCO data base
+      ! --> 3359.00024m3/s
+      DATA inb(34)/2/
+      DATA (iirnf(jc,34),jc=1,jpcoef)/ 620, 620, 18*0 /
+      DATA (ijrnf(jc,34),jc=1,jpcoef)/ 448, 449, 18*0 /
+      DATA (zrnfm(jm,34),jm=1,jpmois)/12*3359./
+      ! 35-Lena (Russia) 72N25 126E40                       R1 
+      ! --> 16192.333m3/s
+      DATA inb(35)/9/
+      DATA (iirnf(jc,35),jc=1,jpcoef)/ 142,143,148,148,149,149,150,150,150,11*0 /
+      DATA (ijrnf(jc,35),jc=1,jpcoef)/ 458,458,456,448,449,448,451,450,449,11*0 /
+      DATA (zrnfm(jm,35),jm=1,jpmois)/   &
+           2663.,    2095.,    1629.,    1324.,    7203.,   64230.,   &
+          40810.,   28310.,   25995.,   13299.,    3673.,    3077./
+      ! 36-Kolyma (Russia) 69N30 161E00                     R1
+      ! Old=71 km3/year=2250m3/s; UNESCO(65-84)=2138m3/s
+      ! --> 2138.66675m3/s
+      DATA inb(36)/2/
+      DATA (iirnf(jc,36),jc=1,jpcoef)/ 184, 185, 18*0 /
+      DATA (ijrnf(jc,36),jc=1,jpcoef)/ 429, 429, 18*0 /
+      DATA (zrnfm(jm,36),jm=1,jpmois)/   &
+           131.,      92.,      76.,      65.,    2576.,    9143.,   &
+          4670.,    3727.,    3226.,    1119.,     630.,     209./
+      ! 37-Indigirka (russia) 70N48 148E54                  R1 
+      ! Old=55 km3/year=1743m3/s; UNESCO(65-68+70+72-84)=1622.
+      ! --> 1622.00012m3/s
+      DATA inb(37)/1/
+      DATA (iirnf(jc,37),jc=1,jpcoef)/ 172, 19*0 /
+      DATA (ijrnf(jc,37),jc=1,jpcoef)/ 438, 19*0 /
+      DATA (zrnfm(jm,37),jm=1,jpmois)/   &
+            32.,      17.,      11.,       7.,     354.,    5629.,   &
+          5210.,    4617.,    2823.,     559.,     142.,      63./
+
+      DATA inb(38)/0/
+      DATA inb(39)/0/
+      DATA inb(40)/0/
+
+      ! Total run-offs(IV)=40773.6641m3/s
+      ! Total run-offs(I+II+III+IV)=368282.75m3/s
+
+      ! V ASIA
+      ! ------
+      ! 41-Amur (Russia) 52N56 141E10                       R2
+      ! Old=325 km3/year=10299m3/s; UNESCO(65-84, p451)=8792m3/s; ratio=1.17
+      ! --> 10299.332m3/s
+      DATA inb(41)/2/
+      DATA (iirnf(jc,41),jc=1,jpcoef)/ 141, 141, 18*0 /
+      DATA (ijrnf(jc,41),jc=1,jpcoef)/ 381, 382, 18*0 /
+      DATA (zrnfm(jm,41),jm=1,jpmois)/   &
+           2108.,    1543.,    1252.,    4088.,   15464.,   17336.,   &
+          16100.,   20801.,   21548.,   15658.,    5188.,    2506./
+      ! 42-Liaohe (China) 40N40 122E09                      R5
+      ! Old=6 km3/year=190m3/s; not found in UNESCO data base
+      ! --> 189.999985m3/s
+      DATA inb(42)/1/
+      DATA (iirnf(jc,42),jc=1,jpcoef)/ 100, 19*0 /
+      DATA (ijrnf(jc,42),jc=1,jpcoef)/ 342, 19*0 /
+      DATA (zrnfm(jm,42),jm=1,jpmois)/12*190./
+      ! 43-Daling (China) 40N56 121E43                      R5
+      ! Old=1 km3/year=32m3/s; not found in UNESCO data base
+      ! --> 31.9999962m3/s
+      DATA inb(43)/2/
+      DATA (iirnf(jc,43),jc=1,jpcoef)/  99, 100, 18*0 /
+      DATA (ijrnf(jc,43),jc=1,jpcoef)/ 342, 342, 18*0 /
+      DATA (zrnfm(jm,43),jm=1,jpmois)/12*32./
+      ! 44-Haiho (China) 6N17   1E23
+      ! Old=2 km3/year=64m3/s; not found in UNESCO data base
+      ! --> 63.9999924m3/s
+      DATA inb(44)/1/
+      DATA (iirnf(jc,44),jc=1,jpcoef)/ 121, 19*0 /
+      DATA (ijrnf(jc,44),jc=1,jpcoef)/ 348, 19*0 /
+      DATA (zrnfm(jm,44),jm=1,jpmois)/12*64./
+      ! 45-Yellow/Huangho (China) 37N32 118E19              R2 
+      ! Old=49 km3/year=1553m3/s; UNESCO(p371)=1210m3/s; ratio=1.28
+      ! --> 1552.5m3/s
+      DATA inb(45)/3/
+      DATA (iirnf(jc,45),jc=1,jpcoef)/  92,  92,  92, 17*0 /
+      DATA (ijrnf(jc,45),jc=1,jpcoef)/ 336, 337, 338, 17*0 /
+      DATA (zrnfm(jm,45),jm=1,jpmois)/   &
+           697.,     674.,    1282.,    1206.,    1109.,     778.,   &
+          1964.,    3270.,    3668.,    2133.,     978.,     871./
+      ! 46-Yangtze (China) 31N48 121E10=Changjiang          R2
+      ! Old=900 km3/year=28520m3/s; UNESCO(p372)=25032m3/s; ratio=1.14
+      ! --> 28519.584m3/s
+      DATA inb(46)/2/
+      DATA (iirnf(jc,46),jc=1,jpcoef)/ 100, 100, 18*0 /
+      DATA (ijrnf(jc,46),jc=1,jpcoef)/ 316, 317, 18*0 /
+      DATA (zrnfm(jm,46),jm=1,jpmois)/   &
+          10994.,   10548.,   13254.,   24097.,   36972.,   47197.,   &
+          53891.,   42070.,   37627.,   30762.,   22046.,   12777./
+      ! 47-Pearl/Zhujiang (China) 23N36 106E34=Xijiang      R2 
+      ! Old=302 km3/year=9570m3/s; UNESCO(76,82, p373)=6987m3/s; ratio=1.37
+      ! --> 9570.75m3/s
+      DATA inb(47)/2/
+      DATA (iirnf(jc,47),jc=1,jpcoef)/  72,  73, 18*0 /
+      DATA (ijrnf(jc,47),jc=1,jpcoef)/ 294, 294, 18*0 /
+      DATA (zrnfm(jm,47),jm=1,jpmois)/   &
+           2357.,    2415.,    2634.,    6446.,   14246.,   18395.,   &
+          19213.,   17558.,   12312.,    7255.,    5864.,    6154./
+      ! 48-Red/Hungho (Vietnam) 20N17 106E34                R5 
+      ! Old=123 km3/year=3897m3/s; not in UNESCO data base
+      ! --> 3897.m3/s
+      DATA inb(48)/3/
+      DATA (iirnf(jc,48),jc=1,jpcoef)/  68,  68,  68, 17*0 /
+      DATA (ijrnf(jc,48),jc=1,jpcoef)/ 288, 289, 290, 17*0 /
+      DATA (zrnfm(jm,48),jm=1,jpmois)/12*3897./
+      ! 49-Mekong (Vietnam) 10N33 105E24                    R5
+      ! Old=470 km3/year=14893m3/s; not in UNESCO data base
+      ! --> 14893.0029m3/s
+      DATA inb(49)/3/
+      DATA (iirnf(jc,49),jc=1,jpcoef)/  69,  69,  70, 17*0 /
+      DATA (ijrnf(jc,49),jc=1,jpcoef)/ 269, 270, 270, 17*0 /
+      DATA (zrnfm(jm,49),jm=1,jpmois)/12*14893./
+      ! 50-Irrawady (Burma) 15N50  95E06                    R5
+      ! Old=428 km3/year=13563m3/s; not in UNESCO data base
+      ! --> 13563.m3/s
+      DATA inb(50)/2/
+      DATA (iirnf(jc,50),jc=1,jpcoef)/  44,  45, 18*0 /
+      DATA (ijrnf(jc,50),jc=1,jpcoef)/ 283, 282, 18*0 /
+      DATA (zrnfm(jm,50),jm=1,jpmois)/12*13563./
+      ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00          R1
+      ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s
+      ! --> 32147.498m3/s
+      DATA inb(51)/4/
+      DATA (iirnf(jc,51),jc=1,jpcoef)/  36,  37,  38,  39, 16*0 /
+      DATA (ijrnf(jc,51),jc=1,jpcoef)/ 295, 295, 295, 295, 16*0 /
+      DATA (zrnfm(jm,51),jm=1,jpmois)/   &
+           6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   &
+          64688.,   80338.,   84802.,   43387.,   17888.,   10322./
+      ! 52-Mehandi (India)                                  R5
+      ! Old=67 km3/year=2123m3/s; not in UNESCO data base
+      ! --> 0m3/s
+      DATA inb(52)/0/
+      DATA (iirnf(jc,52),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,52),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,52),jm=1,jpmois)/12*2123./
+      ! 53-Damodar (India)                                  R2
+      ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85
+      ! --> 432.916656m3/s
+      DATA inb(53)/1/
+      DATA (iirnf(jc,53),jc=1,jpcoef)/  30, 19*0 /
+      DATA (ijrnf(jc,53),jc=1,jpcoef)/ 294, 19*0 /
+      DATA (zrnfm(jm,53),jm=1,jpmois)/   &
+           51.,      37.,      42.,      49.,      85.,     296.,   &
+          896.,    1390.,    1591.,     542.,     172.,      44./   
+      ! 54-Godavari (India) 17N00  81E45                    R2
+      ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39
+      ! --> 3670.5m3/s
+      DATA inb(54)/1/
+      DATA (iirnf(jc,54),jc=1,jpcoef)/  19, 19*0 /
+      DATA (ijrnf(jc,54),jc=1,jpcoef)/ 283, 19*0 /
+      DATA (zrnfm(jm,54),jm=1,jpmois)/   &
+           988.,     737.,     280.,     219.,     196.,    1691.,   &
+          8063.,   14571.,   11428.,    3953.,    1221.,     699./   
+      ! 55-Indus (Pakistan) 24N20  67E47             R2
+      ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15
+      ! --> 7562.m3/s
+      DATA inb(55)/4/
+      DATA (iirnf(jc,55),jc=1,jpcoef)/ 711, 711, 712, 713, 16*0 /
+      DATA (ijrnf(jc,55),jc=1,jpcoef)/ 297, 298, 297, 297, 16*0 /
+      DATA (zrnfm(jm,55),jm=1,jpmois)/   &
+            988.,     737.,    1904.,    1968.,    3625.,    6143.,   &
+          15969.,    36656.,  17173.,    3215.,    1251.,    1115./   
+      ! 56-Tigris and Euphrates (Iraq) 31N00  47E25         R1
+      ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s
+      ! --> 2248.8335m3/s
+      DATA inb(56)/3/
+      DATA (iirnf(jc,56),jc=1,jpcoef)/ 673, 673, 674, 17*0 /
+      DATA (ijrnf(jc,56),jc=1,jpcoef)/ 312, 313, 313, 17*0 /
+      DATA (zrnfm(jm,56),jm=1,jpmois)/   &
+          1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   &
+          1362.,     900.,     786.,     993.,    1184.,    1742./   
+
+      DATA inb(57)/0/
+      DATA inb(58)/0/
+      DATA inb(59)/0/
+      DATA inb(60)/0/
+
+      ! Total run-offs (V)=128642.922m3/s
+      ! Total run-offs (I+II+III+IV+V)=496925.688m3/s
+
+      ! VI AFRICA
+      ! ----------
+      ! 61-Nile (Egypt) 30N10  31E06                        R1
+      ! Old=30 km3/year=951m3/s; UNESCO(73-84)=1251m3/s
+      ! --> 1251.33337m3/s
+      DATA inb(61)/3/
+      DATA (iirnf(jc,61),jc=1,jpcoef)/ 636, 636, 637, 17*0 /
+      DATA (ijrnf(jc,61),jc=1,jpcoef)/ 317, 318, 318, 17*0 /
+      DATA (zrnfm(jm,61),jm=1,jpmois)/   &
+          1239.,    1035.,    1126.,    1110.,    1170.,    1542.,   &
+          1742.,    1559.,    1191.,    1103.,    1075.,    1124./   
+      ! 62-Niger (Nigeria) 5N33   6E33                      R1
+      ! Old=192 km3/year=6084m3/s; HLA=5545m3/s;
+      ! Data from HLA: 4.5N -  6  E   1950/87
+      ! --> 5545.08301m3/s
+      DATA inb(62)/3/
+      DATA (iirnf(jc,62),jc=1,jpcoef)/ 591, 592, 593, 17*0 /
+      DATA (ijrnf(jc,62),jc=1,jpcoef)/ 258, 258, 258, 17*0 /
+      DATA (zrnfm(jm,62),jm=1,jpmois)/   &
+          2029.,    1804.,    1573.,    1418.,    1494.,    2561.,   &
+          5272.,    9629.,   14951.,   16227.,    6842.,    2741./   
+      ! 63-Zaire/Congo (Congo) 6S04  12E24                  R1      
+      ! Old=1250 km3/year=39610m3/s; UNESCO(65-83, p149)=41941m3/s; HLA
+      ! =39720m3/s
+      ! Data from HLA: 6S - 12  E   1902/96
+      ! --> 39719.5m3/s
+      DATA inb(63)/4/
+      DATA (iirnf(jc,63),jc=1,jpcoef)/ 599, 599, 600, 600, 16*0 /
+      DATA (ijrnf(jc,63),jc=1,jpcoef)/ 237, 238, 236, 237, 16*0 /
+      DATA (zrnfm(jm,63),jm=1,jpmois)/   &
+          47200.,   37692.,   34374.,   36603.,   37862.,   35588.,   &
+          30966.,   30774.,   35981.,   42825.,   51455.,   55314./  
+      ! 64-Orange (Sth Africa) 28S41 16E28                  R5
+      ! Old=11 km3/year=349m3/s
+      ! --> 349.000031m3/s
+      DATA inb(64)/2/
+      DATA (iirnf(jc,64),jc=1,jpcoef)/ 609, 609, 18*0 /
+      DATA (ijrnf(jc,64),jc=1,jpcoef)/ 188, 189, 18*0 /
+      DATA (zrnfm(jm,64),jm=1,jpmois)/12*349./
+      ! 65-Zambesi (Mozambique) 18S55 36E04                 R5
+      ! Old=223 km3/year=7066m3/s
+      ! --> 7066.00049m3/s
+      DATA inb(65)/3/
+      DATA (iirnf(jc,65),jc=1,jpcoef)/ 646, 646, 646, 17*0 /
+      DATA (ijrnf(jc,65),jc=1,jpcoef)/ 207, 208, 209, 17*0 /
+      DATA (zrnfm(jm,65),jm=1,jpmois)/12*7066./
+      ! 66-Limpopo (mozambique) 25S15 33E30                 R5
+      ! Old=5 km3/year=158m3/s
+      ! --> 158.m3/s
+      DATA inb(66)/2/
+      DATA (iirnf(jc,66),jc=1,jpcoef)/ 642, 642, 18*0 /
+      DATA (ijrnf(jc,66),jc=1,jpcoef)/ 196, 197, 18*0 /
+      DATA (zrnfm(jm,66),jm=1,jpmois)/12*158./
+      ! 67-Rufiji (tanzania) 8S00 39E20                     R5
+      ! Old=9 km3/year=285m3/s
+      ! --> 285.m3/s
+      DATA inb(67)/1/
+      DATA (iirnf(jc,67),jc=1,jpcoef)/ 655, 19*0 /
+      DATA (ijrnf(jc,67),jc=1,jpcoef)/ 235, 19*0 /
+      DATA (zrnfm(jm,67),jm=1,jpmois)/12*285./
+      ! Other rivers from the Gulf of Guinea
+      ! 68-Kouilou (Congo)  4.5S-11.5E (UNESCO=p51)         R1
+      ! Data from HLA:  4S - 11  E   1953/86 = 919m3/s
+      ! --> 924.25m3/s
+      DATA inb(68)/1/
+      DATA (iirnf(jc,68),jc=1,jpcoef)/ 599, 19*0 /
+      DATA (ijrnf(jc,68),jc=1,jpcoef)/ 241, 19*0 /
+      DATA (zrnfm(jm,68),jm=1,jpmois)/   &
+          1115.,    1166.,    1285.,    1462.,    1454.,     725.,   &
+           480.,     378.,     327.,     400.,    1018.,    1281./
+      ! 69-Nyanga (Gabon)  3S-10E (UNESCO=p66)              R1
+      ! Data from HLA: 2.8N - 10  E   1952/82 = 264m3/s
+      ! --> 264.166687m3/s
+      DATA inb(69)/1/
+      DATA (iirnf(jc,69),jc=1,jpcoef)/ 595, 19*0 /
+      DATA (ijrnf(jc,69),jc=1,jpcoef)/ 244, 19*0 /
+      DATA (zrnfm(jm,69),jm=1,jpmois)/   &
+          126.,      99.,     143.,     253.,     316.,     300.,   &
+          156.,      93.,     231.,     557.,     592.,     304./
+      ! 70-Ogoue (Gabon) 1S-9E (UNESCO, p69)                R1
+      ! Data from HLA: .75S -  9  E   1930/90 = 4512m3/s
+      ! --> 4511.83301m3/s
+      DATA inb(70)/2/
+      DATA (iirnf(jc,70),jc=1,jpcoef)/ 593, 593, 18*0 /
+      DATA (ijrnf(jc,70),jc=1,jpcoef)/ 247, 248, 18*0 /
+      DATA (zrnfm(jm,70),jm=1,jpmois)/   &
+          4514.,    3988.,    4622.,    5403.,    5790.,    4145.,   &
+          2616.,    1961.,    2119.,    4304.,    7870.,    6810./
+      ! 71-Sanaga (Cameroun) 3.5N-9.5E (UNESCO, p31)        R1
+      ! Data from HLA: 3.9N -  9.6E   1944/80 = 1983m3/s
+      ! --> 1982.58337m3/s
+      DATA inb(71)/2/
+      DATA (iirnf(jc,71),jc=1,jpcoef)/ 595, 595, 18*0 /
+      DATA (ijrnf(jc,71),jc=1,jpcoef)/ 255, 256, 18*0 /
+      DATA (zrnfm(jm,71),jm=1,jpmois)/   &
+           813.,     578.,     517.,     633.,     909.,    1278.,   &
+          1928.,    2653.,    4361.,    5470.,    3307.,    1344./
+      ! 72-Nyong (Cameroun) 3.1N-9.5E (UNESCO, p36)         R1
+      ! Data from HLA: 3.5N -  9.8E   1951/84 = 432m3/s
+      ! --> 431.166656m3/s      
+      DATA inb(72)/1/
+      DATA (iirnf(jc,72),jc=1,jpcoef)/ 594, 19*0 /
+      DATA (ijrnf(jc,72),jc=1,jpcoef)/ 257, 19*0 /
+      DATA (zrnfm(jm,72),jm=1,jpmois)/   &
+          232.,     128.,     150.,     266.,     402.,     459.,   &
+          353.,     306.,     604.,     930.,     878.,     466./
+      ! 73-Ntem (Cameroun) 2.5N-9.5E (UNESCO, p36)          R1
+      ! Data from HLA: 3N -  9.8E   1951/87 = 330m3/s      
+      ! --> 329.75m3/s
+      DATA inb(73)/1/
+      DATA (iirnf(jc,73),jc=1,jpcoef)/ 594, 19*0 /
+      DATA (ijrnf(jc,73),jc=1,jpcoef)/ 254, 19*0 /
+      DATA (zrnfm(jm,73),jm=1,jpmois)/   &
+          452.,     455.,     492.,     466.,     482.,     251.,   &
+          151.,     108.,      87.,     133.,     395.,     485./
+      ! 74-Wouri (Cameroun) 4N-9.5E (UNESCO, p34)           R1
+      ! Data from HLA: 4N -  9.5E   1951/84  = 307m3/s
+      ! --> 306.583374m3/s
+      DATA inb(74)/1/
+      DATA (iirnf(jc,74),jc=1,jpcoef)/ 594, 19*0 /
+      DATA (ijrnf(jc,74),jc=1,jpcoef)/ 258, 19*0 /
+      DATA (zrnfm(jm,74),jm=1,jpmois)/   &
+           88.,      63.,      68.,      95.,     139.,     222.,   &
+          395.,     633.,     825.,     675.,     328.,     148./
+      ! 75-Oueme (Benin) 6.5N-2.5E (UNESCO, p27)            R1
+      ! Data from HLA:  6.2N -  2.5E   1951/84 =113m3/s
+      ! --> 112.666664m3/s
+      DATA inb(75)/1/
+      DATA (iirnf(jc,75),jc=1,jpcoef)/ 583, 19*0 /
+      DATA (ijrnf(jc,75),jc=1,jpcoef)/ 262, 19*0 /
+      DATA (zrnfm(jm,75),jm=1,jpmois)/   &
+           0.,       0.,       0.,       0.,       1.,      18.,   &
+          96.,     324.,     531.,     319.,      58.,       5./
+      ! 76-Mono(Tepetou,Benin/Togo) 6.25N-1.8E (U, p27)     R1
+      ! Data from HLA: 6.2N -  1  E   1951/85  = 96m3/s       
+      ! --> 96.4999924m3/s
+      DATA inb(76)/2/
+      DATA (iirnf(jc,76),jc=1,jpcoef)/ 578, 579, 18*0 /
+      DATA (ijrnf(jc,76),jc=1,jpcoef)/ 262, 262, 18*0 /
+      DATA (zrnfm(jm,76),jm=1,jpmois)/   &
+            2.,       1.,       1.,       4.,       8.,      44.,   &
+          168.,     274.,     386.,     215.,      47.,       8./
+      ! 77-Comoe (Ivory Coast) 5N-4W (UNESCO, p56)          R1
+      ! Data from HLA: 5.1N -  4  W   1955/86 = 194m3/s       
+      ! --> 194.25m3/s
+      DATA inb(77)/1/
+      DATA (iirnf(jc,77),jc=1,jpcoef)/ 569, 19*0 /
+      DATA (ijrnf(jc,77),jc=1,jpcoef)/ 260, 19*0 /
+      DATA (zrnfm(jm,77),jm=1,jpmois)/   &
+           14.,       7.,       9.,      17.,      29.,      90.,   &
+          145.,     349.,     740.,     688.,     198.,      45./
+      ! 78-Sassandra (Ivory Coast) 5N-6W (UNESCO, p58)      R1
+      ! Data from HLA: 5N -  6  W   1953/86 = 449m3/s
+      ! --> 449.333344m3/s
+      DATA inb(78)/1/
+      DATA (iirnf(jc,78),jc=1,jpcoef)/ 564, 19*0 /
+      DATA (ijrnf(jc,78),jc=1,jpcoef)/ 260, 19*0 /
+      DATA (zrnfm(jm,78),jm=1,jpmois)/   &
+          144.,     116.,     119.,     143.,     156.,     334.,   &
+          419.,     692.,    1277.,    1190.,     553.,     249./
+      
+      DATA inb(79)/0/
+      DATA inb(80)/0/
+      DATA inb(82)/0/
+      DATA inb(83)/0/
+      DATA inb(84)/0/
+      DATA inb(85)/0/
+      DATA inb(86)/0/
+      DATA inb(87)/0/
+      DATA inb(88)/0/
+      DATA inb(89)/0/
+      DATA inb(90)/0/
+
+      ! Total run-offs (VI)=63977.m3/s
+      ! Total run-offs (I+II+III+IV+V+VI)=560902.688m3/s
+
+      ! VII OCEANIA
+      ! ------------
+      ! 91-Murray (Austrlia) 35S34 138E54                   R5
+      ! Old=22 km3/year=697m3/s
+      ! --> 696.999939m3/s
+      DATA inb(91)/3/
+      DATA (iirnf(jc,91),jc=1,jpcoef)/ 129, 130, 130, 17*0 /
+      DATA (ijrnf(jc,91),jc=1,jpcoef)/ 177, 176, 177, 17*0 /
+      DATA (zrnfm(jm,91),jm=1,jpmois)/12*697./
+      ! 92-Haast (N. Zeland) 43S50 169E02                   R5
+      ! Old=6 km3/year=190m3/s
+      ! --> 189.999985m3/s
+      DATA inb(92)/1/
+      DATA (iirnf(jc,92),jc=1,jpcoef)/ 194, 19*0 /
+      DATA (ijrnf(jc,92),jc=1,jpcoef)/ 153, 19*0 /
+      DATA (zrnfm(jm,92),jm=1,jpmois)/12*190./
+      ! 93-Fly (N. Guinea) 8S30 143E05                      R5
+      ! Old=77 km3/year=2440m3/s
+      ! --> 2440.m3/s
+      DATA inb(93)/1/
+      DATA (iirnf(jc,93),jc=1,jpcoef)/ 143, 19*0 /
+      DATA (ijrnf(jc,93),jc=1,jpcoef)/ 233, 19*0 /
+      DATA (zrnfm(jm,93),jm=1,jpmois)/12*2440./
+      ! 94-Purari (N. Guinea) 7S25 145E05                   R4
+      ! Old=77 km3/year=2440m3/s; UNESCO(77+83,p595)=2727m3/s
+      ! --> 2727.33325m3/s
+      DATA inb(94)/1/
+      DATA (iirnf(jc,94),jc=1,jpcoef)/ 146, 19*0 /
+      DATA (ijrnf(jc,94),jc=1,jpcoef)/ 234, 19*0 /
+      DATA (zrnfm(jm,94),jm=1,jpmois)/   &
+          1972.,    3067.,    2332.,    2981.,    2693.,    2876.,   &
+          2867.,    3477.,    2195.,    2967.,    2674.,    2627./
+      ! 95-Choshui ch''i (taiwan) 24N03 120E23              R2
+      ! Old=6 km3/year=190m3/s; UNESCO(65-68, p374)=120m3/s; ratio=1.58 
+      ! --> 0.m3/s
+      DATA inb(95)/0/
+      DATA (iirnf(jc,95),jc=1,jpcoef)/  20*0 /
+      DATA (ijrnf(jc,95),jc=1,jpcoef)/  20*0 /
+      DATA (zrnfm(jm,95),jm=1,jpmois)/   &
+           65.,      63.,      83.,     100.,     177.,     535.,   &
+          332.,     313.,     236.,     193.,     101.,      84./
+      ! 96-Kaoping (Taiwan)                                 R5  
+      ! Old=9 km3/year=285m3/s
+      ! --> 0.m3/s
+      DATA inb(96)/0/
+      DATA (iirnf(jc,96),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,96),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,96),jm=1,jpmois)/12*285./
+      ! 97-Tsengwen (Taiwan)                                R5
+      ! Old=2 km3/year=63m3/s
+      ! --> 0.m3/s
+      DATA inb(97)/0/
+      DATA (iirnf(jc,97),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,97),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,97),jm=1,jpmois)/12*63./
+      ! 98-Hualien (Taiwan)                                 R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(98)/0/
+      DATA (iirnf(jc,98),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,98),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,98),jm=1,jpmois)/12*127./
+      ! 99-Peinan (Taiwan) 22N46 121E10                     R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 127.000008m3/s
+      DATA inb(99)/1/
+      DATA (iirnf(jc,99),jc=1,jpcoef)/  98, 19*0 /
+      DATA (ijrnf(jc,99),jc=1,jpcoef)/ 287, 19*0 /
+      DATA (zrnfm(jm,99),jm=1,jpmois)/12*127./
+      ! 100-Hsiukuluan (Taiwan)                             R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(100)/0/
+      DATA (iirnf(jc,100),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,100),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,100),jm=1,jpmois)/12*127./
+
+      DATA inb(101)/0/
+      DATA inb(102)/0/
+
+      !  Total run-offs(VII)=6181.33301m3/s
+      !  Total run-offs(I+II+III+IV+V+VI+VII)= 567084. m3/s
+      !                                      = 1.588668056E-6 kg/m2/s
+      !                                      = 17883.5586 km3/Year
+      !                                      = 0.567083955 Sverdrup
+
+      DATA (inb(jr),jr=103,jpriv)/18*0/
+      
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flxrnf : runoff + orca05'
+         IF(lwp) WRITE(numout,*) '~~~~~~'
+         IF(lwp) WRITE(numout,*) '   nrunoff = ', nrunoff
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! 0. initialization and  indexes  modification for zoom version
+      ! --------------------------------------------------------------
+      
+      
+      ! conversion factor m3/s --> kg/m2/s *e1t*e2t
+
+      zconv = rauw
+
+      IF( kt == nit000 ) THEN 
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0                                                                                  
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0
+         upsadv (:,:) = 0.e0
+         zcoefr(:,:,:) = 0.e0
+
+         IF( nrunoff == 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' NO RUNOFF in this simulation '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      ! 1. initialization of the runoff array
+      ! -------------------------------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2) THEN
+
+         iman  = jpmois
+         
+         i15 = nday / 16
+         
+         imois = nmonth + i15 - 1
+         IF( imois == 0) imois = iman
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            ! Number of Day Between Data
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         END IF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+         
+         ! 1.1 Calendar computation
+         
+         ! nrnf1 number of the first array record used in the simulation
+         ! nrnf2 number of the last  array record
+         
+         nrnf1 = imois
+         nrnf2 = nrnf1 + 1
+         nrnf1 = MOD( nrnf1, iman )
+         IF( nrnf1 == 0 ) nrnf1 = iman
+         nrnf2 = MOD( nrnf2, iman )
+         IF( nrnf2 == 0 ) nrnf2 = iman
+         
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flxrnf routine'
+            IF(lwp) WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+            IF(lwp) WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+         ENDIF
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+         DO jr = 1, jpriv-1
+            inbp = inb(jr)
+            IF( inbp /= 0 ) THEN
+               DO jl = 1, inbp
+                  DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                     DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                        runoff(ji,jj) = runoff(ji,jj)   & 
+                           &          + ( (1.-zxy) * zrnfm(nrnf1,jr)   &
+                           &          +       zxy  * zrnfm(nrnf2,jr)  ) / FLOAT(inbp)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+
+         ! 2. conversion in mm/day
+         ! -----------------------
+         !     C a u t i o n : upward water flux, runoff is negative
+
+         runoff(:,:) = -zconv * runoff(:,:) / ( e1t(:,:) * e2t(:,:) )
+         
+
+         ! 3. advectve coefficient
+         ! -----------------------
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+         !  3 values are used: maximum = zrup1, between zrup2, small zrup3.
+         ! 
+         IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+            zrup1 = 0.5
+            zrup2 = 0.25
+            zrup3 = 0.125
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0) THEN
+                  DO jl = 1, inbp
+                     ! ji,jj
+                     DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                        DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = zrup1
+                           END DO
+                           zcoefr(ji,jj,4) = zrup2
+                           zcoefr(ji,jj,5) = zrup3
+                        END DO
+                     END DO
+                     ! --> zrup2 (originally = 0.5)
+                     ! ji,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj
+                     DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj
+                     DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! --> zrup3 (originally = 0.25)
+                     ! ji-1,jj+2
+                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-1,jj-2
+                     DO jj = mj0(ijrnf(jl,jr) - 2), mj1(ijrnf(jl,jr) - 2)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj-2
+                     DO jj = mj0(ijrnf(jl,jr) - 2), mj1(ijrnf(jl,jr) - 2)
+                        DO ji = mi0(iirnf(jl,jr)    ), mi1(iirnf(jl,jr)    )
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj+2
+                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2)
+                        DO ji = mi0(iirnf(jl,jr)    ), mi1(iirnf(jl,jr)    )
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj-2
+                     DO jj = mj0(ijrnf(jl,jr) - 2), mj1(ijrnf(jl,jr) - 2)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj+2
+                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-2
+                     DO jj = mj0(ijrnf(jl,jr) - 2), mj1(ijrnf(jl,jr) - 2)
+                        DO ji = mi0(iirnf(jl,jr) + 2), mi1(iirnf(jl,jr) + 2)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+2
+                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3  
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr) + 2), mi1(iirnf(jl,jr) + 2)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr) + 2), mi1(iirnf(jl,jr) + 2)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj
+                     DO jj = mj0(ijrnf(jl,jr)    ), mj1(ijrnf(jl,jr)    )
+                        DO ji = mi0(iirnf(jl,jr) + 2), mi1(iirnf(jl,jr) + 2)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj
+                     DO jj = mj0(ijrnf(jl,jr)    ), mj1(ijrnf(jl,jr)    )
+                        DO ji = mi0(iirnf(jl,jr) - 2), mi1(iirnf(jl,jr) - 2)
+                           DO jn = 1, 3        
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-2
+                     DO jj = mj0(ijrnf(jl,jr) - 2), mj1(ijrnf(jl,jr) - 2)
+                        DO ji = mi0(iirnf(jl,jr) - 2), mi1(iirnf(jl,jr) - 2)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+2
+                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2)
+                        DO ji = mi0(iirnf(jl,jr) - 2), mi1(iirnf(jl,jr) - 2)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr) - 2), mi1(iirnf(jl,jr) - 2)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr) - 2), mi1(iirnf(jl,jr) - 2)
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            upsrnfh(:,:) = zcoefr(:,:,1)
+            upsrnfz(:)   = 0.e0
+            upsrnfz(1)   = zrup1
+            upsrnfz(2)   = zrup1
+            upsrnfz(3)   = zrup1
+            upsrnfz(4)   = zrup2
+            upsrnfz(5)   = zrup3
+         ENDIF
+      ENDIF
+    
+#endif
+
+   END SUBROUTINE flx_rnf
Index: trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R2.h90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R2.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R2.h90	(revision 325)
@@ -0,0 +1,1317 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flxrnf_ORCA_R2.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  OLD ORCA R2 runoff specification
+   !!                      kept here for memory
+   !!                         ( 20/04/2000 )
+   !!----------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: kt
+      INTEGER, PARAMETER ::   &
+         jpmois =  12,        &  ! number of months
+         jpriv  = 120,        &  ! maximum number of river
+         jpcoef = 300            ! maximum of river mouth grid-points
+      INTEGER ::   &
+         ji, jj, jl, jm,      &  ! dummy loop indices
+         jn, jr, jc              !    "         "
+      INTEGER ::   &
+         i15, imois, iman,    &  ! temporary integers
+         inbp, idbd, idmeom,  &  !    "          "
+         iipt0, iipt1, ijpt0, &  !    "          "
+         ijpt1, ii, ij           !    "          "
+      INTEGER, DIMENSION(jpriv) ::   &
+         inb                     ! ???
+      INTEGER, DIMENSION(jpcoef,jpriv) ::   &
+         iirnf, ijrnf            ! ???
+
+      REAL(wp) ::   &
+         zconv, zxy,          &  ! temporary scalars
+         zrup1, zrup2, zrup3     !    "         "
+      REAL(wp), DIMENSION(jpmois,jpriv) ::   &
+         zrnfm                   ! ???
+      REAL(wp), DIMENSION(jpi, jpj, 5) ::   &
+         zcoefr                  ! ???
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      ! ====
+      ! DATA
+      ! ====
+
+      ! I NORTH AMERICA
+      ! ---------------
+
+      ! 1-Saint Lawrence (Canada) 49N30 67W00               R2
+      ! Old=447 km3/year=14165m3/s; CLIPPER=12430m3/s; ratio=1.14
+      ! --> 13975.249m3/s
+      DATA inb(1)/2/
+      DATA (iirnf(jc,1),jc=1,jpcoef)/ 110, 110, 298*0 /
+      DATA (ijrnf(jc,1),jc=1,jpcoef)/ 110, 111, 298*0 /
+      DATA (zrnfm(jm,1),jm=1,jpmois)/   &
+          11718.,  11971.,  12466.,  14980.,  19257.,  16913.,   &
+          14211.,  13119.,  13367.,  13644.,  13463.,  12594./
+      ! 2-Hudson River (USA) 41N00 77W00                    R1
+      ! Old=12 km3/year=380m3/s; UNESCO(64-83,p255)=408m3/s
+      ! --> 407.416687m3/s
+      DATA inb(2)/1/
+      DATA (iirnf(jc,2),jc=1,jpcoef)/ 106, 299*0 /
+      DATA (ijrnf(jc,2),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (zrnfm(jm,2),jm=1,jpmois)/   &
+          364.,    404.,    648.,    873.,    593.,    301.,   &
+          205.,    171.,    205.,    290.,    379.,    456./
+      ! 3-Missisipi and Atchafalaya (USA) 29N 90W           R1 
+      ! Old=580 km3/year=18380m3/s; CLIPPER=17599m3/s
+      ! --> 17599.334m3/s
+      DATA inb(3)/2/
+      DATA (iirnf(jc,3),jc=1,jpcoef)/  97, 98, 298*0 /
+      DATA (ijrnf(jc,3),jc=1,jpcoef)/  97, 97, 298*0 /
+      DATA (zrnfm(jm,3),jm=1,jpmois)/   &
+          19260.,  20813.,  23026.,  28160.,  26510.,  19650.,   &
+          14181.,  10676.,   9578.,  10167.,  11699.,  17472./
+      ! 4-Brazos (USA) 29N58 95W53                          R1
+      ! Old=7 km3/year=222m3/s; UNESCO(65-84, p298)=200m3/s
+      ! --> 199.666656m3/s
+      DATA inb(4)/1/
+      DATA (iirnf(jc,4),jc=1,jpcoef)/  95, 299*0 /
+      DATA (ijrnf(jc,4),jc=1,jpcoef)/  97, 299*0 /
+      DATA (zrnfm(jm,4),jm=1,jpmois)/   &
+          165.,    224.,    200.,    266.,    457.,    327.,   &
+          143.,     69.,    102.,    132.,    160.,    151./
+      ! 5-Colorado (Mexico) 31N54 114W57                    R5
+      ! Old=20 km3/year=634m3/s
+      ! --> 634.m3/s
+      DATA inb(5)/1/
+      DATA (iirnf(jc,5),jc=1,jpcoef)/  88, 299*0 /
+      DATA (ijrnf(jc,5),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,5),jm=1,jpmois)/12*634./ 
+      ! 6-Columbia (USA) 45N60 121W17                       R1
+      ! Old=251 km3/year=7954m3/s; UNESCO(65-84, p312)=5368m3/s
+      ! --> 5368.41602m3/s
+      DATA inb(6)/1/
+      DATA (iirnf(jc,6),jc=1,jpcoef)/  79, 299*0 /
+      DATA (ijrnf(jc,6),jc=1,jpcoef)/ 110, 299*0 /
+      DATA (zrnfm(jm,6),jm=1,jpmois)/   &
+          4752.,    5077.,    5633.,    6075.,    8422.,    9822.,   &
+          6350.,    4112.,    3273.,    3251.,    3548.,    4106./ 
+      ! 7-Fraser (USA)                                      R5
+      ! Old=112 km3/year=3550m3/s;not found in UNESCO
+      ! --> 3549.99976m3/s
+      DATA inb(7)/1/
+      DATA (iirnf(jc,7),jc=1,jpcoef)/  77, 299*0 /
+      DATA (ijrnf(jc,7),jc=1,jpcoef)/ 112, 299*0 /
+      DATA (zrnfm(jm,7),jm=1,jpmois)/12*3550./ 
+      ! 8-Yukon (USA) 63N00 165W00                          R3
+      ! Old=195 km3/year=6179m3/s; UNESCO(65-77+80-84, p321)=4245; ratio=1.46
+      ! --> 6017.24951m3/s
+      DATA inb(8)/1/
+      DATA (iirnf(jc,8),jc=1,jpcoef)/  58, 299*0 /
+      DATA (ijrnf(jc,8),jc=1,jpcoef)/ 122, 299*0 /
+      DATA (zrnfm(jm,8),jm=1,jpmois)/   &
+           1459.,    1213.,    1065.,    1100.,    9067.,   17675.,   &
+          10680.,   11271.,    8658.,    5453.,    2649.,    1917./ 
+     ! 9-Copper (USA) 61N47 144W45                          R2
+     ! Old=39 km3/year=1236m3/s; UNESCO(65-84, p317)=1052m3/s; ratio=1.18
+     ! --> 1236.25m3/s
+      DATA inb(9)/1/
+      DATA (iirnf(jc,9),jc=1,jpcoef)/  67, 299*0 /
+      DATA (ijrnf(jc,9),jc=1,jpcoef)/ 119, 299*0 /
+      DATA (zrnfm(jm,9),jm=1,jpmois)/   &
+           219.,    195.,    181.,    214.,    904.,   2532.,   &
+          4026.,   3627.,   1632.,    697.,    354.,    254./ 
+      ! 10-Susitna (USA)                                    R5
+      ! Old=40 km3/year=1268m3/s
+      ! --> 1268.m3/s
+      DATA inb(10)/1/
+      DATA (iirnf(jc,10),jc=1,jpcoef)/  65, 299*0 /
+      DATA (ijrnf(jc,10),jc=1,jpcoef)/ 118, 299*0 /
+      DATA (zrnfm(jm,10),jm=1,jpmois)/12*1268./ 
+      ! 11-McKenzie (Canada) 70N00 135W00                   R3
+      ! Old=306 km3/year=9697m3/s; UNESCO(67+72+7479+82-84, p168)=8343m3/s;
+      ! ratio=1.16
+      ! --> 9606.66797m3/s
+      DATA inb(11)/1/
+      DATA (iirnf(jc,11),jc=1,jpcoef)/  69, 299*0 /
+      DATA (ijrnf(jc,11),jc=1,jpcoef)/ 131, 299*0 /
+      DATA (zrnfm(jm,11),jm=1,jpmois)/   &
+           3644.,    3400.,    3258.,    3546.,   14188.,   21544.,   &
+          18954.,   15487.,   11284.,   10169.,    5901.,    3905./
+      ! 12-Kuksokwim (USA) 60N00 ~162W30                    R4
+      ! UNESCO(65-84, p318)=1112m3/s (61N87 158E10, Crooked Creek, inland)
+      ! --> 1111.99988m3/s
+      DATA inb(12)/1/
+      DATA (iirnf(jc,12),jc=1,jpcoef)/  60, 299*0 /
+      DATA (ijrnf(jc,12),jc=1,jpcoef)/ 118, 299*0 /
+      DATA (zrnfm(jm,12),jm=1,jpmois)/   &
+          335.,     308.,     295.,     407.,    2415.,    2027.,   &
+          1917.,   2049.,    1585.,    1072.,     545.,     389./     
+
+      DATA inb(13)/0/
+      DATA inb(14)/0/
+      DATA inb(15)/0/
+
+      ! Total run-offs(I)=60974.2539m3/s
+
+      ! II SOUTH AMERICA
+      ! -----------------
+      ! 16-Chira (Peru) 4s54 81w08                          R2
+      ! Old=5 km3/year=158m3/s; UNESCO (65-68, p357)=80.9; ratio=1.95
+      ! --> 158.000015m3/s
+      DATA inb(16)/1/
+      DATA (iirnf(jc,16),jc=1,jpcoef)/ 101, 299*0 /
+      DATA (ijrnf(jc,16),jc=1,jpcoef)/  66, 299*0 /
+      DATA (zrnfm(jm,16),jm=1,jpmois)/   &
+          70.,     105.,     564.,     582.,     230.,      94.,   &
+          87.,      47.,      35.,      32.,      29.,      21./
+      ! 17-Magdalena (Colombia) 11N06 74W51                 R2
+      ! Old=237 km3/year=7510m3/s; UNESCO(71-73+76-79, p348)=6973m3/s;
+      ! ratio=1.08
+      ! --> 7451.58301m3/s
+      DATA inb(17)/1/
+      DATA (iirnf(jc,17),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (ijrnf(jc,17),jc=1,jpcoef)/  86, 299*0 /
+      DATA (zrnfm(jm,17),jm=1,jpmois)/   &
+          6598.,    4441.,    4087.,    5445.,    7380.,    8067.,   &
+          8509.,    7428.,    7631.,    9296.,   10588.,    9949./
+      ! 18-Orinoco (Venezuela) 8N37 62W15!                  R1
+      ! Old=1100 km3/year=34857m3/s; UNESCO(73-75, p364)=28736m3/s;
+      ! HLA=26371m3/s
+      ! Data from HLA: 8.1N - 63.3W   1925/89
+      ! --> 26371.416
+      DATA inb(18)/1/
+      DATA (iirnf(jc,18),jc=1,jpcoef)/ 112, 299*0 /
+      DATA (ijrnf(jc,18),jc=1,jpcoef)/  86, 299*0 /
+      DATA (zrnfm(jm,18),jm=1,jpmois)/   &
+          10670.,    7513.,    6344.,    6887.,   13086.,   26699.,   &
+          43938.,   59957.,   57435.,   39951.,   27410.,   16567./ 
+      ! 19-Amazon (Brazil) 0S05 50W00                       R1
+      ! Old=6300 km3/year=199634m3/s; CLIPPER=166192m3/s~UNESCO;
+      ! HLA=184806m3/s
+      ! UNESCO data are at Obidos which is far inland and therefore does not
+      ! fully represent the actual discharge
+      ! Data from HLA: 1.5N - 55.3W   1970/96
+      ! --> 184845.484m3/s
+      DATA inb(19)/2/
+      DATA (iirnf(jc,19),jc=1,jpcoef)/ 117, 117, 298*0 /
+      DATA (ijrnf(jc,19),jc=1,jpcoef)/  75,  76, 298*0 /
+      DATA (zrnfm(jm,19),jm=1,jpmois)/   &
+          152233., 176415., 199941., 225565., 244016., 244861.,   &
+          230711., 203128., 164531., 128486., 118214., 130045. /
+      ! 20-Sao Francisco (Brazil) 10S30 36W24               R1
+      ! Old=97 km3/year=3074m3/s; UNESCO(77-79, p338)=2645m3/s
+      ! --> 2645.3335m3/s
+      DATA inb(20)/1/
+      DATA (iirnf(jc,20),jc=1,jpcoef)/ 123, 299*0 /
+      DATA (ijrnf(jc,20),jc=1,jpcoef)/  59, 299*0 /
+      DATA (zrnfm(jm,20),jm=1,jpmois)/   &
+          3244.,   4116.,   5139.,   4330.,   2323.,   1800.,   &
+          1587.,   1511.,   1593.,   1740.,   2190.,   2171. /
+      ! 21-Parana+Uruguay(Arg./Uru.) 34S12 58W18            R1 
+      ! Old=470 km3/year=14893m3/s; UNESCO(p323/324)=22263m3/s
+      ! --> 22203.168m3/s 
+      DATA inb(21)/2/
+      DATA (iirnf(jc,21),jc=1,jpcoef)/ 114, 114, 298*0 /
+      DATA (ijrnf(jc,21),jc=1,jpcoef)/  46,  47, 298*0 /
+      DATA (zrnfm(jm,21),jm=1,jpmois)/   &
+          24803.,   26836.,   24585.,   21358.,   20041.,   21689.,   &
+          22647.,   20403.,   19627.,   21400.,   21126.,   21923./
+      ! 22-Negro (Argentina)  41S02  62W47                  R2
+      ! Old=30 km3/year=951m3/s; UNESCO(65-79,p330)=765m3/s; ratio=1.24
+      ! --> 907.666687m3/s
+      DATA inb(22)/1/
+      DATA (iirnf(jc,22),jc=1,jpcoef)/ 110, 299*0 /
+      DATA (ijrnf(jc,22),jc=1,jpcoef)/  43, 299*0 /
+      DATA (zrnfm(jm,22),jm=1,jpmois)/   &
+          882.,     587.,     519.,     482.,     623.,     984.,   &
+          1120.,   1294.,    1092.,    1166.,    1105.,    1038./
+     ! 23- Tocantins :  ~48W00 ~0.5S                        R4
+     ! UNESCO(76-77+80-81, p335)=12167m3/s (station far inland!)
+     ! --> 12173.082m3/s
+      DATA inb(23)/1/
+      DATA (iirnf(jc,23),jc=1,jpcoef)/118, 299*0 /
+      DATA (ijrnf(jc,23),jc=1,jpcoef)/ 73, 299*0 /
+      DATA (zrnfm(jm,23),jm=1,jpmois)/   &
+          15507.,  24855.,  27854.,  24257.,  15860.,   7861.,   &
+          4440.,   3082.,   2728.,   3417.,   5511.,  10705. /
+
+      DATA inb(24)/0/
+      DATA inb(25)/0/
+
+      ! Total run-offs(II)=256755.75
+      ! Total run-offs(I+II)=317730
+
+      ! III EUROPE
+      ! ----------
+      ! 26-Rhone (France) 43N20 4E50                        R1 
+      ! Old=49 km3/year=1553m3/s; UNESCO(65-83, p512)=1229
+      ! --> 1217.16663m3/s
+      DATA inb(26)/1/
+      DATA (iirnf(jc,26),jc=1,jpcoef)/ 150, 299*0 /
+      DATA (ijrnf(jc,26),jc=1,jpcoef)/ 108, 299*0 /
+      DATA (zrnfm(jm,26),jm=1,jpmois)/   &
+          1385.,    1848.,    1568.,    1311.,    1420.,    1191.,   &
+           937.,     796.,     794.,     962.,    1161.,    1233./
+      ! 27-Po (Italy) 11N10 1W09                            R1 
+      ! Old=46 km3/year=1458m3/s; UNESCO(65-84, p527)=1550m3/s
+      ! --> 1550.08337m3/s
+      DATA inb(27)/1/
+      DATA (iirnf(jc,27),jc=1,jpcoef)/ 159, 299*0 /
+      DATA (ijrnf(jc,27),jc=1,jpcoef)/ 110, 299*0 /
+      DATA (zrnfm(jm,27),jm=1,jpmois)/   &
+          1304.,    1605.,    1856.,    1549.,    1958.,    1760.,   &
+          1040.,    1007.,    1615.,    1907.,    1772.,    1228./
+      ! 28-Danube (Roumania) 45N20 29E40                    R1 
+      ! Old=206 km3/year=6527m3/s; UNESCO(65-84, p544)=7011m3/s
+      ! --> 7011.8335m3/s
+      DATA inb(28)/1/
+      DATA (iirnf(jc,28),jc=1,jpcoef)/ 171, 299*0 /
+      DATA (ijrnf(jc,28),jc=1,jpcoef)/ 106, 299*0 /
+      DATA (zrnfm(jm,28),jm=1,jpmois)/   &
+          6625.,    7352.,    7986.,    9279.,    9482.,    8618.,   &
+          7586.,    6001.,    5210.,    4989.,    4921.,    6093./
+
+      DATA inb(29)/0/
+      DATA inb(30)/0/
+
+      ! Total run-offs(III)=9779.08301m3/s
+      ! Total run-offs(I+II+III)=327509.094m3/s
+
+      ! IV EURASIAN ARCTIC
+      ! ------------------
+      ! 31-Iana (Russia)                                    R1
+      ! Old=29 km3/year=919m3/s; UNESCO(65-72+74+76-84, p463)=936m3/s
+      ! --> 0m3/s
+      DATA inb(31)/0/
+      DATA (iirnf(jc,31),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,31),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,31),jm=1,jpmois)/   &
+             2.,       1.,       0.,       0.,     917.,    3514.,   &
+          2968.,    2329.,    1322.,     178.,      36.,       8./ 
+      ! 32-Ob (Russia) 66N45 69E30                          R1 
+      ! Old=385 km3/year=12200m3/s; UNESCO(65-84, p478)=12862m3/s
+      ! --> 12861.5m3/s
+      DATA inb(32)/2/
+      DATA (iirnf(jc,32),jc=1,jpcoef)/ 153, 153, 298*0 /
+      DATA (ijrnf(jc,32),jc=1,jpcoef)/ 146, 147, 298*0 /
+      DATA (zrnfm(jm,32),jm=1,jpmois)/   &
+           4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   &
+          30773.,   22785.,   14701.,    9705.,    6078.,    5879./
+      ! 33-Yenesei (Russia) 71N50 82E40                     R1 
+      ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s
+      ! --> 17461.666m3/s
+      DATA inb(33)/1/
+      DATA (iirnf(jc,33),jc=1,jpcoef)/  32, 299*0 /
+      DATA (ijrnf(jc,33),jc=1,jpcoef)/ 147, 299*0 /
+      DATA (zrnfm(jm,33),jm=1,jpmois)/   &
+           6659.,    7007.,    6895.,    7089.,   24183.,   74965.,   &
+          25325.,   15940.,   16050.,   12678.,    6741.,    6008./
+     ! 34-Severnaya Dvina(Russia)64N32 40E30                R5 
+     ! Old=106 km3/year=3359m3/s; not in UNESCO data base
+     ! --> 3359.00024m3/s
+      DATA inb(34)/1/
+      DATA (iirnf(jc,34),jc=1,jpcoef)/ 153, 299*0 /
+      DATA (ijrnf(jc,34),jc=1,jpcoef)/ 133, 299*0 /
+      DATA (zrnfm(jm,34),jm=1,jpmois)/12*3359./
+      ! 35-Lena (Russia) 72N25 126E40                       R1 
+      ! --> 16192.333m3/s
+      DATA inb(35)/1/
+      DATA (iirnf(jc,35),jc=1,jpcoef)/  36, 299*0 /
+      DATA (ijrnf(jc,35),jc=1,jpcoef)/ 137, 299*0 /
+      DATA (zrnfm(jm,35),jm=1,jpmois)/   &
+           2663.,    2095.,    1629.,    1324.,    7203.,   64230.,   &
+          40810.,   28310.,   25995.,   13299.,    3673.,    3077./
+      ! 36-Kolyma (Russia) 69N30 161E00                     R1
+      ! Old=71 km3/year=2250m3/s; UNESCO(65-84)=2138m3/s
+      ! --> 2138.66675m3/s
+      DATA inb(36)/1/
+      DATA (iirnf(jc,36),jc=1,jpcoef)/  46, 299*0 /
+      DATA (ijrnf(jc,36),jc=1,jpcoef)/ 128, 299*0 /
+      DATA (zrnfm(jm,36),jm=1,jpmois)/   &
+           131.,      92.,      76.,      65.,    2576.,    9143.,   &
+          4670.,    3727.,    3226.,    1119.,     630.,     209./
+     ! 37-Indigirka (russia) 70N48 148E54                   R1 
+     ! Old=55 km3/year=1743m3/s; UNESCO(65-68+70+72-84)=1622.
+     ! --> 1622.00012m3/s
+      DATA inb(37)/1/
+      DATA (iirnf(jc,37),jc=1,jpcoef)/  42, 299*0 /
+      DATA (ijrnf(jc,37),jc=1,jpcoef)/ 131, 299*0 /
+      DATA (zrnfm(jm,37),jm=1,jpmois)/   &
+            32.,      17.,      11.,       7.,     354.,    5629.,   &
+          5210.,    4617.,    2823.,     559.,     142.,      63./
+
+      DATA inb(38)/0/
+      DATA inb(39)/0/
+      DATA inb(40)/0/
+
+      ! Total run-offs(IV)=40773.6641m3/s
+      ! Total run-offs(I+II+III+IV)=368282.75m3/s
+
+      ! V ASIA
+      ! ------
+      ! 41-Amur (Russia) 52N56 141E10                       R2
+      ! Old=325 km3/year=10299m3/s; UNESCO(65-84, p451)=8792m3/s; ratio=1.17
+      ! --> 10299.332m3/s
+      DATA inb(41)/1/
+      DATA (iirnf(jc,41),jc=1,jpcoef)/  33, 299*0 /
+      DATA (ijrnf(jc,41),jc=1,jpcoef)/ 116, 299*0 /
+      DATA (zrnfm(jm,41),jm=1,jpmois)/   &
+           2108.,    1543.,    1252.,    4088.,   15464.,   17336.,   &
+          16100.,   20801.,   21548.,   15658.,    5188.,    2506./
+      ! 42-Liaohe (China) 40N40 122E09                      R5
+      ! Old=6 km3/year=190m3/s; not found in UNESCO data base
+      ! --> 189.999985m3/s
+      DATA inb(42)/1/
+      DATA (iirnf(jc,42),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,42),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (zrnfm(jm,42),jm=1,jpmois)/12*190./
+      ! 43-Daling (China) 40N56 121E43                      R5
+      ! Old=1 km3/year=32m3/s; not found in UNESCO data base
+      ! --> 31.9999962m3/s
+      DATA inb(43)/1/
+      DATA (iirnf(jc,43),jc=1,jpcoef)/  24, 299*0 /
+      DATA (ijrnf(jc,43),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (zrnfm(jm,43),jm=1,jpmois)/12*32./
+      ! 44-Haiho (China) 6N17   1E23
+      ! Old=2 km3/year=64m3/s; not found in UNESCO data base
+      ! --> 63.9999924m3/s
+      DATA inb(44)/1/
+      DATA (iirnf(jc,44),jc=1,jpcoef)/  28, 299*0 /
+      DATA (ijrnf(jc,44),jc=1,jpcoef)/ 106, 299*0 /
+      DATA (zrnfm(jm,44),jm=1,jpmois)/12*64./
+      ! 45-Yellow/Huangho (China) 37N32 118E19              R2 
+      ! Old=49 km3/year=1553m3/s; UNESCO(p371)=1210m3/s; ratio=1.28
+      ! --> 1552.5m3/s
+      DATA inb(45)/1/
+      DATA (iirnf(jc,45),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,45),jc=1,jpcoef)/ 103, 299*0 /
+      DATA (zrnfm(jm,45),jm=1,jpmois)/   &
+           697.,     674.,    1282.,    1206.,    1109.,     778.,   &
+          1964.,    3270.,    3668.,    2133.,     978.,     871./
+      ! 46-Yangtze (China) 31N48 121E10=Changjiang          R2
+      ! Old=900 km3/year=28520m3/s; UNESCO(p372)=25032m3/s; ratio=1.14
+      ! --> 28519.584m3/s
+      DATA inb(46)/1/
+      DATA (iirnf(jc,46),jc=1,jpcoef)/  23, 299*0 /
+      DATA (ijrnf(jc,46),jc=1,jpcoef)/  98, 299*0 /
+      DATA (zrnfm(jm,46),jm=1,jpmois)/   &
+          10994.,   10548.,   13254.,   24097.,   36972.,   47197.,   &
+          53891.,   42070.,   37627.,   30762.,   22046.,   12777./
+      ! 47-Pearl/Zhujiang (China) 23N36 106E34=Xijiang      R2 
+      ! Old=302 km3/year=9570m3/s; UNESCO(76,82, p373)=6987m3/s; ratio=1.37
+      ! --> 9570.75m3/s
+      DATA inb(47)/1/
+      DATA (iirnf(jc,47),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,47),jc=1,jpcoef)/  95, 299*0 /
+      DATA (zrnfm(jm,47),jm=1,jpmois)/   &
+           2357.,    2415.,    2634.,    6446.,   14246.,   18395.,   &
+          19213.,   17558.,   12312.,    7255.,    5864.,    6154./
+      ! 48-Red/Hungho (Vietnam) 20N17 106E34                R5 
+      ! Old=123 km3/year=3897m3/s; not in UNESCO data base
+      ! --> 3897.m3/s
+      DATA inb(48)/1/
+      DATA (iirnf(jc,48),jc=1,jpcoef)/  16, 299*0 /
+      DATA (ijrnf(jc,48),jc=1,jpcoef)/  91, 299*0 /
+      DATA (zrnfm(jm,48),jm=1,jpmois)/12*3897./
+      ! 49-Mekong (Vietnam) 10N33 105E24                    R5
+      ! Old=470 km3/year=14893m3/s; not in UNESCO data base
+      ! --> 14893.0029m3/s
+      DATA inb(49)/2/
+      DATA (iirnf(jc,49),jc=1,jpcoef)/  16,  16, 298*0 /
+      DATA (ijrnf(jc,49),jc=1,jpcoef)/  86,  87, 298*0 /
+      DATA (zrnfm(jm,49),jm=1,jpmois)/12*14893./
+      ! 50-Irrawady (Burma) 15N50  95E06                    R5
+      ! Old=428 km3/year=13563m3/s; not in UNESCO data base
+      ! --> 13563.m3/s
+      DATA inb(50)/1/
+      DATA (iirnf(jc,50),jc=1,jpcoef)/  10, 299*0 /
+      DATA (ijrnf(jc,50),jc=1,jpcoef)/  90, 299*0 /
+      DATA (zrnfm(jm,50),jm=1,jpmois)/12*13563./
+      ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00          R1
+      ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s
+      ! --> 32147.498m3/s
+      DATA inb(51)/2/
+      DATA (iirnf(jc,51),jc=1,jpcoef)/   7,  8, 298*0 /
+      DATA (ijrnf(jc,51),jc=1,jpcoef)/  93, 93, 298*0 /
+      DATA (zrnfm(jm,51),jm=1,jpmois)/   &
+           6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   &
+          64688.,   80338.,   84802.,   43387.,   17888.,   10322./
+      ! 52-Mehandi (India)                                  R5
+      ! Old=67 km3/year=2123m3/s; not in UNESCO data base
+      ! --> 0m3/s
+      DATA inb(52)/0/
+      DATA (iirnf(jc,52),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,52),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,52),jm=1,jpmois)/12*2123./
+      ! 53-Damodar (India)                                  R2
+      ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85
+      ! --> 432.916656m3/s
+      DATA inb(53)/1/
+      DATA (iirnf(jc,53),jc=1,jpcoef)/   6, 299*0 /
+      DATA (ijrnf(jc,53),jc=1,jpcoef)/  93, 299*0 /
+      DATA (zrnfm(jm,53),jm=1,jpmois)/   &
+           51.,      37.,      42.,      49.,      85.,     296.,   &
+          896.,    1390.,    1591.,     542.,     172.,      44./   
+      ! 54-Godavari (India) 17N00  81E45                    R2
+      ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39
+      ! --> 3670.5m3/s
+      DATA inb(54)/1/
+      DATA (iirnf(jc,54),jc=1,jpcoef)/   3, 299*0 /
+      DATA (ijrnf(jc,54),jc=1,jpcoef)/  90, 299*0 /
+      DATA (zrnfm(jm,54),jm=1,jpmois)/   &
+           988.,     737.,     280.,     219.,     196.,    1691.,   &
+          8063.,   14571.,   11428.,    3953.,    1221.,     699./   
+     ! 55-Indus (Pakistan) 24N20  67E47                     R2
+     ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15
+     ! --> 7562.m3/s
+      DATA inb(55)/2/
+      DATA (iirnf(jc,55),jc=1,jpcoef)/ 176, 176, 298*0 /
+      DATA (ijrnf(jc,55),jc=1,jpcoef)/  93,  94, 298*0 /
+      DATA (zrnfm(jm,55),jm=1,jpmois)/   &
+            988.,     737.,    1904.,    1968.,    3625.,    6143.,   &
+          15969.,    36656.,  17173.,    3215.,    1251.,    1115./   
+      ! 56-Tigris and Euphrates (Iraq) 31N00  47E25         R1
+      ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s
+      ! --> 2248.8335m3/s
+      DATA inb(56)/1/
+      DATA (iirnf(jc,56),jc=1,jpcoef)/ 172, 299*0 /
+      DATA (ijrnf(jc,56),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,56),jm=1,jpmois)/   &
+          1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   &
+          1362.,     900.,     786.,     993.,    1184.,    1742./   
+
+      DATA inb(57)/0/
+      DATA inb(58)/0/
+      DATA inb(59)/0/
+      DATA inb(60)/0/
+
+      ! Total run-offs (V)=128642.922m3/s
+      ! Total run-offs (I+II+III+IV+V)=496925.688m3/s
+      
+      ! VI AFRICA
+      ! ----------
+      ! 61-Nile (Egypt) 30N10  31E06                        R1
+      ! Old=30 km3/year=951m3/s; UNESCO(73-84)=1251m3/s
+      ! --> 1251.33337m3/s
+      DATA inb(61)/1/
+      DATA (iirnf(jc,61),jc=1,jpcoef)/ 176, 299*0 /
+      DATA (ijrnf(jc,61),jc=1,jpcoef)/  97, 299*0 /
+      DATA (zrnfm(jm,61),jm=1,jpmois)/   &
+          1239.,    1035.,    1126.,    1110.,    1170.,    1542.,   &
+          1742.,    1559.,    1191.,    1103.,    1075.,    1124./   
+      ! 62-Niger (Nigeria) 5N33   6E33                      R1
+      ! Old=192 km3/year=6084m3/s; HLA=5545m3/s;
+      ! Data from HLA: 4.5N -  6  E   1950/87
+      ! --> 5545.08301m3/s
+      DATA inb(62)/1/
+      DATA (iirnf(jc,62),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,62),jc=1,jpcoef)/  81, 299*0 /
+      DATA (zrnfm(jm,62),jm=1,jpmois)/   &
+          2029.,    1804.,    1573.,    1418.,    1494.,    2561.,   &
+          5272.,    9629.,   14951.,   16227.,    6842.,    2741./   
+      ! 63-Zaire/Congo (Congo) 6S04  12E24                  R1      
+      ! Old=1250 km3/year=39610m3/s; UNESCO(65-83, p149)=41941m3/s; HLA
+      ! =39720m3/s
+      ! Data from HLA: 6S - 12  E   1902/96
+      ! --> 39719.5m3/s
+      DATA inb(63)/2/
+      DATA (iirnf(jc,63),jc=1,jpcoef)/ 148, 148, 298*0 /
+      DATA (ijrnf(jc,63),jc=1,jpcoef)/  63,  64, 298*0 /
+      DATA (zrnfm(jm,63),jm=1,jpmois)/   &
+          47200.,   37692.,   34374.,   36603.,   37862.,   35588.,   &
+          30966.,   30774.,   35981.,   42825.,   51455.,   55314./  
+      ! 64-Orange (Sth Africa) 28S41 16E28                  R5
+      ! Old=11 km3/year=349m3/s
+      ! --> 349.000031m3/s
+      DATA inb(64)/1/
+      DATA (iirnf(jc,64),jc=1,jpcoef)/ 150, 299*0 /
+      DATA (ijrnf(jc,64),jc=1,jpcoef)/  51, 299*0 /
+      DATA (zrnfm(jm,64),jm=1,jpmois)/12*349./
+      ! 65-Zambesi (Mozambique) 18S55 36E04                 R5
+      ! Old=223 km3/year=7066m3/s
+      ! --> 7066.00049m3/s
+      DATA inb(65)/1/
+      DATA (iirnf(jc,65),jc=1,jpcoef)/ 160, 299*0 /
+      DATA (ijrnf(jc,65),jc=1,jpcoef)/  56, 299*0 /
+      DATA (zrnfm(jm,65),jm=1,jpmois)/12*7066./
+      ! 66-Limpopo (mozambique) 25S15 33E30                 R5
+      ! Old=5 km3/year=158m3/s
+      ! --> 158.m3/s
+      DATA inb(66)/1/
+      DATA (iirnf(jc,66),jc=1,jpcoef)/ 159, 299*0 /
+      DATA (ijrnf(jc,66),jc=1,jpcoef)/  52, 299*0 /
+      DATA (zrnfm(jm,66),jm=1,jpmois)/12*158./
+      ! 67-Rufiji (tanzania) 8S00 39E20                     R5
+      ! Old=9 km3/year=285m3/s
+      ! --> 285.m3/s
+      DATA inb(67)/1/
+      DATA (iirnf(jc,67),jc=1,jpcoef)/ 162, 299*0 /
+      DATA (ijrnf(jc,67),jc=1,jpcoef)/  62, 299*0 /
+      DATA (zrnfm(jm,67),jm=1,jpmois)/12*285./
+      ! Other rivers from the Gulf of Guinea
+      ! 68-Kouilou (Congo)  4.5S-11.5E (UNESCO=p51)         R1
+      ! Data from HLA:  4S - 11  E   1953/86 = 919m3/s
+      ! --> 924.25m3/s
+      DATA inb(68)/1/
+      DATA (iirnf(jc,68),jc=1,jpcoef)/ 147, 299*0 /
+      DATA (ijrnf(jc,68),jc=1,jpcoef)/  67, 299*0 /
+      DATA (zrnfm(jm,68),jm=1,jpmois)/   &
+          1115.,    1166.,    1285.,    1462.,    1454.,     725.,   &
+           480.,     378.,     327.,     400.,    1018.,    1281./
+      ! 69-Nyanga (Gabon)  3S-10E (UNESCO=p66)              R1
+      ! Data from HLA: 2.8N - 10  E   1952/82 = 264m3/s
+      ! --> 264.166687m3/s
+      DATA inb(69)/1/
+      DATA (iirnf(jc,69),jc=1,jpcoef)/ 147, 299*0 /
+      DATA (ijrnf(jc,69),jc=1,jpcoef)/  68, 299*0 /
+      DATA (zrnfm(jm,69),jm=1,jpmois)/   &
+          126.,      99.,     143.,     253.,     316.,     300.,   &
+          156.,      93.,     231.,     557.,     592.,     304./
+      ! 70-Ogoue (Gabon) 1S-9E (UNESCO, p69)                R1
+      ! Data from HLA: .75S -  9  E   1930/90 = 4512m3/s
+      ! --> 4511.83301m3/s
+      DATA inb(70)/1/
+      DATA (iirnf(jc,70),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,70),jc=1,jpcoef)/  72, 299*0 /
+      DATA (zrnfm(jm,70),jm=1,jpmois)/   &
+          4514.,    3988.,    4622.,    5403.,    5790.,    4145.,   &
+          2616.,    1961.,    2119.,    4304.,    7870.,    6810./
+      ! 71-Sanaga (Cameroun) 3.5N-9.5E (UNESCO, p31)        R1
+      ! Data from HLA: 3.9N -  9.6E   1944/80 = 1983m3/s
+      ! --> 1982.58337m3/s
+      DATA inb(71)/1/
+      DATA (iirnf(jc,71),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,71),jc=1,jpcoef)/  81, 299*0 /
+      DATA (zrnfm(jm,71),jm=1,jpmois)/   &
+           813.,     578.,     517.,     633.,     909.,    1278.,   &
+          1928.,    2653.,    4361.,    5470.,    3307.,    1344./
+      ! 72-Nyong (Cameroun) 3.1N-9.5E (UNESCO, p36)         R1
+      ! Data from HLA: 3.5N -  9.8E   1951/84 = 432m3/s
+      ! --> 431.166656m3/s      
+      DATA inb(72)/1/
+      DATA (iirnf(jc,72),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,72),jc=1,jpcoef)/  80, 299*0 /
+      DATA (zrnfm(jm,72),jm=1,jpmois)/   &
+          232.,     128.,     150.,     266.,     402.,     459.,   &
+          353.,     306.,     604.,     930.,     878.,     466./
+      ! 73-Ntem (Cameroun) 2.5N-9.5E (UNESCO, p36)          R1
+      ! Data from HLA: 3N -  9.8E   1951/87 = 330m3/s      
+      ! --> 329.75m3/s
+      DATA inb(73)/1/
+      DATA (iirnf(jc,73),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,73),jc=1,jpcoef)/  79, 299*0 /
+      DATA (zrnfm(jm,73),jm=1,jpmois)/   &
+          452.,     455.,     492.,     466.,     482.,     251.,   &
+          151.,     108.,      87.,     133.,     395.,     485./
+      ! 74-Wouri (Cameroun) 4N-9.5E (UNESCO, p34)           R1
+      ! Data from HLA: 4N -  9.5E   1951/84  = 307m3/s
+      ! --> 306.583374m3/s
+      DATA inb(74)/1/
+      DATA (iirnf(jc,74),jc=1,jpcoef)/ 145, 299*0 /
+      DATA (ijrnf(jc,74),jc=1,jpcoef)/  81, 299*0 /
+      DATA (zrnfm(jm,74),jm=1,jpmois)/   &
+           88.,      63.,      68.,      95.,     139.,     222.,   &
+          395.,     633.,     825.,     675.,     328.,     148./
+      ! 75-Oueme (Benin) 6.5N-2.5E (UNESCO, p27)            R1
+      ! Data from HLA:  6.2N -  2.5E   1951/84 =113m3/s
+      ! --> 112.666664m3/s
+      DATA inb(75)/1/
+      DATA (iirnf(jc,75),jc=1,jpcoef)/ 144, 299*0 /
+      DATA (ijrnf(jc,75),jc=1,jpcoef)/  83, 299*0 /
+      DATA (zrnfm(jm,75),jm=1,jpmois)/   &
+           0.,       0.,       0.,       0.,       1.,      18.,   &
+          96.,     324.,     531.,     319.,      58.,       5./
+      ! 76-Mono(Tepetou,Benin/Togo) 6.25N-1.8E (U, p27)     R1
+      ! Data from HLA: 6.2N -  1  E   1951/85  = 96m3/s       
+      ! --> 96.4999924m3/s
+      DATA inb(76)/1/
+      DATA (iirnf(jc,76),jc=1,jpcoef)/ 143, 299*0 /
+      DATA (ijrnf(jc,76),jc=1,jpcoef)/  83, 299*0 /
+      DATA (zrnfm(jm,76),jm=1,jpmois)/   &
+            2.,       1.,       1.,       4.,       8.,      44.,   &
+          168.,     274.,     386.,     215.,      47.,       8./
+      ! 77-Comoe (Ivory Coast) 5N-4W (UNESCO, p56)          R1
+      ! Data from HLA: 5.1N -  4  W   1955/86 = 194m3/s       
+      ! --> 194.25m3/s
+      DATA inb(77)/1/
+      DATA (iirnf(jc,77),jc=1,jpcoef)/ 140, 299*0 /
+      DATA (ijrnf(jc,77),jc=1,jpcoef)/  82, 299*0 /
+      DATA (zrnfm(jm,77),jm=1,jpmois)/   &
+           14.,       7.,       9.,      17.,      29.,      90.,   &
+          145.,     349.,     740.,     688.,     198.,      45./
+      ! 78-Sassandra (Ivory Coast) 5N-6W (UNESCO, p58)      R1
+      ! Data from HLA: 5N -  6  W   1953/86 = 449m3/s
+      ! --> 449.333344m3/s
+      DATA inb(78)/1/
+      DATA (iirnf(jc,78),jc=1,jpcoef)/ 139, 299*0 /
+      DATA (ijrnf(jc,78),jc=1,jpcoef)/  82, 299*0 /
+      DATA (zrnfm(jm,78),jm=1,jpmois)/   &
+          144.,     116.,     119.,     143.,     156.,     334.,   &
+          419.,     692.,    1277.,    1190.,     553.,     249./
+
+      DATA inb(79)/0/
+      DATA inb(80)/0/
+      DATA inb(82)/0/
+      DATA inb(83)/0/
+      DATA inb(84)/0/
+      DATA inb(85)/0/
+      DATA inb(86)/0/
+      DATA inb(87)/0/
+      DATA inb(88)/0/
+      DATA inb(89)/0/
+      DATA inb(90)/0/
+
+      ! Total run-offs (VI)=63977.m3/s
+      ! Total run-offs (I+II+III+IV+V+VI)=560902.688m3/s
+      
+      ! VII OCEANIA
+      ! ------------
+      ! 91-Murray (Austrlia) 35S34 138E54                   R5
+      ! Old=22 km3/year=697m3/s
+      ! --> 696.999939m3/s
+      DATA inb(91)/1/
+      DATA (iirnf(jc,91),jc=1,jpcoef)/  30, 299*0 /
+      DATA (ijrnf(jc,91),jc=1,jpcoef)/  47, 299*0 /
+      DATA (zrnfm(jm,91),jm=1,jpmois)/12*697./
+      ! 92-Haast (N. Zeland) 43S50 169E02                   R5
+      ! Old=6 km3/year=190m3/s
+      ! --> 189.999985m3/s
+      DATA inb(92)/1/
+      DATA (iirnf(jc,92),jc=1,jpcoef)/  48, 299*0 /
+      DATA (ijrnf(jc,92),jc=1,jpcoef)/  41, 299*0 /
+      DATA (zrnfm(jm,92),jm=1,jpmois)/12*190./
+      ! 93-Fly (N. Guinea) 8S30 143E05                      R5
+      ! Old=77 km3/year=2440m3/s
+      ! --> 2440.m3/s
+      DATA inb(93)/1/
+      DATA (iirnf(jc,93),jc=1,jpcoef)/  34, 299*0 /
+      DATA (ijrnf(jc,93),jc=1,jpcoef)/  62, 299*0 /
+      DATA (zrnfm(jm,93),jm=1,jpmois)/12*2440./
+      ! 94-Purari (N. Guinea) 7S25 145E05                   R4
+      ! Old=77 km3/year=2440m3/s; UNESCO(77+83,p595)=2727m3/s
+      ! --> 2727.33325m3/s
+      DATA inb(94)/1/
+      DATA (iirnf(jc,94),jc=1,jpcoef)/  36, 299*0 /
+      DATA (ijrnf(jc,94),jc=1,jpcoef)/  64, 299*0 /
+      DATA (zrnfm(jm,94),jm=1,jpmois)/   &
+          1972.,    3067.,    2332.,    2981.,    2693.,    2876.,   &
+          2867.,    3477.,    2195.,    2967.,    2674.,    2627./
+      ! 95-Choshui ch''i (taiwan) 24N03 120E23              R2
+      ! Old=6 km3/year=190m3/s; UNESCO(65-68, p374)=120m3/s; ratio=1.58 
+      ! --> 0.m3/s
+      DATA inb(95)/0/
+      DATA (iirnf(jc,95),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,95),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,95),jm=1,jpmois)/   &
+           65.,      63.,      83.,     100.,     177.,     535.,   &
+          332.,     313.,     236.,     193.,     101.,      84./
+      ! 96-Kaoping (Taiwan)                                 R5  
+      ! Old=9 km3/year=285m3/s
+      ! --> 0.m3/s
+      DATA inb(96)/0/
+      DATA (iirnf(jc,96),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,96),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,96),jm=1,jpmois)/12*285./
+      ! 97-Tsengwen (Taiwan)                                R5
+      ! Old=2 km3/year=63m3/s
+      ! --> 0.m3/s
+      DATA inb(97)/0/
+      DATA (iirnf(jc,97),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,97),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,97),jm=1,jpmois)/12*63./
+      ! 98-Hualien (Taiwan)                                 R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(98)/0/
+      DATA (iirnf(jc,98),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,98),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,98),jm=1,jpmois)/12*127./
+      ! 99-Peinan (Taiwan) 22N46 121E10                     R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 127.000008m3/s
+      DATA inb(99)/1/
+      DATA (iirnf(jc,99),jc=1,jpcoef)/  23, 299*0 /
+      DATA (ijrnf(jc,99),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,99),jm=1,jpmois)/12*127./
+      ! 100-Hsiukuluan (Taiwan)                             R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(100)/0/
+      DATA (iirnf(jc,100),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,100),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,100),jm=1,jpmois)/12*127./
+
+      DATA inb(101)/0/
+      DATA inb(102)/0/
+
+      !  Total run-offs(VII)=6181.33301m3/s
+      !  Total run-offs(I+II+III+IV+V+VI+VII)= 567084. m3/s
+      !                                      = 1.588668056E-6 kg/m2/s
+      !                                      = 17883.5586 km3/Year
+      !                                      = 0.567083955 Sverdrup
+
+      ! VIII ANTARCTICA
+      ! ---------------
+      ! 103 -Antarcti! ice discharge (2 613 Gt/year) (jacobs et al 1992)
+      ! Data from Jacobs et al 92: =2613 km3/year=82857.686454 m3/s
+      ! --> 82858 m3/s
+      DATA inb(103)/295/
+      DATA (iirnf(jc,103),jc=1,jpcoef)/   &
+            1,    2,    3,    3,    4,    4,    5,    6,    7,    8,   &
+            9,    9,   10,   11,   12,   13,   14,   14,   15,   16,   &
+           17,   18,   19,   20,   21,   22,   23,   24,   25,   26,   &
+           27,   28,   29,   30,   31,   32,   32,   33,   34,   35,   &
+           35,   36,   36,   37,   38,   39,   40,   40,   41,   42,   &
+           42,   43,   43,   44,   44,   44,   44,   44,   44,   44,   &
+           45,   45,   45,   45,   46,   46,   46,   46,   46,   47,   &
+           47,   47,   47,   47,   48,   48,   48,   48,   48,   49,   &
+           50,   51,   51,   52,   53,   54,   55,   56,   57,   58,   &
+           59,   60,   61,   62,   62,   63,   63,   64,   65,   66,   &
+           66,   67,   67,   68,   69,   69,   70,   71,   71,   72,   &
+           73,   73,   74,   75,   76,   76,   77,   78,   78,   79,   &
+           80,   81,   82,   83,   83,   84,   85,   86,   87,   88,   &
+           88,   89,   89,   90,   91,   92,   93,   94,   95,   96,   &
+           97,   98,   99,  100,  101,  102,  102,  103,  104,  104,   &
+          104,  104,  104,  105,  105,  106,  106,  107,  107,  107,   &
+          108,  108,  109,  109,  110,  110,  111,  111,  112,  112,   &
+          112,  112,  112,  112,  112,  112,  112,  112,  112,  112,   &
+          112,  112,  112,  112,  112,  113,  113,  113,  113,  113,   &
+          114,  114,  114,  114,  115,  115,  115,  115,  115,  116,   &
+          116,  117,  117,  118,  118,  119,  119,  120,  121,  122,   &
+          123,  124,  124,  125,  125,  126,  126,  127,  128,  128,   &
+          129,  130,  130,  131,  132,  132,  133,  133,  133,  133,   &
+          133,  134,  135,  135,  136,  136,  136,  137,  137,  138,   &
+          139,  140,  141,  142,  142,  143,  144,  145,  146,  147,   &
+          148,  149,  150,  151,  152,  153,  154,  155,  156,  156,   &
+          157,  158,  159,  160,  161,  161,  162,  163,  163,  164,   &
+          165,  165,  166,  166,  167,  168,  169,  170,  171,  171,   &
+          172,  173,  173,  174,  175,  176,  177,  177,  178,  178,   &
+          179,  180,  180,  181,  181,    0,    0,    0,    0,    0    &
+                                      /
+      DATA (ijrnf(jc,103),jc=1,jpcoef)/   &
+           19,   20,   20,   21,   21,   22,   22,   22,   22,   22,   &
+           22,   23,   23,   23,   23,   23,   22,   23,   22,   22,   &
+           22,   22,   22,   22,   22,   22,   22,   22,   22,   22,   &
+           22,   22,   22,   22,   22,   21,   22,   21,   21,   20,   &
+           21,   19,   20,   19,   19,   19,   18,   19,   18,   17,   &
+           18,   16,   17,    3,    4,    5,    6,    7,    8,   16,   &
+            3,    8,    9,   16,    3,    9,   10,   15,   16,    3,   &
+           10,   11,   14,   15,    3,   11,   12,   13,   14,    3,   &
+            3,    2,    3,    2,    2,    2,    2,    2,    2,    2,   &
+            2,    2,    2,    2,    3,    3,    4,    4,    4,    4,   &
+            5,    5,    6,    6,    6,    7,    7,    7,    8,    8,   &
+            8,    9,    9,    9,    9,   10,   10,   10,   11,   11,   &
+           11,   11,   11,   10,   11,   10,   10,   10,   10,   10,   &
+           11,   11,   12,   12,   12,   12,   12,   12,   12,   12,   &
+           12,   12,   12,   12,   12,   12,   13,   13,   13,   14,   &
+           15,   16,   17,   17,   18,   18,   19,   19,   20,   21,   &
+           21,   22,   22,   23,   23,   24,   24,   25,    8,    9,   &
+           10,   11,   12,   13,   14,   15,   16,   17,   18,   19,   &
+           20,   21,   22,   25,   26,    7,    8,   22,   23,   26,   &
+            7,   23,   24,   26,    6,    7,   24,   25,   26,    5,   &
+            6,    4,    5,    3,    4,    2,    3,    2,    2,    2,   &
+            2,    2,    3,    3,    4,    4,    5,    5,    5,    6,   &
+            6,    6,    7,    7,    7,    8,    8,    9,   10,   11,   &
+           12,   12,   12,   13,   13,   14,   15,   15,   16,   16,   &
+           16,   16,   16,   16,   17,   17,   17,   17,   17,   17,   &
+           17,   17,   17,   17,   17,   17,   17,   17,   17,   18,   &
+           18,   18,   18,   18,   18,   19,   19,   19,   20,   20,   &
+           20,   21,   21,   22,   22,   22,   22,   22,   21,   22,   &
+           21,   20,   21,   20,   20,   20,   19,   20,   18,   19,   &
+           18,   18,   19,   19,   20,    0,    0,    0,    0,    0    &
+                                      /
+      DATA (zrnfm(jm,103),jm=1,jpmois)/12*82858./
+
+      !  Total run-offs(VIII)=82858 m3/s
+      !  Total run-offs(I+II+III+IV+V+VI+VII+VIII)= 649941. m3/s
+      !                                           = 0.649940955 Sverdrup
+
+
+      DATA (inb(jr),jr=104,jpriv)/17*0/
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flxrnf : runoff + orca2'
+         IF(lwp) WRITE(numout,*) '~~~~~~'
+         IF(lwp) WRITE(numout,*) '   nrunoff = ', nrunoff
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! 0. initialization and  indexes  modification for zoom version
+      ! --------------------------------------------------------------
+      
+      
+      ! conversion factor m3/s --> kg/m2/s *e1t*e2t
+
+      zconv = rauw
+
+      IF( kt == nit000 ) THEN 
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0                                                                                  
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0
+         upsadv (:,:) = 0.e0
+         zcoefr(:,:,:) = 0.e0
+
+         IF( nrunoff == 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' NO RUNOFF in this simulation '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      ! 1. initialization of the runoff array
+      ! -------------------------------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2) THEN
+
+         iman  = jpmois
+         
+         i15 = nday / 16
+         
+         imois = nmonth + i15 - 1
+         IF( imois == 0) imois = iman
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            ! Number of Day Between Data
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         ENDIF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+         
+         ! 1.1 Calendar computation
+         
+         ! nrnf1 number of the first array record used in the simulation
+         ! nrnf2 number of the last  array record
+         
+         nrnf1 = imois
+         nrnf2 = nrnf1 + 1
+         nrnf1 = MOD( nrnf1, iman )
+         IF( nrnf1 == 0 ) nrnf1 = iman
+         nrnf2 = MOD( nrnf2, iman )
+         IF( nrnf2 == 0 ) nrnf2 = iman
+         
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flxrnf routine'
+            IF(lwp) WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+            IF(lwp) WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+         ENDIF
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+         DO jr = 1, jpriv-1
+            inbp = inb(jr)
+            IF( inbp /= 0 ) THEN
+               DO jl = 1, inbp
+                  ii = iirnf(jl,jr) - nimpp + 1 - jpizoom + 1
+                  ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom + 1
+                  iipt0 = MAX( 1, MIN( ii, jpi   ) )
+                  iipt1 = MAX( 0, MIN( ii, jpi-1 ) )
+                  ijpt0 = MAX( 1, MIN( ij, jpj   ) )
+                  ijpt1 = MAX( 0, MIN( ij, jpj-1 ) )
+                  DO jj = ijpt0, ijpt1
+                     DO ji = iipt0, iipt1
+                        runoff(ji,jj) = runoff(ji,jj)   & 
+                                      + ( (1.-zxy) * zrnfm(nrnf1,jr)   &
+                                      +       zxy  * zrnfm(nrnf2,jr)  ) / FLOAT(inbp)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+
+         ! 2. conversion in mm/day
+         ! -----------------------
+         !     C a u t i o n : upward water flux, runoff is negative
+
+         runoff(:,:) = -zconv * runoff(:,:) / ( e1t(:,:) * e2t(:,:) )
+         
+
+         ! 3. advectve coefficient
+         ! -----------------------
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+         !  3 values are used: maximum = zrup1, between zrup2, small zrup3.
+         ! 
+         IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+            zrup1 = 0.5
+            zrup2 = 0.25
+            zrup3 = 0.125
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0) THEN
+                  DO jl = 1, inbp
+                     ! --> zrup1 (originally, = 1 = all upstream).
+                     ! ji,jj
+                     ii = iirnf(jl,jr) - nimpp + 1 - jpizoom - 1
+                     ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom - 1
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = zrup1
+                           END DO
+                           zcoefr(ji,jj,4) = zrup2
+                           zcoefr(ji,jj,5) = zrup3
+                        END DO
+                     END DO
+                     ! --> zrup2 (originally = 0.5)
+                     ! ji,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj-1
+                     iipt0 = MAX( 1, MIN( ii+1, jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1, jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj
+                     ijpt0 = MAX( 1, MIN( ij, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj+1
+                     iipt0 = MAX( 1, MIN( ii-1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! --> zrup3 (originally = 0.25)
+                     ! ji-1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-1,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj-2
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj-2
+                     iipt0 = MAX( 1, MIN( ii+1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-2
+                     iipt0 = MAX( 1, MIN( ii+2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3  
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj
+                     iipt0 = MAX( 1, MIN( ii-2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3        
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            upsrnfh(:,:) = zcoefr(:,:,1)
+            upsrnfz(:)   = 0.e0
+            upsrnfz(1)   = 1.0
+            upsrnfz(2)   = 1.0
+            upsrnfz(3)   = zrup1
+            upsrnfz(4)   = zrup2
+            upsrnfz(5)   = zrup3
+
+            ! Reduces the sea surface restoring term to Levitus98
+            ! in the Sound Strait
+            DO jj = mj0(116), mj1(116)
+               DO ji = mi0(144), mi1(144)
+                  upsrnfh(ji,jj) = 0.25
+               END DO
+               DO ji = mi0(145), mi1(147)
+                  upsrnfh(ji,jj) = 0.5
+               END DO
+               DO ji = mi0(148), mi1(148)
+                  upsrnfh(ji,jj) = 0.25
+               END DO
+            END DO
+         ENDIF
+      ENDIF
+      
+      ! Upstream and centered scheme in the vicinity of some straits
+
+      IF( kt == nit000 ) THEN
+
+         ! ORCA_R2 configuration :
+         ! Gibraltar Strait
+         DO jj = mj0(102), mj1(102)
+            DO ji = mi0(138), mi1(138)
+               upsadv(ji,jj) = 0.2
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)
+            DO ji = mi0(139), mi1(139)
+               upsadv(ji,jj) = 0.4
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)
+            DO ji = mi0(140), mi1(140)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+         DO jj = mj0(101), mj1(102)
+            DO ji = mi0(141), mi1(141)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+         ! Bab el Mandeb Strait
+         DO jj = mj0(87), mj1(88)
+            DO ji = mi0(164), mi1(164)
+               upsadv(ji,jj) = 0.1
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)
+            DO ji = mi0(163), mi1(163)
+               upsadv(ji,jj) = 0.25
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)
+            DO ji = mi0(162), mi1(162)
+               upsadv(ji,jj) = 0.4
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)
+            DO ji = mi0(160), mi1(161)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)
+            DO ji = mi0(158), mi1(160)
+               upsadv(ji,jj) = 0.25
+            END DO
+         END DO
+         DO jj = mj0(90), mj1(90)
+            DO ji = mi0(160), mi1(160)
+               upsadv(ji,jj) = 0.25
+            END DO
+         END DO
+         ! Sound Strait
+         DO jj = mj0(116), mj1(116)
+            DO ji = mi0(145), mi1(147)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+
+      ENDIF
Index: trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R4.h90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R4.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/flxrnf_ORCA_R4.h90	(revision 325)
@@ -0,0 +1,1338 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flxrnf_ORCA_R4.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  OLD ORCA R4 runoff specification
+   !!                      kept here for memory
+   !!                         ( 20/04/2000 )
+   !!----------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: kt
+      INTEGER  :: jpmois
+      INTEGER  ::   &
+         jpriv,    & ! jpriv : maximum river number
+         jpcoef      ! jpcoef: maximum point number
+      INTEGER, PARAMETER ::   jpmois=12, jpriv=120, jpcoef=150
+
+      INTEGER  ::   ji, jj, jl, jm, jn, jr, jc
+      INTEGER  ::   i15, imois, iman
+      INTEGER  ::   inbp, idbd, idmeom
+      INTEGER  ::   iipt0, iipt1, ijpt0, ijpt1, ii, ij
+      INTEGER  ::   iirnf(jpcoef,jpriv),ijrnf(jpcoef,jpriv)
+      INTEGER  ::   inb(jpriv)
+
+      REAL(wp) ::   zconv, zxy
+      REAL(wp) ::   zrup1,zrup2,zrup3
+      REAL(wp) ::   zrnfm(jpmois, jpriv)
+      REAL(wp) ::   zcoefr(jpi, jpj, 5)
+      CHARACTER (len=20) ::   criver(jpriv)
+
+      REAL(wp) ::   zbilan , zero
+
+      COMMON/zzzrnf/ zrnfm, iirnf, ijrnf, inb
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      ! ====
+      ! DATA
+      ! ====
+
+      zero = 0.0e0
+      IF( kt == nit000 ) THEN 
+          criver = "                    "
+          inb = 0
+          iirnf = 0
+          ijrnf = 0
+          zrnfm  = zero
+          runoff = zero
+         
+          ! I NORTH AMERICA
+          ! ---------------
+          
+          ! 1-Saint Lawrence (Canada) 49N30 67W00           R2
+          ! Old=447 km3/year=14165m3/s; CLIPPER=12430m3/s; ratio=1.14
+          ! --> 13975.249m3/s
+          criver(1) = "Saint Lawrence      "
+          inb(1) = 1
+          iirnf(1:1,1) = 57
+          ijrnf(1:1,1) = 55
+          zrnfm(1:jpmois,1) = (/   &
+              11718.,  11971.,  12466.,  14980.,  19257.,  16913.,   &
+              14211.,  13119.,  13367.,  13644.,  13463.,  12594./)
+          ! 2-Hudson River (USA) 41N00 77W00                R1
+          ! Old=12 km3/year=380m3/s; UNESCO(64-83,p255)=408m3/s
+          ! --> 407.416687m3/s
+          criver(2) = "Hudson River        "
+          inb(2) = 1
+          iirnf(1:1,2) = 54
+          ijrnf(1:1,2) = 53
+          zrnfm(1:jpmois,2) = (/   &
+              364.,    404.,    648.,    873.,    593.,    301.,   &
+              205.,    171.,    205.,    290.,    379.,    456./)
+          ! 3-Missisipi and Atchafalaya (USA) 29N 90W       R1 
+          ! Old=580 km3/year=18380m3/s; CLIPPER=17599m3/s
+          ! --> 17599.334m3/s
+          criver(3) = "Missisipi           "
+          inb(3) = 1
+          iirnf(1:1,3) = 50
+          ijrnf(1:1,3) = 49
+          zrnfm(1:jpmois,3) = (/   &
+              19260.,  20813.,  23026.,  28160.,  26510.,  19650.,   &
+              14181.,  10676.,   9578.,  10167.,  11699.,  17472./)
+          ! 4-Brazos (USA) 29N58 95W53                      R1
+          ! Old=7 km3/year=222m3/s; UNESCO(65-84, p298)=200m3/s
+          ! --> 199.666656m3/s
+          criver(4) = "Brazos              "
+          inb(4) = 1
+          iirnf(1:1,4) = 48
+          ijrnf(1:1,4) = 49
+          zrnfm(1:jpmois,4) = (/   &
+              165.,    224.,    200.,    266.,    457.,    327.,   &
+              143.,     69.,    102.,    132.,    160.,    151. /)
+          ! 5-Colorado (Mexico) 31N54 114W57                R5
+          ! Old=20 km3/year=634m3/s
+          ! --> 634.m3/s
+          criver(5) = "Colorado            "
+          inb(5) = 1
+          iirnf(1:1,5) = 43
+          ijrnf(1:1,5) = 50
+          zrnfm(1:jpmois,5) = 634. 
+          ! 6-Columbia (USA) 45N60 121W17                   R1
+          ! Old=251 km3/year=7954m3/s; UNESCO(65-84, p312)=5368m3/s
+          ! --> 5368.41602m3/s
+          criver(6) = "Columbia            "
+          inb(6) = 1
+          iirnf(1:1,6) = 40
+          ijrnf(1:1,6) = 56
+          zrnfm(1:jpmois,6) = (/   &
+              4752.,    5077.,    5633.,    6075.,    8422.,    9822.,   &
+              6350.,    4112.,    3273.,    3251.,    3548.,    4106. /)
+          ! 7-Fraser (USA) 47N 124W                         R5
+          ! Old=112 km3/year=3550m3/s;not found in UNESCO
+          ! --> 3549.99976m3/s
+          criver(7) = "Fraser              "
+          inb(7) = 1
+          iirnf(1:1,7) = 40
+          ijrnf(1:1,7) = 57
+          zrnfm(1:jpmois,7) = 3550. 
+          ! 8-Yukon (USA) 63N00 165W00                      R3
+          ! Old=195 km3/year=6179m3/s; UNESCO(65-77+80-84, p321)=4245; ratio=1.46
+          ! --> 6017.24951m3/s
+          criver(8) = "Yukon               "
+          inb(8) = 1
+          iirnf(1:1,8) = 30
+          ijrnf(1:1,8) = 62
+          zrnfm(1:jpmois,8) = (/   &
+              1459.,    1213.,    1065.,    1100.,    9067.,   17675.,   &
+              10680.,   11271.,    8658.,    5453.,    2649.,    1917./)
+          ! 9-Copper (USA) 61N47 144W45                     R2
+          ! Old=39 km3/year=1236m3/s; UNESCO(65-84, p317)=1052m3/s; ratio=1.18
+          ! --> 1236.25m3/s
+          criver(9) = "Copper              "
+          inb(9) = 1
+          iirnf(1:1,9) = 35
+          ijrnf(1:1,9) = 60
+          zrnfm(1:jpmois,9) = (/   &
+              219.,    195.,    181.,    214.,    904.,   2532.,   &
+              4026.,   3627.,   1632.,    697.,    354.,    254. /) 
+          ! 10-Susitna (USA)   62N 150E                     R5
+          ! Old=40 km3/year=1268m3/s
+          ! --> 1268.m3/s
+          criver(10) = "Susitna             "
+          inb(10) = 1
+          iirnf(1:1,10) = 34
+          ijrnf(1:1,10) = 60
+          zrnfm(1:jpmois,10) = 1268. 
+          ! 11-McKenzie (Canada) 70N00 135W00               R3
+          ! Old=306 km3/year=9697m3/s; UNESCO(67+72+7479+82-84, p168)=8343m3/s;
+          ! ratio=1.16
+          ! --> 9606.66797m3/s
+          criver(11) = "McKenzie            "
+          inb(11) = 1
+          iirnf(1:1,11) = 35
+          ijrnf(1:1,11) = 66
+          zrnfm(1:jpmois,11) = (/   &
+              3644.,    3400.,    3258.,    3546.,   14188.,   21544.,   &
+              18954.,   15487.,   11284.,   10169.,    5901.,    3905./)
+          ! 12-Kuksokwim (USA) 60N00 ~162W30                R4
+          ! UNESCO(65-84, p318)=1112m3/s (61N87 158E10, Crooked Creek, inland)
+          ! --> 1111.99988m3/s
+          criver(12) = "Kuksokwim           "
+          inb(12) = 1
+          iirnf(1:1,12) = 30
+          ijrnf(1:1,12) = 60
+          zrnfm(1:jpmois,12) = (/   &
+              335.,     308.,     295.,     407.,    2415.,    2027.,   &
+              1917.,   2049.,    1585.,    1072.,     545.,     389./)
+          ! 13-Nelson
+          criver(13) = "Nelson              "
+          inb(13) = 1
+          iirnf(1:1,13) = 51
+          ijrnf(1:1,13) = 65
+          zrnfm(1:jpmois,13) = 0.
+
+          ! Total run-offs(I)=60974.2539m3/s
+
+          ! II SOUTH AMERICA
+          ! -----------------
+          ! 16-Chira (Peru) 4s54 81w08                      R2
+          ! Old=5 km3/year=158m3/s; UNESCO (65-68, p357)=80.9; ratio=1.95
+          ! --> 158.000015m3/s
+          criver(16) = "Chira               "
+          inb(16) = 1
+          iirnf(1:1,16) = 51
+          ijrnf(1:1,16) = 34
+          zrnfm(1:jpmois,16) = (/   &
+              70.,     105.,     564.,     582.,     230.,      94.,   &
+              87.,      47.,      35.,      32.,      29.,      21./)
+          ! 17-Magdalena (Colombia) 11N06 74W51             R2
+          ! Old=237 km3/year=7510m3/s; UNESCO(71-73+76-79, p348)=6973m3/s;
+          ! ratio=1.08
+          ! --> 7451.58301m3/s
+          criver(17) = "Magdelena           "
+          inb(17) = 1
+          iirnf(1:1,17) = 53
+          ijrnf(1:1,17) = 45
+          zrnfm(1:jpmois,17) = (/   &
+              6598.,    4441.,    4087.,    5445.,    7380.,    8067.,   &
+              8509.,    7428.,    7631.,    9296.,   10588.,    9949./)
+          ! 18-Orinoco (Venezuela) 8N37 62W15!              R1
+          ! Old=1100 km3/year=34857m3/s; UNESCO(73-75, p364)=28736m3/s;
+          ! HLA=26371m3/s
+          ! Data from HLA: 8.1N - 63.3W   1925/89
+          ! --> 26371.416
+          criver(18) = "Orinico             "
+          inb(18) = 1
+          iirnf(1:1,18) = 57
+          ijrnf(1:1,18) = 44
+          zrnfm(1:jpmois,18) = (/   &
+              10670.,    7513.,    6344.,    6887.,   13086.,   26699.,   &
+              43938.,   59957.,   57435.,   39951.,   27410.,   16567./)
+          ! 19-Amazon (Brazil) 0S05 50W00                   R1
+          ! Old=6300 km3/year=199634m3/s; CLIPPER=166192m3/s~UNESCO;
+          ! HLA=184806m3/s
+          ! UNESCO data are at Obidos which is far inland and therefore does not
+          ! fully represent the actual discharge
+          ! Data from HLA: 1.5N - 55.3W   1970/96
+          ! --> 184845.484m3/s
+          criver(19) = "Amazon              "
+          inb(19) = 3
+          iirnf(1:3,19) = (/ 60, 60, 60 /)
+          ijrnf(1:3,19) = (/ 39, 40, 41 /)
+          zrnfm(1:jpmois,19) = (/   &
+              152233., 176415., 199941., 225565., 244016., 244861.,   &
+              230711., 203128., 164531., 128486., 118214., 130045. /)
+          ! 20-Sao Francisco (Brazil) 10S30 36W24           R1
+          ! Old=97 km3/year=3074m3/s; UNESCO(77-79, p338)=2645m3/s
+          ! --> 2645.3335m3/s
+          criver(20) = "San Fransisco       "
+          inb(20) = 1
+          iirnf(1:1,20) = 63
+          ijrnf(1:1,20) = 31
+          zrnfm(1:jpmois,20) = (/   &
+              3244.,   4116.,   5139.,   4330.,   2323.,   1800.,     &
+              1587.,   1511.,   1593.,   1740.,   2190.,   2171. /)
+          ! 21-Parana+Uruguay(Arg./Uru.) 34S12 58W18        R1 
+          ! Old=470 km3/year=14893m3/s; UNESCO(p323/324)=22263m3/s
+          ! --> 22203.168m3/s 
+          criver(21) = "Parana              "
+          inb(21) = 1
+          iirnf(1:1,21) = 58
+          ijrnf(1:1,21) = 24
+          zrnfm(1:jpmois,21) = (/   &
+              24803.,   26836.,   24585.,   21358.,   20041.,   21689.,   &
+              22647.,   20403.,   19627.,   21400.,   21126.,   21923./)
+          ! 22-Negro (Argentina)  41S02  62W47              R2
+          ! Old=30 km3/year=951m3/s; UNESCO(65-79,p330)=765m3/s; ratio=1.24
+          ! --> 907.666687m3/s
+          criver(22) = "Rio Negro           "
+          inb(22) = 1
+          iirnf(1:1,22) = 56
+          ijrnf(1:1,22) = 22
+          zrnfm(1:jpmois,22) = (/   &
+              882.,     587.,     519.,     482.,     623.,     984.,   &
+              1120.,   1294.,    1092.,    1166.,    1105.,    1038./)
+          ! 23- Tocantins :  ~48W00 ~0.5S                   R4
+          ! UNESCO(76-77+80-81, p335)=12167m3/s (station far inland!)
+          ! --> 12173.082m3/s
+          criver(23) = "Tocantins           "
+          inb(23) = 1
+          iirnf(1:1,23) = 60
+          ijrnf(1:1,23) = 38
+          zrnfm(1:jpmois,23) = (/   &
+              15507.,  24855.,  27854.,  24257.,  15860.,   7861.,   &
+              4440.,   3082.,   2728.,   3417.,   5511.,  10705. /)
+
+          ! Total run-offs(II)=256755.75
+          ! Total run-offs(I+II)=317730
+
+          ! III EUROPE
+          ! ----------
+          ! 26-Rhone (France) 43N20 4E50                    R1 
+          ! Old=49 km3/year=1553m3/s; UNESCO(65-83, p512)=1229
+          ! --> 1217.16663m3/s
+          criver(26) = "Rhone               "
+          inb(26) = 1
+          iirnf(1:1,26) = 76
+          ijrnf(1:1,26) = 55
+          zrnfm(1:jpmois,26) = (/   &
+              1385.,    1848.,    1568.,    1311.,    1420.,    1191.,   &
+              937.,     796.,     794.,     962.,    1161.,    1233./)
+          ! 27-Po (Italy) 41N10 11E09                       R1 
+          ! Old=46 km3/year=1458m3/s; UNESCO(65-84, p527)=1550m3/s
+          ! --> 1550.08337m3/s
+          criver(27) = "Po                  "
+          inb(27) = 1
+          iirnf(1:1,27) = 79
+          ijrnf(1:1,27) = 54
+          zrnfm(1:jpmois,27) = (/   &
+              1304.,    1605.,    1856.,    1549.,    1958.,    1760.,   &
+              1040.,    1007.,    1615.,    1907.,    1772.,    1228./)
+          ! 28-Danube (Roumania) 45N20 29E40                R1 
+          ! Old=206 km3/year=6527m3/s; UNESCO(65-84, p544)=7011m3/s
+          ! --> 7011.8335m3/s
+          criver(28) = "Danube              "
+          inb(28) = 1
+          iirnf(1:1,28) = 87
+          ijrnf(1:1,28) = 53
+          zrnfm(1:jpmois,28) = (/   &
+              6625.,    7352.,    7986.,    9279.,    9482.,    8618.,   &
+              7586.,    6001.,    5210.,    4989.,    4921.,    6093./)
+
+          ! 29-Volga
+          criver(29) = "Volga               "
+          inb(29) = 1
+          iirnf(1:1,29) = 4
+          ijrnf(1:1,29) = 56
+          zrnfm(1:jpmois,29) = 0.
+          ! 30-Dniepr
+          criver(30) = "Dniepr+Don          "
+          inb(30)= 2
+          iirnf(1:2,30) = (/ 89, 90 /)
+          ijrnf(1:2,30) = (/ 56, 56 /)
+
+          ! Total run-offs(III)=9779.08301m3/s
+          ! Total run-offs(I+II+III)=327509.094m3/s
+
+          ! IV EURASIAN ARCTIC
+          ! ------------------
+          ! 31-Iana (Russia)      126E40 72N25              R1
+          ! Old=29 km3/year=919m3/s; UNESCO(65-72+74+76-84, p463)=936m3/s
+          ! --> 0m3/s
+          criver(31) = "Iana                "
+          inb(31) = 1
+          iirnf(1:1,31) = 20
+          ijrnf(1:1,31) = 68
+          zrnfm(1:jpmois,31) = (/   &
+              2.,       1.,       0.,       0.,     917.,    3514.,   &
+              2968.,    2329.,    1322.,   178.,      36.,       8./)
+          ! 32-Ob (Russia) 66N45 69E30                      R1 
+          ! Old=385 km3/year=12200m3/s; UNESCO(65-84, p478)=12862m3/s
+          ! --> 12861.5m3/s
+          criver(32) = "Ob                  "
+          inb(32) = 1
+          iirnf(1:1,32) = 78
+          ijrnf(1:1,32) = 72
+          zrnfm(1:jpmois,32) = (/   &
+              4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   &
+              30773.,   22785.,   14701.,    9705.,    6078.,    5879./)
+          ! 33-Yenesei (Russia) 71N50 82E40                 R1 
+          ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s
+          ! --> 17461.666m3/s
+          criver(33) = "Yenesei             "
+          inb(33) = 1
+          iirnf(1:1,33) = 77
+          ijrnf(1:1,33) = 75
+          zrnfm(1:jpmois,33) = (/   &
+              6659.,    7007.,    6895.,    7089.,   24183.,   74965.,   &
+              25325.,   15940.,   16050.,   12678.,    6741.,    6008./)
+          ! 34-Severnaya Dvina(Russia)64N32 40E30           R5 
+          ! Old=106 km3/year=3359m3/s; not in UNESCO data base
+          ! --> 3359.00024m3/s
+          criver(34) = "Severnaya Dvina     "
+          inb(34) = 1
+          iirnf(1:1,34) = 78
+          ijrnf(1:1,34) = 68
+          zrnfm(1:jpmois,34) = 3359.
+          ! 35-Lena (Russia) 72N25 126E40                   R1 
+          ! --> 16192.333m3/s
+          criver(35) = "Lena                "
+          inb(35) = 1
+          iirnf(1:1,35) = 20
+          ijrnf(1:1,35) = 68
+          zrnfm(1:jpmois,35) = (/   &
+              2663.,    2095.,    1629.,    1324.,    7203.,   64230.,   &
+              40810.,   28310.,   25995.,   13299.,    3673.,    3077./)
+          ! 36-Kolyma (Russia) 69N30 161E00                 R1
+          ! Old=71 km3/year=2250m3/s; UNESCO(65-84)=2138m3/s
+          ! --> 2138.66675m3/s
+          criver(36) = "Kolyma              "
+          inb(36) = 1
+          iirnf(1:1,36) = 24
+          ijrnf(1:1,36) = 65
+          zrnfm(1:jpmois,36) = (/   &
+              131.,      92.,      76.,      65.,    2576.,    9143.,   &
+              4670.,    3727.,    3226.,    1119.,     630.,     209./)
+          ! 37-Indigirka (russia) 70N48 148E54              R1 
+          ! Old=55 km3/year=1743m3/s; UNESCO(65-68+70+72-84)=1622.
+          ! --> 1622.00012m3/s
+          criver(37) = "Indigirka           "
+          inb(37) = 1
+          iirnf(1:1,37) = 23
+          ijrnf(1:1,37) = 66
+          zrnfm(1:jpmois,37) = (/   &
+              32.,      17.,      11.,       7.,     354.,    5629.,   &
+              5210.,    4617.,    2823.,     559.,     142.,      63./)
+          ! 38-Khatanga
+          criver(38) = "Khatanga             "
+          inb(38) = 1
+          iirnf(1:1,38) = 20
+          ijrnf(1:1,38) = 72
+          zrnfm(1:jpmois,38) = 0.
+
+          ! Total run-offs(IV)=40773.6641m3/s
+          ! Total run-offs(I+II+III+IV)=368282.75m3/s
+
+          ! V ASIA
+          ! ------
+          ! 41-Amur (Russia) 52N56 141E10                   R2
+          ! Old=325 km3/year=10299m3/s; UNESCO(65-84, p451)=8792m3/s; ratio=1.17
+          ! --> 10299.332m3/s
+          criver(41) = "Amur                "
+          inb(41) = 1
+          iirnf(1:1,41) = 18
+          ijrnf(1:1,41) = 59
+          zrnfm(1:jpmois,41) = (/   &
+              2108.,    1543.,    1252.,    4088.,   15464.,   17336.,   &
+              16100.,   20801.,   21548.,   15658.,    5188.,    2506./)
+          ! 42-Liaohe (China) 40N40 122E09                  R5
+          ! Old=6 km3/year=190m3/s; not found in UNESCO data base
+          ! --> 189.999985m3/s
+          criver(42) = "Liaohe              "
+          inb(42) = 1
+          iirnf(1:1,42) = 15
+          ijrnf(1:1,42) = 54
+          zrnfm(1:jpmois,42) = 190.
+          ! 43-Daling (China) 40N56 121E43                  R5
+          ! Old=1 km3/year=32m3/s; not found in UNESCO data base
+          ! --> 31.9999962m3/s
+          criver(43) = "Daling              "
+          inb(43) = 1
+          iirnf(1:1,43) = 15
+          ijrnf(1:1,43) = 54
+          zrnfm(1:jpmois,43) = 32.
+          ! 44-Haiho (China) 6N17   1E23
+          ! Old=2 km3/year=64m3/s; not found in UNESCO data base
+          ! --> 63.9999924m3/s
+          criver(44) = "Haiho               "
+          inb(44) = 0
+          iirnf(1:1,44) = 0
+          ijrnf(1:1,44) = 0
+          zrnfm(1:jpmois,44) = 64.
+          ! 45-Yellow/Huangho (China) 37N32 118E19          R2 
+          ! Old=49 km3/year=1553m3/s; UNESCO(p371)=1210m3/s; ratio=1.28
+          ! --> 1552.5m3/s
+          criver(45) = "Yellow/Huangho      "
+          inb(45) = 1
+          iirnf(1:1,45) = 13
+          ijrnf(1:1,45) = 51
+          zrnfm(1:jpmois,45) = (/   &
+              697.,     674.,    1282.,    1206.,    1109.,     778.,   &
+              1964.,    3270.,    3668.,    2133.,     978.,     871./)
+          ! 46-Yangtze (China) 31N48 121E10=Changjiang      R2
+          ! Old=900 km3/year=28520m3/s; UNESCO(p372)=25032m3/s; ratio=1.14
+          ! --> 28519.584m3/s
+          criver(46) = "Yangtze             "
+          inb(46) = 1
+          iirnf(1:1,46) = 13
+          ijrnf(1:1,46) = 50
+          zrnfm(1:jpmois,46) = (/   &
+              10994.,   10548.,   13254.,   24097.,   36972.,   47197.,   &
+              53891.,   42070.,   37627.,   30762.,   22046.,   12777./)
+          ! 47-Pearl/Zhujiang (China) 23N36 106E34=Xijiang  R2 
+          ! Old=302 km3/year=9570m3/s; UNESCO(76,82, p373)=6987m3/s; ratio=1.37
+          ! --> 9570.75m3/s
+          criver(47) = "Pearl Zhujiang       "
+          inb(47) = 1
+          iirnf(1:1,47) = 12
+          ijrnf(1:1,47) = 48
+          zrnfm(1:jpmois,47) = (/   &
+              2357.,    2415.,    2634.,    6446.,   14246.,   18395.,   &
+              19213.,   17558.,   12312.,    7255.,    5864.,    6154./)
+          ! 48-Red/Hungho (Vietnam) 20N17 106E34            R5 
+          ! Old=123 km3/year=3897m3/s; not in UNESCO data base
+          ! --> 3897.m3/s
+          criver(48) = "Red Hungho          "
+          inb(48) = 1
+          iirnf(1:1,48) = 10
+          ijrnf(1:1,48) = 47
+          zrnfm(1:jpmois,48) = 3897.
+          ! 49-Mekong (Vietnam) 10N33 105E24                R5
+          ! Old=470 km3/year=14893m3/s; not in UNESCO data base
+          ! --> 14893.0029m3/s
+          criver(49) = "Mekong              "
+          inb(49) = 1
+          iirnf(1:1,49) =  8
+          ijrnf(1:1,49) = 44
+          zrnfm(1:jpmois,49) = 14893.
+          ! 50-Irrawady (Burma) 15N50  95E06                R5
+          ! Old=428 km3/year=13563m3/s; not in UNESCO data base
+          ! --> 13563.m3/s
+          criver(50) = "Irrawady            "
+          inb(50) = 1
+          iirnf(1:1,50) =  6
+          ijrnf(1:1,50) = 46
+          zrnfm(1:jpmois,50) = 13563.
+          ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00      R1
+          ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s
+          ! --> 32147.498m3/s
+          criver(51) = "Ganges              "
+          inb(51) = 2
+          iirnf(1:2,51) = (/  4,  5 /)
+          ijrnf(1:2,51) = (/ 47, 47 /)
+          zrnfm(1:jpmois,51) = (/   &
+              6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   &
+              64688.,   80338.,   84802.,   43387.,   17888.,   10322./)
+          ! 52-Mehandi (India)                              R5
+          ! Old=67 km3/year=2123m3/s; not in UNESCO data base
+          ! --> 0m3/s
+          criver(52) = "Mehandi             "
+          inb(52) = 0
+          iirnf(1:1,52) = 0
+          ijrnf(1:1,52) = 0
+          zrnfm(1:jpmois,52) = 2123.
+          ! 53-Damodar (India)                              R2
+          ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85
+          ! --> 432.916656m3/s
+          criver(53) = "Damodar             "
+          inb(53) = 0
+          iirnf(1:1,53) = 0
+          ijrnf(1:1,53) = 0
+          zrnfm(1:jpmois,53) = (/   &
+              51.,      37.,      42.,      49.,      85.,     296.,   &
+              896.,    1390.,    1591.,     542.,     172.,      44./)  
+          ! 54-Godavari (India) 17N00  81E45                R2
+          ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39
+          ! --> 3670.5m3/s
+          criver(54) = "Godaravi            "
+          inb(54) = 1
+          iirnf(1:1,54) =  3
+          ijrnf(1:1,54) = 46
+          zrnfm(1:jpmois,54) = (/   &
+              988.,     737.,     280.,     219.,     196.,    1691.,   &
+              8063.,   14571.,   11428.,    3953.,    1221.,     699./)
+          ! 55-Indus (Pakistan) 24N20  67E47                R2
+          ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15
+          ! --> 7562.m3/s
+          criver(55) = "Indus               "
+          inb(55) = 1
+          iirnf(1:1,55) = 89
+          ijrnf(1:1,55) = 47
+          zrnfm(1:jpmois,55) = (/   &
+              988.,     737.,    1904.,    1968.,    3625.,    6143.,   &
+              15969.,    36656.,  17173.,    3215.,    1251.,    1115./)
+          ! 56-Tigris and Euphrates (Iraq) 31N00  47E25     R1
+          ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s
+          ! --> 2248.8335m3/s
+          criver(56) = "Tigris              "
+          inb(56) = 1
+          iirnf(1:1,56) = 88
+          ijrnf(1:1,56) = 47
+          zrnfm(1:jpmois,56) = (/   &
+              1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   &
+              1362.,     900.,     786.,     993.,    1184.,    1742./)
+
+          ! Total run-offs (V)=128642.922m3/s
+          ! Total run-offs (I+II+III+IV+V)=496925.688m3/s
+
+          ! VI AFRICA
+          ! ----------
+          ! 61-Nile (Egypt) 30N10  31E06                    R1
+          ! Old=30 km3/year=951m3/s; UNESCO(73-84)=1251m3/s
+          ! --> 1251.33337m3/s
+          criver(61) = "Nile                "
+          inb(61) = 1
+          iirnf(1:1,61) = 90
+          ijrnf(1:1,61) = 50
+          zrnfm(1:jpmois,61) = (/   &
+              1239.,    1035.,    1126.,    1110.,    1170.,    1542.,   &
+              1742.,    1559.,    1191.,    1103.,    1075.,    1124./)
+          ! 62-Niger (Nigeria) 5N33   6E33                  R1
+          ! Old=192 km3/year=6084m3/s; HLA=5545m3/s;
+          ! Data from HLA: 4.5N -  6  E   1950/87
+          ! --> 5545.08301m3/s
+          criver(62) = "Niger               "
+          inb(62) = 1
+          iirnf(1:1,62) = 74
+          ijrnf(1:1,62) = 41
+          zrnfm(1:jpmois,62) = (/   &
+              2029.,    1804.,    1573.,    1418.,    1494.,    2561.,   &
+              5272.,    9629.,   14951.,   16227.,    6842.,    2741./)
+          ! 63-Zaire/Congo (Congo) 6S04  12E24              R1      
+          ! Old=1250 km3/year=39610m3/s; UNESCO(65-83, p149)=41941m3/s; HLA
+          ! =39720m3/s
+          ! Data from HLA: 6S - 12  E   1902/96
+          ! --> 39719.5m3/s
+          criver(63) = "Zaire Congo         "
+          inb(63) = 1
+          iirnf(1:1,63) = 75
+          ijrnf(1:1,63) = 33
+          zrnfm(1:jpmois,63) = (/   &
+              47200.,   37692.,   34374.,   36603.,   37862.,   35588.,   &
+              30966.,   30774.,   35981.,   42825.,   51455.,   55314./)
+          ! 64-Orange (Sth Africa) 28S41 16E28              R5
+          ! Old=11 km3/year=349m3/s
+          ! --> 349.000031m3/s
+          criver(64) = "Orange              "
+          inb(64) = 1
+          iirnf(1:1,64) = 76
+          ijrnf(1:1,64) = 26
+          zrnfm(1:jpmois,64) = 349.
+          ! 65-Zambesi (Mozambique) 18S55 36E04             R5
+          ! Old=223 km3/year=7066m3/s
+          ! --> 7066.00049m3/s
+          criver(65) = "Zambesi             "
+          inb(65) = 1
+          iirnf(1:1,65) = 81
+          ijrnf(1:1,65) = 29
+          zrnfm(1:jpmois,65) = 7066.
+          ! 66-Limpopo (mozambique) 25S15 33E30             R5
+          ! Old=5 km3/year=158m3/s
+          ! --> 158.m3/s
+          criver(66) = "Limpopo             "
+          inb(66) = 1
+          iirnf(1:1,66) = 81
+          ijrnf(1:1,66) = 28
+          zrnfm(1:jpmois,66) = 158.
+          ! 67-Rufiji (tanzania) 8S00 39E20                 R5
+          ! Old=9 km3/year=285m3/s
+          ! --> 285.m3/s
+          criver(67) = "Rufiji             "
+          inb(67) = 1
+          iirnf(1:1,67) = 82
+          ijrnf(1:1,67) = 33
+          zrnfm(1:jpmois,67) = 285.
+          ! Other rivers from the Gulf of Guinea
+          ! 68-Kouilou (Congo)  4.5S-11.5E (UNESCO=p51)     R1
+          ! Data from HLA:  4S - 11  E   1953/86 = 919m3/s
+          ! --> 924.25m3/s
+          criver(68) = "Kouilou            "
+          inb(68) = 1
+          iirnf(1:1,68) = 75
+          ijrnf(1:1,68) = 33
+          zrnfm(1:jpmois,68) = (/   &
+              1115.,    1166.,    1285.,    1462.,    1454.,     725.,   &
+              480.,     378.,     327.,     400.,    1018.,    1281./)
+          ! 69-Nyanga (Gabon)  3S-10E (UNESCO=p66)          R1
+          ! Data from HLA: 2.8N - 10  E   1952/82 = 264m3/s
+          ! --> 264.166687m3/s
+          criver(69) = "Nyanga              "
+          inb(69) = 1
+          iirnf(1:1,69) = 74
+          ijrnf(1:1,69) = 36
+          zrnfm(1:jpmois,69) = (/   &
+              126.,      99.,     143.,     253.,     316.,     300.,   &
+              156.,      93.,     231.,     557.,     592.,     304./)
+          ! 70-Ogoue (Gabon) 1S-9E (UNESCO, p69)            R1
+          ! Data from HLA: .75S -  9  E   1930/90 = 4512m3/s
+          ! --> 4511.83301m3/s
+          criver(70) = "Ogoue               "
+          inb(70) = 1
+          iirnf(1:1,70) = 74
+          ijrnf(1:1,70) = 37
+          zrnfm(1:jpmois,70) = (/   &
+              4514.,    3988.,    4622.,    5403.,    5790.,    4145.,   &
+              2616.,    1961.,    2119.,    4304.,    7870.,    6810./)
+          ! 71-Sanaga (Cameroun) 3.5N-9.5E (UNESCO, p31)    R1
+          ! Data from HLA: 3.9N -  9.6E   1944/80 = 1983m3/s
+          ! --> 1982.58337m3/s
+          criver(71) = "Sanaga              "
+          inb(71) = 1
+          iirnf(1:1,71) = 74
+          ijrnf(1:1,71) = 41
+          zrnfm(1:jpmois,71) = (/   &
+              813.,     578.,     517.,     633.,     909.,    1278.,   &
+              1928.,    2653.,    4361.,    5470.,    3307.,    1344./)
+          ! 72-Nyong (Cameroun) 3.1N-9.5E (UNESCO, p36)     R1
+          ! Data from HLA: 3.5N -  9.8E   1951/84 = 432m3/s
+          ! --> 431.166656m3/s      
+          criver(72) = "Nyong               "
+          inb(72) = 1
+          iirnf(1:1,72) = 74
+          ijrnf(1:1,72) = 41
+          zrnfm(1:jpmois,72) = (/   &
+              232.,     128.,     150.,     266.,     402.,     459.,   &
+              353.,     306.,     604.,     930.,     878.,     466./)
+          ! 73-Ntem (Cameroun) 2.5N-9.5E (UNESCO, p36)      R1
+          ! Data from HLA: 3N -  9.8E   1951/87 = 330m3/s      
+          ! --> 329.75m3/s
+          criver(73) = "Ntem                "
+          inb(73) = 1
+          iirnf(1:1,73) = 74
+          ijrnf(1:1,73) = 41
+          zrnfm(1:jpmois,73) = (/   &
+              452.,     455.,     492.,     466.,     482.,     251.,   &
+              151.,     108.,      87.,     133.,     395.,     485./)
+          ! 74-Wouri (Cameroun) 4N-9.5E (UNESCO, p34)       R1
+          ! Data from HLA: 4N -  9.5E   1951/84  = 307m3/s
+          ! --> 306.583374m3/s
+          criver(74) = "Wouri               "
+          inb(74) = 1
+          iirnf(1:1,74) = 74
+          ijrnf(1:1,74) = 41
+          zrnfm(1:jpmois,74) = (/   &
+              88.,      63.,      68.,      95.,     139.,     222.,   &
+              395.,     633.,     825.,     675.,     328.,     148./)
+          ! 75-Oueme (Benin) 6.5N-2.5E (UNESCO, p27)        R1
+          ! Data from HLA:  6.2N -  2.5E   1951/84 =113m3/s
+          ! --> 112.666664m3/s
+          criver(75) = "Oueme               "
+          inb(75) = 1
+          iirnf(1:1,75) = 73
+          ijrnf(1:1,75) = 42
+          zrnfm(1:jpmois,75) = (/   &
+              0.,       0.,       0.,       0.,       1.,      18.,   &
+              96.,     324.,     531.,     319.,      58.,       5./)
+          ! 76-Mono(Tepetou,Benin/Togo) 6.25N-1.8E (U, p27) R1
+          ! Data from HLA: 6.2N -  1  E   1951/85  = 96m3/s       
+          ! --> 96.4999924m3/s
+          criver(76) = "Mono                "
+          inb(76) = 1
+          iirnf(1:1,76) = 72
+          ijrnf(1:1,76) = 42
+          zrnfm(1:jpmois,76) = (/   &
+              2.,       1.,       1.,       4.,       8.,      44.,   &
+              168.,     274.,     386.,     215.,      47.,       8./)
+          ! 77-Comoe (Ivory Coast) 5N-4W (UNESCO, p56)      R1
+          ! Data from HLA: 5.1N -  4  W   1955/86 = 194m3/s       
+          ! --> 194.25m3/s
+          criver(77) = "Comoe               "
+          inb(77) = 1
+          iirnf(1:1,77) = 71
+          ijrnf(1:1,77) = 41
+          zrnfm(1:jpmois,77) = (/   &
+              14.,       7.,       9.,      17.,      29.,      90.,   &
+              145.,     349.,     740.,     688.,     198.,      45./)
+          ! 78-Sassandra (Ivory Coast) 5N-6W (UNESCO, p58)  R1
+          ! Data from HLA: 5N -  6  W   1953/86 = 449m3/s
+          ! --> 449.333344m3/s
+          criver(78) = "Sassandra           "
+          inb(78) = 1
+          iirnf(1:1,78) = 71
+          ijrnf(1:1,78) = 41
+          zrnfm(1:jpmois,78) = (/   &
+              144.,     116.,     119.,     143.,     156.,     334.,   &
+              419.,     692.,    1277.,    1190.,     553.,     249./)
+          ! 79-Jubba (Somali Coast)
+          criver(79) = "Jubba               "
+          inb(79) = 1
+          iirnf(1:1,79) = 84
+          ijrnf(1:1,79) = 39
+          zrnfm(1:jpmois,79) = 0.
+          ! 80-Senaga
+          criver(80) = "Senegal             "
+          inb(79) = 1
+          iirnf(1:1,80) = 66
+          ijrnf(1:1,80) = 47
+          zrnfm(1:jpmois,79) = 0.
+      
+          ! Total run-offs (VI)=63977.m3/s
+          ! Total run-offs (I+II+III+IV+V+VI)=560902.688m3/s
+          
+          ! VII OCEANIA
+          ! ------------
+          ! 91-Murray (Australia) 35S34 138E54              R5
+          ! Old=22 km3/year=697m3/s
+          ! --> 696.999939m3/s
+          criver(91) = "Murray              "
+          inb(91) = 1
+          iirnf(1:1,91) = 16
+          ijrnf(1:1,91) = 24
+          zrnfm(1:jpmois,91) = 697.
+          ! 92-Haast (N. Zeland) 43S50 169E02               R5
+          ! Old=6 km3/year=190m3/s
+          ! --> 189.999985m3/s
+          criver(92) = "Haast               "
+          inb(92) = 1
+          iirnf(1:1,92) = 24
+          ijrnf(1:1,92) = 22
+          zrnfm(1:jpmois,92) = 190.
+          ! 93-Fly (N. Guinea) 8S30 143E05                  R5
+          ! Old=77 km3/year=2440m3/s
+          ! --> 2440.m3/s
+          criver(93) = "Fly                 "
+          inb(93) = 1
+          iirnf(1:1,93) = 19
+          ijrnf(1:1,93) = 31
+          zrnfm(1:jpmois,93) = 2440.
+          ! 94-Purari (N. Guinea) 7S25 145E05               R4
+          ! Old=77 km3/year=2440m3/s; UNESCO(77+83,p595)=2727m3/s
+          ! --> 2727.33325m3/s
+          criver(94) = "Purari              "
+          inb(94) = 1
+          iirnf(1:1,94) = 19
+          ijrnf(1:1,94) = 33
+          zrnfm(1:jpmois,94) = (/   &
+              1972.,    3067.,    2332.,    2981.,    2693.,    2876.,   &
+              2867.,    3477.,    2195.,    2967.,    2674.,    2627./)
+          ! 95-Choshui ch''i (taiwan) 24N03 120E23          R2
+          ! Old=6 km3/year=190m3/s; UNESCO(65-68, p374)=120m3/s; ratio=1.58 
+          ! --> 0.m3/s
+          criver(95) = "Choshui             "
+          inb(95) = 1
+          iirnf(1:1,95) = 12
+          ijrnf(1:1,95) = 48
+          zrnfm(1:jpmois,95) = (/   &
+              65.,      63.,      83.,     100.,     177.,     535.,   &
+              332.,     313.,     236.,     193.,     101.,      84./)
+          ! 96-Kaoping (Taiwan)                             R5  
+          ! Old=9 km3/year=285m3/s
+          ! --> 0.m3/s
+          criver(96) = "Kaoping             "
+          inb(96) = 0
+          iirnf(1:1,96) = 0
+          ijrnf(1:1,96) = 0
+          zrnfm(1:jpmois,96) = 285.
+          ! 97-Tsengwen (Taiwan)                            R5
+          ! Old=2 km3/year=63m3/s
+          ! --> 0.m3/s
+          criver(97) = "Tsengwen            "
+          inb(97) = 0
+          iirnf(1:1,97) = 0
+          ijrnf(1:1,97) = 0
+          zrnfm(1:jpmois,97) = 63.
+          ! 98-Hualien (Taiwan)                             R5
+          ! Old=4 km3/year=127m3/s
+          ! --> 0.m3/s
+          criver(98) = "Hualien             "
+          inb(98) = 0
+          iirnf(1:1,98) = 0
+          ijrnf(1:1,98) = 0
+          zrnfm(1:jpmois,98) = 127.
+          ! 99-Peinan (Taiwan) 22N46 121E10                 R5
+          ! Old=4 km3/year=127m3/s
+          ! --> 127.000008m3/s
+          criver(99) = "Peinan              "
+          inb(99) = 1
+          iirnf(1:1,99) = 12
+          ijrnf(1:1,99) = 48
+          zrnfm(1:jpmois,99) = 127.
+          ! 100-Hsiukuluan (Taiwan)                         R5
+          ! Old=4 km3/year=127m3/s
+          ! --> 0.m3/s
+          criver(100) = "Hsiukuluan          "
+          inb(100) = 0
+          iirnf(1:1,100) = 0
+          ijrnf(1:1,100) = 0
+          zrnfm(1:jpmois,100) = 127.
+
+          !  Total run-offs(VII)=6181.33301m3/s
+          
+
+          ! VIII ANTARCTICA
+          ! ---------------
+          ! 103 -Antarctic ice discharge (2 613 Gt/year) (jacobs et al 1992)
+          ! Data from Jacobs et al 92: =2613 km3/year=82857.686454 m3/s
+          ! --> 82858 m3/s
+          criver(103) = "Antarctica         "
+          inb(103) = 108
+          iirnf(1:108,103) = (/   &
+               2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20,   &
+              21,22,23,24,25,25,24,24,24,25,26,27,28,29,30,31,32,33,34,   &
+              35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,51,53,   &
+              53,53,53,54,54,54,56,57,57,57,57,57,57,57,57,57,57,58,59,   &
+              60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,   &
+              79,80,81,82,83,84,85,86,87,88,89,90,91 /)
+          ijrnf(1:108,103) = (/   &
+              12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,11,11,   &
+              10,10, 9, 9, 8, 7, 6, 5, 3, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3,   &
+               3, 4, 5, 6, 6, 6, 7, 7, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7,   &
+               8, 9,10,10,11,12,13,12,11,10, 9, 8, 7, 6, 5, 4, 3, 2, 2,   &
+               2, 2, 2, 2, 3, 4, 4, 5, 7, 8, 9, 9, 9, 9, 9, 9,10,10,10,   &
+              10,10,10,10,11,12,12,12,12,11,11,10,10 /)
+          zrnfm(1:jpmois,100) = 82858.0
+                   
+
+          !  Total run-offs(I+II+III+IV+V+VI+VII)= 567084. m3/s
+          !                                      = 1.588668056E-6 kg/m2/s
+          !                                      = 17883.5586 km3/Year
+          !                                      = 0.567083955 Sverdrup
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flxrnf : runoff + orca4'
+         IF(lwp) WRITE(numout,*) '~~~~~~'
+         IF(lwp) WRITE(numout,*) '   nrunoff = ', nrunoff
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! 0. initialization and  indexes  modification for zoom version
+      ! --------------------------------------------------------------
+      
+      
+      ! conversion factor m3/s --> kg/m2/s *e1t*e2t
+
+      zconv = rauw
+
+      IF( kt == nit000 ) THEN 
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0                                                                                  
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0
+         upsadv (:,:) = 0.e0
+         zcoefr(:,:,:) = 0.e0
+
+         IF( nrunoff == 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' NO RUNOFF in this simulation '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      IF( kt == nit000 ) THEN
+         IF( nrunoff >= 1 ) THEN 
+            zbilan = 0.0 
+!OCL SCALAR
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0 ) THEN
+                  ii = mj0(iirnf(1,jr))
+                  ij = mi0(ijrnf(1,jr))
+                  ii = MAX( 2, MIN( ii, jpi-1 ) )
+                  ij = MAX( 2, MIN( ij, jpj-1 ) )
+!OCL SCALAR
+                  IF( tmask(ii,ij,1) <= 0.5 ) THEN 
+                     IF(lwp) WRITE(numout,*) 'Erreur riviere masquee   ', ii, ij, jr, criver(jr)
+                  ENDIF
+                  IF( tmask(ii-1,ij,1)*tmask(ii+1,ij,1)   &
+                     *tmask(ii,ij-1,1)*tmask(ii,ij+1,1) /= 0. )THEN 
+                     IF(lwp) WRITE(numout,*) 'Erreur riviere non cotiere ',ii, ij, jr, criver(jr)
+                  ENDIF
+                  DO nrnf1 = 1, jpmois
+                     zbilan = zbilan + zrnfm(nrnf1,jr) * tmask(ii,ij,1)
+                  END DO
+               ENDIF
+            END DO
+            IF(lwp) WRITE(numout,*) 'zrnfm (runoff) ', zero, zconv, rauw, SUM(zrnfm)
+            IF(lwp) THEN 
+               WRITE(numout,'("Total runoff : ",1E30.15)' ) zbilan
+               WRITE(numout,*) 'Run-off : POSITION and value '
+               WRITE(numout,*) 'ji jj glamt gphit annual mask 12-month '
+!OCL SCALAR
+               DO jr = 1, jpriv-1
+                  inbp = inb(jr)
+                  IF(inbp /= 0) THEN
+!OCL SCALAR
+                     DO jl = 1, inbp
+                        ii = mj0(iirnf(jl,jr))
+                        ij = mi0(ijrnf(jl,jr))
+                        WRITE(numout,'(2I3,1X,1A20,2X,2I4,2F7.1,1I3,1PE10.1,1I2,12E9.1)')   &
+                           jr, jl, criver(jr),   &
+                           ii, ij, glamt(ii,ij), gphit(ii,ij), inbp,   &
+                           SUM(zrnfm(1:jpmois,jr))/float(inbp),   &
+                           NINT(tmask(ii,ij,1)),   &
+                           zrnfm(1:jpmois,jr)/float(inbp)
+                     END DO
+                  ENDIF
+               END DO
+            ENDIF
+            IF(lwp) WRITE(numout,*) ' zrnfm (runoff) ', zero, zconv, rauw, SUM(zrnfm)
+         ENDIF
+      ENDIF
+
+      ! 1. initialization of the runoff array
+      ! -------------------------------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2) THEN
+
+         iman  = jpmois
+         
+         i15 = nday/16
+         
+         imois = nmonth + i15 - 1
+         IF( imois == 0) imois = iman
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            ! Number of Day Between Data
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         ENDIF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+         
+         ! 1.1 Calendar computation
+         
+         ! nrnf1 number of the first array record used in the simulation
+         ! nrnf2 number of the last  array record
+         
+         nrnf1 = imois
+         nrnf2 = nrnf1 + 1
+         nrnf1 = MOD( nrnf1, iman )
+         IF( nrnf1 == 0 ) nrnf1 = iman
+         nrnf2 = MOD( nrnf2, iman )
+         IF( nrnf2 == 0 ) nrnf2 = iman
+         
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flxrnf routine'
+            IF(lwp) WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+            IF(lwp) WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+            IF(lwp) WRITE(numout,*) 'total zrnfm ', SUM(zrnfm)
+            IF(lwp) WRITE(numout,*) 'total surface ', SUM(e1t*e2t*tmask(:,:,1))
+         ENDIF
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+!OCL SCALAR
+         DO jr = 1, jpriv-1
+            inbp = inb(jr)
+!OCL SCALAR
+            IF( inbp /= 0 ) THEN
+               DO jl = 1, inbp
+                  ii = iirnf(jl,jr) - nimpp + 1 - jpizoom + 1
+                  ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom + 1
+                  iipt0 = MAX( 1, MIN( ii, jpi   ) )
+                  iipt1 = MAX( 0, MIN( ii, jpi-1 ) )
+                  ijpt0 = MAX( 1, MIN( ij, jpj   ) )
+                  ijpt1 = MAX( 0, MIN( ij, jpj-1 ) )
+                  DO jj = ijpt0, ijpt1
+                     DO ji = iipt0, iipt1
+                        runoff(ji,jj) = runoff(ji,jj)   & 
+                                      + ( (1.-zxy) * zrnfm(nrnf1,jr)   &
+                                      +       zxy  * zrnfm(nrnf2,jr)  ) / FLOAT(inbp)      
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+
+         ! 2. conversion in mm/day
+         ! -----------------------
+         !     C a u t i o n : upward water flux, runoff is negative
+
+         runoff(:,:) = -zconv * runoff(:,:) / ( e1t(:,:) * e2t(:,:) )
+         
+
+         ! 3. advectve coefficient
+         ! -----------------------
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+         !  3 values are used: maximum = zrup1, between zrup2, small zrup3.
+         ! 
+         IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+            zrup1 = 0.5
+            zrup2 = 0.25
+            zrup3 = 0.125
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0) THEN
+                  DO jl = 1, inbp
+                     ! --> zrup1 (originally, = 1 = all upstream).
+                     ! ji,jj
+                     ii = iirnf(jl,jr) - nimpp + 1 - jpizoom - 1
+                     ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom - 1
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = zrup1
+                           END DO
+                           zcoefr(ji,jj,4) = zrup2
+                           zcoefr(ji,jj,5) = zrup3
+                        END DO
+                     END DO
+                     ! --> zrup2 (originally = 0.5)
+                     ! ji,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj-1
+                     iipt0 = MAX( 1, MIN( ii+1, jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1, jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj
+                     ijpt0 = MAX( 1, MIN( ij, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj+1
+                     iipt0 = MAX( 1, MIN( ii-1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! --> zrup3 (originally = 0.25)
+                     ! ji-1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-1,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj-2
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj-2
+                     iipt0 = MAX( 1, MIN( ii+1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-2
+                     iipt0 = MAX( 1, MIN( ii+2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3  
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj
+                     iipt0 = MAX( 1, MIN( ii-2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3        
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            upsrnfh(:,:) = zcoefr(:,:,1)
+            upsrnfz(:)   = 0.e0
+            upsrnfz(1)   = 1.0
+            upsrnfz(2)   = 1.0
+            upsrnfz(3)   = zrup1
+            upsrnfz(4)   = zrup2
+            upsrnfz(5)   = zrup3
+         ENDIF
+      ENDIF
+      
+      ! Upstream and centered scheme in the vicinity of some straits
+      
+      IF( kt == nit000 ) THEN
+
+         ! ORCA_R4 configuration :
+         ! Gibraltar Strait
+         DO jj = mj0(52), mj1(53)
+            DO ji = mi0(70), mi1(71)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+
+      ENDIF
Index: trunk/NEMO/OFF_SRC/SBC/ocesbc.F90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/ocesbc.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/ocesbc.F90	(revision 325)
@@ -0,0 +1,28 @@
+MODULE ocesbc
+   !!======================================================================
+   !!                     ***  MODULE  ocesbc  ***
+   !!                     Ocean surface boundary conditions
+   !!======================================================================
+
+   !! * Modules used
+   USE oce
+   USE lib_mpp
+   USE in_out_manager ! I/O manager
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      qt  ,         &  !: total surface heat flux (w/m2)
+      qsr ,         &  !: solar radiation (w/m2)
+      emp ,         &  !: evaporation minus precipitation (kg/m2/s = mm/s)
+      emps             !: evaporation - precipitation (free surface)
+
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   !!======================================================================
+END MODULE ocesbc
Index: trunk/NEMO/OFF_SRC/SBC/taumod.F90
===================================================================
--- trunk/NEMO/OFF_SRC/SBC/taumod.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/SBC/taumod.F90	(revision 325)
@@ -0,0 +1,23 @@
+MODULE taumod
+   !!======================================================================
+   !!                       ***  MODULE  taumod  ***
+   !! Ocean forcing : stress at the the ocean surface
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tau          : define the surface stress for the ocean
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce
+   USE lib_mpp
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Share modules variables
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      taux, tauy          !: surface stress components 
+
+   !!======================================================================
+END MODULE taumod
Index: trunk/NEMO/OFF_SRC/TRA/trabbl.F90
===================================================================
--- trunk/NEMO/OFF_SRC/TRA/trabbl.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/TRA/trabbl.F90	(revision 325)
@@ -0,0 +1,138 @@
+MODULE trabbl
+   !!==============================================================================
+   !!                       ***  MODULE  trabbl  ***
+   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
+   !!==============================================================================
+#if   defined key_trabbl_dif   ||   defined key_trabbl_adv   || defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl_dif'   or            diffusive bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl_dif  : update the active tracer trends due to the bottom
+   !!                  boundary layer (diffusive only)
+   !!   tra_bbl_init : initialization, namlist read, parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_bbl_dif    ! routine called by step.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::            &  !!: * bbl namelist *
+      atrbbl = 1.e+3                  !: lateral coeff. for bottom boundary 
+      !                               !  layer scheme (m2/s)
+   REAL(wp) , PUBLIC , DIMENSION(jpi,jpj) :: &
+      bblx, bbly    ! Bottom boundary layer coefficients
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_bbl_dif( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_bbl_dif  ***
+      !!
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!      with the bottom boundary layer and add it to the general trend 
+      !!      of tracer equations. The bottom boundary layer is supposed to be
+      !!      a purely diffusive bottom boundary layer.
+      !!
+      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
+      !!      is an along bottom slope gradient) an additional lateral diffu-
+      !!      sive trend along the bottom slope is added to the general tracer
+      !!      trend, otherwise nothing is done.
+      !!      Second order operator (laplacian type) with variable coefficient
+      !!      computed as follow for temperature (idem on s): 
+      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
+      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
+      !!      where ztb is a 2D array: the bottom ocean temperature and ahtb
+      !!      is a time and space varying diffusive coefficient defined by:
+      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
+      !!              = 0.       otherwise.
+      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
+      !!      is evaluated using the local density (i.e. referenced at the
+      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!      Add this before trend to the general trend (ta,sa) of the 
+      !!      botton ocean tracer point:
+      !!         ta = ta + difft
+      !!
+      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
+      !!                boundary layer trend
+      !!              - save the trends in bbltrd ('key_diatrends')
+      !!
+      !! References :
+      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!
+      !! History :
+      !!   8.0  !  96-06  (L. Mortier)  Original code
+      !!   8.0  !  97-11  (G. Madec)  Optimization
+      !!   8.5  !  02-08  (G. Madec)  free form + modules
+      !!----------------------------------------------------------------------
+      !! * Arguments 
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL tra_bbl_init
+
+   END SUBROUTINE tra_bbl_dif
+
+   SUBROUTINE tra_bbl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
+      !!
+      !! ** Method  :   Read the nambbl namelist and check the parameters
+      !!      called by tra_bbl at the first timestep (nit000)
+      !!
+      !! History :
+      !!    8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      NAMELIST/nambbl/ atrbbl
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nambbl : bottom boundary layer scheme
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, nambbl )
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbl_init : * Diffusive Bottom Boundary Layer'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist nambbl : set bbl parameters'
+         WRITE(numout,*)
+         WRITE(numout,*) '          bottom boundary layer coef.    atrbbl = ', atrbbl
+         WRITE(numout,*)
+      ENDIF
+ 
+   END SUBROUTINE tra_bbl_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_bbl_dif (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'tra_bbl_dif: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_bbl_dif
+#endif
+
+   !!======================================================================
+END MODULE trabbl
Index: trunk/NEMO/OFF_SRC/TRA/traqsr.F90
===================================================================
--- trunk/NEMO/OFF_SRC/TRA/traqsr.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/TRA/traqsr.F90	(revision 325)
@@ -0,0 +1,93 @@
+MODULE traqsr
+   !!======================================================================
+   !!                       ***  MODULE  traqsr  ***
+   !! Ocean physics: solar radiation penetration in the top ocean levels
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_qsr      : trend due to the solar radiation penetration
+   !!   tra_qsr_init : solar radiation penetration initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_qsr_init ! routine called by opa.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   !: qsr flag (Default=T)
+
+   !! * Module variables
+   REAL(wp), PUBLIC ::  & !!! * penetrative solar radiation namelist *
+      xsi1 = 0.35_wp     ! first depth of extinction 
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_qsr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_qsr_init  ***
+      !!
+      !! ** Purpose :   Initialization for the penetrative solar radiation
+      !!
+      !! ** Method  :   The profile of solar radiation within the ocean is set
+      !!      from two length scale of penetration (xsr1,xsr2) and a ratio
+      !!      (rabs). These parameters are read in the namqsr namelist. The
+      !!      default values correspond to clear water (type I in Jerlov' 
+      !!      (1968) classification.
+      !!         called by tra_qsr at the first timestep (nit000)
+      !!
+      !! ** Action  : - initialize xsr1, xsr2 and rabs
+      !!
+      !! Reference :
+      !!   Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+      !!
+      !! History :
+      !!   8.5  !  02-06  (G. Madec) Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+
+      NAMELIST/namqsr/ ln_traqsr, xsi1
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namqsr : ratio and length of penetration
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namqsr )
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF( ln_traqsr  ) THEN
+        IF ( lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '    Namelist namqsr : set the parameter of penetration'
+         WRITE(numout,*) '        first depth of extinction        xsi1        = ',xsi1
+         WRITE(numout,*) ' '
+        END IF
+      ELSE
+        IF ( lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+        END IF
+      ENDIF
+
+      IF( xsi1 < 0.e0 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '             0<xsi1 not satisfied'
+         nstop = nstop + 1
+      ENDIF
+
+
+   END SUBROUTINE tra_qsr_init
+
+   !!======================================================================
+END MODULE traqsr
Index: trunk/NEMO/OFF_SRC/TRA/zpshde.F90
===================================================================
--- trunk/NEMO/OFF_SRC/TRA/zpshde.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/TRA/zpshde.F90	(revision 325)
@@ -0,0 +1,258 @@
+MODULE zpshde
+   !!==============================================================================
+   !!                       ***  MODULE zpshde   ***
+   !! Ocean active tracers: 
+   !!==============================================================================
+#if defined key_partial_steps || defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_partial_steps' :               z-coordinate with partial steps
+   !!----------------------------------------------------------------------
+   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space domain variables
+   USE oce             ! ocean dynamics and tracers variables
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE eosbn2          ! ocean equation of state
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zps_hde          ! routine called by step.F90
+
+   !! * module variables
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      mbatu, mbatv      ! bottom ocean level index at U- and V-points
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   &
+                            pgtu, pgsu, pgru,   &
+                            pgtv, pgsv, pgrv  )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rd
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos_insitu_2d which will compute rd~(t~,s~) at 
+      !!      the good depth zh from interpolated T and S for the different
+      !!      formulation of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~
+      !!
+      !! ** Action  : - pgtu, pgsu, pgru: horizontal gradient of T, S
+      !!                and rd at U-points 
+      !!              - pgtv, pgsv, pgrv: horizontal gradient of T, S
+      !!                and rd at V-points 
+      !!
+      !! History :
+      !!   8.5  !  02-04  (A. Bozec)  Original code
+      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem, psal, prd            ! 3D T, S and rd fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   &
+         pgtu, pgsu, pgru,       &  ! horizontal grad. of T, S and rd at u- 
+         pgtv, pgsv, pgrv           ! and v-points of the partial step level
+
+      !! * Local declarations
+      INTEGER ::   ji, jj,       &  ! Dummy loop indices
+                   iku,ikv          ! partial step level at u- and v-points
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zti, ztj, zsi, zsj,     &  ! interpolated value of T, S 
+         zri, zrj,               &  ! and rd
+         zhgi, zhgj                 ! depth of interpolation for eos2d
+      REAL(wp) ::   &
+         ze3wu, ze3wv,           &  ! temporary scalars
+         zmaxu1, zmaxu2,         &  !    "         "
+         zmaxv1, zmaxv2             !    "         "
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! Initialization (first time-step only): compute mbatu and mbatv
+      IF( kt == nit000 ) THEN
+         mbatu(:,:) = 0
+         mbatv(:,:) = 0
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
+               mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
+            END DO
+         END DO
+         zti(:,:) = FLOAT( mbatu(:,:) )
+         ztj(:,:) = FLOAT( mbatv(:,:) )
+         ! lateral boundary conditions: T-point, sign unchanged
+         CALL lbc_lnk( zti , 'U', 1. )
+         CALL lbc_lnk( ztj , 'V', 1. )
+         mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
+         mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
+      ENDIF
+      
+
+      ! Interpolation of T and S at the last ocean level
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ! last level
+            iku = mbatu(ji,jj)
+            ikv = mbatv(ji,jj)
+
+            ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+            ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+            zmaxu1 =  ze3wu / fse3w(ji+1,jj  ,iku)
+            zmaxu2 = -ze3wu / fse3w(ji  ,jj  ,iku)
+            zmaxv1 =  ze3wv / fse3w(ji  ,jj+1,ikv)
+            zmaxv2 = -ze3wv / fse3w(ji  ,jj  ,ikv)
+
+            ! i- direction
+
+            IF( ze3wu >= 0. ) THEN      ! case 1
+               ! interpolated values of T and S
+               zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu1 * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) )
+               zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu1 * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) )
+               ! depth of the partial step level
+               zhgi(ji,jj) = fsdept(ji,jj,iku)
+               ! gradient of T and S
+               pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) )
+               pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) )
+
+            ELSE                        ! case 2
+               ! interpolated values of T and S
+               zti(ji,jj) = ptem(ji,jj,iku) + zmaxu2 * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) )
+               zsi(ji,jj) = psal(ji,jj,iku) + zmaxu2 * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) )
+               ! depth of the partial step level
+               zhgi(ji,jj) = fsdept(ji+1,jj,iku)
+               ! gradient of T and S 
+               pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) )
+               pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) )
+            ENDIF
+
+            ! j- direction
+
+            IF( ze3wv >= 0. ) THEN      ! case 1
+               ! interpolated values of T and S
+               ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv1 * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) )
+               zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv1 * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) )
+               ! depth of the partial step level
+               zhgj(ji,jj) = fsdept(ji,jj,ikv) 
+               ! gradient of T and S
+               pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) )
+               pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) )
+
+            ELSE                        ! case 2
+               ! interpolated values of T and S
+               ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv2 * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) )
+               zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv2 * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 
+               ! depth of the partial step level
+               zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 
+               ! gradient of T and S
+               pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) )
+               pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) )
+            ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial
+      ! step and store it in  zri, zrj for each  case
+      CALL eos( zti, zsi, zhgi, zri )
+      CALL eos( ztj, zsj, zhgj, zrj )
+
+
+      ! Gradient of density at the last level 
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            iku = mbatu(ji,jj)
+            ikv = mbatv(ji,jj)
+            ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+            ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+            IF( ze3wu >= 0. ) THEN    ! i-direction: case 1
+               pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) )
+            ELSE                      ! i-direction: case 2
+               pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )
+            ENDIF
+            IF( ze3wv >= 0. ) THEN    ! j-direction: case 1
+               pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) )  
+            ELSE                      ! j-direction: case 2
+               pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )
+            ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! Lateral boundary conditions on each gradient
+      CALL lbc_lnk( pgtu , 'U', -1. )   ;   CALL lbc_lnk( pgtv , 'V', -1. )
+      CALL lbc_lnk( pgsu , 'U', -1. )   ;   CALL lbc_lnk( pgsv , 'V', -1. )
+      CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )
+
+   END SUBROUTINE zps_hde
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   USE par_kind
+CONTAINS
+   SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   &      ! Empty routine
+                            pgtu, pgsu, pgru,   &
+                            pgtv, pgsv, pgrv  )
+      REAL(wp), DIMENSION(:,:,:) :: ptem, psal, prd
+      REAL(wp) :: pgtu, pgsu, pgru, pgtv, pgsv, pgrv
+      WRITE(*,*) 'zps_hde: You should not have seen this print! error?',   &
+         kt, ptem, psal, prd, pgtu, pgsu, pgru, pgtv, pgsv, pgrv
+   END SUBROUTINE zps_hde
+#endif
+
+   !!======================================================================
+END MODULE zpshde
Index: trunk/NEMO/OFF_SRC/ZDF/zdf.matrixsolver.h90
===================================================================
--- trunk/NEMO/OFF_SRC/ZDF/zdf.matrixsolver.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ZDF/zdf.matrixsolver.h90	(revision 325)
@@ -0,0 +1,55 @@
+!! 
+!!         ZDF.MATRIXSOLVER
+!!       ********************
+!! 
+!! Matrix inversion
+!!----------------------------------------------------------------------
+!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+!
+!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+!        (        ...               )( ...  ) ( ...  )
+!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+!
+!   m is decomposed in the product of an upper and lower triangular
+!   matrix
+!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+!   The second member is in 2d array zwy
+!   The solution is in 2d array zwx
+!   The 2d arry zwt and zwz are work space arrays
+!
+!   N.B. the starting vertical index (ikst) is equal to 1 except for
+!   the resolution of tke matrix where surface tke value is prescribed
+!   so that ikstrt=2.
+!!----------------------------------------------------------------------
+!!  OPA 8.5, LODYC-IPSL (2002)
+!!----------------------------------------------------------------------
+
+      ikstp1 = ikst + 1
+      ikenm2 = jpk - 2
+      DO ji = 2, jpim1
+         zwt(ji,ikst) = zwd(ji,ikst)
+      END DO
+      DO jk = ikstp1, jpkm1
+         DO ji = 2, jpim1
+            zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
+         END DO
+      END DO
+      DO ji = 2, jpim1
+         zwz(ji,ikst) = zwy(ji,ikst)
+      END DO
+      DO jk = ikstp1, jpkm1
+         DO ji = 2, jpim1
+            zwz(ji,jk) = zwy(ji,jk) - zwi(ji,jk) / zwt(ji,jk-1) * zwz(ji,jk-1)
+         END DO
+      END DO
+      DO ji = 2, jpim1
+         zwx(ji,jpkm1) = zwz(ji,jpkm1) / zwt(ji,jpkm1)
+      END DO
+      DO jk = ikenm2, ikst, -1
+         DO ji = 2, jpim1
+            zwx(ji,jk) =( zwz(ji,jk) - zws(ji,jk) * zwx(ji,jk+1) ) / zwt(ji,jk)
+         END DO
+      END DO
+      
Index: trunk/NEMO/OFF_SRC/ZDF/zdf.matrixsolver.vopt.h90
===================================================================
--- trunk/NEMO/OFF_SRC/ZDF/zdf.matrixsolver.vopt.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ZDF/zdf.matrixsolver.vopt.h90	(revision 325)
@@ -0,0 +1,67 @@
+!! 
+!!         ZDF.MATRIXSOLVER
+!!       ********************
+!! 
+!! Matrix inversion
+!!----------------------------------------------------------------------
+!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+!
+!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+!        (        ...               )( ...  ) ( ...  )
+!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+!
+!   m is decomposed in the product of an upper and lower triangular
+!   matrix
+!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+!   The second member is in 2d array zwy
+!   The solution is in 2d array zwx
+!   The 3d arry zwt is a work space array
+!   zwy is used and then used as a work space array : its value is modified!
+!
+!   N.B. the starting vertical index (ikst) is equal to 1 except for
+!   the resolution of tke matrix where surface tke value is prescribed
+!   so that ikstrt=2.
+!!----------------------------------------------------------------------
+!!  OPA 8.5, LODYC-IPSL (2002)
+!!----------------------------------------------------------------------
+
+      ikstp1 = ikst + 1
+      ikenm2 = jpk - 2
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            zwt(ji,jj,ikst) = zwd(ji,jj,ikst)
+         END DO
+      END DO
+
+      DO jk = ikstp1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      DO jk = ikstp1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * zwy(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            zwx(ji,jj,jpkm1) = zwy(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+
+      DO jk = ikenm2, ikst, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwx(ji,jj,jk) = ( zwy(ji,jj,jk) - zws(ji,jj,jk) * zwx(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
Index: trunk/NEMO/OFF_SRC/ZDF/zdf_oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/ZDF/zdf_oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ZDF/zdf_oce.F90	(revision 325)
@@ -0,0 +1,31 @@
+MODULE zdf_oce
+   !!======================================================================
+   !!              ***  MODULE  zdf_oce  ***
+   !! Ocean physics : define vertical mixing variables
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! mesh and scale factors
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Share Module variables
+
+   REAL(wp), PUBLIC ::   & !!: namzdf   vertical diffusion
+      avt0  = 1.e-5_wp     !: vertical eddy diffusivity (m2/s)
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
+      avt                   !: vertical diffusivity coeff. at w-point
+ 
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !:
+      avtb            !: background profile of avm and avt
+
+   LOGICAL, PUBLIC ::    &   !:
+      ln_zdfnpc        = .FALSE.        !: convection: non-penetrative convection flag
+ 
+   !!======================================================================
+END MODULE zdf_oce
Index: trunk/NEMO/OFF_SRC/ZDF/zdfddm.F90
===================================================================
--- trunk/NEMO/OFF_SRC/ZDF/zdfddm.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ZDF/zdfddm.F90	(revision 325)
@@ -0,0 +1,139 @@
+MODULE zdfddm
+   !!======================================================================
+   !!                       ***  MODULE  zdfddm  ***
+   !! Ocean physics : double diffusion mixing parameterization
+   !!======================================================================
+#if defined key_zdfddm   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfddm' :                                     double diffusion
+   !!----------------------------------------------------------------------
+   !!   zdf_ddm       : compute the Ks for salinity
+   !!   zdf_ddm_init  : read namelist and control the parameters
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_ddm     ! called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.    !: double diffusive mixing flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
+      avs ,               &  !: salinity vertical diffusivity coeff. at w-point
+      rrau                   !: heat/salt buoyancy flux ratio
+
+   !! * Module variables
+   REAL(wp) ::            & !!! * double diffusive mixing namelist *
+      avts  = 1.e-4_wp      ! maximum value of avs for salt fingering
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_ddm( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_ddm  ***
+      !!                    
+      !! ** Purpose :   Add to the vertical eddy diffusivity coefficient the 
+      !!      effect of salt fingering and diffusive convection. 
+      !!
+      !! ** Method  :   Diapycnal mixing is increased in case of double
+      !!      diffusive mixing (i.e. salt fingering and diffusive layering)
+      !!      following Merryfield et al. (1999). The rate of double diffusive 
+      !!      mixing depend on the buoyancy ratio: Rrau=alpha/beta dk[T]/dk[S]
+      !!      which is computed in rn2.F
+      !!         * salt fingering (Schmitt 1981):
+      !!      for Rrau > 1 and rn2 > 0 : zavfs = avts / ( 1 + (Rrau/hsbfr)^6 )
+      !!      for Rrau > 1 and rn2 > 0 : zavfs = O
+      !!      otherwise                : zavft = 0.7 zavs / Rrau
+      !!         * diffusive layering (Federov 1988):
+      !!      for 0< Rrau < 1 and rn2 > 0 : zavdt = 1.3635e-6  
+      !!                                 * exp( 4.6 exp(-0.54 (1/Rrau-1) ) )
+      !!      otherwise                   : zavdt = 0 
+      !!      for .5 < Rrau < 1 and rn2 > 0 : zavds = zavdt (1.885 Rrau -0.85)
+      !!      for  0 < Rrau <.5 and rn2 > 0 : zavds = zavdt 0.15 Rrau      
+      !!      otherwise                     : zavds = 0 
+      !!         * update the eddy diffusivity:
+      !!      avt = avt + zavft + zavdt
+      !!      avs = avs + zavfs + zavds
+      !!      avmu, avmv are required to remain at least above avt and avs.
+      !!      
+      !! ** Action  :   avt, avs : update vertical eddy diffusivity coef.
+      !!                           for temperature and salinity
+      !!
+      !! References :
+      !!      Merryfield et al., JPO, 29, 1124-1142, 1999.
+      !! History :
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step
+
+      !!----------------------------------------------------------------------
+
+
+      IF ( kt == nit000 )   CALL zdf_ddm_init          ! Initialization (first time-step only)
+
+
+   END SUBROUTINE zdf_ddm
+   
+   
+   SUBROUTINE zdf_ddm_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_ddm_init  ***
+      !!
+      !! ** Purpose :   Initialization of double diffusion mixing scheme
+      !!
+      !! ** Method  :   Read the nammbf namelist and check the parameter values
+      !!      called by zdf_ddm at the first timestep (nit000)
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      NAMELIST/namddm/ avts
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namddm : double diffusion mixing scheme
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namddm )
+
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_ddm : double diffusive mixing'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namddm : set dd mixing parameter'
+         WRITE(numout,*) '             maximum avs for dd mixing      avts   = ', avts
+         WRITE(numout,*)
+      ENDIF
+
+   END SUBROUTINE zdf_ddm_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :          Dummy module          No double diffusion
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .FALSE.   !: double diffusion flag
+CONTAINS
+   SUBROUTINE zdf_ddm( kt )           ! Dummy routine
+      WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt
+   END SUBROUTINE zdf_ddm
+#endif
+
+   !!======================================================================
+END MODULE zdfddm
Index: trunk/NEMO/OFF_SRC/ZDF/zdfini.F90
===================================================================
--- trunk/NEMO/OFF_SRC/ZDF/zdfini.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ZDF/zdfini.F90	(revision 325)
@@ -0,0 +1,67 @@
+MODULE zdfini
+   !!======================================================================
+   !!              ***  MODULE  zdfini  ***
+   !! Ocean physics : define vertical mixing variables
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! mesh and scale factors
+   USE zdf_oce         ! TKE vertical mixing          
+   USE ldfslp          ! ???
+
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC zdf_init          ! routine called by opa.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0   !   LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE zdf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the vertical ocean physics
+      !!
+      !! ** Method  :   Read namelist namzdf, control cpp keys
+      !!
+      !! History :
+      !!        !  97-06  (G. Madec)  Original code from inimix
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+
+      !! * Namelist
+      NAMELIST/namzdf/ avt0, ln_zdfnpc
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!----------------------------------------------------------------------
+
+      ! Read namzdf namelist : vertical mixing parameters
+      ! --------------------
+      REWIND( numnam )
+      READ  ( numnam, namzdf )
+
+      ! Parameter print
+      ! ---------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_init: vertical physics'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist namzdf : set vertical mixing mixing parameters'
+         WRITE(numout,*) '             non-penetrative convection       ln_zdfnpc = ', ln_zdfnpc
+         WRITE(numout,*) '             vertical eddy diffusivity           avt0   = ', avt0
+      ENDIF
+
+   END SUBROUTINE zdf_init
+
+   !!======================================================================
+END MODULE zdfini
Index: trunk/NEMO/OFF_SRC/ZDF/zdfmxl.F90
===================================================================
--- trunk/NEMO/OFF_SRC/ZDF/zdfmxl.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ZDF/zdfmxl.F90	(revision 325)
@@ -0,0 +1,237 @@
+MODULE zdfmxl
+   !!======================================================================
+   !!                       ***  MODULE  zdfmxl  ***
+   !! Ocean physics: mixed layer depth 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_mxl           ! called by step.F90
+
+   !! * Shared module variables
+   INTEGER, PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
+      nmln                  !: number of level in the mixed layer
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
+      hmld ,             &  !: mixing layer depth (turbocline) (m)
+      hmlp ,             &  !: mixed layer depth  (rho=rho0+zdcrit) (m)
+      hmlpt                 !: mixed layer depth at t-points (m)
+
+   !! * module variables
+   REAL(wp) ::   &
+      avt_c = 5.e-4_wp,  &  ! Kz criterion for the turbocline depth
+      rho_c = 0.01_wp       ! density criterion for mixed layer depth
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking'                               j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zdf_mxl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!      with a density criteria.
+      !!
+      !! ** Method  :   The turbocline depth is the depth at which the vertical 
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  autotasking optimization
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk     ! dummy loop indices
+      INTEGER ::   ik             ! temporary integer
+      INTEGER, DIMENSION(jpi,jpj) ::   &
+         imld                     ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   auto-tasking case : j-k-i loop'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 1, jpj                                   !  Vertical slab
+         !                                             ! ===============
+
+         ! 1. Turbocline depth
+         ! -------------------
+         ! last w-level at which avt<avt_c (starting from the bottom jk=jpk)
+         ! (since avt(.,.,jpk)=0, we have jpk=< imld =< 2 )
+         DO jk = jpk, 2, -1
+            DO ji = 1, jpi
+               IF( avt(ji,jj,jk) < avt_c ) imld(ji,jj) = jk 
+            END DO
+         END DO
+
+         ! Turbocline depth and sub-turbocline temperature
+         DO ji = 1, jpi
+            ik = imld(ji,jj)
+            hmld (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+         END DO
+
+!!gm idea
+!!   
+!!gm     DO jk = jpk, 2, -1
+!!gm        DO ji = 1, jpi
+!!gm           IF( avt(ji,jj,jk) < avt_c ) hmld(ji,jj) = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
+!!gm        END DO
+!!gm     END DO
+!!gm
+
+         ! 2. Mixed layer depth
+         ! --------------------
+         ! Initialization to the number of w ocean point mbathy
+         nmln(:,jj) = mbathy(:,jj)
+
+         ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
+         ! (rhop defined at t-point, thus jk-1 for w-level just above)
+         DO jk = jpkm1, 2, -1
+            DO ji = 1, jpi
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,1) + rho_c )   nmln(ji,jj) = jk
+            END DO
+         END DO
+
+         ! Mixed layer depth
+         DO ji = 1, jpi
+            ik = nmln(ji,jj)
+            hmlp (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+            hmlpt(ji,jj) = fsdept(ji,jj,ik-1)
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+   END SUBROUTINE zdf_mxl
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                         k-j-i loop
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zdf_mxl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!      with density criteria.
+      !!
+      !! ** Method  :   The turbocline depth is the depth at which the vertical
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  94-11  (M. Imbard)  Original code
+      !!   8.0  !  96-01  (E. Guilyardi)  sub mixed layer temp.
+      !!   8.1  !  97-07  (G. Madec)  optimization
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk     ! dummy loop indices
+      INTEGER ::   ik             ! temporary integer
+      INTEGER, DIMENSION(jpi,jpj) ::   &
+         imld                     ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+
+      ! 1. Turbocline depth
+      ! -------------------
+      ! last w-level at which avt<avt_c (starting from the bottom jk=jpk)
+      ! (since avt(.,.,jpk)=0, we have jpk=< imld =< 2 )
+      DO jk = jpk, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( avt(ji,jj,jk) < avt_c ) imld(ji,jj) = jk 
+            END DO
+         END DO
+      END DO
+
+      ! Turbocline depth and sub-turbocline temperature
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = imld(ji,jj)
+            hmld (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+!!gm idea
+!!   
+!!gm  DO jk = jpk, 2, -1
+!!gm     DO jj = 1, jpj
+!!gm        DO ji = 1, jpi
+!!gm           IF( avt(ji,jj,jk) < avt_c ) hmld(ji,jj) = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
+!!gm        END DO
+!!gm     END DO
+!!gm  END DO
+!!gm
+
+      ! 2. Mixed layer depth
+      ! --------------------
+      ! Initialization to the number of w ocean point mbathy
+      nmln(:,:) = mbathy(:,:)
+
+      ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
+      ! (rhop defined at t-point, thus jk-1 for w-level just above)
+      DO jk = jpkm1, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,1) + rho_c )   nmln(ji,jj) = jk
+            END DO
+         END DO
+      END DO
+
+      ! Mixed layer depth
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = nmln(ji,jj)
+            hmlp (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+            hmlpt(ji,jj) = fsdept(ji,jj,ik-1)
+         END DO
+      END DO
+
+   END SUBROUTINE zdf_mxl
+#endif
+
+   !!======================================================================
+END MODULE zdfmxl
Index: trunk/NEMO/OFF_SRC/ctlopn.f90
===================================================================
--- trunk/NEMO/OFF_SRC/ctlopn.f90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ctlopn.f90	(revision 325)
@@ -0,0 +1,153 @@
+   SUBROUTINE ctlopn ( knum, cdfile, cdstat, cdform, cdacce,   &
+                       klengh, kout, ldwp, krequ )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctlopn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!
+      !! History :
+      !!        !  95-12  (G. Madec)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER, INTENT( in ) ::   &
+         knum,     & ! logical unit to open
+         krequ,    & ! =1 file required (stop if not exist)
+         !           ! =0 file not required (create the file if does not exist)
+         kout,     & ! number of logical units for write
+         klengh      ! record length
+
+      INTEGER ::   iost
+      CHARACTER (len=* ), INTENT( in ) ::   &
+         cdacce,   & ! access specifier
+         cdform,   & ! formatting specifier
+         cdstat      ! disposition specifier
+      CHARACTER (len=* ), INTENT( in ) ::   &
+         cdfile      ! file name to open
+
+      LOGICAL ::  ldwp   ! boolean term for print
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Header$ 
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+
+
+      ! 1. Required file
+      ! ----------------
+
+      IF( krequ == 1 ) THEN
+
+         iost=0
+         IF( cdacce(1:6) == 'DIRECT' )  THEN
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+         ELSE
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, ERR=100, IOSTAT=iost)
+         ENDIF
+         IF( iost == 0 ) THEN
+            IF(ldwp) THEN
+               WRITE(kout,*) '     file   : ', cdfile,' 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: ', cdfile
+               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 'ctlopn bad opening'
+         ENDIF
+         
+         
+         ! 2. Not required, file create if not exist
+         ! -----------------------------------------
+         
+      ELSEIF( krequ == 0 ) THEN
+
+         iost = 0
+         IF( cdacce(1:6) == 'DIRECT' ) THEN
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, RECL=klengh, ERR=200, IOSTAT=iost )
+         ELSE
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, ERR=200, IOSTAT=iost )
+         ENDIF
+         IF(iost == 0) THEN
+            IF(ldwp) THEN
+               WRITE(kout,*) '     file   : ', cdfile,' open ok'
+               WRITE(kout,*) '     unit   = ', knum
+               WRITE(kout,*) '     status = ', cdstat
+               WRITE(kout,*) '     form   = ', cdform
+               WRITE(kout,*) '     access = ', cdacce
+               WRITE(kout,*)
+            ENDIF
+         ENDIF
+200      CONTINUE
+         IF( iost /= 0 ) THEN
+            iost = 0
+            IF(ldwp) THEN
+               WRITE(kout,*)
+               WRITE(kout,*) '     ===>>>> : file ', cdfile,   &
+                  ' does not exist: it is created'
+               WRITE(kout,*) ' =======   ===  '
+            ENDIF
+            IF( cdacce(1:6) == 'DIRECT' ) THEN
+               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
+                  ACCESS=cdacce, STATUS=cdstat,   &
+                  RECL=klengh, ERR=210, IOSTAT=iost )
+            ELSE
+               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
+                  ACCESS=cdacce, STATUS=cdstat, ERR=210,   &
+                  IOSTAT=iost )
+            ENDIF
+            IF(ldwp) THEN
+               WRITE(kout,*) '     file   : ', cdfile,' open ok'
+               WRITE(kout,*) '     unit   = ', knum
+               WRITE(kout,*) '     status = ', cdstat
+               WRITE(kout,*) '     form   = ', cdform
+               WRITE(kout,*) '     access = ', cdacce
+               WRITE(kout,*)
+            ENDIF
+210         CONTINUE
+            IF( iost /= 0 ) THEN
+               IF(ldwp) THEN
+                  WRITE(kout,*) ' logical unit ',knum,' iostat = ', iost
+                  WRITE(kout,*) ' we stop. verify the file ', cdfile
+                  WRITE(kout,*)
+               ENDIF
+               STOP '001'
+            ENDIF
+         ENDIF
+         
+      ELSE
+         
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ctlopn : invalid option, krequ = ', krequ
+            WRITE(kout,*) ' ~~~~~~   call for file ', cdfile
+            WRITE(kout,*)
+         ENDIF
+
+
+         STOP 'ctlopn invalid option'
+      ENDIF
+      
+   END SUBROUTINE ctlopn
Index: trunk/NEMO/OFF_SRC/daymod.F90
===================================================================
--- trunk/NEMO/OFF_SRC/daymod.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/daymod.F90	(revision 325)
@@ -0,0 +1,159 @@
+MODULE daymod
+   !!======================================================================
+   !!                       ***  MODULE  daymod  ***
+   !! Ocean        :  calendar 
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   day        : calendar
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC day        ! called by step.F90
+
+   !! * Shared module variables
+   INTEGER , PUBLIC ::   &  !:
+      nyear     ,   &  !: current year
+      nmonth    ,   &  !: current month
+      nday      ,   &  !: current day of the month
+      nday_year ,   &  !: curent day counted from jan 1st of the current year
+      ndastp           !: time step date in year/month/day aammjj
+   REAL(wp), PUBLIC ::   &  !:
+       adatrj   ,   &  !: number of elapsed days since the begining of the run
+       adatrj0         !: value of adatrj at nit000-1 (before the present run).
+       !               !  it is the accumulated duration of previous runs
+       !               !  that may have been run with different time steps.
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE day( kt )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE day  ***
+      !! 
+      !! ** Purpose :   Compute the date with a day iteration IF necessary.
+      !!
+      !! ** Method  : - ???
+      !!
+      !! ** Action  : - nyear     : current year
+      !!              - nmonth    : current month of the year nyear
+      !!              - nday      : current day of the month nmonth
+      !!              - nday_year : current day of the year nyear
+      !!              - ndastp    : =nyear*10000+nmonth*100+nday
+      !!              - adatrj    : date in days since the beginning of the run
+      !!
+      !! History :
+      !!        !  94-09  (M. Pontaud M. Imbard)  Original code
+      !!        !  97-03  (O. Marti)
+      !!        !  97-05  (G. Madec) 
+      !!        !  97-08  (M. Imbard)
+      !!   9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday
+      !!        !  04-01  (A.M. Treguier) new calculation based on adatrj
+      !!----------------------------------------------------------------------      
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step indices
+
+      !! * Local declarations
+      INTEGER  ::   js                   ! dummy loop indice
+      INTEGER  ::   iend, iday0, iday1   ! temporary integers
+      REAL(wp) :: zadatrjn, zadatrjb     ! adatrj at timestep kt-1 and kt-2 
+      CHARACTER (len=25) :: charout
+      !!----------------------------------------------------------------------
+
+      ! 0.  initialization of adatrj0 and nday, nmonth,nyear, nday_year.
+      !     ndastp has been initialized in domain.F90 or restart.F90
+      !-----------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         IF( .NOT.ln_rstart )   adatrj0 = 0.e0      ! adatrj0 initialized in rst_read when restart 
+
+         adatrj  = adatrj0
+         nyear   =   ndastp / 10000
+         nmonth  = ( ndastp - (nyear * 10000) ) / 100
+         nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
+
+         ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields)
+         nday_year =  nday
+         !                               ! accumulates days of previous months of this year
+         DO js = 1, nmonth-1
+            IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+               nday_year = nday_year + nbiss(js)
+            ELSE
+               nday_year = nday_year + nobis(js)
+            ENDIF
+         END DO
+
+      ENDIF
+
+      ! I.  calculates adatrj, zadatrjn, zadatrjb.
+      ! ------------------------------------------------------------------
+
+      adatrj    = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday
+      zadatrjn  = adatrj0 + ( kt - nit000     ) * rdttra(1) / rday
+      zadatrjb  = adatrj0 + ( kt - nit000 - 1 ) * rdttra(1) / rday
+
+
+      ! II.  increment the date.  The date corresponds to 'now' variables (kt-1),
+      !      which is the time step of forcing fields. 
+      !      Do not do this at nit000  unless nrstdt= 2
+      !      In that case ndastp (read in restart) was for step nit000-2
+      ! -------------------------------------------------------------------
+
+      iday0 = INT( zadatrjb )
+      iday1 = INT( zadatrjn )
+
+      IF( iday1 - iday0 >= 1 .AND. ( kt /= nit000 .OR. nrstdt == 2 ) ) THEN
+
+         ! increase calendar
+         nyear  =   ndastp / 10000
+         nmonth = ( ndastp - (nyear * 10000) ) / 100
+         nday   =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
+         nday = nday + 1
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            iend = nbiss(nmonth)
+         ELSEIF( nleapy > 1 ) THEN 
+            iend = nleapy
+         ELSE 
+            iend = nobis(nmonth)
+         ENDIF
+         IF( nday == iend + 1 ) THEN
+            nday  = 1
+            nmonth = nmonth + 1
+            IF( nmonth == 13 ) THEN
+               nmonth  = 1
+               nyear = nyear + 1
+            ENDIF
+         ENDIF
+         ndastp = nyear * 10000 + nmonth * 100 + nday
+
+         ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields)
+         nday_year =  nday
+         !                                ! accumulates days of previous months of this year
+         DO js = 1, nmonth-1
+            IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+               nday_year = nday_year + nbiss(js)
+            ELSE
+               nday_year = nday_year + nobis(js)
+            ENDIF
+         END DO
+
+         IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' New day, DATE= ',   &
+            &                   nyear, '/', nmonth, '/', nday, 'nday_year:', nday_year
+      ENDIF
+
+   END SUBROUTINE day
+
+   !!======================================================================
+END MODULE daymod
Index: trunk/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- trunk/NEMO/OFF_SRC/dtadyn.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/dtadyn.F90	(revision 325)
@@ -0,0 +1,811 @@
+MODULE dtadyn
+   !!======================================================================
+   !!                       ***  MODULE  dtadyn  ***
+   !! OFFLINE : interpolation of the physical fields
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dta_dyn_init : initialization, namelist read, and parameters control
+   !!   dta_dyn      : Interpolation of the fields
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE ocesbc
+   USE ldfslp
+   USE blk_oce
+   USE zdfmxl
+   USE trabbl          ! tracers: bottom boundary layer
+   USE ocfzpt
+   USE zdfddm          ! vertical  physics: double diffusion
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC dta_dyn_init   ! called by opa.F90
+   PUBLIC dta_dyn        ! called by step.F90
+
+   !! * Module variables
+   INTEGER , PUBLIC, PARAMETER :: jpflx = 13
+   INTEGER , PUBLIC, PARAMETER :: &
+      jptaux = 1 , & ! indice in flux for taux
+      jptauy = 2 , & ! indice in flux for tauy
+      jpwind = 3 , & ! indice in flux for wspd
+      jpemp = 4  , & ! indice in flux for E-P
+      jpice = 5  , & ! indice in flux for ice concentration
+      jpqsr = 6      ! indice in flux for shortwave heat flux 
+
+   LOGICAL , PUBLIC :: &
+      lperdyn = .TRUE. , & ! boolean for periodic fields or not
+      lfirdyn = .TRUE.     ! boolean for the first call or not
+
+   INTEGER , PUBLIC :: &
+      ndtadyn = 12 ,  & ! Number of dat in one year
+      ndtatot = 12 ,  & ! Number of data in the input field
+      nsptint = 1 ,   & ! type of spatial interpolation
+      nficdyn = 2       ! number of dynamical fields 
+
+   INTEGER :: ndyn1, ndyn2 , &
+      nlecoff = 0  , & ! switch for the first read
+      numfl_t, numfl_u, &
+      numfl_v, numfl_w, numfl_s
+      
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
+      tdta   ,   & ! temperature at two consecutive times
+      sdta   ,   & ! salinity at two consecutive times
+      udta   ,   & ! zonal velocity at two consecutive times
+      vdta   ,   & ! meridional velocity at two consecutive times
+      wdta   ,   & ! vertical velocity at two consecutive times
+      avtdta       ! vertical diffusivity coefficient
+
+#if defined key_ldfslp
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
+      uslpdta ,  & ! zonal isopycnal slopes
+      vslpdta ,  & ! meridional isopycnal slopes
+      wslpidta , & ! zonal diapycnal slopes
+      wslpjdta     ! meridional diapycnal slopes
+#endif
+
+   REAL(wp), DIMENSION(jpi,jpj,jpflx,2) ::   &
+      flxdta       ! auxiliary 2-D forcing fields at two consecutive times
+   REAL(wp), DIMENSION(jpi,jpj,2) ::       &
+      zmxldta      ! mixed layer depth at two consecutive times
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+   REAL(wp), DIMENSION(jpi,jpj,2) ::       &
+      bblxdta ,  & ! frequency of bbl in the x direction at 2 consecutive times
+      bblydta      ! frequency of bbl in the y direction at 2 consecutive times
+#endif
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dta_dyn_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_dyn_init  ***
+      !!
+      !! ** Purpose :   initializations of parameters for the interpolation
+      !!
+      !! ** Method :
+      !!
+      !! History :
+      !!    ! original  : 92-01 (M. Imbard: sub domain)
+      !!    ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
+      !!    ! 98-05 (L. Bopp read output of coupled run)
+      !!    ! 05-03 (O. Aumont and A. El Moussaoui) F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Local declarations
+
+
+      NAMELIST/nam_offdyn/ ndtadyn, ndtatot, nsptint,            & 
+          &                nficdyn, lperdyn
+      !!----------------------------------------------------------------------
+
+      !  Define the dynamical input parameters
+      ! ======================================
+
+      ! Read Namelist nam_offdyn : Lateral physics on tracers
+      REWIND( numnam )
+      READ  ( numnam, nam_offdyn )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'nam_offdyn : offline dynamical selection'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '  Namelist nam_offdyn : set parameters for the lecture of the dynamical fields'
+         WRITE(numout,*) 
+         WRITE(numout,*) ' number of elements in the FILE for a year  ndtadyn = ' , ndtadyn
+         WRITE(numout,*) ' total number of elements in the FILE       ndtatot = ' , ndtatot
+         WRITE(numout,*) ' type of interpolation                      nsptint = ' , nsptint
+         WRITE(numout,*) ' number of dynamics FILE                    nficdyn = ' , nficdyn
+         WRITE(numout,*) ' loop on the same FILE                      lperdyn = ' , lperdyn
+         WRITE(numout,*) ' '
+      ENDIF
+
+   END SUBROUTINE dta_dyn_init
+
+   SUBROUTINE dta_dyn(kt)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_dyn  ***
+      !!
+      !! ** Purpose : Prepares dynamics and physics fields from an 
+      !!              OPA9 simulation  for an off-line simulation
+      !!               for passive tracer
+      !!
+      !! ** Method : calculates the position of DATA to read READ DATA 
+      !!             (example month changement) computes slopes IF needed
+      !!             interpolates DATA IF needed
+      !!
+      !! ** History :
+      !!   ! original  : 92-01 (M. Imbard: sub domain)
+      !!   ! addition  : 98-04 (L.Bopp MA Foujols: slopes for isopyc.) 
+      !!   ! addition  : 98-05 (L. Bopp read output of coupled run)
+      !!   ! addition  : 05-03 (O. Aumont and A. El Moussaoui) F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE eosbn2
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   iper, iperm1, iswap   
+
+      REAL(wp) :: zpdtan, zpdtpe, zdemi, zt
+      REAL(wp) :: zweigh, zweighm1
+
+      REAL(wp), DIMENSION(jpi,jpj,jpflx) ::   &
+         flx  ! auxiliary field for 2-D surface boundary conditions
+
+
+      ! 0. Initialization
+      ! -----------------
+
+      zpdtan = raass / rdt
+      zpdtpe = ((zpdtan / FLOAT (ndtadyn)))
+      zdemi  = zpdtpe * 0.5
+      zt     = (FLOAT (kt) + zdemi ) / zpdtpe
+
+      zweigh   = zt - FLOAT(INT(zt))
+      zweighm1 = 1. - zweigh
+
+      IF (lperdyn) THEN
+         iperm1 = MOD(INT(zt),ndtadyn)
+      ELSE
+         iperm1 = MOD(INT(zt),(ndtatot-1))
+      ENDIF
+      iper = iperm1 + 1
+      IF (iperm1 == 0) THEN
+          IF (lperdyn) THEN
+              iperm1 = ndtadyn
+          ELSE 
+              IF (lfirdyn) THEN
+                  IF (lwp) THEN 
+                      WRITE (numout,*) ' dynamic file is not periodic '
+                      WRITE (numout,*) ' with or without interpolation, '
+                      WRITE (numout,*) ' we take the first value'
+                      WRITE (numout,*) ' for the previous period '
+                      WRITE (numout,*) ' iperm1 = 0  '
+                  END IF 
+              END IF
+          END IF 
+      END IF 
+
+      iswap  = 0
+
+      ! 1. First call lfirdyn = true
+      ! ----------------------------
+
+      IF (lfirdyn) THEN
+      !
+      ! time step MUST BE nint000
+      !
+         IF( kt .NE. nit000 ) THEN
+              IF (lwp) THEN
+                  WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt=',kt  &
+                     ,' nit000=',nit000
+              END IF 
+              STOP 'dtadyn'
+          END if
+      ! Initialize the parameters of the interpolation
+      CALL dta_dyn_init
+      !
+      ! store the information of the period read
+      !
+          ndyn1 = iperm1
+          ndyn2 = iper
+
+          IF (lwp) THEN
+              WRITE (numout,*)         &
+                 ' dynamics DATA READ for the period ndyn1 =',ndyn1, &
+              & ' and for the period ndyn2 = ',ndyn2
+              WRITE (numout,*) ' time step is :',kt
+              WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,&
+                 &         ' records in the dynamic FILE for one year'
+          END IF 
+      !
+      ! DATA READ for the iperm1 period
+      !
+          IF( iperm1 .NE. 0 ) THEN
+             CALL dynrea( kt, iperm1 ) 
+          ELSE 
+             CALL dynrea( kt, 1 )
+          ENDIF
+      !
+      ! Computes dynamical fields
+      !
+                tn(:,:,:)=tdta(:,:,:,2)
+                sn(:,:,:)=sdta(:,:,:,2)
+                avt(:,:,:)=avtdta(:,:,:,2)
+
+
+
+         IF(lwp) THEN
+            WRITE(numout,*)' temperature '
+            WRITE(numout,*)
+            CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) '  level = ',jpk/2
+            CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)  
+            WRITE(numout,*) '  level = ',jpkm1
+            CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
+            WRITE(numout,*)
+            WRITE(numout,*)' Wind '
+            WRITE(numout,*)
+            CALL prihre(flxdta(1,1,jpwind,2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+        ENDIF
+
+#if defined key_ldfslp
+            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density 
+            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
+            CALL zdf_mxl( kt )              ! mixed layer depth
+            CALL ldf_slp( kt, rhd, rn2 )
+
+            uslpdta(:,:,:,2)=uslp(:,:,:)
+            vslpdta(:,:,:,2)=vslp(:,:,:)
+            wslpidta(:,:,:,2)=wslpi(:,:,:)
+            wslpjdta(:,:,:,2)=wslpj(:,:,:)
+#endif
+       !
+       ! swap from record 2 to 1
+       !
+                udta(:,:,:,1)=udta(:,:,:,2)
+                vdta(:,:,:,1)=vdta(:,:,:,2)
+                wdta(:,:,:,1)=wdta(:,:,:,2)
+                avtdta(:,:,:,1)=avtdta(:,:,:,2)
+                tdta(:,:,:,1)=tdta(:,:,:,2)
+                sdta(:,:,:,1)=sdta(:,:,:,2)
+#if defined key_ldfslp
+                uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
+                vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
+                wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
+                wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
+#endif
+                flxdta(:,:,:,1) = flxdta(:,:,:,2)
+                zmxldta(:,:,1)=zmxldta(:,:,2)
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+                bblxdta(:,:,1)=bblxdta(:,:,2)
+                bblydta(:,:,1)=bblydta(:,:,2)
+#endif
+      !
+      ! indicates a swap
+      !
+          iswap = 1
+      !
+      ! DATA READ for the iper period
+      !
+          CALL dynrea(kt,iper)
+      !
+      ! Computes wdta (and slopes if key_trahdfiso)
+      !
+                tn(:,:,:)=tdta(:,:,:,2)
+                sn(:,:,:)=sdta(:,:,:,2)
+                avt(:,:,:)=avtdta(:,:,:,2)
+
+
+#if defined key_ldfslp
+            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density
+            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
+            CALL zdf_mxl( kt )              ! mixed layer depth
+            CALL ldf_slp( kt, rhd, rn2 )
+
+            uslpdta(:,:,:,2)=uslp(:,:,:)
+            vslpdta(:,:,:,2)=vslp(:,:,:)
+            wslpidta(:,:,:,2)=wslpi(:,:,:)
+            wslpjdta(:,:,:,2)=wslpj(:,:,:)
+#endif
+      !
+      ! trace the first CALL
+      !
+          lfirdyn=.FALSE. 
+      ENDIF
+      !
+      ! and now what we have to DO at every time step
+      !
+      ! check the validity of the period in memory
+      !
+      IF (iperm1.NE.ndyn1) THEN 
+          IF (iperm1.EQ.0.) THEN
+              IF (lwp) THEN
+                  WRITE (numout,*) ' dynamic file is not periodic '
+                  WRITE (numout,*) ' with or without interpolation, '
+                  WRITE (numout,*) ' we take the last value'
+                  WRITE (numout,*) ' for the last period '
+                  WRITE (numout,*) ' iperm1 = 12  '
+                  WRITE (numout,*) ' iper = 13'
+              ENDIF
+              iperm1 = 12
+              iper =13
+          ENDIF
+      !
+      ! we have to prepare a NEW READ of DATA
+      !
+      ! swap from record 2 to 1
+      !
+                udta(:,:,:,1)=udta(:,:,:,2)
+                vdta(:,:,:,1)=vdta(:,:,:,2)
+                wdta(:,:,:,1)=wdta(:,:,:,2)
+                avtdta(:,:,:,1)=avtdta(:,:,:,2)
+                tdta(:,:,:,1)=tdta(:,:,:,2)
+                sdta(:,:,:,1)=sdta(:,:,:,2)
+#if defined key_ldfslp
+                uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
+                vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
+                wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
+                wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
+#endif
+                flxdta(:,:,:,1) = flxdta(:,:,:,2)
+                zmxldta(:,:,1)=zmxldta(:,:,2)
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+                bblxdta(:,:,1)=bblxdta(:,:,2)
+                bblydta(:,:,1)=bblydta(:,:,2)
+#endif
+      !
+      ! indicates a swap
+      !
+          iswap = 1
+      !
+      ! READ DATA for the iper period
+      !
+          CALL dynrea(kt,iper)
+      !
+      ! Computes wdta (and slopes if key_trahdfiso)
+      !
+                tn(:,:,:)=tdta(:,:,:,2)
+                sn(:,:,:)=sdta(:,:,:,2)
+                avt(:,:,:)=avtdta(:,:,:,2)
+
+#if defined key_ldfslp
+            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density
+            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency
+            CALL zdf_mxl( kt )              ! mixed layer depth
+            CALL ldf_slp( kt, rhd, rn2 )
+
+            uslpdta(:,:,:,2)=uslp(:,:,:)
+            vslpdta(:,:,:,2)=vslp(:,:,:)
+            wslpidta(:,:,:,2)=wslpi(:,:,:)
+            wslpjdta(:,:,:,2)=wslpj(:,:,:)
+#endif
+       !
+       ! store the information of the period read
+       !
+          ndyn1 = ndyn2
+          ndyn2 = iper
+       !
+       ! we have READ another period of DATA
+       !
+          IF (lwp) THEN
+              WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1
+              WRITE (numout,*) ' and the period ndyn2 = ',ndyn2
+              WRITE (numout,*) ' time step is :',kt
+          END IF 
+
+      END IF 
+
+      !
+      ! compute the DATA at the given time step
+      !
+      IF (nsptint.eq.0) THEN
+      !
+      ! no spatial interpolation
+      !
+      ! DATA are probably correct 
+      ! we have to initialize DATA IF we have changed the period
+      !
+          IF (iswap.eq.1) THEN
+      !
+      ! initialize now fields with the NEW DATA READ
+      !
+                    un(:,:,:)=udta(:,:,:,2)
+                    vn(:,:,:)=vdta(:,:,:,2)
+                    wn(:,:,:)=wdta(:,:,:,2)
+#if defined key_trc_zdfddm
+                    avs(:,:,:)=avtdta(:,:,:,2)
+#endif
+                    avt(:,:,:)=avtdta(:,:,:,2)
+                    tn(:,:,:)=tdta(:,:,:,2)
+                    sn(:,:,:)=sdta(:,:,:,2)
+#if defined key_ldfslp
+                    uslp(:,:,:)=uslpdta(:,:,:,2)
+                    vslp(:,:,:)=vslpdta(:,:,:,2)
+                    wslpi(:,:,:)=wslpidta(:,:,:,2)
+                    wslpj(:,:,:)=wslpjdta(:,:,:,2)
+#endif
+
+                    flx(:,:,:) = flxdta(:,:,:,2)
+                    hmld(:,:)=zmxldta(:,:,2)
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+                    bblx(:,:)=bblxdta(:,:,2)
+                    bbly(:,:)=bblydta(:,:,2)
+#endif
+       !
+       ! keep needed fluxes
+       !
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+                    vatm(:,:) = flx(:,:,jpwind)
+#endif
+                    freeze(:,:) = flx(:,:,jpice)
+                    emp(:,:) = flx(:,:,jpemp)
+                    qsr(:,:) = flx(:,:,jpqsr)
+
+          END IF 
+
+      ELSE 
+          IF (nsptint.eq.1) THEN
+      !
+      ! linear interpolation
+      !
+      ! initialize now fields with a linear interpolation
+      !
+                    un(:,:,:) = zweighm1 * udta(:,:,:,1) + zweigh * udta(:,:,:,2) 
+                    vn(:,:,:) = zweighm1 * vdta(:,:,:,1) + zweigh * vdta(:,:,:,2)
+                    wn(:,:,:) = zweighm1 * wdta(:,:,:,1) + zweigh * wdta(:,:,:,2)
+#if defined key_zdfddm
+                    avs(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
+#endif
+                    avt(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
+                    tn(:,:,:) = zweighm1 * tdta(:,:,:,1) + zweigh * tdta(:,:,:,2)
+                    sn(:,:,:) = zweighm1 * sdta(:,:,:,1) + zweigh * sdta(:,:,:,2)
+   
+         
+#if defined key_ldfslp
+                    uslp(:,:,:) = zweighm1 * uslpdta(:,:,:,1) + zweigh * uslpdta(:,:,:,2) 
+                    vslp(:,:,:) = zweighm1 * vslpdta(:,:,:,1) + zweigh * vslpdta(:,:,:,2) 
+                    wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + zweigh * wslpidta(:,:,:,2) 
+                    wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + zweigh * wslpjdta(:,:,:,2) 
+#endif
+                    flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2) 
+                    hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh  * zmxldta(:,:,2) 
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+                    bblx(:,:)= zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2)
+                    bbly(:,:)= zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2)
+#endif
+       !
+       ! keep needed fluxes
+       !
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+                  vatm(:,:) = flx(:,:,jpwind)
+#endif
+                  freeze(:,:) = flx(:,:,jpice)
+                  emp(:,:) = flx(:,:,jpemp)
+                  qsr(:,:) = flx(:,:,jpqsr)
+       !
+       ! other interpolation
+       !
+          ELSE 
+
+              WRITE (numout,*) ' this kind of interpolation don t EXIST'
+              WRITE (numout,*) ' at the moment. we STOP '
+              STOP 'dtadyn'
+
+          END IF 
+
+      END IF
+      !
+      ! lb in any case, we need rhop
+      !
+      CALL eos( tn, sn, rhd, rhop ) 
+
+   END SUBROUTINE dta_dyn
+
+   SUBROUTINE dynrea( kt, kenr )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dynrea  ***
+      !!
+      !! ** Purpose : READ dynamics fiels from OPA9 netcdf output
+      !! 
+      !! ** Method : READ the kenr records of DATA and store in
+      !!             in udta(...,2), ....  
+      !! 
+      !! ** History : additions : M. Levy et M. Benjelloul jan 2001 
+      !!              (netcdf FORMAT) 
+      !!              05-03 (O. Aumont and A. El Moussaoui) F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt, kenr       ! time index
+      !! * Local declarations
+      INTEGER ::   ji, jj
+      INTEGER ::   ipi,ipj,ipk,itime,jkenr,idtatot
+      INTEGER , DIMENSION(ndtatot) :: istep
+
+      REAL(wp) ::  zdate0
+
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+        zu, zv, zw, zt, zs, zavt, zaeiu, zaeiv, zaeiw ! 3-D dynamical fields
+
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+        zlon, zlat, zemp, zqsr, zmld, zice, zwind 
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+        zbblx, zbbly
+#endif
+      REAL(wp), DIMENSION(jpk) :: zlev
+
+      CHARACTER(len=45)  ::  &
+         clname_t = 'dyna_grid_T.nc', &
+         clname_u = 'dyna_grid_U.nc', &
+         clname_v = 'dyna_grid_V.nc', &
+         clname_w = 'dyna_grid_W.nc', &
+         clname_s = 'dyna_wspd.nc'
+      !
+      ! 0. Initialization
+      ! cas d'un fichier non periodique : on utilise deux fois le premier et
+      ! le dernier champ temporel
+
+      jkenr = kenr
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*)
+      ENDIF
+
+
+      
+      idtatot = ndtatot
+
+      IF( kt == nit000 .AND. nlecoff == 0 ) THEN
+
+         nlecoff = 1
+
+         CALL flinopen(clname_t,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
+            &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_t)
+
+         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk
+            ENDIF
+            STOP 'dynrea  '
+         ENDIF
+
+         CALL flinopen(clname_u,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
+            &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_u)
+
+         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk
+            ENDIF
+            STOP 'dynrea  '
+         ENDIF
+
+         CALL flinopen(clname_v,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
+            &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_v)
+
+         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk
+            ENDIF
+            STOP 'dynrea '
+         ENDIF
+
+         CALL flinopen(clname_w,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
+            &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_w)
+
+         IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk
+            ENDIF
+            STOP 'dynrea '
+         ENDIF
+
+         CALL flinopen(clname_s,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, &
+            &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_s)
+
+         IF( ipi /= jpidta .OR. ipj /= jpjdta  ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+            ENDIF
+            STOP 'dynrea'
+         ENDIF
+
+      ENDIF
+
+      CALL flinget(numfl_u,'vozocrtx',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &         jkenr,mig(1),nlci,mjg(1),nlcj,zu(1:nlci,1:nlcj,1:jpk))
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+      CALL flinget(numfl_u,'sobblcox',jpidta,jpjdta,1,idtatot,jkenr,  &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zbblx(1:nlci,1:nlcj))
+#endif
+
+# if defined key_traldf_eiv
+      CALL flinget(numfl_u,'vozoeivu',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zaeiu(1:nlci,1:nlcj,1:jpk))
+#endif
+
+      CALL flinget(numfl_v,'vomecrty',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zv(1:nlci,1:nlcj,1:jpk))
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+      CALL flinget(numfl_v,'sobblcoy',jpidta,jpjdta,1,idtatot,jkenr,  &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zbbly(1:nlci,1:nlcj))
+#endif
+
+# if defined key_traldf_eiv
+      CALL flinget(numfl_v,'vomeeivv',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zaeiv(1:nlci,1:nlcj,1:jpk))
+#endif
+
+      CALL flinget(numfl_w,'vovecrtz',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zw(1:nlci,1:nlcj,1:jpk))
+
+# if defined key_traldf_eiv
+      CALL flinget(numfl_w,'voveeivw',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zaeiw(1:nlci,1:nlcj,1:jpk))
+#endif
+
+
+#if defined key_zdfddm
+      CALL flinget(numfl_w,'voddmavs',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk))
+#else
+      CALL flinget(numfl_w,'votkeavt',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk))
+#endif
+
+      CALL flinget(numfl_t,'votemper',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zt(1:nlci,1:nlcj,1:jpk))
+
+      CALL flinget(numfl_t,'vosaline',jpidta,jpjdta,jpk,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zs(1:nlci,1:nlcj,1:jpk))
+
+      CALL flinget(numfl_t,'somixhgt',jpidta,jpjdta,1,idtatot,jkenr,  &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zmld(1:nlci,1:nlcj))
+
+
+      CALL flinget(numfl_t,'sowaflup',jpidta,jpjdta,1,idtatot,jkenr,  &
+         &         jkenr,mig(1),nlci,mjg(1),nlcj,zemp(1:nlci,1:nlcj))
+
+      CALL flinget(numfl_t,'soshfldo',jpidta,jpjdta,1,idtatot,jkenr,  &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zqsr(1:nlci,1:nlcj))
+
+      CALL flinget(numfl_t,'soicecov',jpidta,jpjdta,1,idtatot,jkenr,  &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zice(1:nlci,1:nlcj))
+
+      CALL flinget(numfl_s,'wspd',    jpidta,jpjdta,1,idtatot,jkenr,   &
+         &        jkenr,mig(1),nlci,mjg(1),nlcj,zwind(1:nlci,1:nlcj))
+ 
+
+        ! Extra-halo initialization in MPP
+         IF( lk_mpp ) THEN
+            DO ji = nlci+1, jpi
+               zu(ji,:,:) = zu(1,:,:)   
+               zv(ji,:,:) = zv(1,:,:)   
+               zw(ji,:,:) = zw(1,:,:)   
+               zavt(ji,:,:)=zavt(1,:,:)
+               zt(ji,:,:)=zt(1,:,:)
+               zs(ji,:,:)=zs(1,:,:)
+               zmld(ji,:)=zmld(1,:)
+               zwind(ji,:)=zwind(1,:)
+               zemp(ji,:)=zemp(1,:)
+               zqsr(ji,:)=zqsr(1,:)
+               zice(ji,:)=zice(1,:)
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+               zbblx(ji,:)=zbblx(1,:)
+               zbbly(ji,:)=zbbly(1,:)
+#endif
+#if defined key_traldf_eiv
+               zaeiu(ji,:,:)=zaeiu(1,:,:)
+               zaeiv(ji,:,:)=zaeiv(1,:,:)
+               zaeiw(ji,:,:)=zaeiw(1,:,:)
+#endif
+            ENDDO
+            DO jj = nlcj+1, jpj
+               zu(:,jj,:) = zu(:,1,:)
+               zv(:,jj,:) = zv(:,1,:)
+               zw(:,jj,:) = zw(:,1,:)
+               zavt(:,jj,:)=zavt(:,1,:)
+               zt(:,jj,:)=zt(:,1,:)
+               zs(:,jj,:)=zs(:,1,:)
+               zmld(:,jj)=zmld(:,1)
+               zwind(:,jj)=zwind(:,1)
+               zemp(:,jj)=zemp(:,1)
+               zqsr(:,jj)=zqsr(:,1)
+               zice(:,jj)=zice(:,1)
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+               zbblx(:,jj)=zbblx(:,1)
+               zbbly(:,jj)=zbbly(:,1)
+#endif
+#if defined key_traldf_eiv
+               zaeiu(:,jj,:)=zaeiu(:,1,:)
+               zaeiv(:,jj,:)=zaeiv(:,1,:)
+               zaeiw(:,jj,:)=zaeiw(:,1,:)
+#endif
+            ENDDO
+         ENDIF
+
+
+            udta(:,:,:,2)=zu(:,:,:)*umask(:,:,:)
+            vdta(:,:,:,2)=zv(:,:,:)*vmask(:,:,:)
+            wdta(:,:,:,2)=zw(:,:,:)*tmask(:,:,:)
+            tdta(:,:,:,2)=zt(:,:,:)*tmask(:,:,:)
+            sdta(:,:,:,2)=zs(:,:,:)*tmask(:,:,:)
+            avtdta(:,:,:,2)=zavt(:,:,:)*tmask(:,:,:)
+      !
+      !
+      ! flux :
+      !
+            flxdta(:,:,jpwind,2)=zwind(:,:)*tmask(:,:,1)
+            flxdta(:,:,jpice,2)=min(1.,zice(:,:))*tmask(:,:,1)
+            flxdta(:,:,jpemp,2)=zemp(:,:)*tmask(:,:,1)
+            flxdta(:,:,jpqsr,2)=zqsr(:,:)*tmask(:,:,1)
+            zmxldta(:,:,2)=zmld(:,:)*tmask(:,:,1)
+
+#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv
+            bblxdta(:,:,2)=max(0.,zbblx(:,:))
+            bblydta(:,:,2)=max(0.,zbbly(:,:))
+
+        DO ji=1,jpi
+          DO jj=1,jpj
+            if (bblxdta(ji,jj,2).gt.2.) bblxdta(ji,jj,2)=0.
+            if (bblydta(ji,jj,2).gt.2.) bblydta(ji,jj,2)=0.
+          END DO
+        END DO
+#endif
+
+   END SUBROUTINE dynrea
+
+
+
+END MODULE dtadyn
Index: trunk/NEMO/OFF_SRC/eosbn2.F90
===================================================================
--- trunk/NEMO/OFF_SRC/eosbn2.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/eosbn2.F90	(revision 325)
@@ -0,0 +1,834 @@
+MODULE eosbn2
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Ocean diagnostic variable : equation of state - in situ and potential density
+   !!                                               - Brunt-Vaisala frequency 
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   eos            : generic interface of the equation of state
+   !!   eos_insitu     : Compute the in situ density
+   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
+   !!                    volumic mass
+   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
+   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_init       : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE zdfddm          ! vertical physics: double diffusion
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Interface 
+   INTERFACE eos
+      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+   END INTERFACE 
+   INTERFACE bn2
+      MODULE PROCEDURE eos_bn2
+   END INTERFACE 
+
+   !! * Routine accessibility
+   PUBLIC eos        ! called by step.F90, inidtr.F90, tranpc.F90 and intgrd.F90
+   PUBLIC bn2        ! called by step.F90
+
+   !! * Share module variables
+   INTEGER , PUBLIC ::   &  !: nameos : ocean physical parameters
+      neos      = 0,     &  !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+      neos_init = 0         !: control flag for initialization
+
+   REAL(wp), PUBLIC ::   &  !: nameos : ocean physical parameters
+      ralpha = 2.0e-4,   &  !: thermal expension coeff. (linear equation of state)
+      rbeta  = 7.7e-4       !: saline  expension coeff. (linear equation of state)
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE eos_insitu ( ptem, psal, prd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !! 
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
+      !!       potential temperature and salinity using an equation of state
+      !!       defined through the namelist parameter neos.
+      !!
+      !! ** Method  :   3 cases:
+      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      neos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - ralpha * t
+      !!      neos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rbeta * s - ralpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (ptem,psal) are defined over the whole domain.
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :
+      !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994
+      !!
+      !! History :
+      !!        !  89-03 (o. Marti)  Original code
+      !!        ! 94-08 (G. Madec)
+      !!        !  96-01 (G. Madec) statement function for e3
+      !!        !  97-07 (G. Madec) introduction of neos, OPA8.1
+      !!        !  97-07 (G. Madec) density instead of volumic mass
+      !!        !  99-02 (G. Madec, N. Grima) semi-implicit pressure gradient
+      !!        !  01-09 (M. Ben Jelloul) bugfix   
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem,                 &  ! potential temperature
+         psal                     ! salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         prd                      ! potential density (surface referenced)
+
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   &          
+         zt , zs , zh , zsr,   &  ! temporary scalars
+         zr1, zr2, zr3, zr4,   &  !    "         " 
+         zrhop, ze, zbw, zb,   &  !    "         "
+         zd , zc , zaw, za ,   &  !    "         "
+         zb1, za1, zkw, zk0       !    "         "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zws                      ! temporary workspace
+      !!----------------------------------------------------------------------
+
+
+      ! initialization (in not already done)
+      IF( neos_init == 0 ) CALL eos_init
+
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  ! depth
+                  zh = fsdept(ji,jj,jk)
+                  ! square root salinity
+                  zsr= zws(ji,jj,jk)
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
+                     -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
+                     -4.0899e-3 ) *zt+0.824493
+                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+                  zr4= 4.8314e-4
+
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+                  ! add the compression terms
+                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                  zb = zbw + ze * zs
+
+                  zd = -2.042967e-2
+                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                  za = ( zd*zsr + zc ) *zs + zaw
+
+                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     - rau0 ) / rau0 * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd(ji,jj,jk) = ( 0.0285 - ralpha * zt ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd(ji,jj,jk) = (   rbeta  * zs - ralpha * zt ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot ( ptem, psal, prd, prhop)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!           
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state defined through the 
+      !!     namelist parameter neos.
+      !!
+      !! ** Method  :
+      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!              rhop(t,s)  = rho(t,s,0)
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!
+      !!      neos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - ralpha * t
+      !!              rhop(t,s)  = rho(t,s)
+      !!
+      !!      neos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
+      !!                       = rbeta * s - ralpha * tn - 1.
+      !!              rhop(t,s)  = rho(t,s)
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !! References :
+      !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994
+      !!      Brown, J. A. and K. A. Campana. Mon. Weather Rev., 1978
+      !!
+      !! History :
+      !!   4.0  !  89-03  (O. Marti)
+      !!        !  94-08  (G. Madec)
+      !!        !  96-01  (G. Madec) statement function for e3
+      !!        !  97-07  (G. Madec) introduction of neos, OPA8.1
+      !!        !  97-07  (G. Madec) density instead of volumic mass
+      !!        !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+      !!        !  01-09  (M. Ben Jelloul) bugfix   
+      !!   9.0  !  03-08  (G. Madec)  F90, free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem,   &  ! potential temperature
+         psal       ! salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         prd,    &  ! potential density (surface referenced)
+         prhop      ! potential density (surface referenced)
+
+      !! * Local declarations
+      INTEGER  ::  ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   &             ! temporary scalars
+         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   &
+         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws
+      !!----------------------------------------------------------------------
+
+      ! initialization (in not already done)
+      IF( neos_init == 0 ) CALL eos_init
+
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  ! depth
+                  zh = fsdept(ji,jj,jk)
+                  ! square root salinity
+!!Edmee           zsr= SQRT( ABS( zs ) )
+                  zsr= zws(ji,jj,jk)
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
+                     -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
+                     -4.0899e-3 ) *zt+0.824493
+                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+                  zr4= 4.8314e-4
+
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+                  ! save potential volumic mass
+                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
+
+                  ! add the compression terms
+                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                  zb = zbw + ze * zs
+
+                  zd = -2.042967e-2
+                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                  za = ( zd*zsr + zc ) *zs + zaw
+
+                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     - rau0 ) / rau0 * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd  (ji,jj,jk) = ( 0.0285 - ralpha * zt )        * tmask(ji,jj,jk)
+                  prhop(ji,jj,jk) = ( rau0 * prd(ji,jj,jk) + rau0 ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd  (ji,jj,jk) = ( rbeta  * zs - ralpha * zt ) * tmask(ji,jj,jk)
+                  prhop(ji,jj,jk) = ( rau0 * prd(ji,jj,jk) + rau0 )    * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_insitu_pot
+
+   SUBROUTINE eos_insitu_2d ( ptem, psal, pdep, prd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_2d  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
+      !!      potential temperature and salinity using an equation of state
+      !!      defined through the namelist parameter neos. * 2D field case
+      !!
+      !! ** Method :
+      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      neos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - ralpha * t
+      !!      neos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rbeta * s - ralpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (ptem,psal) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd , the in situ density (no units)
+      !!
+      !! References :
+      !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994
+      !!
+      !! History :
+      !!   8.5  !  02-11  (G. Madec, A. Bozec)  partial step
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::   &
+         ptem,                           &  ! potential temperature
+         psal,                           &  ! salinity
+         pdep                               ! depth
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   &
+         prd                                ! potential density (surface referenced)
+
+      !! * Local declarations
+      INTEGER ::  ji, jj                    ! dummy loop indices
+      REAL(wp) ::   &             ! temporary scalars
+         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   &
+         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0,               &
+         zmask
+      REAL(wp), DIMENSION(jpi,jpj) :: zws
+      !!----------------------------------------------------------------------
+
+
+      ! initialization (in not already done)
+      IF( neos_init == 0 ) CALL eos_init
+
+      prd(:,:) = 0.e0
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+!CDIR NOVERRCHK
+         DO jj = 1, jpjm1
+!CDIR NOVERRCHK
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+               zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
+            END DO
+         END DO
+
+         !                                                ! ===============
+         DO jj = 1, jpjm1                                 ! Horizontal slab
+            !                                             ! ===============
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+
+               zmask = tmask(ji,jj,1)      ! land/sea bottom mask = surf. mask
+
+               zt = ptem (ji,jj)            ! interpolated T
+               zs = psal (ji,jj)            ! interpolated S
+               zsr= zws(ji,jj)            ! square root of interpolated S
+               zh = pdep(ji,jj)            ! depth at the partial step level
+
+               ! compute volumic mass pure water at atm pressure
+               zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
+                         -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+               ! seawater volumic mass atm pressure
+               zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt   &
+                         -4.0899e-3 ) *zt+0.824493
+               zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+               zr4= 4.8314e-4
+
+               ! potential volumic mass (reference to the surface)
+               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+               ! add the compression terms
+               ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+               zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+               zb = zbw + ze * zs
+
+               zd = -2.042967e-2
+               zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+               zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt -4.721788
+               za = ( zd*zsr + zc ) *zs + zaw
+
+               zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+               za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+               zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt   &
+                         +2098.925 ) *zt+190925.6
+               zk0= ( zb1*zsr + za1 )*zs + zkw
+
+               ! masked in situ density anomaly
+               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 )   &
+                          / rau0 * zmask
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jj = 1, jpjm1                                 ! Horizontal slab
+            !                                             ! ===============
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+               prd(ji,jj) = ( 0.0285 - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1)
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jj = 1, jpjm1                                 ! Horizontal slab
+            !                                             ! ===============
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+               prd(ji,jj) = ( rbeta * psal(ji,jj) - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1) 
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+
+   END SUBROUTINE eos_insitu_2d
+
+
+   SUBROUTINE eos_bn2( ptem, psal, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
+      !!      step of the input arguments
+      !!      
+      !! ** Method :
+      !!       * neos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * neos = 1  : linear equation of state (temperature only)
+      !!            N^2 = grav * ralpha * dk[ t ]/e3w
+      !!       * neos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = grav * (ralpha * dk[ t ] - rbeta * dk[ s ] ) / e3w
+      !!      The use of potential density to compute N^2 introduces e r r o r
+      !!      in the sign of N^2 at great depths. We recommand the use of 
+      !!      neos = 0, except for academical studies.
+      !!        Macro-tasked on horizontal slab (jk-loop)
+      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
+      !!      and is never used at this level.
+      !!
+      !! ** Action  : - pn2 : the brunt-vaisala frequency
+      !!
+      !! References :
+      !!      McDougall, T. J., J. Phys. Oceanogr., 17, 1950-1964, 1987.
+      !!
+      !! History :
+      !!   6.0  !  94-07  (G. Madec, M. Imbard)  Original code
+      !!   8.0  !  97-07  (G. Madec) introduction of statement functions
+      !!   8.5  !  02-07  (G. Madec) Free form, F90
+      !!   8.5  !  02-08  (G. Madec) introduction of arguments
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem,                           &  ! potential temperature
+         psal                               ! salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         pn2                               ! Brunt-Vaisala frequency
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   &
+         zgde3w, zt, zs, zh,  &  ! temporary scalars 
+         zalbet, zbeta           !    "         "
+#if defined key_zdfddm
+      REAL(wp) ::   zds          ! temporary scalars
+#endif
+      !!----------------------------------------------------------------------
+      !!  OPA8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! pn2 : first and last levels
+      ! ---------------------------
+      ! bn^2=0. at jk=1 and jpk set in inidtr.F : no computation
+
+
+      ! pn2 : interior points only (2=< jk =< jpkm1 )
+      ! -------------------------- 
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+         !                                                ! ===============
+         DO jk = 2, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / fse3w(ji,jj,jk)
+                  zt = 0.5 * ( ptem(ji,jj,jk) + ptem(ji,jj,jk-1) )          ! potential temperature at w-point
+                  zs = 0.5 * ( psal(ji,jj,jk) + psal(ji,jj,jk-1) ) - 35.0   ! salinity anomaly (s-35) at w-point
+                  zh = fsdepw(ji,jj,jk)                                     ! depth in meters  at w-point
+
+                  zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta
+                     &                               - 0.203814e-03 ) * zt   &
+                     &                               + 0.170907e-01 ) * zt   &
+                     &   + 0.665157e-01                                      &
+                     &   +     ( - 0.678662e-05 * zs                         &
+                     &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   &
+                     &   +   ( ( - 0.302285e-13 * zh                         &
+                     &           - 0.251520e-11 * zs                         &
+                     &           + 0.512857e-12 * zt * zt           ) * zh   &
+                     &           - 0.164759e-06 * zs                         &
+                     &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   &
+                     &                               + 0.380374e-04 ) * zh
+
+                  zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta
+                     &                            - 0.301985e-05 ) * zt      &
+                     &   + 0.785567e-03                                      &
+                     &   + (     0.515032e-08 * zs                           &
+                     &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     &
+                     &   +(  (   0.121551e-17 * zh                           &
+                     &         - 0.602281e-15 * zs                           &
+                     &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     &
+                     &                             + 0.408195e-10   * zs     &
+                     &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     &
+                     &                             - 0.121555e-07 ) * zh
+
+                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2 
+                     &          * ( zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
+                     &                     - ( psal(ji,jj,jk-1) - psal(ji,jj,jk) ) )
+#if defined key_zdfddm
+                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
+                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20 ) zds = 1.e-20
+                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
+#endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jk = 2, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  pn2(ji,jj,jk) = zgde3w * ralpha * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jk = 2, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  pn2(ji,jj,jk) = zgde3w * (  ralpha * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
+                     &                      - rbeta  * ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )  )
+               END DO
+            END DO
+#if defined key_zdfddm
+            !                                                ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            zalbet = ralpha / rbeta
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )
+                  IF ( ABS( zds ) <= 1.e-20 ) zds = 1.e-20
+                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
+               END DO
+            END DO
+#endif
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_bn2
+
+
+   SUBROUTINE eos_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos
+      !!
+      !! ** Action  :   blahblah....
+      !!
+      !! History :
+      !!   8.5  !  02-10  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      NAMELIST/nameos/ neos, ralpha, rbeta
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! set the initialization flag to 1
+      neos_init = 1           ! indicate that the initialization has been done
+
+      ! namelist nameos : ocean physical parameters
+
+      ! Read Namelist nameos : equation of state
+      REWIND( numnam )
+      READ  ( numnam, nameos )
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist nameos : set eos parameters'
+         WRITE(numout,*)
+         WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos
+         WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha
+         WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta
+         WRITE(numout,*)
+      ENDIF
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
+         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )'
+         IF( lk_zdfddm ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          double diffusive mixing parameterization requires',   &
+                                             ' that T and S are used as state variables'
+            nstop = nstop + 1
+         ENDIF
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )'
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_init
+
+   !!======================================================================
+END MODULE eosbn2  
Index: trunk/NEMO/OFF_SRC/in_out_manager.F90
===================================================================
--- trunk/NEMO/OFF_SRC/in_out_manager.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/in_out_manager.F90	(revision 325)
@@ -0,0 +1,104 @@
+MODULE in_out_manager   
+
+   USE lib_print         ! formated print library
+   USE par_kind
+   USE par_oce
+
+   PUBLIC
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! namelist parameters
+   !! -------------------------------------
+   ! namrun:  parameters of the run
+   CHARACTER (len=16) ::    &   !:
+      cexper = "exp0"           !: experiment name used for output filename
+   
+   LOGICAL ::   &              !!: * namelist namrun *
+      ln_rstart = .FALSE. ,  &  !: start from (F) rest or (T) a restart file
+      ln_ctl    = .FALSE.       !: run control for debugging
+   
+   INTEGER ::                & !!: * namelist namrun *
+      no     = 0        ,    &  !: job number
+      nrstdt = 0        ,    &  !: control of the time step (0, 1 or 2)
+      nit000 = 1        ,    &  !: index of the first time step
+      nitend = 10       ,    &  !: index of the last time step
+      ndate0 = 961115   ,    &  !: initial calendar date aammjj
+      nleapy = 0        ,    &  !: Leap year calendar flag (0/1 or 30)
+      ninist = 0        ,    &  !: initial state output flag (0/1)
+      nbench = 0                !: benchmark parameter (0/1)
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   
+   INTEGER ::                &  !:
+      nstop = 0 ,            &  !: e r r o r  flag (=number of reason for a
+      !                         !                   prematurely stop the run)
+      nwarn = 0                 !: w a r n i n g  flag (=number of warning
+      !                         !                       found during the run)
+
+   
+   CHARACTER (len=64) ::        &                                                    !:
+      cform_err="(/,' ===>>> : E R R O R',     /,'         ===========',/)"    ,   & !:
+      cform_war="(/,' ===>>> : W A R N I N G', /,'         ===============',/)"      !:
+   !!----------------------------------------------------------------------
+   !! output monitoring
+   !! -----------------------------------
+
+   LOGICAL ::   &               !:
+      lwp                ,   &  !: boolean : true on the 1st processor only
+      lsp_area = .TRUE.         !: to make a control print over a specific area
+
+   INTEGER ::                &  !:
+      nstock =   10 ,        &  !: restart file frequency
+      nprint =    0 ,        &  !: level of print (0 no print)
+      nwrite =   10 ,        &  !: restart file frequency
+      nictls =    0 ,        &  !: Start i indice for the SUM control
+      nictle =    0 ,        &  !: End   i indice for the SUM control
+      njctls =    0 ,        &  !: Start j indice for the SUM control
+      njctle =    0 ,        &  !: End   j indice for the SUM control
+      isplt  =    1 ,        &  !: number of processors following i
+      jsplt  =    1 ,        &  !: number of processors following j
+      ijsplt =    1             !: nb of local domain = nb of processors
+
+   !!----------------------------------------------------------------------
+   !! logical units
+   !! ------------------------------
+   INTEGER ::                &  !:
+      numstp     =  1 ,      &  !: logical unit for time step
+      numout     =  2 ,      &  !: logical unit for output print
+      numnam     =  3 ,      &  !: logical unit for namelist
+      numnam_ice =  4 ,      &  !: logical unit for ice namelist
+      numevo_ice = 17 ,      &  !: logical unit for ice variables (temp. evolution)
+      numsol     = 25 ,      &  !: logical unit for solver statistics
+      numwri     = 40 ,      &  !: logical unit for output write
+      numisp     = 41 ,      &  !: logical unit for island statistics
+      numgap     = 45 ,      &  !: logical unit for differences diagnostic
+      numwrs     = 46 ,      &  !: logical unit for output restart
+      numtdt     = 62 ,      &  !: logical unit for data temperature
+      numsdt     = 63 ,      &  !: logical unit for data salinity
+      numrnf     = 64 ,      &  !: logical unit for runoff data
+      numwso     = 71 ,      &  !: logical unit for 2d output write
+      numwvo     = 72 ,      &  !: logical unit for 3d output write
+      numsst     = 65 ,      &  !: logical unit for surface temperature data
+      numbol     = 67 ,      &  !: logical unit for "bol" diagnostics
+      numptr     = 68 ,      &  !: logical unit for Poleward TRansports
+      numflo     = 69 ,      &  !: logical unit for drifting floats
+      !                         !: * coupled units
+      numlhf     = 71 ,      &  !: unit to transfer fluxes
+      numlws     = 72 ,      &  !: unit to transfer stress
+      numlts     = 73 ,      &  !: unit to transfer sst
+      numlic     = 74           !: unit to transfer ice cover
+
+
+   !! Contral/debugging
+   !! -----------------
+   REAL(wp) ::               &  !:
+      u_ctl, v_ctl,          &  !: sum of ua and va trend
+      t_ctl, s_ctl              !: sum of ta and sa trend
+
+END MODULE in_out_manager
Index: trunk/NEMO/OFF_SRC/istate.F90
===================================================================
--- trunk/NEMO/OFF_SRC/istate.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/istate.F90	(revision 325)
@@ -0,0 +1,71 @@
+MODULE istate
+   !!======================================================================
+   !!                     ***  MODULE  istate  ***
+   !! Ocean state   :  initial state setting
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   istate_init   : initial state setting
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE daymod          ! 
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers.
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!   4.0  !  91-03  ()  Original code
+      !!        !  91-11  (G. Madec)
+      !!   9.0  !  03-09  (G. Madec)  F90: Free form, modules, orthogonality
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      !!----------------------------------------------------------------------
+
+
+      ! Initialization to zero
+      ! ----------------------
+
+      !     before fields       !       now fields        !      after fields       !
+      ;   un   (:,:,:) = 0.e0   ;   ua   (:,:,:) = 0.e0
+      ;   vn   (:,:,:) = 0.e0   ;   va   (:,:,:) = 0.e0
+      ;                         ;   wn   (:,:,:) = 0.e0   
+      ;   hdivn(:,:,:) = 0.e0   ;
+
+      ;   tn   (:,:,:) = 0.e0   ;   ta   (:,:,:) = 0.e0
+      ;   sn   (:,:,:) = 0.e0   ;   sa   (:,:,:) = 0.e0
+
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0 
+
+
+   END SUBROUTINE istate_init
+
+   !!=====================================================================
+END MODULE istate
Index: trunk/NEMO/OFF_SRC/lbclnk.F90
===================================================================
--- trunk/NEMO/OFF_SRC/lbclnk.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/lbclnk.F90	(revision 325)
@@ -0,0 +1,431 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! Ocean        : lateral boundary conditions
+   !!=====================================================================
+#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
+   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d
+   !!                  routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e
+   !!                   routinee defined in lib_mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE lib_mpp          ! distributed memory computing library
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC lbc_lnk_e
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
+   !!                  on OPA ocean mesh
+   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
+   !!                  on OPA ocean mesh
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE lbc_lnk_3d, lbc_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC  lbc_lnk_e 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions (non mpp case)
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!        !  97-06  (G. Madec)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt3d grid-points
+         !             !   = T ,  U , V , F or W  gridpoints
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
+         pt3d          ! 3D array on which the boundary condition is applied
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   =-1 , the sign is changed if north fold boundary
+         !             !   = 1 , no sign change
+         !             !   = 0 , no sign change and > 0 required (use the inner
+         !             !         row/column if closed boundary)
+
+      !! * Local declarations
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Header$ 
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+      !!----------------------------------------------------------------------
+      
+      !                                                      ! ===============
+      DO jk = 1, jpk                                         ! Horizontal slab
+         !                                                   ! ===============
+
+         !                                     ! East-West boundaries
+         !                                     ! ====================
+         SELECT CASE ( nperio )
+
+         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
+            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points
+            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk)
+
+         CASE DEFAULT                          ! * closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d( 1 ,:,jk) = 0.e0
+               pt3d(jpi,:,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3d(jpi,:,jk) = 0.e0
+            END SELECT
+
+         END SELECT
+
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+
+         CASE ( 2 )                            ! *  south symmetric
+
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt3d(:, 1 ,jk) = pt3d(:,3,jk)
+               pt3d(:,jpj,jk) = 0.e0
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk)
+               pt3d(:,jpj,jk) = 0.e0
+            END SELECT
+
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+
+            pt3d( 1 ,jpj,jk) = 0.e0
+            pt3d(jpi,jpj,jk) = 0.e0
+
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpi
+                  ijt = jpi-ji+2
+                  pt3d(ji, 1 ,jk) = 0.e0
+                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
+               END DO
+               DO ji = jpi/2+1, jpi
+                  ijt = jpi-ji+2
+                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpi-1
+                  iju = jpi-ji+1
+                  pt3d(ji, 1 ,jk) = 0.e0
+                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk)
+               END DO
+               DO ji = jpi/2, jpi-1
+                  iju = jpi-ji+1
+                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+                  DO ji = 2, jpi
+                     ijt = jpi-ji+2
+                     pt3d(ji,  1  ,jk) = 0.e0
+                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk)
+                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk)
+                  END DO
+            CASE ( 'F' )                               ! F-point
+                  DO ji = 1, jpi-1
+                     iju = jpi-ji+1
+                     pt3d(ji,jpj-1,jk) = psgn * pt3d(iju,jpj-2,jk)
+                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-3,jk)
+                  END DO
+            END SELECT
+
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+
+            pt3d( 1 ,jpj,jk) = 0.e0
+            pt3d(jpi,jpj,jk) = 0.e0
+
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpi
+                  ijt = jpi-ji+1
+                  pt3d(ji, 1 ,jk) = 0.e0
+                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+                  DO ji = 1, jpi-1
+                     iju = jpi-ji
+                     pt3d(ji, 1 ,jk) = 0.e0
+                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk)
+                  END DO
+            CASE ( 'V' )                               ! V-point
+                  DO ji = 1, jpi
+                     ijt = jpi-ji+1
+                     pt3d(ji, 1 ,jk) = 0.e0
+                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
+                  END DO
+                  DO ji = jpi/2+1, jpi
+                     ijt = jpi-ji+1
+                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
+                  END DO
+            CASE ( 'F' )                               ! F-point
+                  DO ji = 1, jpi-1
+                     iju = jpi-ji
+                     pt3d(ji,jpj  ,jk) = psgn * pt3d(iju,jpj-2,jk)
+                  END DO
+                  DO ji = jpi/2+1, jpi-1
+                     iju = jpi-ji
+                     pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
+                  END DO
+            END SELECT
+
+         CASE DEFAULT                          ! *  closed
+
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1 ,jk) = 0.e0
+               pt3d(:,jpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,jpj,jk) = 0.e0
+            END SELECT
+
+         END SELECT
+         !                                                   ! ===============
+      END DO                                                 !   End of slab
+      !                                                      ! ===============
+   END SUBROUTINE lbc_lnk_3d
+
+
+   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions (non mpp case)
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!        !  97-06  (G. Madec)  Original code
+      !!        !  01-05  (E. Durand)  correction
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt2d grid-point
+         !             !   = T , U , V , F or W  gridpoints
+         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   =-1 , the sign is modified following the type of b.c. used
+         !             !   = 1 , no sign change
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+
+      !! * Local declarations
+      INTEGER  ::   ji
+      INTEGER  ::   ijt, iju
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      
+      
+      !                                        ! East-West boundaries
+      !                                        ! ====================
+      SELECT CASE ( nperio )
+
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         pt2d( 1 ,:) = pt2d(jpim1,:)
+         pt2d(jpi,:) = pt2d(  2  ,:)
+
+      CASE DEFAULT                             ! * closed 
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
+            pt2d( 1 ,:) = 0.e0
+            pt2d(jpi,:) = 0.e0
+         CASE ( 'F' )                                  ! F-point, ice U-V point
+            pt2d(jpi,:) = 0.e0 
+         CASE ( 'I' )                                  ! F-point, ice U-V point
+            pt2d( 1 ,:) = 0.e0 
+            pt2d(jpi,:) = 0.e0 
+         END SELECT
+
+      END SELECT
+
+      !                                        ! North-South boundaries
+      !                                        ! ======================
+      SELECT CASE ( nperio )
+
+      CASE ( 2 )                               ! * South symmetric
+
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points
+            pt2d(:, 1 ) = pt2d(:,3)
+            pt2d(:,jpj) = 0.e0
+         CASE ( 'V' , 'F' , 'I' )                      ! V-, F-points, ice U-V point
+            pt2d(:, 1 ) = psgn * pt2d(:,2)
+            pt2d(:,jpj) = 0.e0
+         END SELECT
+
+      CASE ( 3 , 4 )                           ! * North fold  T-point pivot
+
+         pt2d( 1 , 1 ) = 0.e0        !!!!!  bug gm ??? !Edmee
+         pt2d( 1 ,jpj) = 0.e0
+         pt2d(jpi,jpj) = 0.e0
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'W' )                            ! T-, W-point
+            DO ji = 2, jpi
+               ijt = jpi-ji+2
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi-ji+2
+               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
+            END DO
+
+         CASE ( 'U' )                                  ! U-point
+            DO ji = 1, jpi-1
+               iju = jpi-ji+1
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi-ji+1
+               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
+            END DO
+
+         CASE ( 'V' )                                  ! V-point
+            DO ji = 2, jpi
+               ijt = jpi-ji+2
+               pt2d(ji, 1   ) = 0.e0
+               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)
+               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3)
+            END DO
+
+         CASE ( 'F' )                                  ! F-point
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               pt2d(ji,jpj-1) = psgn * pt2d(iju,jpj-2)
+               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-3)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point
+            pt2d(:, 1 ) = 0.e0
+            pt2d(2,jpj) = psgn * pt2d(3,jpj-1)
+            DO ji = 3, jpi
+               iju = jpi - ji + 3
+               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
+            END DO
+
+         END SELECT
+
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+
+         pt2d( 1 , 1 ) = 0.e0           !!bug  ???
+         pt2d( 1 ,jpj) = 0.e0
+         pt2d(jpi,jpj) = 0.e0
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'W' )                            ! T-, W-point
+            DO ji = 1, jpi
+               ijt = jpi-ji+1
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)
+            END DO
+
+         CASE ( 'U' )                                  ! U-point
+            DO ji = 1, jpi-1
+               iju = jpi-ji
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
+            END DO
+
+         CASE ( 'V' )                                  ! V-point
+            DO ji = 1, jpi
+               ijt = jpi-ji+1
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi-ji+1
+               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
+            END DO
+
+         CASE ( 'F' )                                  ! F-point
+            DO ji = 1, jpi-1
+               iju = jpi-ji
+               pt2d(ji,jpj  ) = psgn * pt2d(iju,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi-1
+               iju = jpi-ji
+               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point
+            pt2d( : , 1 ) = 0.e0
+            pt2d( 2 ,jpj) = 0.e0
+            DO ji = 2 , jpim1
+               ijt = jpi - ji + 2
+               pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )
+            END DO
+
+         END SELECT
+
+      CASE DEFAULT                             ! * closed
+
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
+            pt2d(:, 1 ) = 0.e0
+            pt2d(:,jpj) = 0.e0
+         CASE ( 'F' )                                  ! F-point
+            pt2d(:,jpj) = 0.e0
+         CASE ( 'I' )                                  ! ice U-V point
+            pt2d(:, 1 ) = 0.e0
+            pt2d(:,jpj) = 0.e0
+         END SELECT
+
+      END SELECT
+
+   END SUBROUTINE lbc_lnk_2d
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
Index: trunk/NEMO/OFF_SRC/lib_cray.f90
===================================================================
--- trunk/NEMO/OFF_SRC/lib_cray.f90	(revision 325)
+++ trunk/NEMO/OFF_SRC/lib_cray.f90	(revision 325)
@@ -0,0 +1,61 @@
+!  Cray subroutines or functions used by OPA model and possibly 
+!  not found on other platforms.
+!
+!  check their existence
+!  
+!  sdot
+!  wheneq
+!  saxpy
+!  isrchne
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+!---------------------------------------------------------
+     FUNCTION sdot( I, X, J, Y, K )
+        DIMENSION X(1), Y(1)
+        SDOT = 0.
+        DO N = 1, I
+        SDOT = SDOT + X(1+(N-1)*J) * Y(1+(N-1)*K)
+        END DO
+     END FUNCTION sdot
+!---------------------------------------------------------
+     SUBROUTINE wheneq ( i, x, j, t, ind, nn )
+        IMPLICIT NONE
+
+        INTEGER , INTENT (  in ) :: i, j
+        INTEGER , INTENT ( out ) :: nn
+        REAL    , INTENT (  in ), DIMENSION (1+(i-1)*j) :: x
+        REAL    , INTENT (  in ) :: t
+        INTEGER , INTENT ( out ), DIMENSION (1+(i-1)*j) :: ind
+        INTEGER :: n, k
+        nn = 0
+        DO n = 1, i
+          k = 1 + (n-1) * j
+          IF ( x ( k) == t ) THEN 
+              nn = nn + 1
+              ind (nn) = k
+          ENDIF
+        END DO 
+
+     END SUBROUTINE wheneq
+!---------------------------------------------------------
+     SUBROUTINE saxpy( I, A, X, J, Y, K )
+        DIMENSION X(1),Y(1)
+        DO N = 1, I
+           Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K)
+        END DO
+     END SUBROUTINE saxpy
+!---------------------------------------------------------
+     FUNCTION isrchne( K, X, I, B )
+        DIMENSION X(1)
+        DO N = 1, K
+           IF( X(1+(N-1)*I) /= B ) THEN
+              ISRCHNE = N
+              RETURN
+           ELSE
+              ISRCHNE = N + 1
+           ENDIF
+        END DO
+     END FUNCTION isrchne
Index: trunk/NEMO/OFF_SRC/lib_feti.F90
===================================================================
--- trunk/NEMO/OFF_SRC/lib_feti.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/lib_feti.F90	(revision 325)
@@ -0,0 +1,2318 @@
+MODULE lib_feti
+   !!==============================================================================
+   !!                       ***  MODULE lib_feti   ***
+   !! Ocean solver : FETI library
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+#if defined key_feti
+   !!  feti_creadr
+   !!  feti_prext
+   !!  feti_init
+   !!  feti_iclr
+   !!  feti_vclr
+   !!  feti_vmov
+   !!  feti_vneg    (used in lib_feti)
+   !!  feti_vsub
+   !!  feti_vadd    (used in lib_feti)
+   !!  feti_ldlt    (used in lib_feti)
+   !!  feti_desremo (used in lib_feti)
+   !!  feti_mxv     (used in lib_feti)
+   !!  feti_mxvadd  (used in lib_feti)
+   !!  feti_saut    (used in lib_feti)
+   !!  feti_moyen   (used in lib_feti)
+   !!  feti_assemb  (used in lib_feti)
+   !!  feti_poids
+   !!  feti_probit  (used in lib_feti)
+   !!  feti_inisub
+   !!  feti_subound
+   !!  feti_subdir
+   !!  feti_listdir
+   !!  feti_blodir
+   !!  feti_numblo
+   !!  feti_blomat
+   !!  feti_blomat1
+   !!  feti_nullsp
+   !!  feti_project (used in lib_feti)
+   !!  feti_etesolv (used in lib_feti)
+   !!  feti_osaxpy  (used in lib_feti) 
+   !!  feti_proe    (used in lib_feti)
+   !!  feti_proet   (used in lib_feti)
+   !!  feti_consrhs (used in lib_feti)
+   !!  feti_dualschur
+   !!  feti_extend  (used in lib_feti)
+   !!  feti_restri  (used in lib_feti)
+   !!  feti_halfint
+   !!  feti_front
+   !!  feti_calinv  (used in lib_feti)
+   !!  feti_nbdia   (used in lib_feti)
+   !!  feti_liblod  (used in lib_feti)
+   !!  feti_liblos  (used in lib_feti)
+   !!  feti_resloc
+   !!  feti_pblos   (used in lib_feti)
+   !!  feti_pbloi   (used in lib_feti) 
+   !!  feti_proax
+   !!
+   !!  EXTERNAL used (BLAS): sgemv, strsv, saxpy, irecv
+   !!
+   !! References :
+   !!      Guyon, M, Roux, F-X, Chartier, M and Fraunie, P, 1994 :
+   !!      A domain decomposition solver to compute the barotropic 
+   !!      component of an OGCM in the parallel processing field.
+   !!      Ocean Modelling, issue 105, december 94.
+   !!
+   !! Modifications :
+   !!      original :  98-02 (M. Guyon)
+   !!------------------------------------------------------------------------
+   !! * Modules used
+   USE lib_mpp                 ! distribued memory computing
+
+CONTAINS
+
+      subroutine feti_creadr(ial,ialmax,lmax,ltab,iatab,chtab)
+!  ial = derniere adresse libre dans le super-tableau de longueur lmax .
+!  ltab = taille de la structure de donnee tab , d'adresse iatab .
+      implicit none
+      external mynode
+
+      integer ial,ialmax,lmax,ltab,iatab
+      integer iialmax,iibidon,mynode
+      character(len=12) chtab
+
+      iatab=ial
+      ial=iatab+ltab
+      ialmax=max0(ial,ialmax)
+      if(ial > lmax) then 
+          write(0,*)'  creation de la structure de donnee ',chtab
+          write(0,*)'  depassement taille super-tableau :'
+          write(0,*)'  taille maximale , taille demandee :',lmax,ial
+          stop
+      endif
+
+!... test de la memoire
+
+      iialmax=-ialmax
+      call mpp_min(iialmax,1,iibidon)
+      iialmax=-iialmax
+!     if(mynode() == 0)then
+!         write(0,*)'  creation de la structure de donnee ',chtab
+!         write(0,*)'taille max vaut : ',iialmax
+!     endif
+
+      end subroutine feti_creadr
+!***********************************************************************
+      subroutine feti_prext(n,x)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n)
+      REAL(kind=8)   xmin,xmax
+      integer i
+
+      xmin=x(1)
+      xmax=x(1)
+      do i=2,n
+        xmin=min(xmin,x(i))
+        xmax=max(xmax,x(i))
+      end do
+!     write(0,100)xmin,xmax
+ 100  format(8d10.3)
+
+      end subroutine feti_prext
+!*********************************************************************
+      subroutine feti_init(noeuds,x)
+      implicit none
+      integer noeuds
+      REAL(kind=8)  x(noeuds)
+      integer ji
+
+      do ji=1,noeuds
+        x(ji)=1.
+      end do
+
+      end subroutine feti_init
+!***********************************************************************
+      subroutine feti_iclr(n,x)
+      implicit none
+      integer n
+      integer x(n)
+      integer i
+
+      do i=1,n
+        x(i)=0
+      end do
+
+      end subroutine feti_iclr
+!***********************************************************************
+      subroutine feti_vclr(n,x)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n)
+      integer i
+
+      do i=1,n
+        x(i)=0.e0
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_vmov(n,x,y)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n)
+      integer i
+      do i=1,n
+        y(i)=x(i)
+      end do
+      return
+      end
+!***********************************************************************
+      subroutine feti_vneg(n,x,y)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n)
+      integer i
+
+      do i=1,n
+        y(i)=-x(i)
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_vsub(n,x,y,z)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n),z(n)
+      integer i
+      do i=1,n
+        z(i)=x(i)-y(i)
+      end do
+      return
+      end
+!***********************************************************************
+      subroutine feti_vadd(n,x,y,z)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n),z(n)
+      integer i
+
+      do i=1,n
+        z(i)=y(i)+x(i)
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_ldlt(n,a,d,v,ndlblo,lisblo,nmdlblo,j0)
+
+!...ndlblo nombre de liberte bloques = nombre de pivots nuls = dim(Ker(Ep))
+
+!...nmdlblo = Max (ndlblo(Ep)) <= superstructure management in f77 context
+!            p=1,Np
+
+      implicit none
+      integer n,ndlblo,nmdlblo
+      integer j0
+      REAL(kind=8)  a(n,n),v(n),d(n)
+      integer lisblo(nmdlblo)
+      integer i,j,k
+      REAL(kind=8)  piv,epsilo
+
+!  pivot de reference .
+      piv=a(1,1)
+!  epsilon .
+      epsilo=1.e-10
+!  factorisation de Crout d'une matrice pleine .
+      do j = 1 , n
+!  calcul du produit de la ligne numero j par la diagonale .
+        do k = 1 , j - 1
+          v(k) = a(j,k) * a(k,k)
+        end do
+!  calcul des termes de la partie inferieure de la colonne .
+        call sgemv('N',n-j+1,j-1,-1.e0,a(j,1),n,v,1,1.e0,a(j,j),1)
+!  detection des pivots nuls .
+        if(a(j,j) < (piv*epsilo)) then
+            ndlblo=ndlblo+1
+            lisblo(ndlblo)=j0+j
+            do i=1,j-1
+              a(i,j)=0.e0
+            end do
+            do i=j+1,n
+              a(j,i)=0.e0
+            end do
+            a(j,j)=0.e0
+            d(j)=0.e0
+        else
+            piv=a(j,j)
+            d(j)=1.e0/a(j,j)
+            do i = j+1 , n
+              a(i,j) = a(i,j) * d(j)
+            end do
+        endif
+      end do
+!  recopie de la partie triangulaire superieure .
+      do i = 1, n
+        do j = i+1, n
+          a(i,j)=a(j,i)
+        end do
+      end do
+      do i=1,n
+        a(i,i)=d(i)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_desremo(n,j0,a,y,x) 
+      implicit none
+      integer n,i,j,j0
+      REAL(kind=8)  a(n,n),x(n),y(n)
+
+!  descente remontee du systeme .
+!  initialisation du vecteur resultat .
+      do i=1,n
+        x(i)=y(i)
+      end do
+!  descente du systeme L x = x , L est a diagonale unitaire .
+      call strsv('L','N','U',n-j0,a(j0+1,j0+1),n,x(j0+1),1)
+!  division par la diagonale .
+      do j=j0+1,n
+        x(j)=x(j)*a(j,j)
+      end do          
+!  remontee du systeme U x = x , U est a diagonale unitaire . 
+      call strsv('U','N','U',n-j0,a(j0+1,j0+1),n,x(j0+1),1)
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_mxv(n,m,a,x,y) 
+!  calcul du produit matrice-vecteur :  y = A x
+      implicit none
+      integer n,m
+      REAL(kind=8)  a(n,m),x(m),y(n)
+      REAL(kind=8)  alpha,beta
+!  initialisation du vecteur y .
+      alpha=1.e0
+      beta=0.e0
+      call sgemv('N',n,m,alpha,a,n,x,1,beta,y,1)
+      return
+      end
+!**********************************************************************c
+      subroutine feti_mxvadd(n,m,a,x,y) 
+!  calcul du produit matrice-vecteur :  y = y + A x
+      implicit none
+      integer n,m
+      REAL(kind=8)  a(n,m),x(m),y(n)
+      REAL(kind=8)  alpha,beta
+!  initialisation du vecteur y .
+
+      alpha=1.e0
+      beta=1.e0
+      if((n > 0).and.(m > 0))then
+          call sgemv('N',n,m,alpha,a,n,x,1,beta,y,1)
+      endif
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_saut(numnes,listnes,    &
+          plistin,numins,listin,              &
+                numnos,v,w,bufin,bufout)
+!!        narea,numnos,v,w,bufin,bufout)
+
+!  computation of the jump of a field on the interfaces, in the case 
+!  where subdomain number i is allocated to processor number i-1 .
+
+!     INPUTS : numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern interfaces
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               v       =  local field
+
+!     OUTPUTS : w  =  jump of v
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!      external irecv
+!!    integer irecv, work(100)
+!!    integer numnes,numins,numnos,narea
+      integer numnes,numins,numnos
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  v(numnos),w(numins)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      integer i,j,l
+      integer mesg
+
+      mesg=128
+!  receiving the values of the outer fields on the interface
+!     do i=1,numnes
+!       l=(plistin(i+1)-plistin(i))*8
+!       work(i)=irecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+!     end do
+!  gathering the values of the local field on the interface
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          bufin(j)=v(listin(j))
+        end do
+      end do
+!  sending the values of the local field on the interface
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))*8
+!       call mppsend(mesg+narea-1,bufin(plistin(i)+1),l,listnes(i)-1,0)
+        call mppsend(mesg+listnes(i,3)-1,bufin(plistin(i)+1),l,   &
+            listnes(i,1)-1,0)
+      end do
+!  computing the jump on each interface 
+      do i=1,numnes
+!       call msgwait(work(i))
+        l=(plistin(i+1)-plistin(i))*8
+!       call mpprecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+        call mpprecv(mesg+listnes(i,2)-1,bufout(plistin(i)+1),l)
+      end do
+      do j=1,numins
+        w(j)=bufin(j)-bufout(j)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_moyen(numnes,listnes,   &
+          plistin,numins,listin,              &
+          narea,numnos,weight,v,w,bufin,bufout)
+
+!  averaging a field on the interfaces, in the case where subdomain
+!  number i is allocated to processor number i-1 .
+
+!     INPUTS : numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern interfaces
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea    =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               weight  =  weighting vector
+!               v       =  local field
+
+!     OUTPUTS :      w  =  averaged field
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!     external irecv
+!!    integer irecv, work(100)
+      integer numnes,numins,numnos,narea
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  weight(numnos),v(numnos),w(numnos)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      integer i,j,l,n
+      integer mesg
+
+      mesg=128*2
+!  initialization
+      call feti_vmov(numnos,v,w)
+!  receiving the values of the outer fields on the interface
+!     do i=1,numnes
+!       l=(plistin(i+1)-plistin(i))*8
+!       work(i)=irecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+!     end do
+!  gathering the values of the local field on the interface
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          bufin(j)=v(listin(j))
+        end do
+      end do
+!  sending the values of the local field on the interface
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))*8
+!       call mppsend(mesg+narea-1,bufin(plistin(i)+1),l,listnes(i)-1,0)
+        call mppsend(mesg+listnes(i,3)-1,bufin(plistin(i)+1),l,   &
+            listnes(i,1)-1,0)
+      end do
+!  computing the jump on each interface 
+      do i=1,numnes
+!       call msgwait(work(i))
+        l=(plistin(i+1)-plistin(i))*8
+!       call mpprecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+        call mpprecv(mesg+listnes(i,2)-1,bufout(plistin(i)+1),l)
+      end do
+      do j=1,numins
+        n=listin(j)
+        w(n)=w(n)+bufout(j)
+      end do
+      do n=1,numnos
+        w(n)=w(n)*weight(n)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_assemb(numnes,listnes,   &
+          plistin,numins,listin,               &
+          narea,numnos,v,w,bufin,bufout)
+
+!  assembling a field on the interfaces, in the case where subdomain
+!  number i is allocated to processor number i-1 .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern interfaces
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               v       =  unassembled field
+
+!     OUTPUTS :      w  =  assembled field
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!      external irecv
+!!    integer irecv, work(100)
+      integer numnes,numins,numnos,narea
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  v(numnos),w(numnos)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      integer i,j,l,n
+      integer mesg
+
+      mesg=128*3
+!  initialization
+      call feti_vmov(numnos,v,w)
+!  receiving the values of the outer fields on the interface
+!     do i=1,numnes
+!       l=(plistin(i+1)-plistin(i))*8
+!       work(i)=irecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+!     end do
+!  gathering the values of the local field on the interface
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          bufin(j)=v(listin(j))
+        end do
+      end do
+!  sending the values of the local field on the interface
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))*8
+!       write(90,*)'envoie a ',listnes(i),'de ',l,'octets'
+!       write(90,*)'tag est : ',listnes(i,3)
+!       call mppsend(mesg+narea-1,bufin(plistin(i)+1),l,listnes(i)-1,0)
+        call mppsend(mesg+listnes(i,3)-1,bufin(plistin(i)+1),l,   &
+            listnes(i,1)-1,0)
+      end do
+!  computing the jump on each interface 
+      do i=1,numnes
+!       call msgwait(work(i))
+        l=(plistin(i+1)-plistin(i))*8
+!       write(90,*)'recoie de ',listnes(i),'de ',l,'octets'
+!       write(90,*)'recois avec tag :',listnes(i,2)
+!       call mpprecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+        call mpprecv(mesg+listnes(i,2)-1,bufout(plistin(i)+1),l)
+      end do
+      do j=1,numins
+        n=listin(j)
+        w(n)=w(n)+bufout(j)
+      end do
+
+      return
+      end
+!**********************************************************************c
+!!    subroutine feti_poids(numnes,listnes,plistin,numins,listin,   &
+!!        narea,numnos,w,bufin,bufout)
+      subroutine feti_poids(numnes,                numins,listin,   &
+                numnos,w             )
+
+!  computation of the subdomain weighting vector, in the case where 
+!  subdomain number i is allocated to processor number i-1 .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+
+!     OUTPUTS :      w  =  weighting vector
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!!    integer numnes,numins,numnos,narea
+      integer numnes,numins,numnos
+!!    integer listnes(numnes), plistin(numnes+1), listin(numins)
+      integer                                     listin(numins)
+      REAL(kind=8)  w(numnos)
+!!    REAL(kind=8)  bufin(numins),bufout(numins)
+      integer j,n
+
+!  initialization
+      do n=1,numnos
+        w(n)=1.e0
+      end do
+!  computing the weight on each interface 
+      do j=1,numins
+        n=listin(j)
+        w(n)=w(n)+1.e0
+      end do
+      do n=1,numnos
+        w(n)=1.e0/w(n)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_probit(numnes,listnes,plistin,numins,listin,   &
+          numnos,w,bitw)
+
+!  computing the local right-hand-side associated with a field
+!  on the interface .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               numnos  =  number of nodes in the subdomain
+!               w       =  interface field
+
+!     OUTPUTS :      bitw  =  local right-hand side
+
+      implicit none 
+      integer numnes,numins,numnos
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  w(numins)
+      REAL(kind=8)  bitw(numnos)
+      integer i,j,n
+
+!  initialization
+      do n=1,numnos
+        bitw(n)=0.e0
+      end do
+!  assembling the values on the interfaces 
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          n=listin(j)
+          bitw(n)=bitw(n)+w(j)
+        end do
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_inisub(ni,nj,ibondi,ibondj,iperio,   &
+          ibsw,ibnw,ibse,ibne,                             &
+          ninterf,ninterfc,nni,nnic)
+      implicit none
+      integer ni,nj,ibondi,ibondj,iperio
+      integer ibsw,ibnw,ibse,ibne
+      integer ibsw2,ibnw2,ibse2,ibne2
+      integer ninterf,ninterfc,nni,nnic
+!     integer i,j
+
+!  determination de la position du sous-domaine dans la grille
+!  cela depnd de ibondi et ibondj
+
+!  nombre de sous-domaines voisins et de la longueur du tableau des
+!  noeuds voisins
+
+!  initialisation
+
+      ninterf=0
+      nni=0
+
+!...first, the "segment-points"
+
+      if((ibondi == 2).AND.(iperio /= 1))then
+
+!  la periodicite : pas d'interface east / west si nbondi = 2
+!  ET nperio != 1
+
+!      elseif(iperio == 1) then
+
+!...ca doit marcher!?
+
+      else
+
+!  west
+
+          if(ibondi /= -1)then
+              ninterf=ninterf+1
+              nni=nni+nj+1
+          endif
+
+!  east
+
+          if(ibondi /= 1)then
+              ninterf=ninterf+1
+              nni=nni+nj+1
+          endif
+
+      endif
+
+!  south
+
+      if(ibondj /= -1.AND.ibondj /= 2)then
+          ninterf=ninterf+1
+          nni=nni+ni+1
+      endif
+
+!  north
+
+      if(ibondj /= 1.AND.ibondj /= 2)then
+          ninterf=ninterf+1
+          nni=nni+ni+1
+      endif
+
+      nnic=nni
+      ninterfc=ninterf
+
+
+!...second, the "corner-points"
+
+!...determination of the neighboorings, they depends on iperio
+!   boundary condition => local description : ipXX becomes ipXX2...
+
+      ibnw2 = ibnw
+      ibne2 = ibne
+      ibsw2 = ibsw
+      ibse2 = ibse
+
+!...iperio boundary condition effect
+
+      if(iperio == 1) then
+
+!...general case : Earth == infinite tube
+
+          ibnw2 = 1
+          ibne2 = 1
+          ibsw2 = 1
+          ibse2 = 1
+
+!...real boundary condition
+
+          if(ibondj == -1.OR.ibondj == 2) then
+              ibsw2 = 0
+              ibse2 = 0
+          endif
+
+          if(ibondj == 1.OR.ibondj == 2) then
+              ibnw2 = 0
+              ibne2 = 0
+          endif
+
+      endif
+
+!  la periodicite : pas de coin si nbondi = 2
+!  ET nperio != 1
+
+!  north-west
+
+      if(ibnw == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!  north-east
+
+      if(ibne == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!  south-west
+
+      if(ibsw == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!  south-east
+
+      if(ibse == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!       write(0,*)'  nbre de voisins =',ninterf
+!       write(0,*)'  longueur des interfaces =',nni
+!       write(0,*)'  longueur des interfaces =',nnic
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_subound(ni,nj,ildi,ilei,ildj,ilej,   &
+          imoi,ibondi,ibondj,iperio,   &
+          ninterf,ninterfc,   &
+          iowe,ioea,ioso,iono,   &
+          ibsw,ibnw,ibse,ibne,   &
+          ipsw,ipnw,ipse,ipne,   &
+          nsdvois,nsdvoisc,   &
+          plistin,nni,listin)
+
+      implicit none
+      integer ni,nj,ildi,ilei,ildj,ilej
+      integer imoi,ibondi,ibondj,iperio
+      integer iowe,ioea,ioso,iono
+      integer ibsw,ibnw,ibse,ibne
+      integer ipsw,ipnw,ipse,ipne
+      integer ninterf,ninterfc,nni
+      integer nsdvois(ninterf,3),nsdvoisc(ninterfc,3)
+      integer plistin(ninterfc+1),listin(nni)
+      integer     nint,nni0,ii,jj
+!     integer i,j,nint,nni0,ii,jj
+
+      external mynode
+      integer  mynode
+
+!  determination de la position du sous-domaine dans la grille
+!  cela depnd de ibondi et ibondj
+
+! liste des sous-domaines voisins et des noeuds interface
+
+! be carefull!!! in the FETI algorithm, area number is considered
+! instead of process number
+
+!  initialisation
+
+      nint=0
+      nni0=0
+      plistin(1)=0
+
+!...first, the "segment-points"
+
+      if((ibondi == 2).AND.(iperio /= 1))then
+
+!  la periodicite : pas d'interface east / west si nbondi = 2
+!  ET nperio != 1
+
+      elseif(iperio == 1) then
+
+!  west
+
+          nint=nint+1
+          nsdvoisc(nint,1)=imoi
+          do jj=1,nj+1
+            listin(nni0+jj)=(jj-1)*(ni+1)+1
+          end do
+          nni0=nni0+nj+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=1
+          nsdvoisc(nint,3)=2
+
+!  east
+
+          nint=nint+1
+          nsdvoisc(nint,1)=imoi
+          do jj=1,nj+1
+            listin(nni0+jj)=(jj-1)*(ni+1)+ilei
+          end do
+          nni0=nni0+nj+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=2
+          nsdvoisc(nint,3)=1
+
+      else
+
+!  west
+
+          if(ibondi /= -1)then
+              nint=nint+1
+              nsdvoisc(nint,1)=(iowe+1)
+              do jj=1,nj+1
+                listin(nni0+jj)=(jj-1)*(ni+1)+1
+              end do
+              nni0=nni0+nj+1
+              plistin(nint+1)=nni0
+              nsdvoisc(nint,2)=1
+              nsdvoisc(nint,3)=2
+          endif
+
+!  east
+
+          if(ibondi /= 1)then
+              nint=nint+1
+              nsdvoisc(nint,1)=(ioea+1)
+              do jj=1,nj+1
+                listin(nni0+jj)=(jj-1)*(ni+1)+ilei
+              end do
+              nni0=nni0+nj+1
+              plistin(nint+1)=nni0
+              nsdvoisc(nint,2)=2
+              nsdvoisc(nint,3)=1
+          endif
+
+      endif
+
+!  south
+
+      if(ibondj /= -1.AND.ibondj /= 2)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ioso+1)
+          do ii=1,ni+1
+            listin(nni0+ii)=ii
+          end do
+          nni0=nni0+ni+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=3
+          nsdvoisc(nint,3)=4
+      endif
+
+!  north
+
+      if(ibondj /= 1.AND.ibondj /= 2)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(iono+1)
+          do ii=1,ni+1
+            listin(nni0+ii)=(ilej-1)*(ni+1)+ii
+          end do
+          nni0=nni0+ni+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=4
+          nsdvoisc(nint,3)=3
+      endif
+
+!...second, the "corner-points"
+
+!...determination of the neighboorings, they depends on iperio 
+!   boundary condition => local description : inimpp or inimpp2...
+
+!  la periodicite : pas de coin si nbondi = 2
+!  ET nperio != 1
+
+!!!!!!!!!verifier la definition des voisins-coin
+
+!  north-west
+
+      if(ibnw == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipnw+1)
+          listin(nni0+1)=(ilej-1)*(ni+1)+1
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=5
+          nsdvoisc(nint,3)=8
+      endif
+
+!  north-east
+
+      if(ibne == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipne+1)
+          listin(nni0+1)=(ilej-1)*(ni+1)+ilei
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=6
+          nsdvoisc(nint,3)=7
+      endif
+
+!  south-west
+
+      if(ibsw == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipsw+1)
+          listin(nni0+1)=1
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=7
+          nsdvoisc(nint,3)=6
+      endif
+
+!  south-east
+
+      if(ibse == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipse+1)
+          listin(nni0+1)=ilei
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=8
+          nsdvoisc(nint,3)=5
+      endif
+
+!...je compte les coins
+
+      do ii=1,ninterf
+        nsdvois(ii,1) = nsdvoisc(ii,1)
+        nsdvois(ii,2) = nsdvoisc(ii,2)
+        nsdvois(ii,3) = nsdvoisc(ii,3)
+      enddo
+
+
+!  impressions
+
+!     write(*,*)'  sous-domaine :',imoi
+!     write(*,*)'  nombre de sous-domaines voisins :',ninterfc
+!      do ii=1,ninterfc
+!      write(*,*)'  sous-domaine voisin :',nsdvoisc(ii,1)
+!     write(*,*)'  nombre de noeuds interface :',   &
+!         plistin(ii+1)-plistin(ii)
+!     write(*,*)'  noeuds interface :',(listin(jj),jj=plistin(ii)+1,   &
+!         plistin(ii+1))
+!     end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_subdir(ni,nj,noeuds,ndir,mgcnum)
+      implicit none 
+      integer ni,nj,noeuds,ndir
+      integer mgcnum(ni+1,nj+1)
+      integer i,j
+!     integer i,j,k
+
+!  determination de la position du sous-domaine dans la grille
+!  narea = (j-1)*iglo + i , avec 1<=i<=iglo et 1<=j<=jglo 
+
+
+
+! 1. NUMBER THE GRID-POINTS USING BMASK
+! -------------------------------------
+
+
+      ndir=0
+      do j=1,nj+1
+        do i=1,ni+1
+          ndir=ndir+1-mgcnum(i,j)
+!      do k=1,noeuds
+!        ndir=ndir+1-mgcnum(k,1)
+        enddo
+      enddo
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_listdir(ni,nj,logdir,ndir,lisdir)
+      implicit none 
+      integer ni,nj,ndir
+      integer logdir(ni,nj),lisdir(ndir)
+      integer i0,ji,jj
+
+!  creation de la liste des degres de liberte bloques
+      i0=0
+      do ji=1,ni
+        do jj=1,nj
+          if(logdir(ji,jj) == 0) then
+              i0=i0+1
+              lisdir(i0)=ji+(jj-1)*ni
+          endif
+        end do
+      end do
+      if(i0 /= ndir) then
+!      write(*,*)'  nombre de ddl bloques/prevus :',i0,ndir
+!      write(*,*)'liste des ddl Dirichlet :',(lisdir(ji),ji=1,ndir)
+          stop
+      endif
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_blodir(n,x,ndlblo,list)
+      implicit none
+      integer n,ndlblo
+      integer list(ndlblo)
+      REAL(kind=8)  x(n)
+      integer i
+
+!  remise a zero des ddl bloques
+      do i=1,ndlblo
+        x(list(i))=0.e0
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_numblo(ndlblo,lisblo)
+      implicit none
+      external mynode
+!!    integer mynode,indlblog,iibidon
+      integer mynode
+      integer ndlblo
+      integer lisblo(ndlblo)
+!!    integer n
+
+!      indlblog=-ndlblo
+!      call mpp_min(indlblog,1,iibidon)
+!      indlblog=-indlblog
+!      if(mynode() == 0)THEN
+!      write(0,*)'  nombre de degres de liberte flottants :',ndlblo
+!      write(0,*)'  liste :',(lisblo(n),n=1,ndlblo)
+!      endif
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_blomat(ni,nj,a,ndlblo,lisblo)
+      implicit none
+      integer ni,nj
+      REAL(kind=8)  a(ni,nj,5)
+      integer ndlblo
+      integer lisblo(ndlblo)
+!!    integer i,j,k,l,n
+      integer i,j,k,n
+
+      do n=1,ndlblo
+!  degre de liberte bloque : lisblo(n) = (j-1)*ni + i
+        i=mod(lisblo(n)-1,ni)+1
+        j=((lisblo(n)-1)/ni)+1
+!  annulation des coefficients sur la ligne
+        do k=1,5
+          a(i,j,k)=0.e0
+        end do
+        a(i,j,3)=1.e0
+!  annulation des coefficients dans les colonnes correspondantes
+        if(i > 1) then
+            a(i-1,j,4)=0.e0
+        endif
+        if(i < ni) then
+            a(i+1,j,2)=0.e0
+        endif
+        if(j > 1) then
+            a(i,j-1,5)=0.e0
+        endif
+        if(j < nj) then
+            a(i,j+1,1)=0.e0
+        endif
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_blomat1(ni,nj,a,ndlblo,lisblo,nsp)
+      implicit none
+      integer ni,nj,ndlblo
+      REAL(kind=8)  a(ni,nj,5),nsp(ni,nj,ndlblo)
+      integer lisblo(ndlblo)
+!!    integer i,j,k,l,n
+      integer i,j,n
+
+      do n=1,ndlblo
+!  degre de liberte bloque : lisblo(n) = (j-1)*ni + i
+        i=mod(lisblo(n)-1,ni)+1
+        j=((lisblo(n)-1)/ni)+1
+!  annulation des coefficients dans les colonnes correspondantes
+        if(i > 1) then
+            nsp(i-1,j,n)=-a(i-1,j,4)
+        endif
+        if(i < ni) then
+            nsp(i+1,j,n)=-a(i+1,j,2)
+        endif
+        if(j > 1) then
+            nsp(i,j-1,n)=-a(i,j-1,5)
+        endif
+        if(j < nj) then
+            nsp(i,j+1,n)=-a(i,j+1,1)
+        endif
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_nullsp(noeuds,ni,nj,lpblo,blo,a,ndlblo,lisblo,nsp,z)
+!  calcul du noyau de la matrice
+      implicit none
+      integer noeuds,ni,nj,lpblo,ndlblo
+      REAL(kind=8)  a(ni,nj,5)
+      integer lisblo(ndlblo)
+      REAL(kind=8)  blo(lpblo),nsp(noeuds,ndlblo),z(noeuds)
+      external sdot
+      REAL(kind=8)  sdot,res
+      integer j,i
+
+!  calcul de [Aii]-1 * Aib
+      do j=1,ndlblo
+        call feti_resloc(noeuds,ni,nj,a,lpblo,blo,nsp(1,j),nsp(1,j),z)
+      end do
+!  remise a identite du bloc diagonal correspondant aux modes bloques
+      do i=1,ndlblo
+        do j=1,ndlblo
+          nsp(lisblo(i),j)=0.e0
+        end do
+        nsp(lisblo(i),i)=1.e0
+      end do
+!  verifications
+      do j=1,ndlblo
+        call feti_proax(noeuds,ni,nj,a,nsp(1,j),z)
+        res=sqrt(sdot(noeuds,z,1,z,1)/   &
+            sdot(noeuds,nsp(1,j),1,nsp(1,j),1))
+!       write(0,*)'  residu de la colonne ',j,' du noyau :',res
+!       write(0,*)'  vecteur colonne :'
+!       call prvec(noeuds,nsp(1,j))
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_project(gint,pgint,nspdim,x,b,nmspdim,numit0   &
+          ,nitmax,gvec,agvec,d,ad,add,gamm,numnes,listnes,plistin,numins   &
+          ,listin,narea,numnos,nsp,v,w,bufin,bufout,work)
+
+      implicit none 
+
+      integer nitmax, nspdim
+      REAL(kind=8)  x(nspdim), b(nspdim)
+
+!...the Krylov optimisation used in PCG associated to the Coarse Solver
+!   involve to keep di & adi vectors in etesolve procedure
+!   the nmspdim parameter is introduced to avoid message "out of bound"
+!   arrising qhen the memory is checked!
+
+!   nmspdim  =   Max (nspdim(Ep)) <= memory management (f77 context)
+!               p=1,Np
+
+!      REAL(kind=8)  gvec(nspdim), agvec(nspdim),
+!     &       d(nspdim,0:nitmax-1), ad(nspdim,0:nitmax-1), 
+!     &       add(0:nitmax-1), gamm(0:nitmax-1)
+
+      integer nmspdim
+      REAL(kind=8)  gvec(nspdim), agvec(nspdim),   &
+          d(nmspdim,0:nitmax-1), ad(nmspdim,0:nitmax-1),    &
+          add(0:nitmax-1), gamm(0:nitmax-1)
+
+      integer numnes,numins,narea,  numnos, numit0
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  nsp(numnos,nspdim), v(numnos),    &
+          w(numins), gint(numins), pgint(numins) 
+      REAL(kind=8)  bufin(numins), bufout(numins)
+      REAL(kind=8)  work(0:nitmax-1)
+
+
+      call feti_proet(numnes,listnes,plistin,numins,listin,numnos,   &
+          gint,nspdim,nsp,b,v)
+      call feti_etesolv(nspdim,x,b,nmspdim,numit0,nitmax,gvec,agvec,d,ad   &
+          ,add,gamm,numnes,listnes,plistin,numins,listin,narea,numnos   &
+          ,nsp,v,w,bufin,bufout,work)
+      call feti_proe(numnes,listnes,plistin,numins,listin,narea,numnos,   &
+          nspdim,nsp,x,v,w,bufin,bufout)
+      call feti_vsub(numins,gint,w,pgint)
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_etesolv(nspdim,x,b,nmspdim,numit0,nitmax,gvec    &
+          ,agvec,d,ad,add,gamm,numnes,listnes,plistin,numins,listin    &
+          ,narea,numnos,nsp,v,w,bufin,bufout,work)
+
+!     INPUTS :   nspdim  =   dimension of null space : LOCAL
+!                x       =   initial solution
+!                b       =   right hand side
+!               nmspdim  =   Max (nspdim(Ep)) <= memory management
+!                            p=1,Np
+!               numit0   =   number of previous direction vectors, at most
+!                            nitmax
+!               nitmax   =   number of maximum direction vectors for 
+!                            reconjugation  
+!               gvec     =   gradient vector
+!               agvec    =   A * g
+!               d        =   direction vector
+!               ad       =   A * d
+!               add      =   dot products (Ad,d)
+!               gamm     =   GAMMA coefficients
+!               numnes   =   number of neighbouring subdomains
+!               listnes  =   list of neighbouring subdomains
+!               plistin  =   pointer of sublists of interface nodes
+!               numins   =   number of interface nodes
+!               listin   =   list of interface nodes
+!               narea    =   subdomain number
+!               numnos   =   number of nodes in the subdomain
+
+!     WORKSPACE : bufin  =  contributions of local fields on interface
+!                 bufout =  contributions of outer fields on interface
+!                 work   =  workspace for mpp_sum calls
+
+      implicit none 
+
+      integer nitmax, nspdim
+      REAL(kind=8)  x(nspdim), b(nspdim)
+
+!...the Krylov optimisation involve to keep di & adi vectors
+!   the nmspdim parameter is introduce to avoid message "out of bound"
+!   arrising qhen the memory is checked!
+
+!      REAL(kind=8)  gvec(nspdim), agvec(nspdim),
+!     &       d(nspdim,0:nitmax-1), ad(nspdim,0:nitmax-1), 
+!     &       rho, temp1(2), temp2(2), add(0:nitmax-1),
+!     &       gamm(0:nitmax-1), facg0, facgn, facst, eps
+
+      integer nmspdim
+      REAL(kind=8)  gvec(nmspdim), agvec(nmspdim),    &
+          d(nspdim,0:nitmax-1), ad(nspdim,0:nitmax-1),     &
+          rho, temp1(2), temp2(2), add(0:nitmax-1),    &
+          gamm(0:nitmax-1), facg0, facgn, facst, eps
+
+      integer numnes,numins,narea,  numnos
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  nsp(numnos,nspdim), v(numnos), w(numins)
+      REAL(kind=8)  bufin(numins), bufout(numins)
+      REAL(kind=8)  work(0:nitmax-1)
+
+      integer i, j, n, numit0, nn, n1, numit1
+
+      external sdot
+      REAL(kind=8)  sdot
+
+!    initialisation 
+
+      do 1 i=1,nspdim
+        x(i) = 0.e0
+        gvec(i) = -b(i)
+ 1    continue
+      facg0 = sdot( nspdim, gvec, 1, gvec , 1)
+      call mpp_sum(facg0,1,work)
+
+      if( facg0  ==  0.e0 ) return
+
+      eps=1.e-24
+      facst=facg0*eps
+
+!    initial projection 
+
+      if(numit0 > 0) then
+          do 91 j = 0 , numit0
+            gamm(j) = - sdot(nspdim,gvec,1,d(1,j),1) / add(j)
+ 91       continue
+          call mpp_sum(gamm,numit0+1,work)
+          call feti_mxvadd( nspdim, numit0+1, d, gamm, x )
+          call feti_mxvadd( nspdim, numit0+1, ad, gamm, gvec )
+
+!  test residual after initial projection
+
+          facgn = sdot( nspdim, gvec, 1, gvec, 1 )
+          call mpp_sum(facgn,1,work)
+          if( facgn <= facst ) then
+!             write(0,*) 'residual after initial projection for feti_etesolv='   &
+!                 ,facgn/facg0
+              return
+          endif
+
+      endif
+
+!     compute (Et E) * gvec
+
+      call feti_proe(numnes,listnes,plistin,numins,listin,narea,numnos,   &
+          nspdim,nsp,gvec,v,w,bufin,bufout)
+      call feti_proet(numnes,listnes,plistin,numins,listin,numnos,w,   &
+          nspdim,nsp,agvec,v)
+
+!   conjugate d .
+
+      if(numit0 > 0) then
+          numit1=min0(numit0+1,nitmax-1)
+          do 94 i=0,numit0
+            gamm(i) = -sdot(nspdim,gvec,1,ad(1,i),1)/ add(i)
+ 94       continue
+          call mpp_sum(gamm,numit0+1,work)
+
+          call feti_osaxpy( nspdim,gamm(numit0),d(1,numit0),   &
+              gvec,d(1,numit1))
+          call feti_osaxpy( nspdim,gamm(numit0),ad(1,numit0),   &
+              agvec,ad(1,numit1))
+
+          call feti_mxvadd( nspdim, numit1-1, d, gamm, d(1,numit1) )
+          call feti_mxvadd( nspdim, numit1-1, ad, gamm, ad(1,numit1) )
+      else
+          numit1=0
+
+          do 20 i = 1, nspdim
+            d(i,numit1) = gvec(i)
+ 20       continue
+
+          do 30 i = 1, nspdim
+            ad(i,numit1) = agvec(i)
+ 30       continue
+      endif
+
+!     computing rho
+
+      do 50 nn = numit1, nitmax
+        n=min0(nn,nitmax-1)
+        temp1(1) = sdot( nspdim, gvec, 1, d(1,n), 1 )
+        temp1(2) = sdot( nspdim, ad(1,n), 1, d(1,n), 1 )
+        call mpp_sum(temp1,2,temp2)
+        add(n) = temp1(2)
+        rho = - temp1(1) / add(n)
+
+        call feti_osaxpy( nspdim, rho, d(1,n), x, x )
+        call feti_osaxpy( nspdim, rho, ad(1,n), gvec, gvec )
+
+!        test residual . 
+
+        facgn = sdot( nspdim, gvec, 1, gvec, 1 )
+        call mpp_sum(facgn,1,work)
+!        write(0,*) 'iteration =', nn+1, 'residual = ', facgn/facg0
+        if( facgn <= facst ) then
+            goto 999
+        endif
+
+!   reconjugation of gvec
+
+        do 60 i=0,n
+          gamm(i) = -sdot(nspdim,gvec,1,ad(1,i),1)/ add(i)
+ 60     continue
+        call mpp_sum(gamm,n+1,work)
+        n1=min0(nn+1,nitmax-1)
+
+        call feti_osaxpy( nspdim,gamm(n),d(1,n),gvec,d(1,n1))
+
+        call feti_mxvadd( nspdim, n1-1, d, gamm, d(1,n1) )
+
+!     compute (Et E) * d
+
+        call feti_proe(numnes,listnes,plistin,numins,listin,narea,   &
+            numnos,nspdim,nsp,d(1,n1),v,w,bufin,bufout)
+        call feti_proet(numnes,listnes,plistin,numins,listin,numnos,w,   &
+            nspdim,nsp,ad(1,n1),v)
+
+ 50   continue
+
+      if(narea == 1) then
+          write(0,*) 'No convergence for ete in ',nitmax,' iterations'
+          stop
+      endif
+
+
+ 999  continue
+      numit0=min0(n,nitmax-1)
+!     write(0,*) 'number of iterations for ete :', nn+1, ' ,  residual =', facgn
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_osaxpy( n, a, x, y, z )
+
+      implicit none
+
+      integer n
+      REAL(kind=8)  a, x(n), y(n), z(n)
+
+      integer i
+
+      do 10 i = 1, n
+        z(i) = y(i) + a * x(i)
+ 10   continue
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_proe(numnes,listnes,plistin,numins,listin,narea,   &
+          numnos,nspdim,nsp,alpha,v,w,bufin,   &
+          bufout)
+
+!  jump of a velocity field on the interfaces, in the case where 
+!  subdomain number i is allocated to processor number i-1 .
+!  the velocity field is Nsp * alpha, where Nsp is the nullspace .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               nspdim  =  dimension of the null space
+!               nsp     =  null space
+!               alpha   =  components of the velocity field in the null
+!                          space
+!               v       =  corresponding velocity field
+
+!     OUTPUTS :      w  =  jump on the interface
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+      integer numnes,numins,numnos,narea,nspdim
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  v(numnos),w(numins)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      REAL(kind=8)  alpha(nspdim), nsp(numnos,nspdim)
+      integer i
+
+!  computing the values of the local velocity field 
+      do i=1,numnos
+        v(i)=0.e0
+      end do
+      call feti_mxvadd( numnos, nspdim, nsp, alpha, v )
+!  computing the jump on the interface
+      call feti_saut(numnes,listnes,plistin,numins,listin,   &
+                numnos,v,w,bufin,bufout)
+!!        narea,numnos,v,w,bufin,bufout)
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_proet(numnes,listnes,plistin,numins,listin,   &
+          numnos,w,nspdim,nsp,alpha,v)
+
+!  projection in the null space of the right-hand-side associated with
+!  a Lagrange multiplier w .
+
+!     INPUTS :      numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               numnos  =  number of nodes in the subdomain
+!               w       =  Lagrange multiplier
+!               nspdim  =  dimension of the null space
+!               nsp     =  null space
+
+!     OUTPUTS :      v     =  local right-hand-side
+!               alpha =  projection of v in the null space
+
+      implicit none 
+      external sdot
+      REAL(kind=8)  sdot
+      integer numins,numnos,nspdim,numnes
+      integer listnes(numnes,3),plistin(numnes+1),listin(numins)
+      REAL(kind=8)  v(numnos),w(numins)
+      REAL(kind=8)  alpha(nspdim), nsp(numnos,nspdim)
+      integer i
+
+!  assembling the values of the Lagrange multiplier on the interface
+      call feti_probit(numnes,listnes,plistin,numins,listin,numnos,w,v)
+!  computing the projection of v in the null space .
+      do 1 i=1,nspdim
+        alpha(i)=sdot(numnos,v,1,nsp(1,i),1)
+ 1    continue
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_consrhs( vdim,nspdim,rhs,nsp,cb )
+
+
+      implicit none
+
+      external sdot
+      REAL(kind=8)  sdot
+      integer vdim, nspdim
+
+      REAL(kind=8)   rhs(vdim), nsp(vdim,nspdim), cb(nspdim)
+
+
+      integer i
+
+!  compute the right hand side for constraint 
+
+      do i=1,nspdim
+        cb(i)=-sdot(vdim,rhs,1,nsp(1,i),1)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_dualschur(noeuds,ni,nj,a,lpblo,blo,   &
+          ninterf,ninterfc,nni,nnic,   &
+          ndvois,ndvoisc,plistin,listin,   &
+          poids,u,v,f,bitw,utilu,   &
+          lambda,g,pg,mg,nitmax,nmaxd,j0,wj,dwj,dwwj,   &
+          gamm,work,bufin,bufout,narea,epsilo,ndlblo,   &
+          lisblo,ndkerep,   &
+          xnul,ynul,numit0ete,nitmaxete,eteg,   &
+          eteag,eted,etead,eteadd,etegamm,nsp,etev,   &
+          etew,nnih,plistih,gh,w,dw,   &
+          residu,indic,jn)
+      implicit none
+!  nombre de ddl par noeuds, nombre de noeuds interne et interface
+      integer noeuds,ni,nj,nni,nnic
+!      integer jpj,jpi
+!  numero du sous-domaine = numero de processeur + 1 
+      integer narea
+!  tableaux descripteurs de la matrice locale
+      REAL(kind=8)  a(ni,nj,5)
+!  tableaux descripteurs de l'inverse de la matrice du probleme local
+      integer lpblo
+      REAL(kind=8)  blo(lpblo)
+!  tableaux descripteurs de l'interface
+      integer ninterf,ninterfc
+      integer ndvois(ninterf,3),ndvoisc(ninterfc,3)
+      integer plistin(ninterfc+1),listin(nnic)
+!  tableaux descripteurs de l'interface ajoutes pour nperio == 1
+      REAL(kind=8)  poids(noeuds)
+!  utilitaires pour les assemblages aux interfaces
+      REAL(kind=8)  bufin(nnic),bufout(nnic)
+!  vecteurs locaux
+      REAL(kind=8)  u(noeuds),v(noeuds),f(noeuds)
+      REAL(kind=8)  bitw(noeuds),utilu(noeuds)
+!  vecteurs inconnues aux interfaces
+!  mg est le gradient preconditionne : M = sum(Bi Ai Bit)
+      REAL(kind=8)  lambda(nni),g(nni),pg(nni),mg(nni)
+!  tableaux servant a gerer le stockage de la moitie des coefficients
+!  des tableaux des directions de descente sur chaque interface
+      integer nnih
+      integer plistih(ninterf+1)
+      REAL(kind=8)  gh(nnih)
+!  tableaux des directions de descente
+!  on appelle D la matrice condensee a l'interface : sum(Bi [Ai]-1 Bit)
+!  j0 est le nombre de vecteurs D orthogonaux deja stockes
+!  j0 est egal au plus a nmaxd-1
+!  lorsque le nomtre total d'iterations atteint nmaxd, seule la derniere
+!  direction calculee est stockee dans la colonne numero nmaxd
+      integer nitmax,nmaxd,j0
+      REAL(kind=8)  wj(nnih,nmaxd),dwj(nnih,nmaxd),dwwj(nmaxd)
+      REAL(kind=8)  w(nni),dw(nni)
+!  utilitaires pour les calculs de produits scalaires globaux
+      REAL(kind=8)  work(nmaxd),gamm(nmaxd)
+!  tableaux descripteurs du noyau de la matrice locale et tableaux 
+!  servant a la projection sur le noyau
+
+!...ndlblo is the dimension of the local nullspace .=<. the size of the
+!   memory of the superstructure associated to the nullspace : ndkerep
+!   indeed ndkerep = Max ndlblo = Max dim(Ker(Ep))
+!                                p=1,Np
+!   ndkerep is introduced to avoid messages "out of bounds" when memory
+!   is checked
+
+      integer ndkerep
+      integer ndlblo,numit0ete,nitmaxete
+      integer lisblo(ndlblo)
+      REAL(kind=8)  xnul(ndlblo),ynul(ndlblo),eteg(ndlblo),eteag(ndlblo)
+
+!...the Krylov optimisation used in PCG associated to the Coarse Solver
+!   involve to keep di & adi vectors in etesolve procedure
+!   the ndkerep parameter is introduced to avoid message "out of bound"
+!   arrising when the memory is checked!
+
+!   ndkerep  =   Max (ndlblo(Ep)) <= memory management (f77 context)
+!               p=1,Np
+
+!      REAL(kind=8)  eted(ndlblo,nitmaxete),etead(ndlblo,nitmaxete)
+
+      REAL(kind=8)  eted(ndkerep,nitmaxete),etead(ndkerep,nitmaxete)
+      REAL(kind=8)  eteadd(nitmaxete),etegamm(nitmaxete)
+      REAL(kind=8)  etev(noeuds),etew(nni),nsp(noeuds,ndlblo)
+!  indicateur de convergence
+
+      integer indic
+      REAL(kind=8)  residu
+      integer jn
+!  utilitaires
+!!    integer j,k,j1,ji,jj,jk
+      integer j,k,j1
+      REAL(kind=8)  scal(2),ff,roj,epsilo,epsilo2
+!  fonctions externes
+      external sdot
+      REAL(kind=8)  sdot
+!  booleen pour caracterisation
+!  numerique si llconv=1
+      integer llconv
+
+      llconv=0
+
+!...critere d'arret epsilo2 = epsilo **2 => evite sqrt
+
+      epsilo2 = epsilo * epsilo
+
+!  calcul du carre scalaire du second membre global
+
+      call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,noeuds   &
+          ,f,utilu,bufin,bufout)
+      ff=sdot(noeuds,utilu,1,utilu,1)
+      call mpp_sum(ff,1,work)
+!     write(90,*)'valeur du carre du second membre ds le Schur Dual :',ff
+
+!  calcul du second membre contraint 
+
+      call feti_consrhs(noeuds,ndlblo,f,nsp,ynul)
+
+!  calcul de lambda0 satisfaisant la contrainte
+ 
+!     call feti_vclr(nni,lambda)
+      call feti_etesolv(ndlblo,xnul,ynul,ndkerep,numit0ete,nitmaxete   &
+          ,eteg,eteag,eted,etead,eteadd,etegamm,ninterf,ndvois,plistin   &
+          ,nni,listin,narea,noeuds,nsp,etev,etew,bufin,bufout,work)
+
+      call feti_proe(ninterf,ndvois,plistin,nni,listin,narea,noeuds,   &
+          ndlblo,nsp,xnul,etev,lambda,bufin,bufout)
+
+!  calcul du nouveau second membre
+
+      call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds,lambda,bitw)
+
+      call feti_vadd(noeuds,bitw,f,bitw)
+
+
+!  calcul du champ local initial u0
+!     call feti_blodir(noeuds,bitw,ndlblo,lisblo)
+      call feti_resloc(noeuds,ni,nj,a,lpblo,blo,bitw,u,utilu)
+
+!  calcul du gradient initial g0 = feti_saut(u0)
+!!    call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,u,g   &
+      call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,u,g   &
+          ,bufin,bufout)
+
+!  reinitialisation de lambdaj0 par reconjugaison
+
+      call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea,g, gh)
+      do k=1,j0
+        gamm(k)=sdot(nnih,gh,1,wj(1,k),1)
+      end do
+      if(j0 >= 1) call mpp_sum(gamm,j0,work)
+      do k=1,j0
+        gamm(k)=-gamm(k)/dwwj(k)
+      end do
+      call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, lambda,gh)
+      call feti_mxvadd(nnih,j0,wj,gamm,gh)
+      call feti_extend(ninterf,ndvois,plistin,nni,plistih,nnih,narea,gh, lambda)
+!  calcul du second membre associe a lambdaj0
+      if(j0 > 0) then
+          call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, lambda,bitw)
+          call feti_vadd(noeuds,bitw,f,bitw)
+!  calcul du champ local associe uj0
+!         call feti_blodir(noeuds,bitw,ndlblo,lisblo)
+          call feti_resloc(noeuds,ni,nj,a,lpblo,blo,bitw,u,utilu)
+!  calcul du gradient initial gj0= feti_saut(uj0)
+!!        call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds   &
+          call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds   &
+              ,u,g,bufin,bufout)
+      endif
+!  calcul du gradient projete 
+!     call feti_vmov(nni,g,pg)
+      call feti_project(g,pg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+          ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf,ndvois   &
+          ,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin,bufout,work)
+!  calcul du gradient preconditionne 
+!     call feti_vmov(nni,pg,mg)
+
+      call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, pg,bitw)
+
+      call feti_proax(noeuds,ni,nj,a,bitw,v) 
+!!    call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,v, mg,bufin,bufout)
+      call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,v, mg,bufin,bufout)
+!  verification du residu initial 
+      residu=sdot(nni,mg,1,mg,1)
+      call mpp_sum(residu,1,work)
+      residu = (4. * residu) / ff
+      if(residu <= epsilo2)then
+!         residu=10.*sqrt(residu/ff)
+!         if(residu < epsilo)then
+          if(llconv == 1)then
+              if(narea == 1)then
+                  write(0,*)'  residu carre approche initial :',residu
+              endif
+          endif
+!  calcul du champ global moyenne aux interfaces et du residu global 
+          call feti_vsub(noeuds,u,etev,utilu)
+          call feti_moyen(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+              noeuds,poids,utilu,utilu,bufin,bufout)
+          call feti_vmov(noeuds,utilu,u)
+          call feti_proax(noeuds,ni,nj,a,utilu,v) 
+          call feti_vsub(noeuds,v,f,v)
+          call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+              noeuds,v,utilu,bufin,bufout)
+          residu=sdot(noeuds,utilu,1,utilu,1)
+          call mpp_sum(residu,1,work)
+          residu=sqrt(residu/ff)
+!         residu=residu/ff
+          if(llconv == 1)then
+              if(narea == 1)then
+                  write(0,*)'  residu exact initial :',residu
+              endif
+          endif
+
+ 101      format(10d9.2)
+
+          return
+
+      endif
+
+
+!  calcul de la premiere direction de descente
+!  calcul du gradient preconditionne projete 
+      call feti_project(mg,mg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+          ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf,ndvois   &
+          ,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin,bufout ,work)
+      call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea,   &
+          mg,wj(1,j0+1))
+      do k=1,j0
+        gamm(k)=sdot(nnih,wj(1,j0+1),1,dwj(1,k),1)
+      end do
+      if(j0 >= 1) call mpp_sum(gamm,j0,work)
+      do k=1,j0
+        gamm(k)=-gamm(k)/dwwj(k)
+      end do
+      call feti_mxvadd(nnih,j0,wj,gamm,wj(1,j0+1))
+
+!  iterations de gradient conjugue a l'interface
+
+
+!debug
+      do j=j0+1,j0+nitmax
+
+        if(llconv == 1.and.narea == 1) write(0,*)'etape numero',j-j0
+!  j1 est le numero de colonne de la derniere direction de descente
+!  j1 = j, numero d'iteration total, tant que j < nmaxd
+!  au-dela, j1 = nmaxd
+        j1=min0(j,nmaxd)
+!  calcul de Dwi , D = sum ( Bi [Ai]-1 tBi )
+        call feti_extend(ninterf,ndvois,plistin,nni,plistih,nnih,narea, wj(1,j1),w)
+        call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, w,bitw)
+!       call feti_blodir(noeuds,bitw,ndlblo,lisblo)
+        call feti_resloc(noeuds,ni,nj,a,lpblo,blo,bitw,v,utilu)
+!!      call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,v   &
+        call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,v   &
+            ,dw,bufin,bufout)
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, dw,dwj(1,j1))
+!  calcul du coefficient de descente
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, g,gh)
+        scal(1)=sdot(nnih,gh,1,wj(1,j1),1)
+        scal(2)=sdot(nnih,dwj(1,j1),1,wj(1,j1),1)
+        call mpp_sum(scal,2,work)
+        roj=-scal(1)/scal(2)
+        dwwj(j1)=scal(2)
+!  remise a jour de lambda, g et u
+        call saxpy(nni,roj,w,1,lambda,1)
+        call saxpy(nni,roj,dw,1,g,1)
+        call saxpy(noeuds,roj,v,1,u,1)
+!  calcul du gradient projete 
+!       call feti_vmov(nni,g,pg)
+        call feti_project(g,pg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+            ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf   &
+            ,ndvois,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin   &
+            ,bufout,work)
+!  calcul du gradient preconditionne Mg , M = sum ( Bi Ai tBi )
+!       call feti_vmov(nni,pg,mg)
+        call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, pg,bitw)
+        call feti_proax(noeuds,ni,nj,a,bitw,v) 
+!!      call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,v   &
+        call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,v   &
+            ,mg,bufin,bufout)
+!  verification du residu global approche
+        residu=sdot(nni,mg,1,mg,1)
+        call mpp_sum(residu,1,work)
+!       residu=10.*sqrt(residu/ff)
+        residu = (4. * residu) / ff
+        if(llconv == 1.and.narea == 1)then
+            write(0,*)'  residu carre global approche apres ',   &
+                j-j0,' iterations :',residu
+        endif
+
+!       if(residu <  epsilo) then
+        if(residu <= epsilo2)then
+            if(llconv == 1.and.narea == 1)then
+                write(0,*)'residu carre global approche apres ',   &
+                    j-j0,' iterations :',residu
+            endif
+!  calcul du champ global moyenne aux interfaces et du residu global 
+            call feti_vsub(noeuds,u,etev,utilu)
+            call feti_moyen(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+                noeuds,poids,utilu,utilu,bufin,bufout)
+            call feti_vmov(noeuds,utilu,u)
+            call feti_proax(noeuds,ni,nj,a,utilu,v) 
+            call feti_vsub(noeuds,v,f,v)
+            call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+                noeuds,v,utilu,bufin,bufout)
+            residu=sdot(noeuds,utilu,1,utilu,1)
+            call mpp_sum(residu,1,work)
+!           residu=residu/ff
+            residu=sqrt(residu/ff)
+            if(llconv == 1.and.narea == 1)then
+                write(0,*)'  residu global exact apres ',   &
+                    j-j0,' iterations :',residu
+            endif
+
+            jn = j - j0
+            j0=min0(j,nmaxd-1)
+            if(llconv == 1.and.narea == 1)then
+                write(0,*)'  nombre de directions orthogonales conservees :',j0
+            endif
+
+
+            return
+        endif
+!##################################################################
+!  calcul du champ global moyenne aux interfaces et du residu global 
+        call feti_vsub(noeuds,u,etev,utilu)
+        call feti_moyen(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+            noeuds,poids,utilu,utilu,bufin,bufout)
+        call feti_proax(noeuds,ni,nj,a,utilu,v) 
+        call feti_vsub(noeuds,v,f,v)
+        call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+            noeuds,v,utilu,bufin,bufout)
+        residu=sdot(noeuds,utilu,1,utilu,1)
+        call mpp_sum(residu,1,work)
+!       residu=sqrt(residu/ff)
+        residu=residu/ff
+        if(llconv == 1.and.narea == 1)then
+            write(0,*)'  residu carre global exact apres ',   &
+                j-j0,' iterations :',residu
+        endif
+
+!#####################################################################
+!  calcul de la nouvelle direction de descente par reconjugaison
+!  calcul du gradient preconditionne projete 
+        call feti_project(mg,mg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+            ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf   &
+            ,ndvois,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin   &
+            ,bufout,work)
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, mg,gh)
+        do k=1,j1
+          gamm(k)=sdot(nnih,gh,1,dwj(1,k),1)
+        end do
+        call mpp_sum(gamm,j1,work)
+        do k=1,j1
+          gamm(k)=-gamm(k)/dwwj(k)
+        end do
+        call feti_mxvadd(nnih,j1,wj,gamm,gh)
+        j1=min0(j1+1,nmaxd)
+
+!%%%%%%%%%%stabilisation numerique %%%%%%%%%%%%%%%%%%%%%%%%%
+        call feti_extend(ninterf,ndvois,plistin,nni,plistih,nnih,narea, gh,w)
+        call feti_project(w,w,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+            ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf   &
+            ,ndvois,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin   &
+            ,bufout,work)
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, w,gh)
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+        call feti_vmov(nnih,gh,wj(1,j1))
+
+      end do
+
+      residu = sqrt(residu)
+      if(narea == 1) then
+          write(0,*)'  residu global approche apres ',nitmax,   &
+              '  iterations :',residu
+      endif
+      indic=-2
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_extend(numnes,listnes,   &
+          plistin,numins,plistih,   &
+          numinh,narea,wh,w)
+
+!  reassembling an half interface field 
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern ibnterfaces
+!               plistin =  pointer of sublists of interface nodes
+!               plistih =  pointer of half-sublists of interface nodes
+!               numins  =  number of interface nodes
+!               numinh  =  half number of interface nodes
+!               narea    =  subdomain number
+!               wh      =  half interface vector 
+
+!     OUTPUTS :      w  =  complete interface vector
+
+!     WORKSPACE : work
+      implicit none 
+!      external irecv
+!!    integer irecv, work(100)
+      integer numnes,numins,numinh,narea
+      integer listnes(numnes,3), plistin(numnes+1), plistih(numnes+1)
+      REAL(kind=8)  wh(numinh),w(numins)
+      integer i,l,lin,lout
+      integer mesg
+
+      mesg=128*10
+!  if subdomains i < j are neighbours, subdomain i manage the first
+!  half of the interface, and subdomain j the remaining part
+
+!  receiving the values of the outer fields on the interface
+!  sending the values of the inner field on the interface
+
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!        if(narea < listnes(i)) then
+        if(listnes(i,3) < listnes(i,2))then
+            lout=(l-(l/2))
+            lin=(l/2)
+!           work(i)=irecv(mesg+listnes(i)-1,w(plistin(i)+(l/2)+1), lout*8)
+!           call mppsend(mesg+narea-1,wh(plistih(i)+1),lin*8,listnes(i) -1,0)
+            call mppsend(mesg+listnes(i,3)-1,wh(plistih(i)+1),lin*8, listnes(i,1)-1,0)
+            call feti_vmov(lin,wh(plistih(i)+1),w(plistin(i)+1))
+        else
+            lout=(l/2)
+            lin=(l-(l/2))
+!           work(i)=irecv(mesg+listnes(i)-1,w(plistin(i)+1),lout*8)
+!           call mppsend(mesg+narea-1,wh(plistih(i)+1),lin*8,listnes(i)-1,0)
+            call mppsend(mesg+listnes(i,3)-1,wh(plistih(i)+1),lin*8, listnes(i,1)-1,0)
+            call feti_vmov(lin,wh(plistih(i)+1),w(plistin(i)+(l/2)+1))
+        endif
+      enddo
+!  waiting for the completion on each interface 
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!       if(narea < listnes(i)) then
+        if(listnes(i,3) < listnes(i,2))then
+            lout=(l-(l/2))
+!           call mpprecv(mesg+listnes(i)-1,w(plistin(i)+(l/2)+1), lout*8)
+            call mpprecv(mesg+listnes(i,2)-1,w(plistin(i)+(l/2)+1), lout*8)
+            call feti_vneg(lout,w(plistin(i)+(l/2)+1),   &
+                w(plistin(i)+(l/2)+1))
+        else
+            lout=(l/2)
+!           call mpprecv(mesg+listnes(i)-1,w(plistin(i)+1),lout*8)
+            call mpprecv(mesg+listnes(i,2)-1,w(plistin(i)+1),lout*8)
+            call feti_vneg(lout,w(plistin(i)+1),w(plistin(i)+1))
+        endif
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_restri(numnes,listnes,plistin,numins,plistih,   &
+          numinh,narea,w,wh)
+
+!  restriction of an interface field to one half on each interface
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               plistih =  pointer of half-sublists of interface nodes
+!               numins  =  number of interface nodes
+!               numinh  =  half number of interface nodes
+!               narea    =  subdomain number
+!               w       =  complete interface vector 
+
+!     OUTPUTS :      wh  =  half interface vector
+
+!     WORKSPACE : work
+      implicit none 
+      integer numnes,numins,numinh,narea
+      integer listnes(numnes,3), plistin(numnes+1), plistih(numnes+1)
+      REAL(kind=8)  wh(numinh),w(numins)
+      integer i,l,lin
+
+!  if subdomains i < j are neighbours, subdomain i manage the first
+!  half of the interface, and subdomain j the remaining part
+
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!       if(narea < listnes(i)) then
+        if(listnes(i,3) < listnes(i,2))then
+            lin=(l/2)
+            call feti_vmov(lin,w(plistin(i)+1),wh(plistih(i)+1))
+        else
+            lin=(l-(l/2))
+            call feti_vmov(lin,w(plistin(i)+(l/2)+1),wh(plistih(i)+1))
+        endif
+      end do
+
+      return
+      end
+!**********************************************************************c
+!!    subroutine feti_halfint(numnes,listnes,plistin,numins,plistih   &
+!!        ,numinh,narea)
+      subroutine feti_halfint(numnes,listnes,plistin,       plistih   &
+          ,numinh      )
+
+!  construction of the pointer of the restriction of an interface 
+!  field to one half on each interface
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               narea    =  subdomain number
+
+!     OUTPUTS :      numinh  =  half number of interface nodes
+!               plistih =  pointer of half-sublists of interface nodes
+
+!     WORKSPACE : work
+      implicit none 
+!!    integer numnes,numins,numinh,narea
+      integer numnes,       numinh
+      integer listnes(numnes,3), plistin(numnes+1), plistih(numnes+1)
+      integer i,l
+
+!  if subdomains i < j are neighbours, subdomain i manage the first
+!  half of the interface, and subdomain j the remaining part
+
+      plistih(1)=0
+      numinh=0
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!        if(narea < listnes(i,1)) then
+        if(listnes(i,3) < listnes(i,2)) then
+!          write(*,*)'je gere interface avec : ',listnes(i,1)
+            plistih(i+1)=plistih(i)+(l/2)
+        else
+!          write(*,*)'il gere interface avec : ',listnes(i,1)
+            plistih(i+1)=plistih(i)+(l-(l/2))
+        endif
+      end do
+      numinh=plistih(numnes+1)
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_front(n,ni,nj,a,lcmat,cmat,d,v,w,ndlblo,lisblo   &
+          ,nmdlblo)
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+!  routine de calcul de la decomposition frontale par blocs de
+!  la matrice pentadiagonale a .
+!  cmat contient les termes des blocs diagonaux factorises .
+      dimension cmat(lcmat),d(n)
+
+!...ndlblo nombre de liberte bloques = nombre de pivots nuls = dim(Ker(Ep))
+
+!...nmdlblo = Max (ndlblo(Ep)) <= superstructure management in f77 context
+!            p=1,Np
+
+      integer ndlblo,nmdlblo
+      integer lisblo(nmdlblo)
+
+!  d ne contient pas, en sortie, l'inverse de la diagonale de Crout .
+!  v est un tableau servant a stocker la partie triangulaire inferieure
+!  stricte d'un bloc diagonal , et w un tableau servant a stocker un
+!  bloc sur-diagonal plein .
+!  de dimension egale a la largeur maximale d'un front .
+      dimension v(ni,ni),w(ni)
+!!!
+      ndimd=ni
+      lbd=ndimd*ndimd
+
+!      lecture du tout premier bloc diagonal
+
+      nb=1
+!  adresse du bloc diagonal courant
+      iac=1
+      call feti_liblod(n,ni,a,ndimd,nb,cmat(iac))
+!  inversion du premier bloc diagonal .
+!     write(*,*)'  inversion du premier bloc diagonal '
+      j0=0
+      call feti_ldlt(ndimd,cmat(iac),d(1),w,ndlblo,lisblo,nmdlblo,j0)
+      call feti_calinv(ndimd,cmat(iac),v)
+
+!  contraction puis inversion des blocs diagonaux de la la matrice
+!  front par front .
+
+      do 2 nb=2,nj
+!       write(*,*)'  front numero ',nb
+!  adresse du bloc diagonal precedent
+        iap=iac
+        iac=(nb-1)*lbd+1
+
+!      lecture du bloc sur-diagonal precedent: passage bande-vecteur
+
+        call feti_liblos(n,a,ndimd,nb-1,w)
+
+!  elimination du bloc extra-diagonal .
+
+!   lecture du bloc diagonal courant: passage bande-plein
+
+        call feti_liblod(n,ni,a,ndimd,nb,cmat(iac))
+
+!  calcul du nouveau bloc diagonal courant .
+
+!       write(*,*)'  calcul du nouveau bloc diagonal courant '
+        call feti_nbdia(ndimd,w,cmat(iap),cmat(iac))
+
+!  inversion du nouveau bloc diagonal courant .
+
+!       write(*,*)'  factorisation du nouveau bloc diagonal courant '
+        j0=(nb-1)*ndimd
+        call feti_ldlt(ndimd,cmat(iac),d((nb-1)*ndimd+1),w,ndlblo,   &
+            lisblo,nmdlblo,j0)
+        call feti_calinv(ndimd,cmat(iac),v)
+
+ 2    continue
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_calinv(dim,a,b)
+!  calcul de la partie triangulaire inferieure du bloc :
+!  b = [a]-1 puis recopie dans a complet .
+      implicit none
+      integer dim
+      REAL(kind=8)  a(dim,dim),b(dim,dim)
+      integer i,j
+
+      call feti_vclr(dim*dim,b)
+      do j=1,dim
+        b(j,j)=1.e0
+        call feti_desremo(dim,j-1,a,b(1,j),b(1,j))
+      end do
+      do j=1,dim
+        do i=j,dim
+          a(i,j)=b(i,j)
+          a(j,i)=b(i,j)
+        end do
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_nbdia(n,d,w,v)
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension d(n),v(n,n),w(n,n)
+
+      do 1 j=1,n
+        do 2 i=1,n
+          v(i,j)=v(i,j)-d(i)*w(i,j)*d(j)
+ 2      continue
+ 1    continue
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_liblod(n,ni,a,ndimd,nb,db)
+
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension db(ndimd,ndimd)
+!  tableaux descripteurs de la structure morse de la matrice .
+      dimension a(n,5)
+
+      call feti_vclr(ndimd*ndimd,db)
+!       do i=1,ndimd*ndimd
+!         db(i,1)=0.e0
+!8     continue
+      n0=(nb-1)*ndimd
+!  lecture de la diagonale db(i,i) .
+      do 3 i=1,ndimd
+        db(i,i)=a(n0+i,3)
+ 3    continue
+!  lecture de la premiere sur-diagonale db(i,i+1) .
+      do 4 i=1,ndimd-1
+        db(i,i+1)=a(n0+i,4)
+ 4    continue
+!  lecture de la premiere sous-diagonale db(i,i-1) .
+      do 2 i=2,ndimd
+        db(i,i-1)=a(n0+i,2)
+ 2    continue
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_liblos(n,a,ndimd,nb,v)
+
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension v(ndimd)
+!  tableaux descripteurs de la structure morse de la matrice .
+      dimension a(n,5)
+
+      n0=(nb-1)*ndimd
+!  lecture de la deuxieme sur-diagonale v(i) .
+      do 5 i=1,ndimd
+        v(i)=a(n0+i,5)
+ 5    continue
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_resloc(n,ni,nj,a,lcmat,cmat,y,x,z)
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+!  routine de resolution utilisant la decomposition frontale par blocs
+!  de la matrice heptadiagonale a .
+!  cmat contient les termes des blocs diagonaux factorises .
+      dimension cmat(lcmat)
+!  d contient l'inverse de la diagonale de Crout .
+      dimension y(n),x(n),z(n)
+!
+      call feti_vmov(n,y,z)
+      ndimd=ni
+      lbd=ndimd*ndimd
+!  descente du systeme .
+      do nb=1,nj-1
+!  calcul du second membre condense : z(i+1)=y(i+1)- FD-1 z(i) .
+        iacmat=(nb-1)*lbd+1
+        n0=(nb-1)*ndimd
+        call feti_mxv(ndimd,ndimd,cmat(iacmat),z(n0+1),x(n0+1))
+        call feti_pbloi(n,ni,nj,a,x,z,nb)
+      end do
+!  inversion du dernier bloc diagonal .
+      iacmat=(nj-1)*lbd+1
+      n0=(nj-1)*ndimd
+      call feti_mxv(ndimd,ndimd,cmat(iacmat),z(n0+1),x(n0+1))
+!  remontee du systeme par bloc .
+      do nb=nj-1,1,-1
+!  calcul du second membre condense : z(i)=z(i)- E x(i+1) .
+        call feti_pblos(n,ni,nj,a,x,z,nb)
+!  calcul de la solution pour le bloc diagonal courant .
+        iacmat=(nb-1)*lbd+1
+        n0=(nb-1)*ndimd
+        call feti_mxv(ndimd,ndimd,cmat(iacmat),z(n0+1),x(n0+1))
+      end do
+
+      end
+!***********************************************************************
+      subroutine feti_pblos(n,ni,nj,a,x,y,nb)
+!  calcul du produit matrice-vecteur morse : y = y - A x .
+!  produit par le bloc superieur numero nb .
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+      dimension x(n),y(n)
+
+      n0=(nb-1)*ni
+!  produit par la deuxieme sur-diagonale a(i,i+ni) .
+      do i=n0+1,n0+ni
+        y(i)=y(i)-x(i+ni)*a(i,5)
+      end do
+
+      end subroutine feti_pblos
+!***********************************************************************
+      subroutine feti_pbloi(n,ni,nj,a,x,y,nb)
+!  calcul du produit matrice-vecteur morse : y = y - A x .
+!  produit par le bloc inferieur numero nb .
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+      dimension x(n),y(n)
+
+      n0=nb*ni
+!  produit par la deuxieme sous-diagonale a(i,i-ni) .
+      do i=n0+1,n0+ni
+        y(i)=y(i)-x(i-ni)*a(i,1)
+      end do
+
+      end subroutine feti_pbloi
+!***********************************************************************
+      subroutine feti_proax(n,ni,nj,a,x,y)
+!  calcul du produit matrice-vecteur morse par la matrice heptadiagonale
+!  a stockee par bandes .
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+      dimension x(n),y(n)
+
+!  produit par la diagonale .
+      do i=1,n
+        y(i)=x(i)*a(i,3)
+      end do
+!  produit par la premiere sur-diagonale a(i,i+1) .
+      do i=1,n-1
+        y(i)=y(i)+x(i+1)*a(i,4)
+      end do
+!  produit par la deuxieme sur-diagonale a(i,i+ni) .
+      do i=1,n-ni
+        y(i)=y(i)+x(i+ni)*a(i,5)
+      end do
+! produit par la premiere sous-diagonale a(i,i-1)
+      do i=2,n
+          y(i)=y(i)+x(i-1)*a(i,2)
+      end do
+! produit par la deuxieme sous-diagonale a(i,i-ni)
+      do i=1+ni,n
+          y(i)=y(i)+x(i-ni)*a(i,1)
+      end do
+
+      end subroutine feti_proax
+
+#else
+   !! no use of FETI librairy
+#endif
+
+   !!======================================================================
+END MODULE lib_feti
Index: trunk/NEMO/OFF_SRC/lib_isml.f90
===================================================================
--- trunk/NEMO/OFF_SRC/lib_isml.f90	(revision 325)
+++ trunk/NEMO/OFF_SRC/lib_isml.f90	(revision 325)
@@ -0,0 +1,675 @@
+!
+! subroutines for PCG or SOR solvers
+! (used if the ISML library is not available)
+!
+! linrg
+!   gauss
+!   vmov
+!   desremopt
+!   dtrsv
+!   dger
+!   xerbla
+!   lsame
+! folr (empty)
+!
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+!---------------------------------------------------------
+   SUBROUTINE linrg(kn,pa,klda,painv,kldainv)
+
+      !! compute inverse matrix
+
+      IMPLICIT NONE 
+      INTEGER kn,klda,kldainv
+      REAL (kind=8) ::   pa(kn,kn),painv(kn,kn)
+      REAL (kind=8) ::   zb(kn,kn)
+      REAL (kind=8) ::   zv(kn)
+      INTEGER iplin(kn)
+      INTEGER ji
+
+      IF( kn /= klda .OR. kn /= kldainv ) THEN 
+          write(0,*)'change your parameters'
+          STOP 
+      ENDIF 
+
+      CALL vmov( kn*kn, pa, painv )
+
+      CALL gauss( kn, painv, iplin, zv )
+
+      zb(:,:) = 0.e0   
+      DO ji = 1, kn
+        zb(ji,ji) = 1.e0
+        CALL desremopt( kn, painv, iplin, zb(1,ji), zb(1,ji), zv )
+      END DO 
+      CALL vmov( kn*kn, zb, painv )
+
+   END SUBROUTINE linrg
+!---------------------------------------------------------
+   SUBROUTINE gauss(kn,pa,kplin,pv)
+
+      IMPLICIT NONE 
+      INTEGER kn
+      INTEGER ji,jj,jk
+      INTEGER ik,ipp
+      REAL (kind=8) ::   pa(kn,kn),pv(kn)
+!!    REAL (kind=8) ::   zpivmax,zalpha
+      REAL (kind=8) ::   zalpha
+      INTEGER kplin(kn)
+      INTEGER isamax
+      EXTERNAL isamax
+
+!  factorisation de Gauss de la matrice a avec pivot partiel . 
+!  initialisation des pointeurs .
+      DO ji=1,kn
+        kplin(ji)=ji
+      END DO 
+      DO jk=1,kn-1
+!  recherche du pivot maximal .
+!!      ik=jk
+!!      zpivmax=dabs(pa(jk,jk))
+!!        DO ji=jk,kn
+!!          IF(dabs(pa(ji,jk)) > zpivmax) THEN 
+!!            zpivmax=dabs(pa(ji,jk))
+!!            ik=ji
+!!          ENDIF 
+!!        END DO 
+        ik=isamax( kn-jk+1, pa(jk,jk) )+jk-1
+!  permutation de la ligne jk et de la ligne ik .
+        IF(jk == 58) THEN
+            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
+            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
+        ENDIF 
+        ipp=kplin(ik)
+        kplin(ik)=kplin(jk)
+        kplin(jk)=ipp
+        DO jj=1,kn
+          pv(jj)=pa(ik,jj)
+          pa(ik,jj)=pa(jk,jj)
+          pa(jk,jj)=pv(jj)
+        END DO 
+        IF(jk == 58) THEN
+            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
+            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
+        ENDIF 
+!  calcul des coefficients de la colonne k ligne a ligne .
+        DO ji=jk+1,kn
+          IF(pa(jk,jk) == 0) THEN 
+              PRINT *,'probleme diagonale nulle',jk,pa(jk,jk)
+              pa(ji,jk)=pa(ji,jk)/1.E-20
+          ENDIF 
+          IF(pa(jk,jk) /= 0) pa(ji,jk)=pa(ji,jk)/pa(jk,jk)
+        END DO 
+!!        DO ji=jk+1,kn
+!!          DO jj=jk+1,kn
+!!            pa(ji,jj)=pa(ji,jj)-pa(ji,jk)*pa(jk,jj)
+!!          END DO 
+!!        END DO 
+        zalpha=-1.
+        CALL dger(kn-jk,kn-jk,zalpha,pa(jk+1,jk),1,pa(jk,jk+1),kn,   &
+            pa(jk+1,jk+1),kn)
+      END DO 
+
+   END SUBROUTINE gauss
+!---------------------------------------------------------
+   FUNCTION isamax( I, X )
+      DIMENSION X(I)
+      ISAMAX = 0
+      XMIN = -1e+50
+      DO N = 1, I
+         IF(ABS(X(N)) > XMIN ) THEN
+            XMIN = X(N)
+            ISAMAX = N
+         ENDIF
+      END DO
+   END FUNCTION isamax
+!---------------------------------------------------------
+   SUBROUTINE vmov(kn,px,py)
+
+      IMPLICIT NONE 
+      INTEGER kn
+      REAL (kind=8) ::   px(kn),py(kn)
+      INTEGER ji
+
+      DO ji=1,kn
+         py(ji)=px(ji)
+      END DO 
+
+   END SUBROUTINE vmov
+!---------------------------------------------------------
+   subroutine desremopt(n,a,plin,y,x,v)
+      implicit none
+      integer n,i,  j0
+!!    integer n,i,j,j0
+      real (kind=8) ::   a(n,n),x(n),y(n),v(n)
+      integer plin(n)
+!  descente remontee du systeme .
+!  initialisation du vecteur resultat .
+!  prise en compte de la permutation des lignes .
+      do i=1,n
+        v(i)=y(plin(i))
+      end do
+      do i=1,n
+        if(v(i) /= 0.) then
+          j0=i-1
+          goto 1
+        endif
+      end do
+1     continue
+!  descente du systeme L v = v , L est a diagonale unitaire .
+!!      do j=j0+1,n
+!!        do i=j+1,n
+!!          v(i)=v(i)-a(i,j)*v(j)
+!!        end do
+!!      end do
+      call dtrsv('L','N','U',n-j0,a(j0+1,j0+1),n,v(j0+1),1)
+!  remontee du systeme U v = v . 
+!!      do j=n,1,-1
+!!        v(j)=v(j)/a(j,j)
+!!        do i=1,j-1
+!!          v(i)=v(i)-a(i,j)*v(j)
+!!        end do
+!!      end do          
+      call dtrsv('U','N','N',n,a,n,v,1)
+!  prise en compte de la permutation des colonnes .
+      do i=1,n
+        x(i)=v(i)
+      end do
+
+   end SUBROUTINE desremopt
+!---------------------------------------------------------
+   SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+!!    .. Scalar Arguments ..
+      INTEGER            INCX, LDA, N
+      CHARACTER (len=1) ::   DIAG, TRANS, UPLO
+!!    .. Array Arguments ..
+!     DOUBLE PRECISION   A( LDA, * ), X( * )
+      REAL (kind=8) ::     A( LDA, * ), X( * )
+!!    ..
+
+!! Purpose
+!! =======
+
+!! DTRSV  solves one of the systems of equations
+
+!!    A*x = b,   or   A'*x = b,
+
+!! where b and x are n element vectors and A is an n by n unit, or
+!! non-unit, upper or lower triangular matrix.
+
+!! No test for singularity or near-singularity is included in this
+!! routine. Such tests must be performed before calling this routine.
+
+!! Parameters
+!! ==========
+
+!! UPLO   - CHARACTER*1.
+!!          On entry, UPLO specifies whether the matrix is an upper or
+!!          lower triangular matrix as follows:
+
+!!             UPLO = 'U' or 'u'   A is an upper triangular matrix.
+
+!!             UPLO = 'L' or 'l'   A is a lower triangular matrix.
+
+!!          Unchanged on exit.
+
+!! TRANS  - CHARACTER*1.
+!!          On entry, TRANS specifies the equations to be solved as
+!!          follows:
+
+!!             TRANS = 'N' or 'n'   A*x = b.
+
+!!             TRANS = 'T' or 't'   A'*x = b.
+
+!!             TRANS = 'C' or 'c'   A'*x = b.
+
+!!          Unchanged on exit.
+
+!! DIAG   - CHARACTER*1.
+!!          On entry, DIAG specifies whether or not A is unit
+!!          triangular as follows:
+
+!!             DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+
+!!             DIAG = 'N' or 'n'   A is not assumed to be unit
+!!                                 triangular.
+
+!!          Unchanged on exit.
+
+!! N      - INTEGER.
+!!          On entry, N specifies the order of the matrix A.
+!!          N must be at least zero.
+!!          Unchanged on exit.
+
+!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+!!          Before entry with  UPLO = 'U' or 'u', the leading n by n
+!!          upper triangular part of the array A must contain the upper
+!!          triangular matrix and the strictly lower triangular part of
+!!          A is not referenced.
+!!          Before entry with UPLO = 'L' or 'l', the leading n by n
+!!          lower triangular part of the array A must contain the lower
+!!          triangular matrix and the strictly upper triangular part of
+!!          A is not referenced.
+!!          Note that when  DIAG = 'U' or 'u', the diagonal elements of
+!!          A are not referenced either, but are assumed to be unity.
+!!          Unchanged on exit.
+
+!! LDA    - INTEGER.
+!!          On entry, LDA specifies the first dimension of A as declared
+!!          in the calling (sub) program. LDA must be at least
+!!          max( 1, n ).
+!!          Unchanged on exit.
+
+!! X      - DOUBLE PRECISION array of dimension at least
+!!          ( 1 + ( n - 1 )*abs( INCX ) ).
+!!          Before entry, the incremented array X must contain the n
+!!          element right-hand side vector b. On exit, X is overwritten
+!!          with the solution vector x.
+
+!! INCX   - INTEGER.
+!!          On entry, INCX specifies the increment for the elements of
+!!          X. INCX must not be zero.
+!!          Unchanged on exit.
+
+
+!! Level 2 Blas routine.
+
+!! -- Written on 22-October-1986.
+!!    Jack Dongarra, Argonne National Lab.
+!!    Jeremy Du Croz, Nag Central Office.
+!!    Sven Hammarling, Nag Central Office.
+!!    Richard Hanson, Sandia National Labs.
+
+
+!!    .. Parameters ..
+!     DOUBLE PRECISION   ZERO
+!     PARAMETER        ( ZERO = 0.0D+0 )
+      REAL (kind=8) ::                 ZERO
+      PARAMETER        ( ZERO = 0.0 )
+!!    .. Local Scalars ..
+!     DOUBLE PRECISION   TEMP
+      REAL (kind=8) ::                 TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+      LOGICAL            NOUNIT
+!!    .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+!!    .. External Subroutines ..
+      EXTERNAL           XERBLA
+!!    .. Intrinsic Functions ..
+      INTRINSIC          MAX
+!!    ..
+!!    .. Executable Statements ..
+
+!!    Test the input parameters.
+
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.   &
+               .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.   &
+               .NOT.LSAME( TRANS, 'T' ).AND.   &
+               .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.   &
+               .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N < 0 )THEN
+         INFO = 4
+      ELSE IF( LDA < MAX( 1, N ) )THEN
+         INFO = 6
+      ELSE IF( INCX == 0 )THEN
+         INFO = 8
+      END IF
+      IF( INFO /= 0 )THEN
+         CALL XERBLA( 'DTRSV ', INFO )
+         RETURN
+      END IF
+
+!!    Quick return if possible.
+
+      IF( N == 0 )   RETURN
+
+      NOUNIT = LSAME( DIAG, 'N' )
+
+!!    Set up the start point in X if the increment is not unity. This
+!!    will be  ( N - 1 )*INCX  too small for descending loops.
+
+      IF( INCX <= 0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX /= 1 )THEN
+         KX = 1
+      END IF
+
+!!    Start the operations. In this version the elements of A are
+!!    accessed sequentially with one pass through A.
+
+      IF( LSAME( TRANS, 'N' ) )THEN
+
+!!       Form  x := inv( A )*x.
+
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX == 1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ) /= ZERO )THEN
+                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 10, I = J - 1, 1, -1
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   10                CONTINUE
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 40, J = N, 1, -1
+                  IF( X( JX ) /= ZERO )THEN
+                     IF( NOUNIT )  X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 30, I = J - 1, 1, -1
+                        IX      = IX      - INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX == 1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ) /= ZERO )THEN
+                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 50, I = J + 1, N
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   50                CONTINUE
+                  END IF
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  IF( X( JX ) /= ZERO )THEN
+                     IF( NOUNIT )   X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 70, I = J + 1, N
+                        IX      = IX      + INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+
+!!       Form  x := inv( A' )*x.
+
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX == 1 )THEN
+               DO 100, J = 1, N
+                  TEMP = X( J )
+                  DO 90, I = 1, J - 1
+                     TEMP = TEMP - A( I, J )*X( I )
+   90             CONTINUE
+                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
+                  X( J ) = TEMP
+  100          CONTINUE
+            ELSE
+               JX = KX
+               DO 120, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 110, I = 1, J - 1
+                     TEMP = TEMP - A( I, J )*X( IX )
+                     IX   = IX   + INCX
+  110             CONTINUE
+                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  120          CONTINUE
+            END IF
+         ELSE
+            IF( INCX == 1 )THEN
+               DO 140, J = N, 1, -1
+                  TEMP = X( J )
+                  DO 130, I = N, J + 1, -1
+                     TEMP = TEMP - A( I, J )*X( I )
+  130             CONTINUE
+                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
+                  X( J ) = TEMP
+  140          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 160, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 150, I = N, J + 1, -1
+                     TEMP = TEMP - A( I, J )*X( IX )
+                     IX   = IX   - INCX
+  150             CONTINUE
+                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+
+   END SUBROUTINE DTRSV
+!---------------------------------------------------------
+   SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+!!    .. Scalar Arguments ..
+!     DOUBLE PRECISION   ALPHA
+      REAL (kind=8) ::                 ALPHA
+      INTEGER            INCX, INCY, LDA, M, N
+!!    .. Array Arguments ..
+!     DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+      REAL (kind=8) ::   A( LDA, * ), X( * ), Y( * )
+!!    ..
+
+!! Purpose
+!! =======
+
+!! DGER   performs the rank 1 operation
+
+!!    A := alpha*x*y' + A,
+
+!! where alpha is a scalar, x is an m element vector, y is an n element
+!! vector and A is an m by n matrix.
+
+!! Parameters
+!! ==========
+
+!! M      - INTEGER.
+!!          On entry, M specifies the number of rows of the matrix A.
+!!          M must be at least zero.
+!!          Unchanged on exit.
+
+!! N      - INTEGER.
+!!          On entry, N specifies the number of columns of the matrix A.
+!!          N must be at least zero.
+!!          Unchanged on exit.
+
+!! ALPHA  - DOUBLE PRECISION.
+!!          On entry, ALPHA specifies the scalar alpha.
+!!          Unchanged on exit.
+
+!! X      - DOUBLE PRECISION array of dimension at least
+!!          ( 1 + ( m - 1 )*abs( INCX ) ).
+!!          Before entry, the incremented array X must contain the m
+!!          element vector x.
+!!          Unchanged on exit.
+
+!! INCX   - INTEGER.
+!!          On entry, INCX specifies the increment for the elements of
+!!          X. INCX must not be zero.
+!!          Unchanged on exit.
+
+!! Y      - DOUBLE PRECISION array of dimension at least
+!!          ( 1 + ( n - 1 )*abs( INCY ) ).
+!!          Before entry, the incremented array Y must contain the n
+!!          element vector y.
+!!          Unchanged on exit.
+
+!! INCY   - INTEGER.
+!!          On entry, INCY specifies the increment for the elements of
+!!          Y. INCY must not be zero.
+!!          Unchanged on exit.
+
+!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+!!          Before entry, the leading m by n part of the array A must
+!!          contain the matrix of coefficients. On exit, A is
+!!          overwritten by the updated matrix.
+
+!! LDA    - INTEGER.
+!!          On entry, LDA specifies the first dimension of A as declared
+!!          in the calling (sub) program. LDA must be at least
+!!          max( 1, m ).
+!!          Unchanged on exit.
+
+
+!! Level 2 Blas routine.
+
+!! -- Written on 22-October-1986.
+!!    Jack Dongarra, Argonne National Lab.
+!!    Jeremy Du Croz, Nag Central Office.
+!!    Sven Hammarling, Nag Central Office.
+!!    Richard Hanson, Sandia National Labs.
+
+
+!!    .. Parameters ..
+!     DOUBLE PRECISION   ZERO
+!     PARAMETER        ( ZERO = 0.0D+0 )
+      REAL (kind=8) ::                 ZERO
+      PARAMETER        ( ZERO = 0.0 )
+!!    .. Local Scalars ..
+!     DOUBLE PRECISION   TEMP
+      REAL (kind=8) ::                 TEMP
+      INTEGER            I, INFO, IX, J, JY, KX
+!!    .. External Subroutines ..
+      EXTERNAL           XERBLA
+!!    .. Intrinsic Functions ..
+      INTRINSIC          MAX
+!!    ..
+!!    .. Executable Statements ..
+
+!!    Test the input parameters.
+
+      INFO = 0
+      IF     ( M < 0 )THEN
+         INFO = 1
+      ELSE IF( N < 0 )THEN
+         INFO = 2
+      ELSE IF( INCX == 0 )THEN
+         INFO = 5
+      ELSE IF( INCY == 0 )THEN
+         INFO = 7
+      ELSE IF( LDA < MAX( 1, M ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO /= 0 )THEN
+         CALL XERBLA( 'DGER  ', INFO )
+         RETURN
+      END IF
+
+!!    Quick return if possible.
+
+      IF( ( M == 0 ).OR.( N == 0 ).OR.( ALPHA == ZERO ) )   &
+         RETURN
+
+!!    Start the operations. In this version the elements of A are
+!!    accessed sequentially with one pass through A.
+
+      IF( INCY > 0 )THEN
+         JY = 1
+      ELSE
+         JY = 1 - ( N - 1 )*INCY
+      END IF
+      IF( INCX == 1 )THEN
+         DO 20, J = 1, N
+            IF( Y( JY ) /= ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               DO 10, I = 1, M
+                  A( I, J ) = A( I, J ) + X( I )*TEMP
+   10          CONTINUE
+            END IF
+            JY = JY + INCY
+   20    CONTINUE
+      ELSE
+         IF( INCX > 0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( M - 1 )*INCX
+         END IF
+         DO 40, J = 1, N
+            IF( Y( JY ) /= ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               IX   = KX
+               DO 30, I = 1, M
+                  A( I, J ) = A( I, J ) + X( IX )*TEMP
+                  IX        = IX        + INCX
+   30          CONTINUE
+            END IF
+            JY = JY + INCY
+   40    CONTINUE
+      END IF
+
+   END SUBROUTINE DGER
+!---------------------------------------------------------
+   SUBROUTINE XERBLA ( SRNAME, INFO )
+!!    ..    Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER (len=6) ::    SRNAME
+!!    ..
+
+!! Purpose
+!! =======
+
+!! XERBLA  is an error handler for the Level 2 BLAS routines.
+
+!! It is called by the Level 2 BLAS routines if an input parameter is
+!! invalid.
+
+!! Installers should consider modifying the STOP statement in order to
+!! call system-specific exception-handling facilities.
+
+!! Parameters
+!! ==========
+
+!! SRNAME - CHARACTER*6.
+!!          On entry, SRNAME specifies the name of the routine which
+!!          called XERBLA.
+
+!! INFO   - INTEGER.
+!!          On entry, INFO specifies the position of the invalid
+!!          parameter in the parameter-list of the calling routine.
+
+
+!! Auxiliary routine for Level 2 Blas.
+
+!! Written on 20-July-1986.
+
+!!    .. Executable Statements ..
+
+      WRITE (*,99999) SRNAME, INFO
+
+      STOP
+
+99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,   &
+               ' had an illegal value' )
+
+   END SUBROUTINE XERBLA
+!-----------------------------------------------------------
+   FUNCTION lsame( c1, c2 )
+      logical lsame
+      CHARACTER (len=*), INTENT(in) ::   c1, c2
+      IF( c1 == c2 ) THEN
+          lsame=.TRUE.
+      ELSE
+          lsame=.FALSE.
+      ENDIF
+   END FUNCTION lsame
Index: trunk/NEMO/OFF_SRC/lib_mpp.F90
===================================================================
--- trunk/NEMO/OFF_SRC/lib_mpp.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/lib_mpp.F90	(revision 325)
@@ -0,0 +1,4647 @@
+MODULE lib_mpp
+   !!======================================================================
+   !!                       ***  MODULE  lib_mpp  ***
+   !! Ocean numerics:  massively parallel processing librairy
+   !!=====================================================================
+#if   defined key_mpp_mpi   ||   defined key_mpp_shmem
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'     OR      MPI massively parallel processing library
+   !!   'key_mpp_shmem'         SHMEM massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   mynode
+   !!   mpparent
+   !!   mppshmem
+   !!   mpp_lnk     : generic interface (defined in lbclnk) for :
+   !!                 mpp_lnk_2d, mpp_lnk_3d
+   !!   mpp_lnk_e   : interface defined in lbclnk
+   !!   mpplnks
+   !!   mpprecv
+   !!   mppsend
+   !!   mppscatter
+   !!   mppgather
+   !!   mpp_isl    : generic inteface  for :
+   !!                mppisl_int , mppisl_a_int , mppisl_real, mppisl_a_real
+   !!   mpp_min    : generic interface for : 
+   !!                mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max    : generic interface for :
+   !!                mppmax_real, mppmax_a_real
+   !!   mpp_sum    : generic interface for :
+   !!                mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mppsync
+   !!   mppstop
+   !!   mppobc     : variant of mpp_lnk for open boundaries
+   !!   mpp_ini_north
+   !!   mpp_lbc_north
+   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo (nsolv=4)
+   !!----------------------------------------------------------------------
+   !! 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
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+
+   !! * Interfaces
+   !! define generic interface for these routine as they are called sometimes
+   !!        with scalar arguments instead of array arguments, which causes problems
+   !!        for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+
+   INTERFACE mpp_isl
+      MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
+   END INTERFACE
+   INTERFACE mpp_lbc_north
+      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
+   END INTERFACE
+  INTERFACE mpp_minloc
+     MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+  END INTERFACE
+  INTERFACE mpp_maxloc
+     MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+  END INTERFACE
+
+
+   !! * Share module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.       !: mpp flag
+
+
+   !! * Module variables
+   !! 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
+
+#if defined key_mpp_mpi
+   !! ========================= !!
+   !!  MPI  variable definition !!
+   !! ========================= !!
+#  include <mpif.h>
+
+   INTEGER ::   &
+      size,     &  ! number of process
+      rank         ! process number  [ 0 - size-1 ]
+
+   ! variables used in case of north fold condition in mpp_mpi with jpni > 1
+   INTEGER ::      &       !
+      ngrp_world,  &       ! group ID for the world processors
+      ngrp_north,  &       ! group ID for the northern processors (to be fold)
+      ncomm_north, &       ! communicator made by the processors belonging to ngrp_north
+      ndim_rank_north, &   ! number of 'sea' processor in the northern line (can be /= jpni !)
+      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
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   &
+      nrank_north          ! dimension ndim_rank_north, number of the procs belonging to ncomm_north
+   CHARACTER (len=1) ::  &
+      c_mpi_send = 'S'     ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL  ::           &
+      l_isend = .FALSE.    ! isend use indicator (T if c_mpi_send='I')
+
+
+#elif defined key_mpp_shmem
+   !! ========================= !!
+   !! SHMEM variable definition !!
+   !! ========================= !!
+#  include  <fpvm3.h>
+#  include <mpp/shmem.fh>
+
+   CHARACTER (len=80), PARAMETER ::   simfile    = 'pvm3_ndim'   ! file name
+   CHARACTER (len=47), PARAMETER ::   executable = 'opa'         ! executable name
+   CHARACTER, PARAMETER ::            opaall     = ""            ! group name (old def opaall*(*))
+
+   INTEGER, PARAMETER ::   & !! SHMEM control print
+      mynode_print   = 0,  &  ! flag for print, mynode   routine
+      mpprecv_print  = 0,  &  ! flag for print, mpprecv  routine
+      mppsend_print  = 0,  &  ! flag for print, mppsend  routine
+      mppsync_print  = 0,  &  ! flag for print, mppsync  routine
+      mppsum_print   = 0,  &  ! flag for print, mpp_sum  routine
+      mppisl_print   = 0,  &  ! flag for print, mpp_isl  routine
+      mppmin_print   = 0,  &  ! flag for print, mpp_min  routine
+      mppmax_print   = 0,  &  ! flag for print, mpp_max  routine
+      mpparent_print = 0      ! flag for print, mpparent routine
+
+   INTEGER, PARAMETER ::   & !! Variable definition
+      jpvmint = 21            ! ???
+
+   INTEGER, PARAMETER ::   & !! Maximum  dimension of array to sum on the processors
+      jpmsec   = 50000,    &  ! ???
+      jpmpplat =    30,    &  ! ???
+      jpmppsum = MAX( jpisl*jpisl, jpmpplat*jpk, jpmsec )   ! ???
+
+   INTEGER ::   &
+      npvm_ipas ,  &  ! pvm initialization flag
+      npvm_mytid,  &  ! pvm tid
+      npvm_me   ,  &  ! node number [ 0 - nproc-1 ]
+      npvm_nproc,  &  ! real number of nodes
+      npvm_inum       ! ???
+   INTEGER, DIMENSION(0:nprocmax-1) ::   &
+      npvm_tids       ! tids array [ 0 - nproc-1 ]
+
+   INTEGER ::   &
+      nt3d_ipas ,  &  ! pvm initialization flag
+      nt3d_mytid,  &  ! pvm tid
+      nt3d_me   ,  &  ! node number [ 0 - nproc-1 ]
+      nt3d_nproc      ! real number of nodes
+   INTEGER, DIMENSION(0:nprocmax-1) ::   &
+      nt3d_tids       ! tids array [ 0 - nproc-1 ]
+
+   !! real sum reduction
+   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       nrs1sync_shmem,   &  ! 
+       nrs2sync_shmem
+   REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       wrs1wrk_shmem,    &  !
+       wrs2wrk_shmem        !
+   REAL(wp), DIMENSION(jpmppsum) ::   &
+       wrstab_shmem         !
+
+   !! minimum and maximum reduction
+   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       ni1sync_shmem,    &  ! 
+       ni2sync_shmem        ! 
+   REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       wi1wrk_shmem,     &  !
+       wi2wrk_shmem
+   REAL(wp), DIMENSION(jpmppsum) ::   &
+       wintab_shmem,     &  ! 
+       wi1tab_shmem,     &  ! 
+       wi2tab_shmem         ! 
+       
+       !! value not equal zero for barotropic stream function around islands
+   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       ni11sync_shmem,   &  !
+       ni12sync_shmem,   &  !
+       ni21sync_shmem,   &  !
+       ni22sync_shmem       !
+   REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       wi11wrk_shmem,    &  ! 
+       wi12wrk_shmem,    &  !
+       wi21wrk_shmem,    &  !
+       wi22wrk_shmem        !
+   REAL(wp), DIMENSION(jpmppsum) ::   &
+       wiltab_shmem ,    &  !
+       wi11tab_shmem,    &  !
+       wi12tab_shmem,    &  ! 
+       wi21tab_shmem,    &  ! 
+       wi22tab_shmem
+
+   INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       ni11wrk_shmem,    &  !
+       ni12wrk_shmem,    &  !
+       ni21wrk_shmem,    &  !
+       ni22wrk_shmem        !
+   INTEGER, DIMENSION(jpmppsum) ::   &
+       niitab_shmem ,    &  !
+       ni11tab_shmem,    &  !
+       ni12tab_shmem        !
+   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       nis1sync_shmem,   &  !
+       nis2sync_shmem       !
+   INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       nis1wrk_shmem,    &  ! 
+       nis2wrk_shmem        !
+   INTEGER, DIMENSION(jpmppsum) ::   &
+       nistab_shmem
+
+   !! integer sum reduction
+   INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       nil1sync_shmem,   &  !
+       nil2sync_shmem       !
+   INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       nil1wrk_shmem,    &  !
+       nil2wrk_shmem        !
+   INTEGER, DIMENSION(jpmppsum) ::   &
+       niltab_shmem
+#endif
+
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   &
+       t3ns, t3sn  ! 3d message passing arrays north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,jpk,2) ::   &
+       t3ew, t3we  ! 3d message passing arrays east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   &
+       t3p1, t3p2  ! 3d message passing arrays north fold
+   REAL(wp), DIMENSION(jpi,jprecj,2) ::   &
+       t2ns, t2sn  ! 2d message passing arrays north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,2) ::   &
+       t2ew, t2we  ! 2d message passing arrays east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,2) ::   &
+       t2p1, t2p2  ! 2d message passing arrays north fold
+   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   &
+       tr2ns, tr2sn  ! 2d message passing arrays north-south & south-north including extra outer halo
+   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   &
+       tr2ew, tr2we  ! 2d message passing arrays east-west & west-east including extra outer halo
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!---------------------------------------------------------------------
+
+CONTAINS
+
+   FUNCTION mynode()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!                    
+      !! ** Purpose :   Find processor unit
+      !!
+      !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+      !! * Local variables   (MPI version)
+      INTEGER ::   mynode, ierr
+      NAMELIST/nam_mpp/ c_mpi_send
+      !!----------------------------------------------------------------------
+
+      WRITE(numout,*)
+      WRITE(numout,*) 'mynode : mpi initialisation'
+      WRITE(numout,*) '~~~~~~ '
+      WRITE(numout,*)
+
+      ! Namelist namrun : parameters of the run
+      REWIND( numnam )
+      READ  ( numnam, nam_mpp )
+
+      WRITE(numout,*) '        Namelist nam_mpp'
+      WRITE(numout,*) '           mpi send type            c_mpi_send = ', c_mpi_send
+
+      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(numout,cform_err)
+         WRITE(numout,*) '           bad value for c_mpi_send = ', c_mpi_send
+         nstop = nstop + 1
+      END SELECT
+
+      CALL mpi_comm_rank( mpi_comm_world, rank, ierr )
+      CALL mpi_comm_size( mpi_comm_world, size, ierr )
+      mynode = rank
+#else
+      !! * Local variables   (SHMEM version)
+      INTEGER ::   mynode
+      INTEGER ::   &
+           imypid, imyhost, ji, info, iparent_tid
+      !!----------------------------------------------------------------------
+
+      IF( npvm_ipas /= nprocmax ) THEN
+         !         ---   first passage in mynode
+         !         -------------
+         !         enroll in pvm
+         !         -------------
+         CALL pvmfmytid( npvm_mytid )
+         IF( mynode_print /= 0 ) THEN
+            WRITE(numout,*) 'mynode, npvm_ipas =', npvm_ipas, ' nprocmax=', nprocmax
+            WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid, ' after pvmfmytid'
+         ENDIF
+
+         !         ---------------------------------------------------------------
+         !         find out IF i am parent or child spawned processes have parents
+         !         ---------------------------------------------------------------
+         CALL mpparent( iparent_tid )
+         IF( mynode_print /= 0 ) THEN
+            WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid,   &
+               &            ' after mpparent, npvm_tids(0) = ',   &
+               &            npvm_tids(0), ' iparent_tid=', iparent_tid
+         ENDIF
+         IF( iparent_tid < 0 )  THEN
+            WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid,   &
+               &            ' after mpparent, npvm_tids(0) = ',   &
+               &            npvm_tids(0), ' iparent_tid=', iparent_tid
+            npvm_tids(0) = npvm_mytid
+            npvm_me = 0
+            IF( ndim_mpp > nprocmax ) THEN
+               WRITE(numout,*) 'npvm_mytid=', npvm_mytid, ' too great'
+               STOP  ' mynode '
+            ELSE
+               npvm_nproc = ndim_mpp
+            ENDIF
+
+            ! -------------------------
+            ! start up copies of myself
+            ! -------------------------
+            IF( npvm_nproc > 1 ) THEN
+               DO ji = 1, npvm_nproc-1
+                  npvm_tids(ji) = nt3d_tids(ji)
+               END DO
+               info=npvm_nproc-1
+  
+               IF( mynode_print /= 0 ) THEN
+                  WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                     &            ' maitre=',executable,' info=', info   &
+                     &            ,' npvm_nproc=',npvm_nproc
+                  WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                     &            ' npvm_tids ',(npvm_tids(ji),ji=0,npvm_nproc-1)
+               ENDIF
+
+               ! ---------------------------
+               ! multicast tids array to children
+               ! ---------------------------
+               CALL pvmfinitsend( pvmdefault, info )
+               CALL pvmfpack ( jpvmint, npvm_nproc, 1         , 1, info )
+               CALL pvmfpack ( jpvmint, npvm_tids , npvm_nproc, 1, info )
+               CALL pvmfmcast( npvm_nproc-1, npvm_tids(1), 10, info )
+            ENDIF
+         ELSE
+
+            ! ---------------------------------
+            ! receive the tids array and set me
+            ! ---------------------------------
+            IF( mynode_print /= 0 )   WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, ' pvmfrecv'
+            CALL pvmfrecv( iparent_tid, 10, info )
+            IF( mynode_print /= 0 )   WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid, " fin pvmfrecv"
+            CALL pvmfunpack( jpvmint, npvm_nproc, 1         , 1, info )
+            CALL pvmfunpack( jpvmint, npvm_tids , npvm_nproc, 1, info )
+            IF( mynode_print /= 0 ) THEN
+               WRITE(numout,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                  &            ' esclave=', executable,' info=', info,' npvm_nproc=',npvm_nproc
+               WRITE(numout,*) 'mynode, npvm_mytid=', npvm_mytid,   &
+                  &            'npvm_tids', ( npvm_tids(ji), ji = 0, npvm_nproc-1 )
+            ENDIF
+            DO ji = 0, npvm_nproc-1
+               IF( npvm_mytid == npvm_tids(ji) ) npvm_me = ji
+            END DO
+         ENDIF
+
+         ! ------------------------------------------------------------
+         ! all nproc tasks are equal now
+         ! and can address each other by tids(0) thru tids(nproc-1)
+         ! for each process me => process number [0-(nproc-1)]
+         ! ------------------------------------------------------------
+         CALL pvmfjoingroup ( "bidon", info )
+         CALL pvmfbarrier   ( "bidon", npvm_nproc, info )
+         DO ji = 0, npvm_nproc-1
+            IF( ji == npvm_me ) THEN
+               CALL pvmfjoingroup ( opaall, npvm_inum )
+               IF( npvm_inum /= npvm_me )   WRITE(numout,*) 'mynode not arrived in the good order for opaall'
+            ENDIF
+            CALL pvmfbarrier( "bidon", npvm_nproc, info )
+         END DO
+         CALL pvmfbarrier( opaall, npvm_nproc, info )
+  
+      ELSE
+         ! ---   other passage in mynode
+      ENDIF
+ 
+      npvm_ipas = nprocmax
+      mynode    = npvm_me
+      imypid    = npvm_mytid
+      imyhost   = npvm_tids(0)
+      IF( mynode_print /= 0 ) THEN
+         WRITE(numout,*)'mynode: npvm_mytid=', npvm_mytid, ' npvm_me=', npvm_me,   &
+            &           ' npvm_nproc=', npvm_nproc , ' npvm_ipas=', npvm_ipas
+      ENDIF
+#endif
+   END FUNCTION mynode
+
+
+   SUBROUTINE mpparent( kparent_tid )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpparent  ***
+      !!
+      !! ** Purpose :   use an pvmfparent routine for T3E (key_mpp_shmem)
+      !!              or  only return -1 (key_mpp_mpi)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(inout) ::   kparent_tid      ! ???
+  
+#if defined key_mpp_mpi
+      ! MPI version : retour -1
+
+      kparent_tid = -1
+
+#else
+      !! * Local variables   (SHMEN onto T3E version)
+      INTEGER ::   &
+           it3d_my_pe, LEADZ, ji, info
+  
+      CALL pvmfmytid( nt3d_mytid )
+      CALL pvmfgetpe( nt3d_mytid, it3d_my_pe )
+      IF( mpparent_print /= 0 ) THEN
+         WRITE(numout,*) 'mpparent: nt3d_mytid= ', nt3d_mytid ,' it3d_my_pe=',it3d_my_pe
+      ENDIF
+      IF( it3d_my_pe == 0 ) THEN
+         !-----------------------------------------------------------------!
+         !     process = 0 => receive other tids                           !
+         !-----------------------------------------------------------------!
+         kparent_tid = -1
+         IF(mpparent_print /= 0 ) THEN
+            WRITE(numout,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' kparent_tid=',kparent_tid
+         ENDIF
+         !          --- END receive dimension ---
+         IF( ndim_mpp > nprocmax ) THEN
+            WRITE(numout,*) 'mytid=',nt3d_mytid,' too great'
+            STOP  ' mpparent '
+         ELSE
+            nt3d_nproc =  ndim_mpp
+         ENDIF
+         IF( mpparent_print /= 0 ) THEN
+            WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_nproc=', nt3d_nproc
+         ENDIF
+         !-------- receive tids from others process --------
+         DO ji = 1, nt3d_nproc-1
+            CALL pvmfrecv( ji , 100, info )
+            CALL pvmfunpack( jpvmint, nt3d_tids(ji), 1, 1, info )
+            IF( mpparent_print /= 0 ) THEN
+               WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' receive=', nt3d_tids(ji), ' from = ', ji
+            ENDIF
+         END DO
+         nt3d_tids(0) = nt3d_mytid
+         IF( mpparent_print /= 0 ) THEN
+            WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' nt3d_tids(ji) =', (nt3d_tids(ji),   &
+                 ji = 0, nt3d_nproc-1 )
+            WRITE(numout,*) 'mpparent, nt3d_mytid=', nt3d_mytid , ' kparent_tid=', kparent_tid
+         ENDIF
+
+      ELSE
+         !!----------------------------------------------------------------!
+         !     process <> 0 => send  other tids                            !
+         !!----------------------------------------------------------------!
+         kparent_tid = 0
+         CALL pvmfinitsend( pvmdataraw, info )
+         CALL pvmfpack( jpvmint, nt3d_mytid, 1, 1, info )
+         CALL pvmfsend( kparent_tid, 100, info )
+      ENDIF
+#endif
+
+   END SUBROUTINE mpparent
+
+#if defined key_mpp_shmem
+
+   SUBROUTINE mppshmem
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppshmem  ***
+      !!
+      !! ** Purpose :   SHMEM ROUTINE
+      !!
+      !!----------------------------------------------------------------------
+      nrs1sync_shmem = SHMEM_SYNC_VALUE
+      nrs2sync_shmem = SHMEM_SYNC_VALUE
+      nis1sync_shmem = SHMEM_SYNC_VALUE
+      nis2sync_shmem = SHMEM_SYNC_VALUE
+      nil1sync_shmem = SHMEM_SYNC_VALUE
+      nil2sync_shmem = SHMEM_SYNC_VALUE
+      ni11sync_shmem = SHMEM_SYNC_VALUE
+      ni12sync_shmem = SHMEM_SYNC_VALUE
+      ni21sync_shmem = SHMEM_SYNC_VALUE
+      ni22sync_shmem = SHMEM_SYNC_VALUE
+      CALL barrier()
+  
+   END SUBROUTINE mppshmem
+
+#endif
+
+   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement
+      !!
+      !! ** 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
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1) , INTENT( in ) ::   &
+         cd_type       ! define the nature of ptab array grid-points
+         !             ! = T , U , V , F , W points
+         !             ! = S : T-point, north fold treatment ???
+         !             ! = G : F-point, north fold treatment ???
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   = -1. , the sign is changed if north fold boundary
+         !             !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
+         ptab          ! 3D array on which the boundary condition is applied
+
+      !! * Local variables
+      INTEGER ::   ji, 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
+      !!----------------------------------------------------------------------
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                        ! East-West boundaries
+      !                                        ! ====================
+      IF( nbondi == 2 .AND.   &      ! Cyclic east-west
+         &   (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         ptab( 1 ,:,:) = ptab(jpim1,:,:)
+         ptab(jpi,:,:) = ptab(  2  ,:,:)
+
+      ELSE                           ! closed
+         SELECT CASE ( cd_type )
+         CASE ( 'T', 'U', 'V', 'W' )
+            ptab(     1       :jpreci,:,:) = 0.e0
+            ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+         CASE ( 'F' )
+            ptab(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+         END SELECT 
+      ENDIF
+
+      !                                        ! North-South boundaries
+      !                                        ! ======================
+      SELECT CASE ( cd_type )
+      CASE ( 'T', 'U', 'V', 'W' )
+         ptab(:,     1       :jprecj,:) = 0.e0
+         ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+      CASE ( 'F' )
+         ptab(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+      END SELECT
+
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+
+      ! 2.1 Read Dirichlet lateral conditions
+
+      SELECT CASE ( nbondi )
+      CASE ( -1, 0, 1 )    ! all exept 2 
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT
+
+      ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      imigr = jpreci * jpj * jpk
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
+      CASE ( 0 )
+         CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
+         CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
+      CASE ( 1 )
+         CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
+      END SELECT
+
+      CALL barrier()
+      CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+      !! * Local variables   (MPI version)
+
+      imigr = jpreci * jpj * jpk
+
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+#endif
+
+      ! 2.3 Write Dirichlet lateral conditions
+
+      iihom = nlci-jpreci
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+
+      ! 3.1 Read Dirichlet lateral conditions
+
+      IF( nbondj /= 2 ) THEN
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+
+      ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      imigr = jprecj * jpi * jpk
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL shmem_put( t3sn(1,1,1,2), t3sn(1,1,1,1), imigr, nono )
+      CASE ( 0 )
+         CALL shmem_put( t3ns(1,1,1,2), t3ns(1,1,1,1), imigr, noso )
+         CALL shmem_put( t3sn(1,1,1,2), t3sn(1,1,1,1), imigr, nono )
+      CASE ( 1 )
+         CALL shmem_put( t3ns(1,1,1,2), t3ns(1,1,1,1), imigr, noso )
+      END SELECT
+
+      CALL barrier()
+      CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+      !! * Local variables   (MPI version)
+  
+      imigr=jprecj*jpi*jpk
+
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+
+#endif
+
+      ! 3.3 Write Dirichlet lateral conditions
+
+      ijhom = nlcj-jprecj
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = t3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+
+      ! 4.1 treatment without exchange (jpni odd)
+      !     T-point pivot  
+
+      SELECT CASE ( jpni )
+
+      CASE ( 1 )  ! only one proc along I, no mpp exchange
+
+         SELECT CASE ( npolj )
+  
+         CASE ( 3 , 4 )    ! T pivot
+            iloc = jpiglo - 2 * ( nimpp - 1 )
+
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'S', 'W' )
+               DO jk = 1, jpk
+                  DO ji = 2, nlci
+                     ijt=iloc-ji+2
+                     ptab(ji,nlcj,jk) = psgn * ptab(ijt,nlcj-2,jk)
+                  END DO
+                  DO ji = nlci/2+1, nlci
+                     ijt=iloc-ji+2
+                     ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-1,jk)
+                  END DO
+               END DO
+          
+            CASE ( 'U' )
+               DO jk = 1, jpk
+                  DO ji = 1, nlci-1
+                     iju=iloc-ji+1
+                     ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-2,jk)
+                  END DO
+                  DO ji = nlci/2, nlci-1
+                     iju=iloc-ji+1
+                     ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'V' )
+               DO jk = 1, jpk
+                  DO ji = 2, nlci
+                     ijt=iloc-ji+2
+                     ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-2,jk)
+                     ptab(ji,nlcj  ,jk) = psgn * ptab(ijt,nlcj-3,jk)
+                  END DO
+               END DO
+
+            CASE ( 'F', 'G' )
+               DO jk = 1, jpk
+                  DO ji = 1, nlci-1
+                     iju=iloc-ji+1
+                     ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-2,jk)
+                     ptab(ji,nlcj  ,jk) = psgn * ptab(iju,nlcj-3,jk)
+                  END DO
+               END DO
+  
+          END SELECT
+       
+         CASE ( 5 , 6 ) ! F pivot
+            iloc=jpiglo-2*(nimpp-1)
+  
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'S', 'W' )
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt=iloc-ji+1
+                     ptab(ji,nlcj,jk) = psgn * ptab(ijt,nlcj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'U' )
+               DO jk = 1, jpk
+                  DO ji = 1, nlci-1
+                     iju=iloc-ji
+                     ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'V' )
+               DO jk = 1, jpk
+                  DO ji = 1, nlci
+                     ijt=iloc-ji+1
+                     ptab(ji,nlcj  ,jk) = psgn * ptab(ijt,nlcj-2,jk)
+                  END DO
+                  DO ji = nlci/2+1, nlci
+                     ijt=iloc-ji+1
+                     ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-1,jk)
+                  END DO
+               END DO
+
+            CASE ( 'F', 'G' )
+               DO jk = 1, jpk
+                  DO ji = 1, nlci-1
+                     iju=iloc-ji
+                     ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-2,jk)
+                  END DO
+                  DO ji = nlci/2+1, nlci-1
+                     iju=iloc-ji
+                     ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-1,jk)
+                  END DO
+               END DO
+            END SELECT  ! cd_type
+
+         END SELECT     !  npolj
+  
+      CASE DEFAULT ! more than 1 proc along I
+         IF ( npolj /= 0 ) CALL mpp_lbc_north (ptab, cd_type, psgn)  ! only for northern procs.
+
+      END SELECT ! jpni 
+
+
+      ! 5. East and west directions exchange
+      ! ------------------------------------
+
+      SELECT CASE ( npolj )
+
+      CASE ( 3, 4, 5, 6 )
+
+         ! 5.1 Read Dirichlet lateral conditions
+
+         SELECT CASE ( nbondi )
+
+         CASE ( -1, 0, 1 )
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+               t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+            END DO
+
+         END SELECT
+
+         ! 5.2 Migrations
+
+#if defined key_mpp_shmem
+         !! SHMEM version
+
+         imigr = jpreci * jpj * jpk
+
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
+         CASE ( 0 )
+            CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
+            CALL shmem_put( t3we(1,1,1,2), t3we(1,1,1,1), imigr, noea )
+         CASE ( 1 )
+            CALL shmem_put( t3ew(1,1,1,2), t3ew(1,1,1,1), imigr, nowe )
+         END SELECT
+
+         CALL barrier()
+         CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+         !! MPI version
+
+         imigr=jpreci*jpj*jpk
+  
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+            CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+            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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         END SELECT
+#endif
+
+         ! 5.3 Write Dirichlet lateral conditions
+
+         iihom = nlci-jpreci
+
+         SELECT CASE ( nbondi)
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            END DO
+         CASE ( 0 ) 
+            DO jl = 1, jpreci
+               ptab(jl      ,:,:) = t3we(:,jl,:,2)
+               ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            END DO
+         END SELECT
+
+      END SELECT    ! npolj 
+
+   END SUBROUTINE mpp_lnk_3d
+
+
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array
+      !!
+      !! ** 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
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1) , INTENT( in ) ::   &
+         cd_type       ! define the nature of pt2d array grid-points
+         !             !  = T , U , V , F , W 
+         !             !  = S : T-point, north fold treatment
+         !             !  = G : F-point, north fold treatment
+         !             !  = I : sea-ice velocity at F-point with index shift
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   = -1. , the sign is changed if north fold boundary
+         !             !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+
+      !! * Local variables
+      INTEGER  ::   ji, jj, jl      ! dummy loop indices
+      INTEGER  ::   &
+         imigr, iihom, ijhom,    &  ! temporary integers
+         iloc, ijt, iju             !    "          "
+      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      INTEGER  ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+
+      !                                        ! East-West boundaries
+      !                                        ! ====================
+      IF( nbondi == 2 .AND.   &      ! Cyclic east-west
+         &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d( 1 ,:) = pt2d(jpim1,:)
+         pt2d(jpi,:) = pt2d(  2  ,:)
+
+      ELSE                           ! ... closed
+         SELECT CASE ( cd_type )
+         CASE ( 'T', 'U', 'V', 'W' , 'I' )
+            pt2d(     1       :jpreci,:) = 0.e0
+            pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0
+         CASE ( 'F' )
+            pt2d(nlci-jpreci+1:jpi   ,:) = 0.e0
+         END SELECT
+      ENDIF
+
+      !                                        ! North-South boundaries
+      !                                        ! ======================
+      SELECT CASE ( cd_type )
+      CASE ( 'T', 'U', 'V', 'W' , 'I' )
+         pt2d(:,     1       :jprecj) = 0.e0
+         pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0
+      CASE ( 'F' )
+         pt2d(:,nlcj-jprecj+1:jpj   ) = 0.e0
+      END SELECT
+
+
+      ! 2. East and west directions
+      ! ---------------------------
+
+      ! 2.1 Read Dirichlet lateral conditions
+
+      SELECT CASE ( nbondi )
+      CASE ( -1, 0, 1 )    ! all except 2
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            t2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+
+      ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      imigr = jpreci * jpj
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
+      CASE ( 0 )
+         CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
+         CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
+      CASE ( 1 )
+         CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
+      END SELECT
+
+      CALL barrier()
+      CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+      !! * MPI version
+
+      imigr = jpreci * jpj
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         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, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+
+#endif
+
+      ! 2.3 Write Dirichlet lateral conditions
+
+      iihom = nlci - jpreci
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+
+      ! 3.1 Read Dirichlet lateral conditions
+
+      IF( nbondj /= 2 ) THEN
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+
+      ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      imigr = jprecj * jpi
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr, nono )
+      CASE ( 0 )
+         CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr, noso )
+         CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr, nono )
+      CASE ( 1 )
+         CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr, noso )
+      END SELECT 
+      CALL barrier()
+      CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+      !! * MPI version
+
+      imigr = jprecj * jpi
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         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, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+  
+#endif
+
+      ! 3.3 Write Dirichlet lateral conditions
+
+      ijhom = nlcj - jprecj
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+         END DO
+      END SELECT 
+  
+
+      ! 4. north fold treatment
+      ! -----------------------
+  
+      ! 4.1 treatment without exchange (jpni odd)
+      
+      SELECT CASE ( jpni )
+  
+      CASE ( 1 ) ! only one proc along I, no mpp exchange
+  
+         SELECT CASE ( npolj )
+  
+         CASE ( 3 , 4 )   !  T pivot
+            iloc = jpiglo - 2 * ( nimpp - 1 )
+  
+            SELECT CASE ( cd_type )
+  
+            CASE ( 'T' , 'S', 'W' )
+               DO ji = 2, nlci
+                  ijt=iloc-ji+2
+                  pt2d(ji,nlcj) = psgn * pt2d(ijt,nlcj-2)
+               END DO
+               DO ji = nlci/2+1, nlci
+                  ijt=iloc-ji+2
+                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
+               END DO
+  
+            CASE ( 'U' )
+               DO ji = 1, nlci-1
+                  iju=iloc-ji+1
+                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-2)
+               END DO
+               DO ji = nlci/2, nlci-1
+                  iju=iloc-ji+1
+                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
+               END DO
+  
+            CASE ( 'V' )
+               DO ji = 2, nlci
+                  ijt=iloc-ji+2
+                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-2)
+                  pt2d(ji,nlcj  ) = psgn * pt2d(ijt,nlcj-3)
+               END DO
+  
+            CASE ( 'F', 'G' )
+               DO ji = 1, nlci-1
+                  iju=iloc-ji+1
+                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-2)
+                  pt2d(ji,nlcj  ) = psgn * pt2d(iju,nlcj-3)
+               END DO
+  
+            CASE ( 'I' )                                  ! ice U-V point
+               pt2d(2,nlcj) = psgn * pt2d(3,nlcj-1)
+               DO ji = 3, nlci
+                  iju = iloc - ji + 3
+                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-1)
+               END DO
+  
+            END SELECT
+  
+         CASE ( 5 , 6 )                 ! F pivot
+            iloc=jpiglo-2*(nimpp-1)
+  
+            SELECT CASE (cd_type )
+  
+            CASE ( 'T', 'S', 'W' )
+               DO ji = 1, nlci
+                  ijt=iloc-ji+1
+                  pt2d(ji,nlcj) = psgn * pt2d(ijt,nlcj-1)
+               END DO
+  
+            CASE ( 'U' )
+               DO ji = 1, nlci-1
+                  iju=iloc-ji
+                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-1)
+               END DO
+
+            CASE ( 'V' )
+               DO ji = 1, nlci
+                  ijt=iloc-ji+1
+                  pt2d(ji,nlcj  ) = psgn * pt2d(ijt,nlcj-2)
+               END DO
+               DO ji = nlci/2+1, nlci
+                  ijt=iloc-ji+1
+                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
+               END DO
+  
+            CASE ( 'F', 'G' )
+               DO ji = 1, nlci-1
+                  iju=iloc-ji
+                  pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-2)
+               END DO
+               DO ji = nlci/2+1, nlci-1
+                  iju=iloc-ji
+                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
+               END DO
+  
+            CASE ( 'I' )                                  ! ice U-V point
+               pt2d( 2 ,nlcj) = 0.e0
+               DO ji = 2 , nlci-1
+                  ijt = iloc - ji + 2
+                  pt2d(ji,nlcj)= 0.5 * ( pt2d(ji,nlcj-1) + psgn * pt2d(ijt,nlcj-1) )
+               END DO
+  
+            END SELECT   ! cd_type
+  
+         END SELECT   ! npolj
+
+      CASE DEFAULT   ! more than 1 proc along I
+         IF( npolj /= 0 )   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! only for northern procs.
+
+      END SELECT   ! jpni
+
+
+      ! 5. East and west directions
+      ! ---------------------------
+
+      SELECT CASE ( npolj )
+
+      CASE ( 3, 4, 5, 6 )
+
+         ! 5.1 Read Dirichlet lateral conditions
+
+         SELECT CASE ( nbondi )
+         CASE ( -1, 0, 1 )
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               DO jj = 1, jpj
+                  t2ew(jj,jl,1) = pt2d(jpreci+jl,jj)
+                  t2we(jj,jl,1) = pt2d(iihom +jl,jj)
+               END DO
+            END DO
+         END SELECT
+
+         ! 5.2 Migrations
+
+#if defined key_mpp_shmem
+         !! * SHMEM version
+
+         imigr=jpreci*jpj
+
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
+         CASE ( 0 )
+            CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
+            CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr, noea )
+         CASE ( 1 )
+            CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr, nowe )
+         END SELECT
+
+         CALL barrier()
+         CALL shmem_udcflush()
+  
+#elif defined key_mpp_mpi
+         !! * MPI version
+  
+         imigr=jpreci*jpj
+  
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            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, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         END SELECT 
+#endif
+
+         ! 5.3 Write Dirichlet lateral conditions
+  
+         iihom = nlci - jpreci
+  
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, jpreci
+               pt2d(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, jpreci
+               pt2d(jl      ,:) = t2we(:,jl,2)
+               pt2d(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, jpreci
+               pt2d(jl,:) = t2we(:,jl,2)
+            END DO
+         END SELECT 
+  
+      END SELECT   ! npolj
+  
+   END SUBROUTINE mpp_lnk_2d
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_e  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
+      !!
+      !! ** 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
+      !!                    jpr2di : number of rows for extra outer halo
+      !!                    jpr2dj : number of columns for extra outer halo
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!   
+      !! History :
+      !!       
+      !!   9.0  !  05-09  (R. Benshila, G. Madec)  original code
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1) , INTENT( in ) ::   &
+         cd_type       ! define the nature of pt2d array grid-points
+         !             !  = T , U , V , F , W 
+         !             !  = S : T-point, north fold treatment
+         !             !  = G : F-point, north fold treatment
+         !             !  = I : sea-ice velocity at F-point with index shift
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   = -1. , the sign is changed if north fold boundary
+         !             !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+
+      !! * Local variables
+      INTEGER  ::   ji, jl      ! dummy loop indices
+      INTEGER  ::   &
+         imigr, iihom, ijhom,    &  ! temporary integers
+         iloc, ijt, iju             !    "          "
+      INTEGER  ::   &
+         ipreci, iprecj             ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for isend
+      INTEGER  ::   ml_stat(MPI_STATUS_SIZE)     ! for isend
+     !!---------------------------------------------------------------------
+
+      ! take into account outer extra 2D overlap area
+      ipreci = jpreci + jpr2di
+      iprecj = jprecj + jpr2dj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+
+      !                                        ! East-West boundaries
+      !                                        ! ====================
+      IF( nbondi == 2 .AND.   &      ! Cyclic east-west
+         &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)
+         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)
+
+      ELSE                           ! ... closed
+         SELECT CASE ( cd_type )
+         CASE ( 'T', 'U', 'V', 'W' , 'I' )
+            pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0
+            pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0
+         CASE ( 'F' )
+            pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0
+         END SELECT
+      ENDIF
+
+      !                                        ! North-South boundaries
+      !                                        ! ======================
+      SELECT CASE ( cd_type )
+      CASE ( 'T', 'U', 'V', 'W' , 'I' )
+         pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0
+         pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0
+      CASE ( 'F' )
+         pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0
+      END SELECT
+
+
+      ! 2. East and west directions
+      ! ---------------------------
+
+      ! 2.1 Read Dirichlet lateral conditions
+
+      SELECT CASE ( nbondi )
+      CASE ( -1, 0, 1 )    ! all except 2
+         iihom = nlci-nreci-jpr2di
+         DO jl = 1, ipreci
+            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            tr2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+
+      ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
+      CASE ( 0 )
+         CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
+         CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
+      CASE ( 1 )
+         CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
+      END SELECT
+
+      CALL barrier()
+      CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+      !! * MPI version
+
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+
+#endif
+
+      ! 2.3 Write Dirichlet lateral conditions
+
+      iihom = nlci - jpreci
+
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, ipreci
+            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+
+      ! 3.1 Read Dirichlet lateral conditions
+
+      IF( nbondj /= 2 ) THEN
+         ijhom = nlcj-nrecj-jpr2dj
+         DO jl = 1, iprecj
+            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+
+      ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      imigr = iprecj * ( jpi + 2*jpr2di )
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL shmem_put( tr2sn(1-jpr2di,1,2), tr2sn(1,1,1), imigr, nono )
+      CASE ( 0 )
+         CALL shmem_put( tr2ns(1-jpr2di,1,2), tr2ns(1,1,1), imigr, noso )
+         CALL shmem_put( tr2sn(1-jpr2di,1,2), tr2sn(1,1,1), imigr, nono )
+      CASE ( 1 )
+         CALL shmem_put( tr2ns(1-jpr2di,1,2), tr2ns(1,1,1), imigr, noso )
+      END SELECT 
+      CALL barrier()
+      CALL shmem_udcflush()
+
+#elif defined key_mpp_mpi
+      !! * MPI version
+
+      imigr = iprecj * ( jpi + 2*jpr2di )
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+  
+#endif
+
+      ! 3.3 Write Dirichlet lateral conditions
+
+      ijhom = nlcj - jprecj  
+
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, iprecj
+            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+         END DO
+      END SELECT 
+  
+
+      ! 4. north fold treatment
+      ! -----------------------
+  
+      ! 4.1 treatment without exchange (jpni odd)
+      
+      SELECT CASE ( jpni )
+  
+      CASE ( 1 ) ! only one proc along I, no mpp exchange
+  
+         SELECT CASE ( npolj )
+  
+         CASE ( 3 , 4 )   !  T pivot
+            iloc = jpiglo - 2 * ( nimpp - 1 )
+  
+            SELECT CASE ( cd_type )
+  
+            CASE ( 'T', 'S', 'W' )
+               DO jl = 0, iprecj-1
+                  DO ji = 2-jpr2di, nlci+jpr2di
+                     ijt=iloc-ji+2
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-2-jl)
+                  END DO
+               END DO
+               DO ji = nlci/2+1, nlci+jpr2di
+                  ijt=iloc-ji+2
+                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
+               END DO
+ 
+            CASE ( 'U' )
+               DO jl =0, iprecj-1
+                  DO ji = 1-jpr2di, nlci-1-jpr2di
+                     iju=iloc-ji+1
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-2-jl)
+                  END DO
+               END DO
+               DO ji = nlci/2, nlci-1+jpr2di
+                  iju=iloc-ji+1
+                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
+               END DO
+  
+            CASE ( 'V' )
+               DO jl = -1, iprecj-1
+                  DO ji = 2-jpr2di, nlci+jpr2di
+                     ijt=iloc-ji+2
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-3-jl)
+                  END DO
+               END DO
+  
+            CASE ( 'F', 'G' )
+               DO jl = -1, iprecj-1
+                  DO ji = 1-jpr2di, nlci-1+jpr2di
+                     iju=iloc-ji+1
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-3-jl)
+                  END DO
+               END DO
+  
+            CASE ( 'I' )                                  ! ice U-V point
+               DO jl = 0, iprecj-1
+                  pt2d(2,nlcj+jl) = psgn * pt2d(3,nlcj-1-jl)
+                  DO ji = 3, nlci+jpr2di
+                     iju = iloc - ji + 3
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-1-jl)
+                  END DO
+               END DO
+  
+            END SELECT
+  
+         CASE ( 5 , 6 )                 ! F pivot
+            iloc=jpiglo-2*(nimpp-1)
+  
+            SELECT CASE (cd_type )
+  
+            CASE ( 'T', 'S', 'W' )
+               DO jl = 0, iprecj-1
+                  DO ji = 1-jpr2di, nlci+jpr2di
+                     ijt=iloc-ji+1
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-1-jl)
+                  END DO
+               END DO
+  
+            CASE ( 'U' )
+               DO jl = 0, iprecj-1
+                  DO ji = 1-jpr2di, nlci-1+jpr2di
+                     iju=iloc-ji
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-1-jl)
+                  END DO
+               END DO
+ 
+            CASE ( 'V' )
+               DO jl = 0, iprecj-1
+                  DO ji = 1-jpr2di, nlci+jpr2di
+                     ijt=iloc-ji+1
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(ijt,nlcj-2-jl)
+                  END DO
+               END DO 
+               DO ji = nlci/2+1, nlci+jpr2di
+                  ijt=iloc-ji+1
+                  pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
+               END DO
+  
+            CASE ( 'F', 'G' )
+               DO jl = 0, iprecj-1
+                  DO ji = 1-jpr2di, nlci-1+jpr2di
+                     iju=iloc-ji
+                     pt2d(ji,nlcj+jl) = psgn * pt2d(iju,nlcj-2-jl)
+                  END DO
+               END DO
+               DO ji = nlci/2+1, nlci-1+jpr2di
+                  iju=iloc-ji
+                  pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
+               END DO
+  
+            CASE ( 'I' )                                  ! ice U-V point
+               pt2d( 2 ,nlcj) = 0.e0
+               DO jl = 0, iprecj-1
+                  DO ji = 2 , nlci-1+jpr2di
+                     ijt = iloc - ji + 2
+                     pt2d(ji,nlcj+jl)= 0.5 * ( pt2d(ji,nlcj-1-jl) + psgn * pt2d(ijt,nlcj-1-jl) )
+                  END DO
+               END DO
+  
+            END SELECT   ! cd_type
+  
+         END SELECT   ! npolj
+
+      CASE DEFAULT   ! more than 1 proc along I
+         IF( npolj /= 0 )   CALL mpp_lbc_north_e( pt2d, cd_type, psgn )   ! only for northern procs
+         
+      END SELECT   ! jpni
+
+
+      ! 5. East and west directions
+      ! ---------------------------
+
+      SELECT CASE ( npolj )
+
+      CASE ( 3, 4, 5, 6 )
+
+         ! 5.1 Read Dirichlet lateral conditions
+
+         SELECT CASE ( nbondi )
+         CASE ( -1, 0, 1 )
+            iihom = nlci-nreci-jpr2di
+            DO jl = 1, ipreci
+               tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+               tr2we(:,jl,1) = pt2d(iihom +jl,:)
+            END DO
+         END SELECT
+
+         ! 5.2 Migrations
+
+#if defined key_mpp_shmem
+         !! * SHMEM version
+
+         imigr = ipreci * ( jpj + 2*jpr2dj )
+
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
+         CASE ( 0 )
+            CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
+            CALL shmem_put( tr2we(1-jpr2dj,1,2), tr2we(1,1,1), imigr, noea )
+         CASE ( 1 )
+            CALL shmem_put( tr2ew(1-jpr2dj,1,2), tr2ew(1,1,1), imigr, nowe )
+         END SELECT
+
+         CALL barrier()
+         CALL shmem_udcflush()
+  
+#elif defined key_mpp_mpi
+         !! * MPI version
+  
+         imigr=ipreci* ( jpj + 2*jpr2dj )
+  
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+            CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+            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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+            IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         END SELECT 
+#endif
+
+         ! 5.3 Write Dirichlet lateral conditions
+  
+         iihom = nlci - jpreci
+  
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            DO jl = 1, ipreci
+               pt2d(iihom+jl,:) = tr2ew(:,jl,2)
+            END DO
+         CASE ( 0 )
+            DO jl = 1, ipreci
+               pt2d(jl- jpr2di,:) = tr2we(:,jl,2)
+               pt2d(iihom+jl,:) = tr2ew(:,jl,2)
+            END DO
+         CASE ( 1 )
+            DO jl = 1, ipreci
+               pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            END DO
+         END SELECT 
+  
+      END SELECT   ! npolj
+  
+   END SUBROUTINE mpp_lnk_2d_e
+
+
+   SUBROUTINE mpplnks( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpplnks  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for add 2d array local boundary
+      !!
+      !! ** 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
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   &
+         ptab                     ! 2D array
+  
+      !! * Local variables
+      INTEGER ::   ji, jl         ! dummy loop indices
+      INTEGER ::   &
+         imigr, iihom, ijhom      ! temporary integers
+      INTEGER ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
+      INTEGER ::   ml_stat(MPI_STATUS_SIZE)     ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+
+      ! 1. north fold treatment
+      ! -----------------------
+
+      ! 1.1 treatment without exchange (jpni odd)
+  
+      SELECT CASE ( npolj )
+      CASE ( 4 )
+         DO ji = 1, nlci
+            ptab(ji,nlcj-2) = ptab(ji,nlcj-2) + t2p1(ji,1,1)
+         END DO
+      CASE ( 6 )
+         DO ji = 1, nlci
+            ptab(ji,nlcj-1) = ptab(ji,nlcj-1) + t2p1(ji,1,1)
+         END DO
+
+      ! 1.2 treatment with exchange (jpni greater than 1)
+      ! 
+      CASE ( 3 )
+#if defined key_mpp_shmem
+  
+         !! * SHMEN version
+  
+         imigr=jprecj*jpi
+  
+         CALL shmem_put(t2p1(1,1,2),t2p1(1,1,1),imigr,nono)
+         CALL barrier()
+         CALL shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+       !! * MPI version
+
+       imigr=jprecj*jpi
+
+       CALL mppsend(3,t2p1(1,1,1),imigr,nono, ml_req1)
+       CALL mpprecv(3,t2p1(1,1,2),imigr)
+       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+
+#endif      
+
+       ! Write north fold conditions
+
+       DO ji = 1, nlci
+          ptab(ji,nlcj-2) = ptab(ji,nlcj-2)+t2p1(ji,1,2)
+       END DO
+
+    CASE ( 5 )
+
+#if defined key_mpp_shmem
+
+       !! * SHMEN version
+
+       imigr=jprecj*jpi
+
+       CALL shmem_put(t2p1(1,1,2),t2p1(1,1,1),imigr,nono)
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jprecj*jpi
+
+       CALL mppsend(3,t2p1(1,1,1),imigr,nono, ml_req1)
+       CALL mpprecv(3,t2p1(1,1,2),imigr)
+       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+
+#endif      
+
+       ! Write north fold conditions
+
+       DO ji = 1, nlci
+          ptab(ji,nlcj-1) = ptab(ji,nlcj-1)+t2p1(ji,1,2)
+       END DO
+
+    END SELECT
+
+
+    ! 2. East and west directions
+    ! ---------------------------
+
+    ! 2.1 Read Dirichlet lateral conditions
+
+    iihom = nlci-jpreci
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1, 0, 1 )  ! all except 2
+       DO jl = 1, jpreci
+             t2ew(:,jl,1) = ptab(  jl    ,:)
+             t2we(:,jl,1) = ptab(iihom+jl,:)
+       END DO
+    END SELECT
+
+    ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+
+    !! * SHMEN version
+
+    imigr=jpreci*jpj
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+    CASE ( 0 )
+       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+    CASE ( 1 )
+       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+
+    END SELECT
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jpreci*jpj
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req1)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+    CASE ( 0 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1)
+       CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req2)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+       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,t2ew(1,1,1),imigr,nowe, ml_req1)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+
+    END SELECT
+
+#endif
+
+    ! 2.3 Write Dirichlet lateral conditions
+
+       iihom = nlci-nreci
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       DO jl = 1, jpreci
+             ptab(iihom +jl,:) = ptab(iihom +jl,:)+t2ew(:,jl,2)
+       END DO
+
+    CASE ( 0 )
+       DO jl = 1, jpreci
+             ptab(jpreci+jl,:) = ptab(jpreci+jl,:)+t2we(:,jl,2)
+             ptab(iihom +jl,:) = ptab(iihom +jl,:)+t2ew(:,jl,2)
+       END DO
+
+    CASE ( 1 )
+       DO jl = 1, jpreci
+             ptab(jpreci+jl,:) = ptab(jpreci+jl,:)+t2we(:,jl,2)
+       END DO
+    END SELECT
+
+
+    ! 3. North and south directions
+    ! -----------------------------
+
+    ! 3.1 Read Dirichlet lateral conditions
+
+    ijhom = nlcj-jprecj
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1, 0, 1 )
+       DO jl = 1, jprecj
+             t2sn(:,jl,1) = ptab(:,ijhom+jl)
+             t2ns(:,jl,1) = ptab(:,   jl   )
+       END DO
+
+    END SELECT 
+
+    ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+
+    !! * SHMEN version
+
+    imigr=jprecj*jpi
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
+
+    CASE ( 0 )
+       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
+       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
+
+    CASE ( 1 )
+       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
+
+    END SELECT
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jprecj*jpi
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req1)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+
+    CASE ( 0 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1)
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req2)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+       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,t2ns(1,1,1),imigr,noso, ml_req1)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+       IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+    END SELECT
+
+#endif
+
+    ! 3.3 Write Dirichlet lateral conditions
+
+       ijhom = nlcj-nrecj
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       DO jl = 1, jprecj
+             ptab(:,ijhom +jl) = ptab(:,ijhom +jl)+t2ns(:,jl,2)
+       END DO
+
+    CASE ( 0 )
+       DO jl = 1, jprecj
+             ptab(:,jprecj+jl) = ptab(:,jprecj+jl)+t2sn(:,jl,2)
+             ptab(:,ijhom +jl) = ptab(:,ijhom +jl)+t2ns(:,jl,2)
+       END DO
+
+    CASE ( 1 ) 
+       DO jl = 1, jprecj
+             ptab(:,jprecj+jl) = ptab(:,jprecj+jl)+t2sn(:,jl,2)
+       END DO
+
+    END SELECT
+
+  END SUBROUTINE mpplnks
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req)
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!                   
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), INTENT(inout) ::   pmess(*)       ! array of real
+      INTEGER , INTENT( in  ) ::   kbytes,     &  ! size of the array pmess
+         &                         kdest ,     &  ! receive process number
+         &                         ktyp,       &  ! Tag of the message
+         &                         md_req         ! Argument for isend
+      !!----------------------------------------------------------------------
+#if defined key_mpp_shmem
+      !! * SHMEM version  :    routine not used
+
+#elif defined key_mpp_mpi
+      !! * MPI version
+      INTEGER ::   iflag
+
+      SELECT CASE ( c_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
+            &                          mpi_comm_world, iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest, ktyp,   &
+            &                          mpi_comm_world, 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 )
+      END SELECT
+#endif
+
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), INTENT(inout) ::   pmess(*)       ! array of real
+      INTEGER , INTENT( in  ) ::   kbytes,     &  ! suze of the array pmess
+         &                         ktyp           ! Tag of the recevied message
+      !!----------------------------------------------------------------------
+#if defined key_mpp_shmem
+      !! * SHMEM version  :    routine not used
+
+#  elif defined key_mpp_mpi
+      !! * MPI version
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp,   &
+         &                          mpi_comm_world, istatus, iflag )
+#endif
+
+   END SUBROUTINE mpprecv
+
+
+   SUBROUTINE mppgather( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!                   
+      !! ** Purpose :   Transfert between a local subdomain array and a work 
+      !!     array which is distributed following the vertical level.
+      !!
+      !! ** Method  :
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT( in  ) ::   ptab   ! subdomain input array
+      INTEGER ,                           INTENT( in  ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT( out ) ::   pio    ! subdomain input array
+      !!---------------------------------------------------------------------
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      CALL barrier()
+      CALL shmem_put( pio(1,1,npvm_me+1), ptab, jpi*jpj, kp )
+      CALL barrier()
+
+#elif defined key_mpp_mpi
+      !! * Local variables   (MPI version)
+      INTEGER :: itaille,ierror
+  
+      itaille=jpi*jpj
+      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille,   &
+         &                            mpi_double_precision, kp , mpi_comm_world, ierror ) 
+#endif
+
+   END SUBROUTINE mppgather
+
+
+   SUBROUTINE mppscatter( pio, kp, ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppscatter  ***
+      !!
+      !! ** Purpose :   Transfert between awork array which is distributed 
+      !!      following the vertical level and the local subdomain array.
+      !!
+      !! ** Method :
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
+      INTEGER                             ::   kp        ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
+      !!---------------------------------------------------------------------
+#if defined key_mpp_shmem
+      !! * SHMEM version
+
+      CALL barrier()
+      CALL shmem_get( ptab, pio(1,1,npvm_me+1), jpi*jpj, kp )
+      CALL barrier()
+
+#  elif defined key_mpp_mpi
+      !! * Local variables   (MPI version)
+      INTEGER :: itaille, ierror
+  
+      itaille=jpi*jpj
+
+      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille,   &
+         &                            mpi_double_precision, kp, mpi_comm_world, ierror )
+#endif
+
+   END SUBROUTINE mppscatter
+
+
+   SUBROUTINE mppisl_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppisl_a_int  ***
+      !!                   
+      !! ** Purpose :   Massively parallel processors
+      !!                Find the  non zero value
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  )                  ::   kdim       ! ???
+      INTEGER, INTENT(inout), DIMENSION(kdim) ::   ktab       ! ???
+  
+#if defined key_mpp_shmem
+      !! * Local variables   (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+
+      IF( kdim > jpmppsum ) THEN
+         WRITE(numout,*) 'mppisl_a_int routine : kdim is too big'
+         WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+         STOP 'mppisl_a_int'
+      ENDIF
+
+      DO ji = 1, kdim
+         niitab_shmem(ji) = ktab(ji)
+      END DO
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,kdim,0   &
+              ,0,N$PES,ni11wrk_shmem,ni11sync_shmem)
+         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,kdim,0   &
+              ,0,N$PES,ni12wrk_shmem,ni12sync_shmem)
+      ELSE
+         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,kdim,0   &
+              ,0,N$PES,ni21wrk_shmem,ni21sync_shmem)
+         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,kdim,0   &
+              ,0,N$PES,ni22wrk_shmem,ni22sync_shmem)
+      ENDIF
+      CALL  barrier()
+      ibool=ibool+1
+      ibool=MOD( ibool,2)
+      DO ji = 1, kdim
+         IF( ni11tab_shmem(ji) /= 0. ) THEN
+            ktab(ji) = ni11tab_shmem(ji)
+         ELSE
+            ktab(ji) = ni12tab_shmem(ji)
+         ENDIF
+      END DO
+  
+#  elif defined key_mpp_mpi
+      !! * Local variables   (MPI version)
+      LOGICAL  :: lcommute
+      INTEGER, DIMENSION(kdim) ::   iwork
+      INTEGER  :: mpi_isl,ierror
+  
+      lcommute = .TRUE.
+      CALL mpi_op_create( lc_isl, lcommute, mpi_isl, ierror )
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer   &
+           , mpi_isl, mpi_comm_world, ierror )
+      ktab(:) = iwork(:)
+#endif
+
+   END SUBROUTINE mppisl_a_int
+
+
+   SUBROUTINE mppisl_int( ktab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppisl_int  ***
+      !!                   
+      !! ** Purpose :   Massively parallel processors
+      !!                Find the non zero value
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER , INTENT( inout ) ::   ktab        ! 
+
+#if defined key_mpp_shmem
+      !! * Local variables   (SHMEM version)
+      INTEGER, SAVE :: ibool=0
+
+      niitab_shmem(1) = ktab
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,1,0   &
+              ,0,N$PES,ni11wrk_shmem,ni11sync_shmem)
+         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,1,0   &
+              ,0,N$PES,ni12wrk_shmem,ni12sync_shmem)
+      ELSE
+         CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,1,0   &
+              ,0,N$PES,ni21wrk_shmem,ni21sync_shmem)
+         CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,1,0   &
+              ,0,N$PES,ni22wrk_shmem,ni22sync_shmem)
+      ENDIF
+      CALL  barrier()
+      ibool=ibool+1
+      ibool=MOD( ibool,2)
+      IF( ni11tab_shmem(1) /= 0. ) THEN
+         ktab = ni11tab_shmem(1)
+      ELSE
+         ktab = ni12tab_shmem(1)
+      ENDIF
+  
+#  elif defined key_mpp_mpi
+  
+      !! * Local variables   (MPI version)
+      LOGICAL :: lcommute
+      INTEGER :: mpi_isl,ierror
+      INTEGER ::   iwork
+  
+      lcommute = .TRUE.
+      CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
+      CALL mpi_allreduce(ktab, iwork, 1,mpi_integer   &
+           ,mpi_isl,mpi_comm_world,ierror)
+      ktab = iwork
+#endif
+
+   END SUBROUTINE mppisl_int
+
+
+   SUBROUTINE mppmin_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_a_int  ***
+      !! 
+      !! ** Purpose :   Find minimum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+  
+#if defined key_mpp_shmem
+      !! * Local declarations    (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+  
+      IF( kdim > jpmppsum ) THEN
+         WRITE(numout,*) 'mppmin_a_int routine : kdim is too big'
+         WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+         STOP 'min_a_int'
+      ENDIF
+  
+      DO ji = 1, kdim
+         niltab_shmem(ji) = ktab(ji)
+      END DO
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+      ELSE
+         CALL shmem_int8_min_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, DIMENSION(kdim) ::   iwork
+  
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
+           &                mpi_min, mpi_comm_world, ierror )
+  
+      ktab(:) = iwork(:)
+#endif
+
+   END SUBROUTINE mppmin_a_int
+
+
+   SUBROUTINE mppmin_int( ktab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_int  ***
+      !!
+      !! ** Purpose :
+      !!     Massively parallel processors
+      !!     Find minimum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(inout) ::   ktab      ! ???
+  
+      !! * 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_min_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+              ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+      ELSE
+         CALL shmem_int8_min_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
+  
+      CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
+           &              ,mpi_min,mpi_comm_world,ierror)
+  
+      ktab = iwork
+#endif
+
+   END SUBROUTINE mppmin_int
+
+
+   SUBROUTINE mppsum_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_int  ***
+      !!                    
+      !! ** Purpose :   Massively parallel processors
+      !!                Global integer sum
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  )                   ::   kdim      ! ???
+      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
+  
+#if defined key_mpp_shmem
+
+      !! * Local variables   (SHMEM version)
+      INTEGER :: ji
+      INTEGER, SAVE :: ibool=0
+
+      IF( kdim > jpmppsum ) THEN
+         WRITE(numout,*) 'mppsum_a_int routine : kdim is too big'
+         WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+         STOP 'mppsum_a_int'
+      ENDIF
+
+      DO ji = 1, kdim
+         nistab_shmem(ji) = ktab(ji)
+      END DO
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem,kdim,0,0,   &
+              N$PES,nis1wrk_shmem,nis1sync_shmem)
+      ELSE
+         CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem,kdim,0,0,   &
+              N$PES,nis2wrk_shmem,nis2sync_shmem)
+      ENDIF
+      CALL  barrier()
+      ibool = ibool + 1
+      ibool = MOD( ibool, 2 )
+      DO ji = 1, kdim
+         ktab(ji) = nistab_shmem(ji)
+      END DO
+  
+#  elif defined key_mpp_mpi
+
+      !! * Local variables   (MPI version)
+      INTEGER :: ierror
+      INTEGER, DIMENSION (kdim) ::  iwork
+  
+      CALL mpi_allreduce(ktab, iwork,kdim,mpi_integer   &
+           ,mpi_sum,mpi_comm_world,ierror)
+  
+      ktab(:) = iwork(:)
+#endif
+
+   END SUBROUTINE mppsum_a_int
+
+
+  SUBROUTINE mppsum_int( ktab )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppsum_int  ***
+    !!                  
+    !! ** Purpose :   Global integer sum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, INTENT(inout) ::   ktab
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    nistab_shmem(1) = ktab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem, 1,0,0,   &
+            N$PES,nis1wrk_shmem,nis1sync_shmem)
+    ELSE
+       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem, 1,0,0,   &
+            N$PES,nis2wrk_shmem,nis2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ktab = nistab_shmem(1)
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror, iwork
+
+    CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
+         ,mpi_sum,mpi_comm_world,ierror)
+
+    ktab = iwork
+
+#endif
+
+  END SUBROUTINE mppsum_int
+
+
+  SUBROUTINE mppisl_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppisl_a_real  ***
+    !!         
+    !! ** Purpose :   Massively parallel processors
+    !!           Find the non zero island barotropic stream function value
+    !!
+    !!   Modifications:
+    !!        !  93-09 (M. Imbard)
+    !!        !  96-05 (j. Escobar)
+    !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
+    !!----------------------------------------------------------------------
+    INTEGER , INTENT( in  )                  ::   kdim      ! ???
+    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab      ! ???
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppisl_a_real routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppisl_a_real'
+    ENDIF
+
+    DO ji = 1, kdim
+       wiltab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi11wrk_shmem,ni11sync_shmem)
+       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi12wrk_shmem,ni12sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi21wrk_shmem,ni21sync_shmem)
+       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi22wrk_shmem,ni22sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       IF(wi1tab_shmem(ji) /= 0. ) THEN
+          ptab(ji) = wi1tab_shmem(ji)
+       ELSE
+          ptab(ji) = wi2tab_shmem(ji)
+       ENDIF
+    END DO
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    LOGICAL ::   lcommute = .TRUE.
+    INTEGER ::   mpi_isl, ierror
+    REAL(wp), DIMENSION(kdim) ::  zwork
+
+    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)
+    ptab(:) = zwork(:)
+
+#endif
+
+  END SUBROUTINE mppisl_a_real
+
+
+   SUBROUTINE mppisl_real( ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppisl_real  ***
+      !!                  
+      !! ** Purpose :   Massively parallel processors
+      !!       Find the  non zero island barotropic stream function value
+      !!
+      !!     Modifications:
+      !!        !  93-09 (M. Imbard)
+      !!        !  96-05 (j. Escobar)
+      !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   ptab
+
+#if defined key_mpp_shmem
+
+      !! * Local variables   (SHMEM version)
+      INTEGER, SAVE :: ibool=0
+
+      wiltab_shmem(1) = ptab
+      CALL  barrier()
+      IF(ibool == 0 ) THEN 
+         CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi11wrk_shmem,ni11sync_shmem)
+         CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi12wrk_shmem,ni12sync_shmem)
+      ELSE
+         CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi21wrk_shmem,ni21sync_shmem)
+         CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi22wrk_shmem,ni22sync_shmem)
+      ENDIF
+      CALL barrier()
+      ibool = ibool + 1
+      ibool = MOD( ibool, 2 )
+      IF( wi1tab_shmem(1) /= 0. ) THEN
+         ptab = wi1tab_shmem(1)
+      ELSE
+         ptab = wi2tab_shmem(1)
+      ENDIF
+
+#  elif defined key_mpp_mpi
+
+      !! * Local variables   (MPI version)
+      LOGICAL  ::   lcommute = .TRUE.
+      INTEGER  ::   mpi_isl, ierror
+      REAL(wp) ::   zwork
+
+      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 )
+      ptab = zwork
+
+#endif
+
+   END SUBROUTINE mppisl_real
+
+
+  FUNCTION lc_isl( py, px, kdim, kdtatyp )
+    INTEGER :: kdim
+    REAL(wp), DIMENSION(kdim) ::  px, py
+    INTEGER :: kdtatyp, ji
+    INTEGER :: lc_isl
+    DO ji = 1, kdim
+       IF( py(ji) /= 0. )   px(ji) = py(ji)
+    END DO
+    lc_isl=0
+
+  END FUNCTION lc_isl
+
+
+  SUBROUTINE mppmax_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppmax_a_real  ***
+    !!                  
+    !! ** Purpose :   Maximum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in  )                  ::   kdim
+    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppmax_a_real routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppmax_a_real'
+    ENDIF
+
+    DO ji = 1, kdim
+       wintab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ptab(ji) = wintab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+    REAL(wp), DIMENSION(kdim) ::  zwork
+
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
+         ,mpi_max,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#endif
+
+  END SUBROUTINE mppmax_a_real
+
+
+  SUBROUTINE mppmax_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppmax_real  ***
+    !!                    
+    !! ** Purpose :   Maximum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), INTENT(inout) ::   ptab      ! ???
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wintab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ptab = wintab_shmem(1)
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER  ::   ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_allreduce( ptab, zwork  , 1             , mpi_double_precision,   &
+       &                      mpi_max, mpi_comm_world, ierror     )
+    ptab = zwork
+
+#endif
+
+  END SUBROUTINE mppmax_real
+
+
+  SUBROUTINE mppmin_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppmin_a_real  ***
+    !!                  
+    !! ** Purpose :   Minimum
+    !!
+    !!-----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in  )                  ::   kdim
+    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mpprmin routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mpprmin'
+    ENDIF
+
+    DO ji = 1, kdim
+       wintab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ptab(ji) = wintab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+    REAL(wp), DIMENSION(kdim) ::   zwork
+
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
+         ,mpi_min,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#endif
+
+  END SUBROUTINE mppmin_a_real
+
+
+  SUBROUTINE mppmin_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppmin_real  ***
+    !! 
+    !! ** Purpose :   minimum in Massively Parallel Processing
+    !!                REAL scalar case
+    !!
+    !!-----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), INTENT( inout ) ::   ptab        ! 
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wintab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ptab = wintab_shmem(1)
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER  ::   ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_allreduce( ptab, zwork, 1,mpi_double_precision   &
+         &               ,mpi_min,mpi_comm_world,ierror)
+    ptab = zwork
+
+#endif
+
+  END SUBROUTINE mppmin_real
+
+
+  SUBROUTINE mppsum_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsum_a_real  ***
+    !! 
+    !! ** Purpose :   global sum in Massively Parallel Processing
+    !!                REAL ARRAY argument case
+    !!
+    !!-----------------------------------------------------------------------
+    INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
+    REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppsum_a_real routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppsum_a_real'
+    ENDIF
+
+    DO ji = 1, kdim
+       wrstab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem,kdim,0   &
+            ,0,N$PES,wrs1wrk_shmem,nrs1sync_shmem )
+    ELSE
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem,kdim,0   &
+            ,0,N$PES,wrs2wrk_shmem,nrs2sync_shmem )
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ptab(ji) = wrstab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER                   ::   ierror    ! temporary integer
+    REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
+
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_double_precision   &
+         &              ,mpi_sum,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#endif
+
+  END SUBROUTINE mppsum_a_real
+
+
+  SUBROUTINE mppsum_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsum_real  ***
+    !!              
+    !! ** Purpose :   global sum in Massively Parallel Processing
+    !!                SCALAR argument case
+    !!
+    !!-----------------------------------------------------------------------
+    REAL(wp), INTENT(inout) ::   ptab        ! input scalar
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wrstab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem, 1,0   &
+            ,0,N$PES,wrs1wrk_shmem,nrs1sync_shmem )
+    ELSE
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem, 1,0   &
+            ,0,N$PES,wrs2wrk_shmem,nrs2sync_shmem )
+    ENDIF
+    CALL  barrier()
+    ibool = ibool + 1
+    ibool = MOD( ibool, 2 )
+    ptab = wrstab_shmem(1)
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER  ::   ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_allreduce(ptab, zwork, 1,mpi_double_precision   &
+         &              ,mpi_sum,mpi_comm_world,ierror)
+    ptab = zwork
+
+#endif
+
+  END SUBROUTINE mppsum_real
+
+  SUBROUTINE mpp_minloc2d(ptab, pmask, pmin, ki,kj )
+    !!------------------------------------------------------------------------
+    !!             ***  routine mpp_minloc  ***
+    !!
+    !! ** Purpose :  Compute the global minimum of an array ptab
+    !!              and also give its global position
+    !!
+    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+    !!
+    !! ** Arguments : I : ptab =local 2D array
+    !!                O : pmin = global minimum
+    !!                O : ki,kj = global position of minimum
+    !!
+    !! ** Author : J.M. Molines 10/10/2004
+    !!--------------------------------------------------------------------------
+#ifdef key_mpp_shmem
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_minloc not yet available in SHMEM'
+       STOP
+    ENDIF
+# elif key_mpp_mpi
+    !! * Arguments
+    REAL(wp), DIMENSION (jpi,jpj), INTENT (in)  :: ptab ,& ! Local 2D array
+         &                                         pmask   ! Local mask
+    REAL(wp)                     , INTENT (out) :: pmin    ! Global minimum of ptab
+    INTEGER                      , INTENT (out) :: ki,kj   ! index of minimum in global frame
+
+    !! * Local variables
+    REAL(wp) :: zmin   ! local minimum
+    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
+    INTEGER, DIMENSION (2)  :: ilocs
+    INTEGER :: ierror
+
+
+    zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
+    ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+
+    ki = ilocs(1) + nimpp - 1
+    kj = ilocs(2) + njmpp - 1
+
+    zain(1,:)=zmin
+    zain(2,:)=ki+10000.*kj
+
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,ierror)
+
+    pmin=zaout(1,1)
+    kj= INT(zaout(2,1)/10000.)
+    ki= INT(zaout(2,1) - 10000.*kj )
+#endif
+
+  END SUBROUTINE mpp_minloc2d
+
+
+  SUBROUTINE mpp_minloc3d(ptab, pmask, pmin, ki,kj ,kk)
+    !!------------------------------------------------------------------------
+    !!             ***  routine mpp_minloc  ***
+    !!
+    !! ** Purpose :  Compute the global minimum of an array ptab
+    !!              and also give its global position
+    !!
+    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+    !!
+    !! ** Arguments : I : ptab =local 2D array
+    !!                O : pmin = global minimum
+    !!                O : ki,kj = global position of minimum
+    !!
+    !! ** Author : J.M. Molines 10/10/2004
+    !!--------------------------------------------------------------------------
+#ifdef key_mpp_shmem
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_minloc not yet available in SHMEM'
+       STOP
+    ENDIF
+# elif key_mpp_mpi
+    !! * Arguments
+    REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT (in)  :: ptab ,& ! Local 2D array
+         &                                         pmask   ! Local mask
+    REAL(wp)                     , INTENT (out) :: pmin    ! Global minimum of ptab
+    INTEGER                      , INTENT (out) :: ki,kj,kk ! index of minimum in global frame
+
+    !! * Local variables
+    REAL(wp) :: zmin   ! local minimum
+    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
+    INTEGER, DIMENSION (3)  :: ilocs
+    INTEGER :: ierror
+
+
+    zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+    ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+
+    ki = ilocs(1) + nimpp - 1
+    kj = ilocs(2) + njmpp - 1
+    kk = ilocs(3)
+
+    zain(1,:)=zmin
+    zain(2,:)=ki+10000.*kj+100000000.*kk
+
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,ierror)
+
+    pmin=zaout(1,1)
+    kk= INT(zaout(2,1)/100000000.)
+    kj= INT(zaout(2,1) - kk * 100000000. )/10000
+    ki= INT(zaout(2,1) - kk * 100000000. -kj * 10000. )
+#endif
+
+  END SUBROUTINE mpp_minloc3d
+
+
+  SUBROUTINE mpp_maxloc2d(ptab, pmask, pmax, ki,kj )
+    !!------------------------------------------------------------------------
+    !!             ***  routine mpp_maxloc  ***
+    !!
+    !! ** Purpose :  Compute the global maximum of an array ptab
+    !!              and also give its global position
+    !!
+    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+    !!
+    !! ** Arguments : I : ptab =local 2D array
+    !!                O : pmax = global maximum
+    !!                O : ki,kj = global position of maximum
+    !!
+    !! ** Author : J.M. Molines 10/10/2004
+    !!--------------------------------------------------------------------------
+#ifdef key_mpp_shmem
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_maxloc not yet available in SHMEM'
+       STOP
+    ENDIF
+# elif key_mpp_mpi
+    !! * Arguments
+    REAL(wp), DIMENSION (jpi,jpj), INTENT (in)  :: ptab ,& ! Local 2D array
+         &                                         pmask   ! Local mask
+    REAL(wp)                     , INTENT (out) :: pmax    ! Global maximum of ptab
+    INTEGER                      , INTENT (out) :: ki,kj   ! index of maximum in global frame
+
+    !! * Local variables
+    REAL(wp) :: zmax   ! local maximum
+    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
+    INTEGER, DIMENSION (2)  :: ilocs
+    INTEGER :: ierror
+
+
+    zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
+    ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+
+    ki = ilocs(1) + nimpp - 1
+    kj = ilocs(2) + njmpp - 1
+
+    zain(1,:)=zmax
+    zain(2,:)=ki+10000.*kj
+
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,ierror)
+
+    pmax=zaout(1,1)
+    kj= INT(zaout(2,1)/10000.)
+    ki= INT(zaout(2,1) - 10000.*kj )
+#endif
+
+  END SUBROUTINE mpp_maxloc2d
+
+  SUBROUTINE mpp_maxloc3d(ptab, pmask, pmax, ki,kj,kk )
+    !!------------------------------------------------------------------------
+    !!             ***  routine mpp_maxloc  ***
+    !!
+    !! ** Purpose :  Compute the global maximum of an array ptab
+    !!              and also give its global position
+    !!
+    !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+    !!
+    !! ** Arguments : I : ptab =local 2D array
+    !!                O : pmax = global maximum
+    !!                O : ki,kj = global position of maximum
+    !!
+    !! ** Author : J.M. Molines 10/10/2004
+    !!--------------------------------------------------------------------------
+#ifdef key_mpp_shmem
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_maxloc not yet available in SHMEM'
+       STOP
+    ENDIF
+# elif key_mpp_mpi
+    !! * Arguments
+    REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT (in)  :: ptab ,& ! Local 2D array
+         &                                         pmask   ! Local mask
+    REAL(wp)                     , INTENT (out) :: pmax    ! Global maximum of ptab
+    INTEGER                      , INTENT (out) :: ki,kj,kk   ! index of maximum in global frame
+
+    !! * Local variables
+    REAL(wp) :: zmax   ! local maximum
+    REAL(wp) ,DIMENSION(2,1) :: zain, zaout
+    INTEGER, DIMENSION (3)  :: ilocs
+    INTEGER :: ierror
+
+
+    zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+    ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+
+    ki = ilocs(1) + nimpp - 1
+    kj = ilocs(2) + njmpp - 1
+    kk = ilocs(3)
+
+    zain(1,:)=zmax
+    zain(2,:)=ki+10000.*kj+100000000.*kk
+
+    CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,ierror)
+
+    pmax=zaout(1,1)
+    kk= INT(zaout(2,1)/100000000.)
+    kj= INT(zaout(2,1) - kk * 100000000. )/10000
+    ki= INT(zaout(2,1) - kk * 100000000. -kj * 10000. )
+#endif
+
+  END SUBROUTINE mpp_maxloc3d
+
+  SUBROUTINE mppsync()
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsync  ***
+    !!                   
+    !! ** Purpose :   Massively parallel processors, synchroneous
+    !!
+    !!-----------------------------------------------------------------------
+
+#if defined key_mpp_shmem
+
+    !! * Local variables   (SHMEM version)
+    CALL barrier()
+
+#  elif defined key_mpp_mpi
+
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+
+    CALL mpi_barrier(mpi_comm_world,ierror)
+
+#endif
+
+  END SUBROUTINE mppsync
+
+
+  SUBROUTINE mppstop
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppstop  ***
+    !!                   
+    !! ** purpose :   Stop massilively parallel processors method
+    !!
+    !!----------------------------------------------------------------------
+    !! * Local declarations
+    INTEGER ::   info
+    !!----------------------------------------------------------------------
+
+    ! 1. Mpp synchroneus
+    ! ------------------
+
+    CALL mppsync
+#if defined key_mpp_mpi
+    CALL mpi_finalize( info )
+#endif
+
+  END SUBROUTINE mppstop
+
+
+  SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppobc  ***
+    !! 
+    !! ** Purpose :   Message passing manadgement for open boundary
+    !!     conditions array
+    !!
+    !! ** 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
+    !!
+    !! History :
+    !!        !  98-07 (J.M. Molines) Open boundary conditions
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in ) ::   &
+         kd1, kd2,   &  ! starting and ending indices
+         kl ,        &  ! index of open boundary
+         kk,         &  ! vertical dimension
+         ktype,      &  ! define north/south or east/west cdt
+         !              !  = 1  north/south  ;  = 2  east/west
+         kij            ! horizontal dimension
+    REAL(wp), DIMENSION(kij,kk), INTENT( inout )  ::   &
+         ptab           ! variable array
+
+    !! * Local variables
+    INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+    INTEGER  ::   &
+         iipt0, iipt1, ilpt1,     &  ! temporary integers
+         ijpt0, ijpt1,            &  !    "          "
+         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
+    !!----------------------------------------------------------------------
+
+
+    ! boundary condition initialization
+    ! ---------------------------------
+
+    ztab(:,:) = 0.e0
+
+    IF( ktype==1 ) THEN                                  ! north/south boundaries
+       iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
+       iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
+       ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
+       ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
+       ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
+    ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
+       iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
+       iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
+       ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
+       ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
+       ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
+    ELSE
+       IF(lwp)WRITE(numout,*) 'mppobc: bad ktype'
+       STOP 'mppobc'
+    ENDIF
+
+    DO jk = 1, kk
+       IF( ktype==1 ) THEN                               ! north/south boundaries
+          DO jj = ijpt0, ijpt1
+             DO ji = iipt0, iipt1
+                ztab(ji,jj) = ptab(ji,jk)
+             END DO
+          END DO
+       ELSEIF( ktype==2 ) THEN                           ! east/west boundaries
+          DO jj = ijpt0, ijpt1
+             DO ji = iipt0, iipt1
+                ztab(ji,jj) = ptab(jj,jk)
+             END DO
+          END DO
+       ENDIF
+
+
+       ! 1. East and west directions
+       ! ---------------------------
+
+       ! 1.1 Read Dirichlet lateral conditions
+
+       IF( nbondi /= 2 ) THEN
+          iihom = nlci-nreci
+
+          DO jl = 1, jpreci
+             t2ew(:,jl,1) = ztab(jpreci+jl,:)
+             t2we(:,jl,1) = ztab(iihom +jl,:)
+          END DO
+       ENDIF
+
+       ! 1.2 Migrations
+
+#if defined key_mpp_shmem
+       !! *  (SHMEM version)
+       imigr=jpreci*jpj*jpbyt
+
+       IF( nbondi == -1 ) THEN
+          CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr/jpbyt, noea )
+       ELSEIF( nbondi == 0 ) THEN
+          CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr/jpbyt, nowe )
+          CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr/jpbyt, noea )
+       ELSEIF( nbondi == 1 ) THEN
+          CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr/jpbyt, nowe )
+       ENDIF
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif key_mpp_mpi
+       !! * (MPI version)
+
+       imigr=jpreci*jpj
+
+       IF( nbondi == -1 ) THEN
+          CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req1)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+       ELSEIF( nbondi == 0 ) THEN
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1)
+          CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req2)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+       ELSEIF( nbondi == 1 ) THEN
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+       ENDIF
+#endif
+
+
+       ! 1.3 Write Dirichlet lateral conditions
+
+       iihom = nlci-jpreci
+       IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+          DO jl = 1, jpreci
+             ztab(jl,:) = t2we(:,jl,2)
+          END DO
+       ENDIF
+
+       IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+          DO jl = 1, jpreci
+             ztab(iihom+jl,:) = t2ew(:,jl,2)
+          END DO
+       ENDIF
+
+
+       ! 2. North and south directions
+       ! -----------------------------
+
+       ! 2.1 Read Dirichlet lateral conditions
+
+       IF( nbondj /= 2 ) THEN
+          ijhom = nlcj-nrecj
+          DO jl = 1, jprecj
+             t2sn(:,jl,1) = ztab(:,ijhom +jl)
+             t2ns(:,jl,1) = ztab(:,jprecj+jl)
+          END DO
+       ENDIF
+
+       ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+       !! * SHMEM version
+
+       imigr=jprecj*jpi*jpbyt
+
+       IF( nbondj == -1 ) THEN
+          CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr/jpbyt, nono )
+       ELSEIF( nbondj == 0 ) THEN
+          CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr/jpbyt, noso )
+          CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr/jpbyt, nono )
+       ELSEIF( nbondj == 1 ) THEN
+          CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr/jpbyt, noso )
+       ENDIF
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jprecj*jpi
+
+       IF( nbondj == -1 ) THEN
+          CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req1)
+          CALL mpprecv(3,t2ns(1,1,2),imigr)
+          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+       ELSEIF( nbondj == 0 ) THEN
+          CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1)
+          CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req2)
+          CALL mpprecv(3,t2ns(1,1,2),imigr)
+          CALL mpprecv(4,t2sn(1,1,2),imigr)
+          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+       ELSEIF( nbondj == 1 ) THEN
+          CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1)
+          CALL mpprecv(4,t2sn(1,1,2),imigr)
+          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+       ENDIF
+
+#endif
+
+       ! 2.3 Write Dirichlet lateral conditions
+
+       ijhom = nlcj - jprecj
+       IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+          DO jl = 1, jprecj
+             ztab(:,jl) = t2sn(:,jl,2)
+          END DO
+       ENDIF
+
+       IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+          DO jl = 1, jprecj
+             ztab(:,ijhom+jl) = t2ns(:,jl,2)
+          END DO
+       ENDIF
+
+       IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
+          ! north/south boundaries
+          DO jj = ijpt0,ijpt1
+             DO ji = iipt0,ilpt1
+                ptab(ji,jk) = ztab(ji,jj)  
+             END DO
+          END DO
+       ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
+          ! east/west boundaries
+          DO jj = ijpt0,ilpt1
+             DO ji = iipt0,iipt1
+                ptab(jj,jk) = ztab(ji,jj) 
+             END DO
+          END DO
+       ENDIF
+
+    END DO
+
+  END SUBROUTINE mppobc
+
+
+  SUBROUTINE mpp_ini_north
+    !!----------------------------------------------------------------------
+    !!               ***  routine mpp_ini_north  ***
+    !!
+    !! ** Purpose :   Initialize special communicator for north folding 
+    !!      condition together with global variables needed in the mpp folding
+    !!
+    !! ** Method  : - Look for northern processors
+    !!              - Put their number in nrank_north
+    !!              - Create groups for the world processors and the north processors
+    !!              - Create a communicator for northern processors
+    !!
+    !! ** output
+    !!      njmppmax = njmpp for northern procs
+    !!      ndim_rank_north = 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_north = group ID for the northern processors
+    !!      ncomm_north = communicator for the northern procs.
+    !!      north_root = number (in the world) of proc 0 in the northern comm.
+    !!
+    !! History :
+    !!        !  03-09 (J.M. Molines, MPI only )
+    !!----------------------------------------------------------------------
+#ifdef key_mpp_shmem
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_ini_north not available in SHMEM'
+       STOP
+    ENDIF
+# elif key_mpp_mpi
+    INTEGER :: ierr
+    INTEGER :: jproc
+    INTEGER :: ii,ji
+    !!----------------------------------------------------------------------
+
+    njmppmax=MAXVAL(njmppt)
+
+    ! Look for how many procs on the northern boundary
+    !
+    ndim_rank_north=0
+    DO jproc=1,jpnij
+       IF ( njmppt(jproc) == njmppmax ) THEN
+          ndim_rank_north = ndim_rank_north + 1
+       END IF
+    END DO
+
+
+    ! Allocate the right size to nrank_north
+    !
+    ALLOCATE(nrank_north(ndim_rank_north))
+
+    ! Fill the nrank_north array with proc. number of northern procs.
+    ! Note : the rank start at 0 in MPI
+    !
+    ii=0
+    DO ji = 1, jpnij
+       IF ( njmppt(ji) == njmppmax   ) THEN
+          ii=ii+1
+          nrank_north(ii)=ji-1
+       END IF
+    END DO
+    ! create the world group
+    !
+    CALL MPI_COMM_GROUP(mpi_comm_world,ngrp_world,ierr)
+    !
+    ! Create the North group from the world group
+    CALL MPI_GROUP_INCL(ngrp_world,ndim_rank_north,nrank_north,ngrp_north,ierr)
+
+    ! 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)
+
+
+    ! find proc number in the world of proc 0 in the north
+    CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_north,1,0,ngrp_world,north_root,ierr)
+#endif
+
+  END SUBROUTINE mpp_ini_north
+
+
+   SUBROUTINE mpp_lbc_north_3d ( pt3d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_3d  ***
+      !!
+      !! ** Purpose :
+      !!      Ensure proper north fold horizontal bondary condition in mpp configuration
+      !!      in case of jpn1 > 1
+      !!
+      !! ** Method :
+      !!      Gather the 4 northern lines of the global domain on 1 processor and 
+      !!      apply lbc north-fold on this sub array. Then scatter the fold array 
+      !!      back to the processors.
+      !!
+      !! History :
+      !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
+      !!                                  from lbc routine
+      !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt3d grid-points
+         !             !   = T ,  U , V , F or W  gridpoints
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
+         pt3d          ! 3D array on which the boundary condition is applied
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   = -1. , the sign is changed if north fold boundary
+         !             !   =  1. , the sign is kept  if north fold boundary
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jk, jr, jproc
+      INTEGER :: ierr
+      INTEGER :: ildi,ilei,iilb
+      INTEGER :: ijpj,ijpjm1,ij,ijt,iju
+      INTEGER :: itaille
+      REAL(wp), DIMENSION(jpiglo,4,jpk) :: ztab
+      REAL(wp), DIMENSION(jpi,4,jpk,jpni) :: znorthgloio
+      REAL(wp), DIMENSION(jpi,4,jpk) :: znorthloc
+      !!----------------------------------------------------------------------
+
+    ! If we get in this routine it s because : North fold condition and mpp with more
+    !   than one proc across i : we deal only with the North condition
+
+    ! 0. Sign setting
+    ! ---------------
+
+    ijpj=4
+    ijpjm1=3
+
+    ! put in znorthloc the last 4 jlines of pt3d
+    DO jk = 1, jpk 
+       DO jj = nlcj - ijpj +1, nlcj
+          ij = jj - nlcj + ijpj
+          znorthloc(:,ij,jk) = pt3d(:,jj,jk)
+       END DO
+    END DO
+
+
+    IF (npolj /= 0 ) THEN
+       ! Build in proc 0 of ncomm_north the znorthgloio
+       znorthgloio(:,:,:,:) = 0_wp
+
+#ifdef key_mpp_shmem
+       not done : compiler error
+#elif defined key_mpp_mpi
+       itaille=jpi*jpk*ijpj
+       CALL MPI_GATHER(znorthloc,itaille,MPI_DOUBLE_PRECISION,znorthgloio,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
+#endif
+
+    ENDIF
+
+    IF (narea == north_root+1 ) THEN
+       ! recover the global north array
+       ztab(:,:,:) = 0_wp
+
+       DO jr = 1, ndim_rank_north
+          jproc = nrank_north(jr) + 1
+          ildi  = nldit (jproc)
+          ilei  = nleit (jproc)
+          iilb  = nimppt(jproc)
+          DO jk = 1, jpk 
+             DO jj = 1, 4
+                DO ji = ildi, ilei
+                   ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)
+                END DO
+             END DO
+          END DO
+       END DO
+
+
+       ! Horizontal slab
+       ! ===============
+
+       DO jk = 1, jpk 
+
+
+          ! 2. North-Fold boundary conditions
+          ! ----------------------------------
+
+          SELECT CASE ( npolj )
+
+          CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+
+             ztab( 1    ,ijpj,jk) = 0.e0
+             ztab(jpiglo,ijpj,jk) = 0.e0
+
+             SELECT CASE ( cd_type )
+
+             CASE ( 'T' , 'S' , 'W' )                   ! T-, W-point
+                DO ji = 2, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2+1, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(ijt,ijpjm1,jk)
+                END DO
+
+             CASE ( 'U' )                               ! U-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpj,jk) = psgn * ztab(iju,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(iju,ijpjm1,jk)
+                END DO
+
+             CASE ( 'V' )                               ! V-point
+                DO ji = 2, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpj-1,jk) = psgn * ztab(ijt,ijpj-2,jk)
+                   ztab(ji,ijpj  ,jk) = psgn * ztab(ijt,ijpj-3,jk)
+                END DO
+
+             CASE ( 'F' , 'G' )                         ! F-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpj-1,jk) = psgn * ztab(iju,ijpj-2,jk)
+                   ztab(ji,ijpj  ,jk) = psgn * ztab(iju,ijpj-3,jk)
+                END DO
+
+             END SELECT
+
+          CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+
+             ztab( 1    ,ijpj,jk) = 0.e0
+             ztab(jpiglo,ijpj,jk) = 0.e0
+
+             SELECT CASE ( cd_type )
+
+             CASE ( 'T' , 'S' , 'W' )                   ! T-, W-point
+                DO ji = 1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-1,jk)
+                END DO
+
+             CASE ( 'U' )                               ! U-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpj,jk) = psgn * ztab(iju,ijpj-1,jk)
+                END DO
+
+             CASE ( 'V' )                               ! V-point
+                DO ji = 1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2+1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(ijt,ijpjm1,jk)
+                END DO
+
+             CASE ( 'F' , 'G' )                         ! F-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpj  ,jk) = psgn * ztab(iju,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2+1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(iju,ijpjm1,jk)
+                END DO
+
+             END SELECT
+
+          CASE DEFAULT                           ! *  closed
+
+             SELECT CASE ( cd_type) 
+
+             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+                ztab(:, 1  ,jk) = 0.e0
+                ztab(:,ijpj,jk) = 0.e0
+
+             CASE ( 'F' )                               ! F-point
+                ztab(:,ijpj,jk) = 0.e0
+
+             END SELECT
+
+          END SELECT
+
+          !     End of slab
+          !     ===========
+
+       END DO
+
+       !! Scatter back to pt3d
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jk=  1, jpk
+             DO jj=1,ijpj
+                DO ji=ildi,ilei
+                   znorthgloio(ji,jj,jk,jr)=ztab(ji+iilb-1,jj,jk)
+                END DO
+             END DO
+          END DO
+       END DO
+
+    ENDIF      ! only done on proc 0 of ncomm_north
+
+#ifdef key_mpp_shmem
+    not done yet in shmem : compiler error
+#elif key_mpp_mpi
+    IF ( npolj /= 0 ) THEN
+       itaille=jpi*jpk*ijpj
+       CALL MPI_SCATTER(znorthgloio,itaille,MPI_DOUBLE_PRECISION,znorthloc,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
+    ENDIF
+#endif
+
+    ! put in the last ijpj jlines of pt3d znorthloc
+    DO jk = 1 , jpk 
+       DO jj = nlcj - ijpj + 1 , nlcj
+          ij = jj - nlcj + ijpj
+          pt3d(:,jj,jk)= znorthloc(:,ij,jk)
+       END DO
+    END DO
+
+  END SUBROUTINE mpp_lbc_north_3d
+
+
+  SUBROUTINE mpp_lbc_north_2d ( pt2d, cd_type, psgn)
+    !!---------------------------------------------------------------------
+    !!                   ***  routine mpp_lbc_north_2d  ***
+    !!
+    !! ** Purpose :
+    !!      Ensure proper north fold horizontal bondary condition in mpp configuration
+    !!      in case of jpn1 > 1 (for 2d array )
+    !!
+    !! ** Method :
+    !!      Gather the 4 northern lines of the global domain on 1 processor and 
+    !!      apply lbc north-fold on this sub array. Then scatter the fold array 
+    !!      back to the processors.
+    !!
+    !! History :
+    !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
+    !!                                  from lbc routine
+    !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
+    !!----------------------------------------------------------------------
+
+    !! * Arguments
+    CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt2d grid-points
+    !             !   = T ,  U , V , F or W  gridpoints
+    REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+    REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+    !             !   = -1. , the sign is changed if north fold boundary
+    !             !   =  1. , the sign is kept  if north fold boundary
+
+
+    !! * Local declarations
+
+    INTEGER :: ji, jj,  jr, jproc
+    INTEGER :: ierr
+    INTEGER :: ildi,ilei,iilb
+    INTEGER :: ijpj,ijpjm1,ij,ijt,iju
+    INTEGER :: itaille
+
+    REAL(wp), DIMENSION(jpiglo,4) :: ztab
+    REAL(wp), DIMENSION(jpi,4,jpni) :: znorthgloio
+    REAL(wp), DIMENSION(jpi,4) :: znorthloc
+    !!----------------------------------------------------------------------
+    !!  OPA 8.5, LODYC-IPSL (2002)
+    !!----------------------------------------------------------------------
+    ! If we get in this routine it s because : North fold condition and mpp with more
+    !   than one proc across i : we deal only with the North condition
+
+    ! 0. Sign setting
+    ! ---------------
+
+    ijpj=4
+    ijpjm1=3
+
+
+    ! put in znorthloc the last 4 jlines of pt2d
+    DO jj = nlcj - ijpj +1, nlcj
+       ij = jj - nlcj + ijpj
+       znorthloc(:,ij)=pt2d(:,jj)
+    END DO
+
+    IF (npolj /= 0 ) THEN
+       ! Build in proc 0 of ncomm_north the znorthgloio
+       znorthgloio(:,:,:) = 0_wp
+#ifdef key_mpp_shmem
+       not done : compiler error
+#elif defined key_mpp_mpi
+       itaille=jpi*ijpj
+       CALL MPI_GATHER(znorthloc,itaille,MPI_DOUBLE_PRECISION,znorthgloio,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
+#endif
+    ENDIF
+
+    IF (narea == north_root+1 ) THEN
+       ! recover the global north array
+       ztab(:,:) = 0_wp
+
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jj=1,4
+             DO ji=ildi,ilei
+                ztab(ji+iilb-1,jj)=znorthgloio(ji,jj,jr)
+             END DO
+          END DO
+       END DO
+
+
+       ! 2. North-Fold boundary conditions
+       ! ----------------------------------
+
+       SELECT CASE ( npolj )
+
+       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+
+          ztab( 1    ,ijpj) = 0.e0
+          ztab(jpiglo,ijpj) = 0.e0
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'W' , 'S' )                         ! T-, W-point
+             DO ji = 2, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-2)
+             END DO
+             DO ji = jpiglo/2+1, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
+             END DO
+
+          CASE ( 'U' )                                     ! U-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-2)
+             END DO
+             DO ji = jpiglo/2, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
+             END DO
+
+          CASE ( 'V' )                                     ! V-point
+             DO ji = 2, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpj-1) = psgn * ztab(ijt,ijpj-2)
+                ztab(ji,ijpj  ) = psgn * ztab(ijt,ijpj-3)
+             END DO
+
+          CASE ( 'F' , 'G' )                               ! F-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpj-1) = psgn * ztab(iju,ijpj-2)
+                ztab(ji,ijpj  ) = psgn * ztab(iju,ijpj-3)
+             END DO
+
+          CASE ( 'I' )                                     ! ice U-V point
+             ztab(2,ijpj) = psgn * ztab(3,ijpj-1)
+             DO ji = 3, jpiglo
+                iju = jpiglo - ji + 3
+                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-1)
+             END DO
+
+          END SELECT
+
+       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+
+          ztab( 1 ,ijpj) = 0.e0
+          ztab(jpiglo,ijpj) = 0.e0
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'W' ,'S' )                          ! T-, W-point
+             DO ji = 1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-1)
+             END DO
+
+          CASE ( 'U' )                                     ! U-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-1)
+             END DO
+
+          CASE ( 'V' )                                     ! V-point
+             DO ji = 1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-2)
+             END DO
+             DO ji = jpiglo/2+1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
+             END DO
+
+          CASE ( 'F' , 'G' )                               ! F-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpj  ) = psgn * ztab(iju,ijpj-2)
+             END DO
+             DO ji = jpiglo/2+1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
+             END DO
+
+             CASE ( 'I' )                                  ! ice U-V point
+                ztab( 2 ,ijpj) = 0.e0
+                DO ji = 2 , jpiglo-1
+                   ijt = jpi - ji + 2
+                   ztab(ji,ijpj)= 0.5 * ( ztab(ji,ijpj-1) + psgn * ztab(ijt,ijpj-1) )
+                END DO
+
+          END SELECT
+
+       CASE DEFAULT                           ! *  closed : the code probably never go through
+
+            SELECT CASE ( cd_type) 
+  
+            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+               ztab(:, 1 ) = 0.e0
+               ztab(:,ijpj) = 0.e0
+
+            CASE ( 'F' )                                   ! F-point
+               ztab(:,ijpj) = 0.e0
+
+            CASE ( 'I' )                                   ! ice U-V point
+               ztab(:, 1 ) = 0.e0
+               ztab(:,ijpj) = 0.e0
+
+            END SELECT
+
+         END SELECT
+
+         !     End of slab
+         !     ===========
+
+         !! Scatter back to pt2d
+         DO jr = 1, ndim_rank_north
+            jproc=nrank_north(jr)+1
+            ildi=nldit (jproc)
+            ilei=nleit (jproc)
+            iilb=nimppt(jproc)
+            DO jj=1,ijpj
+               DO ji=ildi,ilei
+                  znorthgloio(ji,jj,jr)=ztab(ji+iilb-1,jj)
+               END DO
+            END DO
+         END DO
+
+      ENDIF      ! only done on proc 0 of ncomm_north
+
+#ifdef key_mpp_shmem
+      not done yet in shmem : compiler error
+#elif key_mpp_mpi
+      IF ( npolj /= 0 ) THEN
+         itaille=jpi*ijpj
+         CALL MPI_SCATTER(znorthgloio,itaille,MPI_DOUBLE_PRECISION,znorthloc,itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
+      ENDIF
+#endif
+
+      ! put in the last ijpj jlines of pt2d znorthloc
+      DO jj = nlcj - ijpj + 1 , nlcj
+         ij = jj - nlcj + ijpj
+         pt2d(:,jj)= znorthloc(:,ij)
+      END DO
+
+   END SUBROUTINE mpp_lbc_north_2d
+
+
+   SUBROUTINE mpp_lbc_north_e ( pt2d, cd_type, psgn)
+    !!---------------------------------------------------------------------
+    !!                   ***  routine mpp_lbc_north_2d  ***
+    !!
+    !! ** Purpose :
+    !!      Ensure proper north fold horizontal bondary condition in mpp configuration
+    !!      in case of jpn1 > 1 (for 2d array with outer extra halo)
+    !!
+    !! ** Method :
+    !!      Gather the 4+2*jpr2dj northern lines of the global domain on 1 processor and 
+    !!      apply lbc north-fold on this sub array. Then scatter the fold array 
+    !!      back to the processors.
+    !!
+    !! History :
+    !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
+    !!                                  from lbc routine
+    !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
+    !!   9.0  !  05-09  (R. Benshila )   adapt mpp_lbc_north_2d 
+    !!----------------------------------------------------------------------
+
+    !! * Arguments
+    CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt2d grid-points
+    !             !   = T ,  U , V , F or W  gridpoints
+    REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+    REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+    !             !   = -1. , the sign is changed if north fold boundary
+    !             !   =  1. , the sign is kept  if north fold boundary
+
+
+    !! * Local declarations
+
+    INTEGER :: ji, jj,  jr, jproc, jl
+    INTEGER :: ierr
+    INTEGER :: ildi,ilei,iilb
+    INTEGER :: ijpj,ijpjm1,ij,ijt,iju, iprecj
+    INTEGER :: itaille
+
+    REAL(wp), DIMENSION(jpiglo,1-jpr2dj:4+jpr2dj) :: ztab
+    REAL(wp), DIMENSION(jpi,1-jpr2dj:4+jpr2dj,jpni) :: znorthgloio
+    REAL(wp), DIMENSION(jpi,1-jpr2dj:4+jpr2dj) :: znorthloc
+
+    ! If we get in this routine it s because : North fold condition and mpp with more
+    !   than one proc across i : we deal only with the North condition
+
+    ! 0. Sign setting
+    ! ---------------
+
+    ijpj=4
+    ijpjm1=3
+    iprecj = jpr2dj+jprecj
+
+    ! put in znorthloc the last 4 jlines of pt2d
+    DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
+       ij = jj - nlcj + ijpj
+       znorthloc(:,ij)=pt2d(1:jpi,jj)
+    END DO
+
+    IF (npolj /= 0 ) THEN
+       ! Build in proc 0 of ncomm_north the znorthgloio
+       znorthgloio(:,:,:) = 0_wp
+#ifdef key_mpp_shmem
+       not done : compiler error
+#elif defined key_mpp_mpi
+       itaille=jpi*(ijpj+2*jpr2dj)
+       CALL MPI_GATHER(znorthloc(1,1-jpr2dj),itaille,MPI_DOUBLE_PRECISION, &
+                     & znorthgloio(1,1-jpr2dj,1),itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
+#endif
+    ENDIF
+
+    IF (narea == north_root+1 ) THEN
+       ! recover the global north array
+       ztab(:,:) = 0_wp
+
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jj=1-jpr2dj,ijpj+jpr2dj
+             DO ji=ildi,ilei
+                ztab(ji+iilb-1,jj)=znorthgloio(ji,jj,jr)
+             END DO
+          END DO
+       END DO
+
+
+       ! 2. North-Fold boundary conditions
+       ! ----------------------------------
+
+       SELECT CASE ( npolj )
+
+       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+
+          ztab( 1    ,ijpj:ijpj+jpr2dj) = 0.e0
+          ztab(jpiglo,ijpj:ijpj+jpr2dj) = 0.e0
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'W' , 'S' )                         ! T-, W-point
+             DO jl =0, iprecj-1
+                DO ji = 2, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-2-jl)
+                END DO
+             END DO
+             DO ji = jpiglo/2+1, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
+             END DO
+
+          CASE ( 'U' )                                     ! U-point
+             DO jl =0, iprecj-1
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-2-jl)
+                END DO
+             END DO
+             DO ji = jpiglo/2, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
+             END DO
+
+          CASE ( 'V' )                                     ! V-point
+            DO jl =-1, iprecj-1
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-3-jl)
+               END DO
+            END DO
+
+          CASE ( 'F' , 'G' )                               ! F-point
+            DO jl =-1, iprecj-1
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-3-jl)
+               END DO
+             END DO
+
+          CASE ( 'I' )                                     ! ice U-V point
+             DO jl =0, iprecj-1
+                ztab(2,ijpj+jl) = psgn * ztab(3,ijpj-1+jl)
+                DO ji = 3, jpiglo
+                   iju = jpiglo - ji + 3
+                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-1-jl)
+                END DO
+             END DO
+
+          END SELECT
+
+       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+
+          ztab( 1 ,ijpj:ijpj+jpr2dj) = 0.e0
+          ztab(jpiglo,ijpj:ijpj+jpr2dj) = 0.e0
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'W' ,'S' )                          ! T-, W-point
+             DO jl = 0, iprecj-1
+                DO ji = 1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-1-jl)
+                END DO
+             END DO
+
+          CASE ( 'U' )                                     ! U-point
+             DO jl = 0, iprecj-1
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-1-jl)
+                END DO
+             END DO
+
+          CASE ( 'V' )                                     ! V-point
+             DO jl = 0, iprecj-1
+                DO ji = 1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpj+jl) = psgn * ztab(ijt,ijpj-2-jl)
+                END DO
+             END DO
+             DO ji = jpiglo/2+1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
+             END DO
+
+          CASE ( 'F' , 'G' )                               ! F-point
+             DO jl = 0, iprecj-1
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpj+jl) = psgn * ztab(iju,ijpj-2-jl)
+                END DO
+             END DO
+             DO ji = jpiglo/2+1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
+             END DO
+
+             CASE ( 'I' )                                  ! ice U-V point
+                ztab( 2 ,ijpj:ijpj+jpr2dj) = 0.e0
+                DO jl = 0, jpr2dj
+                   DO ji = 2 , jpiglo-1
+                      ijt = jpi - ji + 2
+                      ztab(ji,ijpj+jl)= 0.5 * ( ztab(ji,ijpj-1-jl) + psgn * ztab(ijt,ijpj-1-jl) )
+                   END DO
+                END DO
+
+          END SELECT
+
+       CASE DEFAULT                           ! *  closed : the code probably never go through
+
+            SELECT CASE ( cd_type) 
+  
+            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+               ztab(:, 1:1-jpr2dj     ) = 0.e0
+               ztab(:,ijpj:ijpj+jpr2dj) = 0.e0
+
+            CASE ( 'F' )                                   ! F-point
+               ztab(:,ijpj:ijpj+jpr2dj) = 0.e0
+
+            CASE ( 'I' )                                   ! ice U-V point
+               ztab(:, 1:1-jpr2dj     ) = 0.e0
+               ztab(:,ijpj:ijpj+jpr2dj) = 0.e0
+
+            END SELECT
+
+         END SELECT
+
+         !     End of slab
+         !     ===========
+
+         !! Scatter back to pt2d
+         DO jr = 1, ndim_rank_north
+            jproc=nrank_north(jr)+1
+            ildi=nldit (jproc)
+            ilei=nleit (jproc)
+            iilb=nimppt(jproc)
+            DO jj=1-jpr2dj,ijpj+jpr2dj
+               DO ji=ildi,ilei
+                  znorthgloio(ji,jj,jr)=ztab(ji+iilb-1,jj)
+               END DO
+            END DO
+         END DO
+
+      ENDIF      ! only done on proc 0 of ncomm_north
+
+#ifdef key_mpp_shmem
+      not done yet in shmem : compiler error
+#elif key_mpp_mpi
+      IF ( npolj /= 0 ) THEN
+         itaille=jpi*(ijpj+2*jpr2dj)
+         CALL MPI_SCATTER(znorthgloio(1,1-jpr2dj,1),itaille,MPI_DOUBLE_PRECISION, &
+                        & znorthloc(1,1-jpr2dj),itaille,MPI_DOUBLE_PRECISION,0,ncomm_north,ierr)
+      ENDIF
+#endif
+
+      ! put in the last ijpj jlines of pt2d znorthloc
+      DO jj = nlcj - ijpj  -jpr2dj + 1 , nlcj +jpr2dj
+         ij = jj - nlcj + ijpj 
+         pt2d(1:jpi,jj)= znorthloc(:,ij)
+      END DO
+
+   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
+#     include <mpif.h>
+
+      INTEGER                                 :: code,rang
+ 
+      ! 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)
+
+   END SUBROUTINE mpi_init_opa
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_isl
+      MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real
+   END INTERFACE
+   INTERFACE mppobc
+      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
+   END INTERFACE
+  INTERFACE mpp_minloc
+     MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+  END INTERFACE
+  INTERFACE mpp_maxloc
+     MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+  END INTERFACE
+
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+
+CONTAINS
+
+   FUNCTION mynode() RESULT (function_value)
+      function_value = 0
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   SUBROUTINE mpp_sum_as( parr, kdim )      ! Dummy routine
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1)
+   END SUBROUTINE mpp_sum_as
+
+   SUBROUTINE mpp_sum_a2s( parr, kdim )      ! Dummy routine
+      REAL   , DIMENSION(:,:) :: parr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1)
+   END SUBROUTINE mpp_sum_a2s
+
+   SUBROUTINE mpp_sum_ai( karr, kdim )      ! Dummy routine
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1)
+   END SUBROUTINE mpp_sum_ai
+
+   SUBROUTINE mpp_sum_s( psca )            ! Dummy routine
+      REAL                  :: psca
+      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca
+   END SUBROUTINE mpp_sum_s
+
+   SUBROUTINE mpp_sum_i( kint )            ! Dummy routine
+      integer               :: kint
+      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint
+   END SUBROUTINE mpp_sum_i
+
+   SUBROUTINE mppmax_a_real( parr, kdim )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1)
+   END SUBROUTINE mppmax_a_real
+
+   SUBROUTINE mppmax_real( psca )
+      REAL                  :: psca
+      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca
+   END SUBROUTINE mppmax_real
+
+   SUBROUTINE mppmin_a_real( parr, kdim )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1)
+   END SUBROUTINE mppmin_a_real
+
+   SUBROUTINE mppmin_real( psca )
+      REAL                  :: psca
+      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca
+   END SUBROUTINE mppmin_real
+
+   SUBROUTINE mppmin_a_int( karr, kdim )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1)
+   END SUBROUTINE mppmin_a_int
+
+   SUBROUTINE mppmin_int( kint )
+      INTEGER               :: kint
+      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint
+   END SUBROUTINE mppmin_int
+
+   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
+    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+    REAL, DIMENSION(:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?',   &
+         &        parr(1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_1d
+
+   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
+    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+    REAL, DIMENSION(:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?',   &
+         &        parr(1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_2d
+
+   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
+    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+    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
+   END SUBROUTINE mppobc_3d
+
+   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
+    INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+    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
+   END SUBROUTINE mppobc_4d
+
+
+   SUBROUTINE mpplnks( parr )            ! Dummy routine
+      REAL, DIMENSION(:,:) :: parr
+      WRITE(*,*) 'mpplnks: You should not have seen this print! error?', parr(1,1)
+   END SUBROUTINE mpplnks
+
+   SUBROUTINE mppisl_a_int( karr, kdim )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mppisl_a_int: You should not have seen this print! error?', kdim, karr(1)
+   END SUBROUTINE mppisl_a_int
+
+   SUBROUTINE mppisl_int( kint )
+      INTEGER               :: kint
+      WRITE(*,*) 'mppisl_int: You should not have seen this print! error?', kint
+   END SUBROUTINE mppisl_int
+
+   SUBROUTINE mppisl_a_real( parr, kdim )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      WRITE(*,*) 'mppisl_a_real: You should not have seen this print! error?', kdim, parr(1)
+   END SUBROUTINE mppisl_a_real
+
+   SUBROUTINE mppisl_real( psca )
+      REAL                  :: psca
+      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', psca
+   END SUBROUTINE mppisl_real
+
+   SUBROUTINE mpp_minloc2d ( ptab, pmask, pmin, ki, kj )
+      REAL                   :: pmin
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmin, ki, kj
+      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_minloc2d
+
+   SUBROUTINE mpp_minloc3d ( ptab, pmask, pmin, ki, kj, kk )
+      REAL                     :: pmin
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmin, ki, kj, kk
+      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_minloc3d
+
+   SUBROUTINE mpp_maxloc2d ( ptab, pmask, pmax, ki, kj )
+      REAL                   :: pmax
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmax, ki, kj
+      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_maxloc2d
+
+   SUBROUTINE mpp_maxloc3d ( ptab, pmask, pmax, ki, kj, kk )
+      REAL                     :: pmax
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mppisl_real: You should not have seen this print! error?', pmax, ki, kj, kk
+      WRITE(*,*) '   "      ":             "                 "            ', ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_maxloc3d
+
+   SUBROUTINE mppstop
+      WRITE(*,*) 'mppstop: You should not have seen this print! error?'
+   END SUBROUTINE mppstop
+
+#endif
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: trunk/NEMO/OFF_SRC/lib_print.f90
===================================================================
--- trunk/NEMO/OFF_SRC/lib_print.f90	(revision 325)
+++ trunk/NEMO/OFF_SRC/lib_print.f90	(revision 325)
@@ -0,0 +1,265 @@
+MODULE lib_print
+   !!======================================================================
+   !!                    ***  MODULE  lib_print  ***
+   !! print librairy :  formated real and integer array print
+   !!=====================================================================
+      
+   !!----------------------------------------------------------------------
+   !!   prihin       : print an integer 2D horizontal field
+   !!   prihre       : print an real 2D horizontal field
+   !!   prizre       : print an real 2D vertical field
+   !!----------------------------------------------------------------------
+   !! * Mules used
+   USE par_kind      ! kind parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC prihin, prihre, prizre
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE prihin( ktab, ki   , kj   , kideb, kifin ,   &
+                      kind, kjdeb, kjfin, kjnd , kscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  prihre  ***
+      !!  
+      !! ** purpose :   Print an integer field
+      !!
+      !! ** method :   format of print is selected with the dummy argument kscale
+      !!
+      !! History :
+      !!        !  90-04 (0. Marti)  Original code
+      !!        !  92-02 (M. Imbard)
+      !!        !  03-07 (G. Madec)  F90, free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj,                 &  ! array dimensions
+         kideb, kifin, kind,     &  ! first and last index, increment for i 
+         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
+         kscale,                 &  ! kscale=0 or > 5  print ktab with format i8
+      !                             !         kscale=1 print ktab with format i1
+      !                             !         kscale=2 print ktab with format i2
+      !                             !         kscale=3 print ktab with format i3
+      !                             !         kscale=4 print ktab with format i4
+      !                             !         kscale=5 print ktab with format i5
+         kumout                     ! unit in which print
+      INTEGER, DIMENSION(ki,kj), INTENT( in ) ::   &
+         ktab                       ! integer 2D array to be print
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      INTEGER ::   iind, ijnd       ! temporary integers
+
+      isca = 10
+      IF( kscale == 0 )   isca = 10
+      IF( kscale == 1 )   isca = 100
+      IF( kscale == 2 )   isca = 60
+      IF( kscale == 3 )   isca = 40
+      IF( kscale == 4 )   isca = 30
+      IF( kscale == 5 )   isca = 20
+
+      iind = MAX( 1, kind )
+      ijnd = MAX( 1, kjnd )
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
+
+        IF( il1 > kifin ) RETURN
+        WRITE(kumout,'(/)')
+        il2 = il1+iind*(isca-1)
+        IF( il2 > kifin )   il2 = kifin
+
+        IF( kscale == 1 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)') il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,100i1)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 2 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,60i2)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 3 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,40i3)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 4 ) THEN
+            WRITE(kumout,'(4x,30i4,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,30i4)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 5 ) THEN
+            WRITE(kumout,'(4x,20i5,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,20i5)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSE
+            WRITE(kumout,'(4x,10i8,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,10i8)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ENDIF
+
+        il1 = il1 + iind * isca
+      END DO  
+
+   END SUBROUTINE prihin
+
+
+   SUBROUTINE prihre( ptab, ki   , kj   , kideb, kifin ,   &
+                      kind, kjdeb, kjfin, kjnd , pscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE prihre  ***
+      !!      
+      !! ** purpose :   Print a real field with the format 10e12.4 or 20f6.2
+      !!
+      !! ** method  :   the print format is selected with the pscale argument
+      !!
+      !! History :
+      !!   1.0  !  86-01  (P. Andrich)  Original code
+      !!        !  89-11  (C. Levy)
+      !!        !  92-02  (M. Imbard)
+      !!        !  92-06  (M. Imbard)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj,                 &  ! array dimensions
+         kideb, kifin, kind,     &  ! first and last index, increment for i
+         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
+         kumout                     ! unit in which print
+      REAL(wp), INTENT( in ) ::   &
+         pscale                     ! = 0  print        ptab with e13.5 format
+         !                          ! else print pscale*ptab with f6.2 format
+      REAL(wp), DIMENSION(ki,kj), INTENT( in ) ::   &
+         ptab                       ! integer 2D array to be print
+
+      !! * Local variables
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+
+      isca = 10
+      IF( pscale /= 0. )   isca=20
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(kind*isca) + 1
+
+        IF( il1 > kifin )   RETURN
+
+        WRITE(kumout,9100)
+
+        il2 = il1+kind*(isca-1)
+        IF(il2 > kifin) il2 = kifin
+        IF( pscale == 0.) THEN
+            WRITE(kumout,9101) ( ji, ji = il1, il2, kind )
+            DO jj = kjfin, kjdeb, -kjnd
+              WRITE(kumout,9102) jj, ( ptab(ji,jj), ji = il1, il2, kind )
+            END DO  
+        ELSE
+            WRITE(kumout,9103) ( ji, ji = il1, il2, kind )
+            DO jj = kjfin, kjdeb, -kjnd
+              WRITE(kumout,9104) jj, ( pscale*ptab(ji,jj), ji = il1, il2, kind )
+            END DO  
+        ENDIF
+        il1 = il1+kind*isca
+
+      END DO  
+
+      ! formats
+ 9100 FORMAT(/)
+ 9101 FORMAT(10i12, /)
+ 9102 FORMAT(1x, i3, 10(1pe12.4))
+ 9103 FORMAT(3x, 20i6, /)
+ 9104 FORMAT(1x, i3, 1x, 20f6.2)
+
+   END SUBROUTINE prihre
+
+
+   SUBROUTINE prizre( ptab , ki   , kj   , kk   , kjcut ,   &
+                      kideb, kifin, kid  , kkdeb, kkfin ,   &
+                      kkd  , pscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE prizre  ***
+      !!
+      !! ** purpose :   Print a vertical slab from a tridimentional real field
+      !!
+      !!   METHOD :
+      !! ** method  :   the print format is selected with the argument pscale
+      !!
+      !! History :
+      !!      original : 86-01 (o. Marti)
+      !!      addition : 92-02 (M. Imbard)
+      !!      addition : 92-06 (M. Imbard)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj, kk,             &  ! array dimensions
+         kjcut,                  &  ! index j for the vertical slab
+         kideb, kifin, kid,      &  ! first and last index, increment for i
+         kkdeb, kkfin, kkd,      &  ! first and last index, increment for k
+         kumout                     ! unit in which print
+      REAL(wp), INTENT( in ) ::   &
+         pscale                     ! = 0  print        ptab with e12.4 format
+         !                          ! else print pscale*ptab with f6.2 format
+      REAL(wp), DIMENSION(ki,kj,kk), INTENT( in ) ::   &
+         ptab                       ! integer 3D array to be print
+
+      !! * Local variables
+      INTEGER ::   ji, jn, jk       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      INTEGER ::   iind, iknd       !    "          "
+
+
+      iind = kid
+      iknd = kkd
+      isca = 10
+      IF( pscale /= 0.) isca = 20
+
+      IF (iind == 0) iind = 1
+      IF (iknd == 0) iknd = 1
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
+
+        IF(il1 > kifin) RETURN
+        WRITE(kumout,9100)
+        il2 = il1+iind*(isca-1)
+        IF(il2 > kifin) il2 = kifin
+
+        IF( pscale == 0.) THEN
+            WRITE(kumout,9101) ( ji, ji = il1, il2, iind )
+            DO jk = kkdeb, kkfin, iknd
+              WRITE (kumout,9102) jk, ( ptab(ji,kjcut,jk), ji = il1, il2, iind )
+            END DO  
+        ELSE
+            WRITE (kumout,9103) ( ji, ji = il1, il2, iind )
+            DO jk = kkdeb, kkfin, iknd
+              WRITE(kumout,9104)jk, ( pscale*ptab(ji,kjcut,jk), ji = il1, il2, iind )
+            END DO  
+        ENDIF
+
+        il1 = il1+iind*isca
+      END DO      
+
+ 9100 FORMAT(/)
+ 9101 FORMAT(10i12, /)
+ 9102 FORMAT(1x, i3, 10(1pe12.4))
+ 9103 FORMAT(3x, 20i6, /)
+ 9104 FORMAT(1x, i3, 1x, 20f6.1)
+
+      END SUBROUTINE prizre
+
+   !!======================================================================
+END MODULE lib_print
Index: trunk/NEMO/OFF_SRC/model.f90
===================================================================
--- trunk/NEMO/OFF_SRC/model.f90	(revision 325)
+++ trunk/NEMO/OFF_SRC/model.f90	(revision 325)
@@ -0,0 +1,21 @@
+PROGRAM model
+   !!----------------------------------------------------------------------
+   !!                     ***  PROGRAM model  ***
+   !!
+   !! ** Purpose :   encapsulate the opa model so that opa can also be 
+   !!      called together with the adjoint and linear tangent models
+   !!
+   !! History :
+   !!   8.0  !  01-02  (M. Imbard, A. Weaver)  Original code
+   !!   9.0  !  03-10  (G. Madec) F90
+   !!----------------------------------------------------------------------
+   USE opa                  ! OPA system     (opa_model routine)
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+ 
+   CALL opa_model           ! OPA system
+ 
+END PROGRAM model
Index: trunk/NEMO/OFF_SRC/module_example
===================================================================
--- trunk/NEMO/OFF_SRC/module_example	(revision 325)
+++ trunk/NEMO/OFF_SRC/module_example	(revision 325)
@@ -0,0 +1,211 @@
+MODULE exampl
+   !!======================================================================
+   !!                       ***  MODULE  example  ***
+   !! Ocean physics:  brief description of the purpose of the module
+   !!                 (please no more than 2 lines)
+   !!=====================================================================
+#if defined key_example
+   !!----------------------------------------------------------------------
+   !!   'key_example'  :                brief description of the key option
+   !!----------------------------------------------------------------------
+   !!   exa_mpl      : liste of module subroutine (caution, never use the
+   !!   exa_mpl_init : name of the module for a routine)
+   !!   exa_mpl_stp  : Please try to use 3 letter block for routine names
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE module_name1            ! brief description of the used module
+   USE module_name2            ! ....
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC exa_mpl    ! routine called in xxx.F90 module
+
+   !! * Share Module variables
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !:
+      var1    ,   &  !: var1 description (CAUTION always use !: to describe a 
+      !              !  PUBLIC variable simplify the search of where it is declared
+      var2           !: var2 description
+
+   !! * Module variables
+   INTEGER ::                 & !!! ** toto namelist (namtoto) **
+      nflag  =  1                ! default value of nflag 
+   REAL(wp) ::                & !!! ** toto namlist (namtoto) **
+      var3  = 2._wp / 9._wp      ! default value of var3
+   REAL(wp) ::   &  
+      var4          ! var4 description (local permanent variable)
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      tab1          ! coefficient used for horizontal smoothing
+
+   !! * Substitutions
+#  include "exampl_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! or LIM 2.0 , UCL-LOCEAN-IPSL (2005)
+   !! or  TOP 1.0 , LOCEAN-IPSL (2005)
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking'                              autotasking (j-slab)
+   !!----------------------------------------------------------------------
+#  include "exampl_autotsk.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                           vector opt. (k-j-i loop)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE exa_mpl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE exa_mpl  ***
+      !!
+      !! ** Purpose :   Brief description of the routine
+      !!
+      !! ** Method  :   description of the methodoloy used to achieve the
+      !!      objectives of the routine. Be as clear as possible!
+      !!
+      !! ** Action  : - first action (share memory array/varible modified
+      !!                in this routine
+      !!              - second action .....
+      !!              - .....
+      !!
+      !! References :
+      !!   Give references if exist otherwise suppress these lines
+      !!
+      !! History :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!        !  02-08  (Author names)  brief description of modifications
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE toto_module                ! description od the module
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   &  
+         kt                          ! describe it!!!
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk        ! dummy loop arguments
+      INTEGER ::   &
+         itoto, itata,            &  ! temporary integers
+         ititi                       ! please do not forget the DOCTOR rule:
+         !                           ! local integer: name start with i
+      REAL(wp) ::   &
+         zmlmin, zbbrau,          &  ! temporary scalars
+         zfact1, zfact2, zfact3,  &  !    "         "
+         zbn2, zesurf,            &  ! local scalar: name start with z
+         zemxl                       !
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         ztoto                       ! temporary workspace
+      !!--------------------------------------------------------------------
+
+
+
+      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only)
+
+      ! Local constant initialization
+      zmlmin = 1.e-8
+      zbbrau =  .5 * ebb / rau0
+      zfact1 = -.5 * rdt * efave
+      zfact2 = 1.5 * rdt * ediss
+      zfact3 = 0.5 * rdt * ediss
+
+
+      SELECT CASE ( npdl )
+
+      CASE ( 0 )           ! describe case 1
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmv(ji,jj,jk) = ....
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )           ! describe case 2
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmv(ji,jj,jk) = ...
+               END DO
+            END DO
+         END DO
+
+      END SELECT
+
+      ! Lateral boundary conditions (avmu)   (unchanged sign)
+      CALL mpplnk2( avmu, 'U', 1. )
+
+   END SUBROUTINE exa_mpl
+
+# endif
+
+   SUBROUTINE exa_mpl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE exa_mpl_init  ***
+      !!                   
+      !! ** Purpose :   initialization of ....
+      !!
+      !! ** Method  :   blah blah blah ...
+      !!
+      !! ** input   :   Namlist namexa
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
+
+      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0  
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namexa : example parameters
+      REWIND ( numnam )
+      READ   ( numnam, namexa )
+
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'exa_mpl_init : example '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namexa : set example parameters'
+         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '             brief desciption               nexa_0  = ', nexa_0
+      ENDIF
+
+      ! Parameter control
+#if defined key_toto
+      IF(lwp) WRITE(numout,cform_err)
+      IF(lwp) WRITE(numout,*) '          this part and key_toto are incompatible'
+      nstop = nstop + 1
+#endif
+
+      ! Check nexa_0 values
+      IF( nexa_0 < 0 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag: nmxl is < 0 or > 3 '
+         nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE exa_mpl_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE exa_mpl              ! Empty routine
+   END SUBROUTINE exa_mpl
+#endif
+
+   !!======================================================================
+END MODULE exampl
Index: trunk/NEMO/OFF_SRC/mppini.F90
===================================================================
--- trunk/NEMO/OFF_SRC/mppini.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/mppini.F90	(revision 325)
@@ -0,0 +1,544 @@
+MODULE mppini
+   !!==============================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   mpp_init       : Lay out the global domain over processors
+   !!   mpp_init2      : Lay out the global domain over processors 
+   !!                    with land processor elimination
+   !!   mpp_init_ioispl: IOIPSL initialization in mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O Manager
+   USE lib_mpp         ! distribued memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if ! defined key_mpp_mpi   &&   ! defined key_mpp_shmem
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!      variables to the value of the global domain
+      !!
+      !! History :
+      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
+      !!----------------------------------------------------------------------
+      ! No mpp computation
+
+      nimpp  = 1
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nperio = jperio
+      nbondi = 2
+      nbondj = 2
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~~~~: '
+         WRITE(numout,*) '         nperio = ', nperio
+         WRITE(numout,*) '         npolj  = ', npolj
+         WRITE(numout,*) '         nimpp  = ', nimpp
+         WRITE(numout,*) '         njmpp  = ', njmpp
+      ENDIF
+
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) THEN
+          IF(lwp)WRITE(numout,cform_err)
+          IF(lwp)WRITE(numout,*) 'equality  jpni = jpnj = jpnij = 1 is not satisfied'
+          IF(lwp)WRITE(numout,*) 'the domain is lay out for distributed memory computing! '
+          nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE mpp_init
+
+
+   SUBROUTINE mpp_init2 
+      CALL mpp_init                             ! same routine as mpp_init
+   END SUBROUTINE mpp_init2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
+   !!   'key_mpp_shmem'                 SHMEM massively parallel processing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action  : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   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
+      !!----------------------------------------------------------------------
+
+#if defined key_mpp_shmem
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+
+      CALL mppshmem                           ! Initialisation of shmem array
+
+#endif
+#if defined key_mpp_mpi
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+#endif
+
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes ilcit() ilcjt()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array (cf. par_oce.F90).
+      
+      nreci  = 2 * jpreci
+      nrecj  = 2 * jprecj
+      iresti = MOD( jpiglo - nreci , jpni )
+      irestj = MOD( jpjglo - nrecj , jpnj )
+
+      IF(  iresti == 0 )   iresti = jpni
+      DO jj = 1, jpnj
+         DO ji = 1, iresti
+            ilcit(ji,jj) = jpi
+         END DO
+         DO ji = iresti+1, jpni
+            ilcit(ji,jj) = jpi -1
+         END DO
+      END DO
+      
+      IF( irestj == 0 )   irestj = jpnj
+      DO ji = 1, jpni
+         DO jj = 1, irestj
+            ilcjt(ji,jj) = jpj
+         END DO
+         DO jj = irestj+1, jpnj
+            ilcjt(ji,jj) = jpj -1
+         END DO
+      END DO
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           defines mpp subdomains'
+         WRITE(numout,*) '           ----------------------'
+         WRITE(numout,*) '              iresti=',iresti,' irestj=',irestj
+         WRITE(numout,*) '              jpni=',jpni,' jpnj=',jpnj
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = 1, jpnj
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            il1 = il1+ifreq
+         END DO
+ 9200    FORMAT('     ***',20('*************',a3))
+ 9203    FORMAT('     *     ',20('         *   ',a3))
+ 9201    FORMAT('        ',20('   ',i3,'          '))
+ 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+      ENDIF
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
+      
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
+      IF(lwp) WRITE(numout,*)
+      
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      
+      IF( jpni > 1 ) THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 ) THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, jpnij
+         ii = 1 + MOD( jn-1, jpni )
+         ij = 1 + (jn-1) / jpni
+         nimppt(jn) = iimppt(ii,ij)
+         njmppt(jn) = ijmppt(ii,ij)
+         nlcit (jn) = ilcit (ii,ij)     
+         nlci       = nlcit (jn)     
+         nlcjt (jn) = ilcjt (ii,ij)     
+         nlcj       = nlcjt (jn)
+         nbondj = -1                                   ! general case
+         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
+         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
+         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
+         ibonjt(jn) = nbondj
+         
+         nbondi = 0                                    ! 
+         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
+         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
+         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
+         ibonit(jn) = nbondi
+         
+         nldi =  1   + jpreci
+         nlei = nlci - jpreci
+         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
+         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
+         nldj =  1   + jprecj
+         nlej = nlcj - jprecj
+         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
+         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
+         nldit(jn) = nldi
+         nleit(jn) = nlei
+         nldjt(jn) = nldj
+         nlejt(jn) = nlej
+      END DO
+      
+
+      ! 4. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 5. Subdomain neighbours
+      ! ----------------------
+
+      nproc = narea - 1
+      noso  = nproc - jpni
+      nowe  = nproc - 1
+      noea  = nproc + 1
+      nono  = nproc + jpni
+      ! great neighbours
+      npnw = nono - 1
+      npne = nono + 1
+      npsw = noso - 1
+      npse = noso + 1
+      nbsw = 1
+      nbnw = 1
+      IF( MOD( nproc, jpni ) == 0 ) THEN
+         nbsw = 0
+         nbnw = 0
+      ENDIF
+      nbse = 1
+      nbne = 1
+      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
+         nbse = 0
+         nbne = 0
+      ENDIF
+      IF(nproc < jpni) THEN
+         nbsw = 0
+         nbse = 0
+      ENDIF
+      IF( nproc >= (jpnj-1)*jpni ) THEN
+         nbnw = 0
+         nbne = 0
+      ENDIF
+      nlcj = nlcjt(narea)  
+      nlci = nlcit(narea)  
+      nldi = nldit(narea)
+      nlei = nleit(narea)
+      nldj = nldjt(narea)
+      nlej = nlejt(narea)
+      nbondi = ibonit(narea)
+      nbondj = ibonjt(narea)
+      nimpp  = nimppt(narea)  
+      njmpp  = njmppt(narea)  
+
+     ! Save processor layout in layout.dat file 
+       IF (lwp) THEN
+        inum = 11    
+
+        OPEN(inum,FILE='layout.dat')
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jn = 1, jpnij
+         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
+                                      nldit(jn), nldjt(jn), &
+                                      nleit(jn), nlejt(jn), &
+                                      nimppt(jn), njmppt(jn)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! w a r n i n g  narea (zone) /= nproc (processors)!
+
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+         IF( jpni == 1 )THEN
+            nbondi = 2
+            nperio = 1
+         ELSE
+            nbondi = 0
+         ENDIF
+         IF( MOD( narea, jpni ) == 0 ) THEN
+            noea = nproc-(jpni-1)
+            npne = npne-jpni
+            npse = npse-jpni
+         ENDIF
+         IF( MOD( narea, jpni ) == 1 ) THEN
+            nowe = nproc+(jpni-1)
+            npnw = npnw+jpni
+            npsw = npsw+jpni
+         ENDIF
+         nbsw = 1
+         nbnw = 1
+         nbse = 1
+         nbne = 1
+         IF( nproc < jpni ) THEN
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         IF( nproc >= (jpnj-1)*jpni ) THEN
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         ijm1 = jpni*(jpnj-1)
+         imil = ijm1+(jpni+1)/2
+         IF( narea > ijm1 ) npolj = 3
+         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
+         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+          ijm1 = jpni*(jpnj-1)
+          imil = ijm1+(jpni+1)/2
+          IF( narea > ijm1) npolj = 5
+          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
+          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+
+      ! FETI method
+
+      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
+         
+         ! general case : Earth == infinite tube
+         
+         nbnw = 1
+         npnw = narea
+         nbne = 1
+         npne = narea
+         nbsw = 1
+         npsw = (narea-2)
+         nbse = 1
+         npse = (narea-2)
+         
+         ! REAL boundary condition
+         
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         
+         IF( nbondj == 1  .OR. nbondj == 2 ) THEN 
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
+         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
+         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
+         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 )THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' mpp_init: error on cyclicity'
+         nstop = nstop + 1
+      ENDIF
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+      END IF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+#  include "mppini_2.h90"
+
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                  NO use of NetCDF files
+   !!----------------------------------------------------------------------
+   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
+   END SUBROUTINE mpp_init_ioipsl  
+# else
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec)  MPP-IOIPSL 
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      INTEGER, DIMENSION(4) ::   &
+         iglo, iloc, iabsf, iabsl, ihals, ihale   ! ???
+      !!----------------------------------------------------------------------
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iglo(3) = jpk
+      iglo(4) = 1
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iloc(3) = jpk
+      iloc(4) = 1
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsf(3) = 1
+      iabsf(4) = 1
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = jpreci
+      ihals(2) = jprecj
+      ihals(3) = 0
+      ihals(4) = 0
+      ihale(1) = jpreci
+      ihale(2) = jprecj
+      ihale(3) = 0
+      ihale(4) = 0
+      IF( nbondi == -1 .OR. nbondi == 2 )   ihals(1) = 0
+      IF( nbondi ==  1 .OR. nbondi == 2 )   ihale(1) = 0
+      IF( nbondj == -1 .OR. nbondj == 2 )   ihals(2) = 0
+      IF( nbondj ==  1 .OR. nbondj == 2 )   ihale(2) = 0
+      IF(lwp) THEN
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2), iloc (3), iloc (4)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2), iabsf(3), iabsf(4)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2), ihals(3), ihals(4)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2), ihale(3), ihale(4)
+      ENDIF
+
+      CALL ioipsl_inimpp( jpnij, nproc, iglo, iloc, iabsf, iabsl, ihals, ihale )
+
+   END SUBROUTINE mpp_init_ioipsl  
+
+# endif
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: trunk/NEMO/OFF_SRC/mppini_2.h90
===================================================================
--- trunk/NEMO/OFF_SRC/mppini_2.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/mppini_2.h90	(revision 325)
@@ -0,0 +1,616 @@
+   SUBROUTINE mpp_init2
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init2  ***
+      !!
+      !! * Purpose :   Lay out the global domain over processors.
+      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
+      !!     FOR DEFINING BETTER CUTTING OUT.
+      !!       This routine is used with a the bathymetry file.
+      !!       In this version, the land processors are avoided and the adress
+      !!     processor (nproc, narea,noea, ...) are calculated again.
+      !!     The jpnij parameter can be lesser than jpni x jpnj
+      !!     and this jpnij parameter must be calculated before with an
+      !!     algoritmic preprocessing program.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action :        nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! Local variables
+      CHARACTER (len=25) ::               &  ! temporary name
+                clname , clvar               ! filename and cdf variable name for bathy
+      LOGICAL ::   llbon                      ! check the existence of bathy files
+      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
+      INTEGER ::   inum = 11                  ! temporary logical unit
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,          &  ! temporary integers
+         icont, ili, ilj,                  &  !    "          "
+         isurf, ijm1, imil,                &  !    "          "
+         iino, ijno, iiso, ijso,           &  !    "          " 
+         iiea, ijea, iiwe, ijwe,           &  !    "          "
+         iinw, ijnw, iine, ijne,           &  !    "          "
+         iisw, ijsw, iise, ijse,           &  !    "          "
+         iresti, irestj, iproc                !    "          "
+      INTEGER, DIMENSION(jpnij) ::   &
+         iin, ijn          
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
+         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
+         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
+         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
+         ione  , ionw  , iose  , iosw  ,   &  !    "           "
+         ibne  , ibnw  , ibse  , ibsw         !    "           "
+      INTEGER  ::   &
+         ipi, ipj, ipk,              &  ! temporary integers
+         itime                          !    "          "
+      INTEGER, DIMENSION (1) ::   istep
+
+      INTEGER, DIMENSION(jpiglo,jpjglo) ::   &
+         imask                                ! temporary global workspace
+
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         zlamt, zphit, zdta                   ! temporary data workspace
+      REAL(wp), DIMENSION(jpk) ::   &   
+         zdept                                ! temporary workspace (NetCDF read)
+      REAL(wp) ::   zidom , zjdom,   &        ! temporary scalars
+         zdt, zdate0
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Header$ 
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+
+#if defined key_mpp_shmem
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+
+      CALL mppshmem     ! Initialisation of shmem array
+
+#endif
+#if defined key_mpp_mpi
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+#endif
+
+
+      IF( jpni*jpnj < jpnij ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible'
+         nstop = nstop + 1
+      ENDIF
+
+
+      ! 0. initialisation
+      ! -----------------
+
+      ! open the file
+         IF ( lk_zps ) THEN 
+            clname = 'bathy_meter.nc'         ! Meter bathy in case of partial steps
+            clvar = 'Bathymetry'
+         ELSE
+            clname = 'bathy_level.nc'                       ! Level bathymetry
+            clvar = 'Bathy_level'
+         ENDIF
+
+         INQUIRE( FILE=clname, EXIST=llbon )
+      IF( llbon ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         read bathymetry in ', clname
+            IF(lwp) WRITE(numout,*)
+            itime = 1
+            ipi = jpidta
+            ipj = jpjdta
+            ipk = 1
+            zdt = rdt
+
+            CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   &
+                           ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum )
+            CALL flinget( inum, clvar, jpidta, jpjdta, 1,   &
+                          itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) )
+            CALL flinclo( inum )
+      ELSE
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*)'    mppini_2 : unable to read the file ', clname
+         nstop = nstop + 1
+      ENDIF
+
+      ! land/sea mask over the global/zoom domain
+
+      imask(:,:)=1
+      WHERE ( zdta(jpizoom:(jpizoom+jpiglo-1),jpjzoom:(jpjglo+jpjzoom-1)) <= 0. ) imask = 0
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+
+      !  Computation of local domain sizes ilci() ilcj()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array.
+
+      nreci=2*jpreci
+      nrecj=2*jprecj
+      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
+      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
+
+      ilci(1:iresti      ,:) = jpi
+      ilci(iresti+1:jpni ,:) = jpi-1
+
+      ilcj(:,      1:irestj) = jpj
+      ilcj(:, irestj+1:jpnj) = jpj-1
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+
+      zidom = nreci + sum(ilci(:,1) - nreci ) 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
+
+      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
+      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
+      IF(lwp) WRITE(numout,*)
+
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      ipproc(:,:) = -1
+
+      IF( jpni > 1 )THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 )THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
+            END DO
+         END DO
+      ENDIF
+
+
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+
+      nperio = 0
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+
+         ibondj(ii,ij) = -1
+         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
+         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
+         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
+
+         ibondi(ii,ij) = 0
+         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
+         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
+         IF( jpni            == 1 )   ibondi(ii,ij) =  2
+
+         ! 2.4 Subdomain neighbors
+
+         iproc = jarea - 1
+         ioso(ii,ij) = iproc - jpni
+         iowe(ii,ij) = iproc - 1
+         ioea(ii,ij) = iproc + 1
+         iono(ii,ij) = iproc + jpni
+         ildi(ii,ij) = 1 + jpreci
+         ilei(ii,ij) = ili -jpreci
+         ionw(ii,ij) = iono(ii,ij) - 1
+         ione(ii,ij) = iono(ii,ij) + 1
+         iosw(ii,ij) = ioso(ii,ij) - 1
+         iose(ii,ij) = ioso(ii,ij) + 1
+         ibsw(ii,ij) = 1
+         ibnw(ii,ij) = 1
+         IF( MOD(iproc,jpni) == 0 ) THEN
+            ibsw(ii,ij) = 0
+            ibnw(ii,ij) = 0
+         ENDIF
+         ibse(ii,ij) = 1
+         ibne(ii,ij) = 1
+         IF( MOD(iproc,jpni) == jpni-1 ) THEN
+            ibse(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( iproc < jpni ) THEN
+            ibsw(ii,ij) = 0
+            ibse(ii,ij) = 0
+         ENDIF
+         IF( iproc >= (jpnj-1)*jpni ) THEN
+            ibnw(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
+         ildj(ii,ij) =  1  + jprecj
+         ilej(ii,ij) = ilj - jprecj
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
+
+         ! warning ii*ij (zone) /= nproc (processors)!
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            IF( jpni == 1 )THEN
+               ibondi(ii,ij) = 2
+               nperio = 1
+            ELSE
+               ibondi(ii,ij) = 0
+            ENDIF
+            IF( MOD(jarea,jpni) == 0 ) THEN
+               ioea(ii,ij) = iproc - (jpni-1)
+               ione(ii,ij) = ione(ii,ij) - jpni
+               iose(ii,ij) = iose(ii,ij) - jpni
+            ENDIF
+            IF( MOD(jarea,jpni) == 1 ) THEN
+               iowe(ii,ij) = iproc + jpni - 1
+               ionw(ii,ij) = ionw(ii,ij) + jpni
+               iosw(ii,ij) = iosw(ii,ij) + jpni 
+            ENDIF
+            ibsw(ii,ij) = 1
+            ibnw(ii,ij) = 1
+            ibse(ii,ij) = 1
+            ibne(ii,ij) = 1
+            IF( iproc < jpni ) THEN
+               ibsw(ii,ij) = 0
+               ibse(ii,ij) = 0
+            ENDIF
+            IF( iproc >= (jpnj-1)*jpni ) THEN
+               ibnw(ii,ij) = 0
+               ibne(ii,ij) = 0
+            ENDIF
+         ENDIF
+         ipolj(ii,ij) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+
+         isurf = 0
+         DO jj = 1+jprecj, ilj-jprecj
+            DO  ji = 1+jpreci, ili-jpreci
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      ! Control
+      IF(icont+1 /= jpnij) THEN
+         IF(lwp) THEN 
+            WRITE(numout,*) ' Eliminate land processors algorithm'
+            WRITE(numout,*)
+            WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj
+            WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj' 
+            WRITE(numout,*)
+            WRITE(numout,*) ' E R R O R '
+            WRITE(numout,*) ' ***********, mpp_init2 finds jpnij=',icont+1
+            WRITE(numout,*) ' we stop'
+         ENDIF
+         STOP 'mpp_init2'
+      ENDIF
+
+
+      ! 4. Subdomain print
+      ! ------------------
+
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1,(jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = 1, jpnj
+               ! WRITE(numout,9400)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+               ! WRITE(numout,9400)
+            END DO
+            il1 = il1+ifreq
+         END DO
+ 9400     FORMAT('     ***',20('*************',a3))
+ 9403     FORMAT('     *     ',20('         *   ',a3))
+ 9401     FORMAT('        ',20('   ',i3,'          '))
+ 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+
+      ! 5. neighbour treatment
+      ! ----------------------
+
+      DO jarea = 1, jpni*jpnj
+         iproc = jarea-1
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
+            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD(iono(ii,ij),jpni)
+            ijno = 1 +    (iono(ii,ij))/jpni
+            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
+            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD(ioso(ii,ij),jpni)
+            ijso = 1 +    (ioso(ii,ij))/jpni
+            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
+            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
+            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
+            iiea = 1 + MOD(ioea(ii,ij),jpni)
+            ijea = 1 +    (ioea(ii,ij))/jpni
+            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
+            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
+            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD(iowe(ii,ij),jpni)
+            ijwe = 1 +    (iowe(ii,ij))/jpni
+            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
+            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
+            iine = 1 + MOD(ione(ii,ij),jpni)
+            ijne = 1 +    (ione(ii,ij))/jpni
+            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
+            iisw = 1 + MOD(iosw(ii,ij),jpni)
+            ijsw = 1 +    (iosw(ii,ij))/jpni
+            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
+            iinw = 1 + MOD(ionw(ii,ij),jpni)
+            ijnw = 1 +    (ionw(ii,ij))/jpni
+            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
+            iise = 1 + MOD(iose(ii,ij),jpni)
+            ijse = 1 +    (iose(ii,ij))/jpni
+            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
+         ENDIF
+      END DO
+
+
+      ! 6. Change processor name
+      ! ------------------------
+
+      nproc = narea-1
+      ii = iin(narea)
+      ij = ijn(narea)
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         ijso = 1 +    (ioso(ii,ij))/jpni
+         noso = ipproc(iiso,ijso)
+      ENDIF
+      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiwe = 1 + MOD(iowe(ii,ij),jpni)
+         ijwe = 1 +    (iowe(ii,ij))/jpni
+         nowe = ipproc(iiwe,ijwe)
+      ENDIF
+      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiea = 1 + MOD(ioea(ii,ij),jpni)
+         ijea = 1 +    (ioea(ii,ij))/jpni
+         noea = ipproc(iiea,ijea)
+      ENDIF
+      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iino = 1 + MOD(iono(ii,ij),jpni)
+         ijno = 1 +    (iono(ii,ij))/jpni
+         nono = ipproc(iino,ijno)
+      ENDIF
+      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iise = 1 + MOD(iose(ii,ij),jpni)
+         ijse = 1 +    (iose(ii,ij))/jpni
+         npse = ipproc(iise,ijse)
+      ENDIF
+      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iisw = 1 + MOD(iosw(ii,ij),jpni)
+         ijsw = 1 +    (iosw(ii,ij))/jpni
+         npsw = ipproc(iisw,ijsw)
+      ENDIF
+      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iine = 1 + MOD(ione(ii,ij),jpni)
+         ijne = 1 +    (ione(ii,ij))/jpni
+         npne = ipproc(iine,ijne)
+      ENDIF
+      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iinw = 1 + MOD(ionw(ii,ij),jpni)
+         ijnw = 1 +    (ionw(ii,ij))/jpni
+         npnw = ipproc(iinw,ijnw)
+      ENDIF
+      nbnw = ibnw(ii,ij)
+      nbne = ibne(ii,ij)
+      nbsw = ibsw(ii,ij)
+      nbse = ibse(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)  
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij)  
+         nlcjt(jproc) = ilcj(ii,ij)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (lwp) THEN
+        OPEN(inum,FILE='layout.dat')
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jproc = 1, jpnij
+         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
+                                      nldit(jproc), nldjt(jproc), &
+                                      nleit(jproc), nlejt(jproc), &
+                                      nimppt(jproc), njmppt(jproc)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! FETI method
+
+      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
+
+         ! general CASE : Earth == infinite tube
+
+         nbnw = 1
+         npnw = narea
+         nbne = 1
+         npne = narea
+         nbsw = 1
+         npsw = (narea-2)
+         nbse = 1
+         npse = (narea-2)
+
+         ! REAL boundary condition
+
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+
+         IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+
+      IF( nperio == 1 .AND.jpni /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' mpp_init2:  error on cyclicity'
+         nstop = nstop + 1
+      ENDIF
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+
+      npolj = 0
+      ij = ijn(narea)
+
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         IF( ij == jpnj ) npolj = 3
+      ENDIF
+
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF( ij == jpnj ) npolj = 5
+      ENDIF
+      
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc=  ',nproc
+         WRITE(numout,*) ' nowe=   ',nowe
+         WRITE(numout,*) ' noea=   ',noea
+         WRITE(numout,*) ' nono=   ',nono
+         WRITE(numout,*) ' noso=   ',noso
+         WRITE(numout,*) ' nbondi= ',nbondi
+         WRITE(numout,*) ' nbondj= ',nbondj
+         WRITE(numout,*) ' npolj=  ',npolj
+         WRITE(numout,*) ' nperio= ',nperio
+         WRITE(numout,*) ' nlci=   ',nlci
+         WRITE(numout,*) ' nlcj=   ',nlcj
+         WRITE(numout,*) ' nimpp=  ',nimpp
+         WRITE(numout,*) ' njmpp=  ',njmpp
+         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
+         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
+         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
+         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
+      ENDIF
+
+   END SUBROUTINE mpp_init2
Index: trunk/NEMO/OFF_SRC/oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/oce.F90	(revision 325)
@@ -0,0 +1,46 @@
+MODULE oce
+   !!======================================================================
+   !!                      ***  MODULE  oce  ***
+   !! Ocean        :  dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! History :
+   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! dynamics and tracer fields
+   !! --------------------------
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
+      ! before !  now      !  after  !      ! the after trends becomes the fields
+      ! fields !  fields   !  trends !      ! only in dyn(tra)_zdf and dyn(tra)_nxt
+                  un       ,  ua     ,   &  !: i-horizontal velocity (m/s)
+                  vn       ,  va     ,   &  !: j-horizontal velocity (m/s)
+                  wn       ,             &  !: vertical velocity (m/s)
+                  hdivn    ,             &  !: horizontal divergence (1/s)
+                  tn       ,  ta     ,   &  !: potential temperature (celcius)
+                  sn       ,  sa            !: salinity (psu)
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !:
+      rhd ,                              &  !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
+      rhop,                              &  !: potential volumic mass (kg/m3)
+      rn2                                   !: brunt-vaisala frequency (1/s2)
+
+#if defined key_partial_steps     ||   defined key_esopa
+   !! interpolated gradient
+   !! ---------------------
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
+      gtu, gsu, gru,      &  !: t-, s- and rd horizontal gradient at u- and 
+      gtv, gsv, grv          !: v-points at bottom ocean level 
+#else
+   REAL(wp), PUBLIC ::   &   !:
+      gtu, gsu, gru,      &  !: dummy scalars
+      gtv, gsv, grv          !:
+#endif
+
+   !!----------------------------------------------------------------------
+END MODULE oce
Index: trunk/NEMO/OFF_SRC/ocfzpt.F90
===================================================================
--- trunk/NEMO/OFF_SRC/ocfzpt.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/ocfzpt.F90	(revision 325)
@@ -0,0 +1,72 @@
+MODULE ocfzpt
+   !!======================================================================
+   !!                       ***  MODULE  ocfzpt  ***
+   !! Ocean active tracers:  freezing point computation and freezing area
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC oc_fz_pt        ! called by opa.F90 and step.F90
+
+   !! * Shared module variables   
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !:
+      freeze, freezn,  &  !: after and now ice mask (0 or 1)
+      fzptb, fzptn        !: before and now freezing point
+   !!----------------------------------------------------------------------
+   !! OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE oc_fz_pt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE oc_fz_pt  ***
+      !!
+      !! ** Purpose : - Calculate ocean surface freezing temperature
+      !!              - Calculate related boolean for now ice distribution 
+      !!
+      !! ** Method  :   Caution, freezing point only for jackett & McDougall eos
+      !!
+      !! ** Action  : - fzptn  : now freezing temperature at ocean surface
+      !!              - fzptb  : before freezing temperature at ocean surface
+      !!              - freezn : boolean indicating freezing conditions at the 
+      !!                ocean surface at time step "now"
+      !!
+      !! History :
+      !!        !  94-08  (M.-A. Filiberti)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::  ji, jj      ! dummy loop indices
+      !!----------------------------------------------------------------------      
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            fzptb(ji,jj) = fzptn(ji,jj)        ! swap freezing point array
+
+            !                                  ! ocean local surface freezing temperature
+            !                                  ! sn >= 0 : this is verified in stpctl at each time step
+            fzptn (ji,jj) = ( -0.0575 + 1.710523e-3 * SQRT( sn(ji,jj,1) )   &
+                                      - 2.154996e-4 *       sn(ji,jj,1)   ) * sn(ji,jj,1)   !!   &
+            !!                        - 7.53e-4 * pressure
+
+            !                                  ! Define boolean related to freezing conditions
+            freezn(ji,jj) = tmask(ji,jj,1) * MAX( 0., SIGN( 1., fzptn(ji,jj) - tn(ji,jj,1) )  )
+         END DO
+      END DO
+
+   END SUBROUTINE oc_fz_pt
+
+   !!======================================================================
+END MODULE ocfzpt
Index: trunk/NEMO/OFF_SRC/opa.F90
===================================================================
--- trunk/NEMO/OFF_SRC/opa.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/opa.F90	(revision 325)
@@ -0,0 +1,187 @@
+MODULE opa
+   !!==============================================================================
+   !!                       ***  MODULE opa   ***
+   !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice)
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space domain variables
+   USE oce             ! dynamics and tracers variables
+   USE daymod          ! calendar
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+
+   USE domcfg          ! domain configuration               (dom_cfg routine)
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE domain          ! domain initialization             (dom_init routine)
+   USE istate          ! initial state setting          (istate_init routine)
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
+
+   ! ocean physics
+   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
+   USE zdfini
+   USE traqsr          ! solar radiation penetration   (tra_qsr_init routine)
+
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE dtadyn          ! Lecture and Interpolation of the dynamical fields
+   USE initrc          ! Initilization of the passive tracers
+   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
+   USE step            ! OPA time-stepping                  (stp     routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC opa_model      ! called by model.F90
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE opa_model
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE opa  ***
+      !!
+      !! ** Purpose :   opa solves the primitive equations on an orthogonal 
+      !!      curvilinear mesh on the sphere.
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!
+      !! References :
+      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
+      !!              internal report, IPSL.
+      !!
+      !! History :
+      !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code
+      !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec)
+      !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
+      !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,
+      !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1 
+      !!        !  92-06  (L.Terray) coupling implementation
+      !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice 
+      !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
+      !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray,
+      !!                   M.A. Filiberti, J. Vialar, A.M. Treguier,
+      !!                   M. Levy)  release 8.0
+      !!   8.1  !  97-06  (M. Imbard, G. Madec)
+      !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
+      !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
+      !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+      !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   istp       ! time step index
+      CHARACTER (len=64) ::        &
+         cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+      !!----------------------------------------------------------------------
+      
+      
+      ! Initializations
+      ! ===============
+      
+      ! open listing and namelist units
+      IF ( numout /= 0 .AND. numout /= 6 ) THEN 
+         OPEN( UNIT=numout, FILE='ocean.output', FORM='FORMATTED' )
+      ENDIF
+
+      ! Nodes selection
+      narea = mynode()
+      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 )
+      lwp   = narea == 1
+
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '                 L O D Y C - I P S L'
+         WRITE(numout,*) '                     O P A model'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '               version OPA 9.0  (2003)'
+         WRITE(numout,*)
+      ENDIF
+
+      !                                     ! ============================== !
+      !                                     !  Model general initialization  !
+      !                                     ! ============================== !
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+                                            ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN
+         CALL mpp_init                          ! standard cutting out
+      ELSE
+         CALL mpp_init2                         ! eliminate land processors
+      ENDIF
+      
+      CALL phy_cst                          ! Physical constants
+
+      CALL dom_cfg                          ! Domain configuration
+      
+      CALL dom_init                         ! Domain
+
+      CALL day( nit000 )                    ! Calendar
+
+      CALL istate_init                      ! ocean initial state (Dynamics and tracers)
+!!add
+                       CALL eos( tn, sn, rhd, rhop )        ! before potential and in situ densities
+
+                       CALL bn2( tn, sn, rn2 )              ! before Brunt-Vaisala frequency
+
+      IF( lk_zps    )   CALL zps_hde( nit000, tn, sn, rhd,  &  ! Partial steps: before Horizontal DErivative
+                                          gtu, gsu, gru, &  ! of t, s, rd at the bottom ocean level
+                                          gtv, gsv, grv )
+
+!!add
+
+      ! Initialization for the dynamics
+      !
+      CALL dta_dyn(nit000)     
+
+#if defined key_passivetrc
+      CALL ini_trc                           ! Passive tracers
+      IF( ln_ctl )    CALL prt_ctl_trc_init   ! Print control
+#endif
+
+      !                                     ! Ocean physics
+      CALL tra_qsr_init                         ! Solar radiation penetration
+
+      CALL ldf_tra_init                         ! Lateral ocean tracer physics
+
+      CALL zdf_init                             ! Vertical ocean physics
+
+      !                                     ! Ocean trends
+
+      !                                     ! =============== !
+      !                                     !  time stepping  !
+      !                                     ! =============== !
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+      istp = nit000
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )
+         CALL stp( istp )
+         istp = istp + 1
+      END DO
+      !                                     ! ========= !
+      !                                     !  Job end  !
+      !                                     ! ========= !
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+      IF( nstop /= 0 ) THEN                 ! error print
+      IF(lwp) WRITE(numout,cform_err)
+      IF(lwp) WRITE(numout,*) nstop, ' error have been found' 
+      ENDIF
+
+      IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp)
+
+   END SUBROUTINE opa_model
+
+   !!======================================================================
+END MODULE opa
Index: trunk/NEMO/OFF_SRC/par_EEL_R2.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_EEL_R2.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_EEL_R2.h90	(revision 325)
@@ -0,0 +1,87 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R2.h90  ***
+   !!   Ocean Domain : 2 km resolution Channel (EEL_R2 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &  !:
+      cp_cfg = "eel"            !: name of the configuration
+   INTEGER, PARAMETER ::     &  !:
+      jp_cfg = 2   ,         &  !: resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 83,          &  !: 1st horizontal dimension ( >= jpi )
+      jpjdta  = 242,         &  !: 2nd    "            "    ( >= jpj )
+      jpkdta  = 30,          &  !: number of levels         ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =     1 ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =     1 ,      &  !: number of islands
+      jpnisl  = jpiglo          !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp  , & !: ???
+      pp_to_be_computed =      0._wp      !: ???
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 3            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 2000.0_wp,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = 2000.0_wp       !: meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_EEL_R5.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_EEL_R5.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_EEL_R5.h90	(revision 325)
@@ -0,0 +1,86 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R5.h90  ***   
+   !!   Ocean Domain : 5 km resolution Channel (EEL_R5 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &  !:
+      cp_cfg = "eel"            !: name of the configuration
+   INTEGER, PARAMETER ::     &  !:
+      jp_cfg = 5      ,      &  !: resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files
+      jpidta  = 202   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 104   ,      &  !: second                     > or = to jpj
+      jpkdta  =  40   ,      &  !: number of levels           > or = to jpk
+
+      ! total domain size      !!! * full domain *
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =   0   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   1   ,      &  !: number of islands
+      jpnisl  = jpiglo          !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp ,  &  !:
+      pp_to_be_computed =      0._wp       !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 2            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (meters)
+      ppe2_m   = 5000.0_wp       !: meridional grid-spacing (meters)
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp), PARAMETER  ::       &   !:
+      &     ppsur = pp_to_be_computed       ,  &  !: Computed in domzgr, set ppdzmin, pphmax below
+      &     ppa0  = pp_to_be_computed       ,  &  !:
+      &     ppa1  = pp_to_be_computed       ,  &  !:
+      !
+      &     ppkth = 20._wp                  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr = 16.00000000000_wp             !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = 120._wp               ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 4000._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_EEL_R6.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_EEL_R6.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_EEL_R6.h90	(revision 325)
@@ -0,0 +1,86 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R6.h90  ***   
+   !!   Ocean Domain : 6 km resolution Channel (EEL_R6 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &  !:
+      cp_cfg = "eel"            !: name of the configuration
+   INTEGER, PARAMETER ::     &  !:
+      jp_cfg = 6      ,      &  !: resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 29,          &  !: 1st lateral dimension ( >= jpi )
+      jpjdta  = 83,          &  !: 2nd    "         "    ( >= jpj )
+      jpkdta  = 30,          &  !: number of levels      ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+
+      ! Domain characteristics
+      jperio  =      1,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =      1,      &  !: number of islands
+      jpnisl  = jpiglo          !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp ,  &  !: ???
+      pp_to_be_computed =      0._wp       !: ???
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 3            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 6000.0_wp,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = 6000.0_wp       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_GYRE.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_GYRE.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_GYRE.h90	(revision 325)
@@ -0,0 +1,91 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_GYRE.h90  ***
+   !!   Ocean Domain : GYRE configuration at 1/jp_cfg degree resolution 
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &  !:
+      cp_cfg = "gyre"           !: name of the configuration
+   INTEGER, PARAMETER ::     &  !:
+      jp_cfg =  1   ,        &  !: 
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 30*jp_cfg+2, &  !: 1st horizontal dimension ( >= jpi )
+      jpjdta  = 20*jp_cfg+2, &  !: 2nd    "            "    ( >= jpj )
+      jpkdta  = 101,         &  !: number of levels         ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =     0 ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =     1 ,      &  !: number of islands
+      jpnisl  = jpiglo          !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp  , & !: ???
+      pp_to_be_computed =      0._wp      !: ???
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 5            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+      !                        ! =5  beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   29.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,    &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used        !: meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = 0.e0      ,  &  !: Computed in domzgr
+      &     ppa0  = 0.e0      ,  &  !:
+      &     ppa1  = 0.e0      ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !    layer number above which  stretching will
+      !                                           !    be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !    for the grid. The highest zacr, the smallest
+      !                                           !    the stretching.
+
+   !!
+   !!  If all ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = 1.0e0   ,  &  !: (meters): depth of the top (first) model layer
+      !                             !            depth of second "w" level
+      &     pphmax  = 5000.         !: (meters): maximum depth of the ocean
+      !                             !            depth of the last "w" level
+
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_ORCA_R025.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_ORCA_R025.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_ORCA_R025.h90	(revision 325)
@@ -0,0 +1,83 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R025.h90  ***  
+   !!   Ocean Domain : 0.25 degrees resolution global ocean
+   !!                  (0RCA_R025 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 1021,        &  !: second                     > or = to jpj
+      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    4  ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  150  ,      &  !: number of islands
+      jpnisl  = 3000            !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
+      !                                     !: layer number above which  stretching will
+      !                                     !: be maximum. Usually of order jpk/2.
+      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
+      !                                     !: for the grid. The highest zacr, the smallest
+      !                                     !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_ORCA_R05.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_ORCA_R05.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_ORCA_R05.h90	(revision 325)
@@ -0,0 +1,115 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R05.h90  ***  
+   !!   Ocean Domain : 0.5 degrees resolution global ocean
+   !!                  (0RCA_R05 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 05  ,         &  !: resolution of the configuration (degrees)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 722,         &  !: 1st lateral dimension > or = to jpiglo
+      jpjdta  = 511,         &  !: 2nd   "         "     > or = to jpjglo
+      jpkdta  =  31,         &  !: number of levels      > or = to jpkglo
+
+#if defined key_antarctic
+      ! zoom domain size       !!! * antarctic zoom *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j 
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   1   ,      &  !: number of islands
+      jpnisl  =   1             !: maximum number of points per island
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+      jpiglo  = 562,         &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta-301+1,&  !: 2nd     "                 "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =  81   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom = 301   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   5   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   1   ,      &  !: number of islands
+      jpnisl  =   1             !: maximum number of points per island
+
+#else
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position    
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =    6  ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   79  ,      &  !: number of islands
+      jpnisl  = 2000            !: maximum number of points per island
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999._wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER, PARAMETER   ::   & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! =====================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_ORCA_R2.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_ORCA_R2.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_ORCA_R2.h90	(revision 325)
@@ -0,0 +1,139 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R2.h90  ***  
+   !!   Ocean Domain : 2 degrees resolution global ocean
+   !!                  (0RCA_R2 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::    &  
+      cp_cfg = "orca"           !: name of the configuration 
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 2,            &  !: resolution of the configuration (degrees)
+
+      ! data size              !!! * size of all input files *
+      jpidta  = 182,         &  !: 1st lateral dimension ( >= jpiglo )
+      jpjdta  = 149,         &  !: 2nd    "       "      ( >= jpjglo )
+      jpkdta  = 31,          &  !: number of levels      ( >= jpk    )
+
+#if defined key_antarctic
+      ! zoom domain size       !!! *  antarctic zoom  * 
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 50,          &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   3   ,      &  !: number of islands
+      jpnisl  = 400             !: maximum number of points per island
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+      jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta-97+1, &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position 
+      jpizoom =  21   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =  97   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   3   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   7   ,      &  !: number of islands
+      jpnisl  = 400             !: maximum number of points per island
+
+#elif defined key_cfg_1d
+      ! global domain size     !!! *  global domain  *
+      jpiglo  = 3     ,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 3     ,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom 
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   133  ,    &  !: in data domain indices (160W,75N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   110  ,    &  !: in data domain indices (160W,50N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   97   ,    &  !: in data domain indices (160W,30N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   86   ,    &  !: in data domain indices (160W,10N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   49   ,    &  !: in data domain indices (160W,30S)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   27   ,    &  !: in data domain indices (160W,60S)
+      jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =    7   ,    &  !: in data domain indices (160W,75S)
+      ! Domain characteristics
+      jperio  =   0   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  18   ,      &  !: number of islands
+      jpnisl  = 800             !: maximum number of points per island
+#else
+      ! global domain size     !!! *  global domain  *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom 
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   4   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  18   ,      &  !: number of islands
+      jpnisl  = 800             !: maximum number of points per island
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_ORCA_R4.h90
===================================================================
--- trunk/NEMO/OFF_SRC/par_ORCA_R4.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_ORCA_R4.h90	(revision 325)
@@ -0,0 +1,83 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R4.h90  ***   
+   !!   Ocean Domain : 4 degrees resolution global ocean
+   !!                  (0RCA_R4 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::    &
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 4      ,      &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  =  92   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  76   ,      &  !: second                     > or = to jpj
+      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
+      ! global domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   4   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  11   ,      &  !: number of islands
+      jpnisl  = 800             !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!---------------------------------------------------------------------
Index: trunk/NEMO/OFF_SRC/par_kind.F90
===================================================================
--- trunk/NEMO/OFF_SRC/par_kind.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_kind.F90	(revision 325)
@@ -0,0 +1,39 @@
+MODULE par_kind
+   !!======================================================================
+   !!                   ***  MODULE par_kind  ***
+   !! Ocean :  define the kind of real for the whole model
+   !!======================================================================
+   !! History :
+   !!   8.5   02/06  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PUBLIC, PARAMETER ::    &  !:
+      jpbyt   = 8       ,           &  !: real size for mpp communications
+      jpbytda = 4       ,           &  !: real size in input data files 4 or 8
+      jpbi3e  = 4                      !: real size for T3E
+
+   ! Number model from which the SELECTED_*_KIND are requested:
+   !             4 byte REAL       8 byte REAL
+   ! CRAY:           -            precision = 13
+   !                              exponent = 2465
+   ! IEEE:      precision = 6     precision = 15
+   !            exponent = 37     exponent = 307
+
+   INTEGER, PUBLIC, PARAMETER ::        &  !: Floating point section
+      sp = SELECTED_REAL_KIND( 6, 37),  &  !: single precision (real 4)
+      dp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+      wp = dp                              !: working precision
+
+   INTEGER, PUBLIC, PARAMETER ::        &  !: Integer section
+      i4 = SELECTED_INT_KIND(9) ,       &  !: single precision (integer 4)
+      i8 = SELECTED_INT_KIND(14)           !: double precision (integer 8)
+
+!!----------------------------------------------------------------------
+END MODULE par_kind
Index: trunk/NEMO/OFF_SRC/par_oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/par_oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/par_oce.F90	(revision 325)
@@ -0,0 +1,199 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! History :
+   !!   4.0  !  91     (Imbard, Levy, Madec)  Original code
+   !!   9.0  !  04-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind          ! kind parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! * if we dont use massively parallel computer (parameters jpni=jpnj=1)
+   !!      so jpiglo=jpi and jpjglo=jpj
+
+   INTEGER, PUBLIC, PARAMETER ::    &  !:
+      jpni   = 1,                   &  !: number of processors following i 
+      jpnj   = 1,                   &  !: number of processors following j
+      jpnij  = 1,                   &  !: nb of local domain = nb of processors 
+      !                                !  ( <= jpni x jpnj )
+      jpr2di = 0,                   &  !: number of columns for extra outer halo 
+      jpr2dj = 0,                   &  !: number of rows    for extra outer halo 
+      jpreci = 1,                   &  !: number of columns for overlap 
+      jprecj = 1                       !: number of rows    for overlap 
+
+   !! Ocean Domain sizes
+   !! ------------------
+   !!   data           domain   (jpidta,jpjdta)
+   !!   global or zoom domain   (jpiglo,jpjglo)
+   !!   local          domain   ( jpi  , jpj  )
+   
+#if   defined key_orca_r4
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r4'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R4.h90"
+#elif defined key_orca_r2
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r2'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R2.h90"
+#elif defined key_orca_r05
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r05'  :                          global ocean : ORCA R05
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R05.h90"
+#elif defined key_orca_r025
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r025' :                         global ocean : ORCA R025
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R025.h90"
+#elif defined key_eel_r2
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r2'    :                                 channel : EEL R2
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R2.h90"
+#elif defined key_eel_r5
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r5'    :                                 channel : EEL R5
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R5.h90"
+#elif defined key_eel_r6
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r6'    :                                 channel : EEL R6
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R6.h90"
+#elif defined key_gyre
+   !!---------------------------------------------------------------------
+   !!   'key_gyre'      :                        mid-latitude basin : GYRE
+   !!---------------------------------------------------------------------
+#             include "par_GYRE.h90"
+#else
+   !!---------------------------------------------------------------------
+   !!   default option  :                               small closed basin
+   !!---------------------------------------------------------------------
+   CHARACTER(len=16), PUBLIC, PARAMETER ::   &  !:
+      cp_cfg = "default"               !: name of the configuration
+   INTEGER, PARAMETER ::            &  !:
+      jp_cfg = 0  ,                 &  !: resolution of the configuration
+
+      ! data size                     !!! * size of all input files *
+      jpidta  = 10,                 &  !: 1st lateral dimension ( >= jpi )
+      jpjdta  = 12,                 &  !: 2nd    "         "    ( >= jpj )
+      jpkdta  = 31,                 &  !: number of levels      ( >= jpk )
+
+      ! global or zoom domain size    !!! * computational domain *
+      jpiglo  = jpidta,             &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,             &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,             &  !: number of vertical levels
+      ! zoom starting position 
+      jpizoom =   1   ,             &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,             &  !: in data domain indices
+
+      ! Domain characteristics
+      jperio  =  0,                 &  !: lateral cond. type (between 0 and 6)
+         !                             !  = 0 closed
+         !                             !  = 1 cyclic East-West
+         !                             !  = 2 equatorial symmetric
+         !                             !  = 3 North fold T-point pivot
+         !                             !  = 4 cyclic East-West AND North fold T-point pivot
+         !                             !  = 5 North fold F-point pivot
+         !                             !  = 6 cyclic East-West AND North fold F-point pivot
+      jpisl   =  0,                 &  !: number of islands (rigid-lid only)
+      jpnisl  =  0                     !: maximum number of points per island
+
+      !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+      !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+      REAL(wp), PARAMETER ::   &  !:
+         pp_not_used       = 999999._wp , &  !:
+         pp_to_be_computed = 999999._wp      !:
+
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+
+   INTEGER, PUBLIC, PARAMETER   ::   &  !:
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+   REAL(wp) , PUBLIC, PARAMETER ::   &   !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =  -35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg =    1.0_wp,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg =    0.5_wp,   &  !: meridional grid-spacing (degrees)
+      ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (degrees)
+      ppe2_m   = 5000.0_wp       !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+
+   REAL(wp), PUBLIC, PARAMETER  ::   &  !:
+      &     ppsur = -4762.96143546300_wp ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp ,  &  !:
+      &     ppkth =    21.43336197938_wp ,  &  !:
+      &     ppacr =     3.00000000000_wp       !:
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+
+   REAL(wp), PUBLIC, PARAMETER ::   &  !:
+      &     ppdzmin = 10._wp             ,  &  !: Minimum vertical spacing
+      &     pphmax  = 5000._wp                 !: Maximum depth
+
+   !!---------------------------------------------------------------------
+#endif
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   &  !:
+      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ,   &  !: first  dimension
+      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ,   &  !: second dimension
+      jpim1 = jpi-1,                                             &  !: inner domain indices
+      jpjm1 = jpj-1,                                             &  !:   "            "
+      jpkm1 = jpk-1,                                             &  !:   "            "
+      jpij  = jpi*jpj                                               !:  jpi x jpj
+
+   !!---------------------------------------------------------------------
+   !! Optimization/control flags
+   !!---------------------------------------------------------------------
+#if defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
+#endif
+
+#if defined key_vectopt_memory
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .TRUE.   !: vector optimization flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .FALSE.  !: vector optimization flag
+#endif
+
+#if defined key_vectopt_loop
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
+#endif
+
+   !!======================================================================
+END MODULE par_oce
Index: trunk/NEMO/OFF_SRC/phycst.F90
===================================================================
--- trunk/NEMO/OFF_SRC/phycst.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/phycst.F90	(revision 325)
@@ -0,0 +1,196 @@
+MODULE phycst
+   !!======================================================================
+   !!                    ***  MODULE  phycst  ***
+   !!     Definition of of both ocean and ice parameters used in the code
+   !!=====================================================================
+   !! * Modules used
+   USE par_oce          ! ocean parameters
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC phy_cst          ! routine called by inipar.F90
+
+   !! * Shared module variables
+   INTEGER, PUBLIC, DIMENSION(12) ::   &  !:
+      nbiss = (/ 31, 29, 31, 30, 31, 30,      &  !: number of days per month
+         &       31, 31, 30, 31, 30, 31 /) ,  &  !  (leap-year)
+      nobis = (/ 31, 28, 31, 30, 31, 30,      &  !: number of days per month
+         &       31, 31, 30, 31, 30, 31 /)       !  (365 days a year)
+   
+   REAL(wp), PUBLIC ::                        &  !:
+      rpi = 3.141592653589793_wp           ,  &  !: pi
+      rad = 3.141592653589793_wp / 180._wp ,  &  !: conversion from degre into radian
+      rsmall = 0.5 * EPSILON( 1. )               !: smallest real computer value
+   
+   REAL(wp), PUBLIC ::          & !:
+      rday = 24.*60.*60.  ,     & !: day (s)
+      rsiyea              ,     & !: sideral year (s)
+      rsiday              ,     & !: sideral day (s)
+      raajj = 365._wp     ,     & !: number of days in one year
+      raamo =  12._wp     ,     & !: number of months in one year
+      rjjhh =  24._wp     ,     & !: number of hours in one day
+      rhhmm =  60._wp     ,     & !: number of minutes in one hour
+      rmmss =  60._wp     ,     & !: number of seconds in one minute
+      raass               ,     & !: number of seconds in one year
+      rmoss               ,     & !: number of seconds in one month
+      rjjss               ,     & !: number of seconds in one day
+!!!   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit!
+      omega               ,    &  !: earth rotation parameter
+      ra    = 6371229._wp ,    &  !: earth radius (meter)
+      grav  = 9.80665_wp          !: gravity (m/s2)
+   
+   REAL(wp), PUBLIC ::         &  !:
+      rtt      = 273.16_wp  ,  &  !: triple point of temperature (Kelvin)
+      rt0      = 273.15_wp  ,  &  !: freezing point of water (Kelvin)
+      rt0_snow = 273.15_wp  ,  &  !: melting point of snow  (Kelvin)
+      rt0_ice  = 273.05_wp  ,  &  !: melting point of ice   (Kelvin)
+      rau0     = 1020._wp   ,  &  !: volumic mass of reference (kg/m3)
+      rauw     = 1000._wp   ,  &  !: density of pure water (kg/m3)
+      rcp      =    4.e+3_wp,  &  !: ocean specific heat
+      ro0cpr                      !: = 1. / ( rau0 * rcp )
+
+   REAL(wp), PUBLIC ::            &  !:
+      rcdsn   =   0.22_wp     ,   &  !: conductivity of the snow
+      rcdic   =   2.034396_wp ,   &  !: conductivity of the ice
+      rcpsn   =   6.9069e+5_wp,   &  !: density times specific heat for snow
+      rcpic   =   1.8837e+6_wp,   &  !: volumetric latent heat fusion of sea ice
+      xlsn    = 110.121e+6_wp ,   &  !: volumetric latent heat fusion of snow
+      xlic    = 300.33e+6_wp  ,   &  !: volumetric latent heat fusion of ice
+      xsn     =   2.8e+6      ,   &  !: latent heat of sublimation of snow
+      rhoic   = 900._wp       ,   &  !: density of sea ice (kg/m3)
+      rhosn   = 330._wp       ,   &  !: density of snow (kg/m3)
+      emic    =   0.97_wp     ,   &  !: emissivity of snow or ice
+      sice    =   6.0_wp      ,   &  !: salinity of ice (psu)
+      soce    =  34.7_wp      ,   &  !: salinity of sea (psu)
+      cevap   =   2.5e+6_wp   ,   &  !: latent heat of evaporation (water)
+      srgamma =   0.9_wp      ,   &  !: correction factor for solar radiation (Oberhuber, 1974)
+      vkarmn  =   0.4_wp      ,   &  !: von Karman constant
+      stefan  =   5.67e-8_wp         !: Stefan-Boltzmann constant 
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Header$ 
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+   
+CONTAINS
+   
+   SUBROUTINE phy_cst
+      !!----------------------------------------------------------------------
+      !!                       ***  ROUTINE phy_cst  ***
+      !!
+      !! ** Purpose :   Print model parameters and set and print the constants
+      !!
+      !! ** Method  :   no
+      !!
+      !! History :
+      !!        !  90-10  (C. Levy - G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  91-12  (M. Imbard)
+      !!   8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants 
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      CHARACTER (len=64) ::   cform = "(A9, 3(A13, I7) )" 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+
+      ! Ocean Parameters
+      ! ----------------
+      IF(lwp) THEN
+         WRITE(numout,*) '       parameter file'
+         WRITE(numout,*)
+         WRITE(numout,*) '          dimension of model'
+         WRITE(numout,*) '              Local domain      Global domain       Data domain '
+         WRITE(numout,cform) '         ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta
+         WRITE(numout,cform) '         ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta
+         WRITE(numout,cform) '         ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta
+         WRITE(numout,*)      '        ','   jpij    : ', jpij
+         WRITE(numout,*)
+         WRITE(numout,*) '          mpp local domain info (mpp)'
+         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci
+         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj
+         WRITE(numout,*) '             jpnij   : ', jpnij
+
+         WRITE(numout,*)
+         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio
+         WRITE(numout,*) '          domain island (use in rigid-lid case)  : jpisl   = ', jpisl 
+         WRITE(numout,*) '                                                   jpnisl  = ', jpnisl
+      ENDIF
+
+      ! Define constants
+      ! ----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '       constants'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
+
+      rsiyea = 365.25 * rday * 2. * rpi / 6.283076
+      rsiday = rday / ( 1. + rday / rsiyea )
+      omega  = 2. * rpi / rsiday 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
+      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
+      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
+      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1'
+
+      rjjss = rjjhh * rhhmm * rmmss
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
+      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
+      IF(lwp) WRITE(numout,*) '          nb of seconds per day               rjjss = ', rjjss, ' s'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
+      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
+      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
+      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+
+      ro0cpr = 1. / ( rau0 * rcp )
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          volumic mass of pure water         rauw   = ', rauw, ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '          volumic mass of reference          rau0   = ', rau0, ' kg/m^3'
+      IF(lwp) WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp
+      IF(lwp) WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K'
+         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K'
+         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K' 
+         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K'
+         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m' 
+         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m' 
+         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg' 
+         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
+         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'
+         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic  
+         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu'
+         WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu'
+         WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3' 
+         WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma 
+         WRITE(numout,*) '          von Karman constant                       = ', vkarmn 
+         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
+
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad
+
+         WRITE(numout,*)
+         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall
+      ENDIF
+
+   END SUBROUTINE phy_cst
+
+   !!======================================================================
+END MODULE phycst
Index: trunk/NEMO/OFF_SRC/sms.F90
===================================================================
--- trunk/NEMO/OFF_SRC/sms.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/sms.F90	(revision 325)
@@ -0,0 +1,16 @@
+MODULE sms
+   !!======================================================================
+   !!                       ***  MODULE sms  ***
+   !!  Dummy module
+   !!  Declaration : passive tracers declaration
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                     NO passive tracers
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+END MODULE sms
Index: trunk/NEMO/OFF_SRC/step.F90
===================================================================
--- trunk/NEMO/OFF_SRC/step.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/step.F90	(revision 325)
@@ -0,0 +1,103 @@
+MODULE step
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping    : manager of the ocean, tracer and ice time stepping
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   stp            : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE ldftra_oce
+   USE in_out_manager  ! I/O manager
+   USE lbclnk
+   USE trcdia
+   USE daymod          ! calendar                         (day     routine)
+   USE trcstp          ! passive tracer time-stepping      (trc_stp routine)
+   USE dtadyn          ! Lecture and interpolation of the dynamical fields
+   USE eosbn2          ! equation of state                (eos_bn2 routine)
+   USE trcrst          ! restart for passive tracers
+   USE stpctl          ! time stepping control            (stp_ctl routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC stp            ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE stp( kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp  ***
+      !!                      
+      !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.)
+      !!              - Time stepping of LIM (dynamic and thermodynamic eqs.)
+      !!              - Tme stepping  of TRC (passive tracer eqs.)
+      !! 
+      !! ** Method  : -1- Update forcings and data  
+      !!              -2- Update ocean physics 
+      !!              -3- Compute the t and s trends 
+      !!              -4- Update t and s 
+      !!              -5- Compute the momentum trends
+      !!              -6- Update the horizontal velocity
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -8- Outputs and diagnostics
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  add a first output record
+      !!        !  96-04  (G. Madec)  introduction of dynspg
+      !!        !  96-04  (M.A. Foujols)  introduction of passive tracer
+      !!   8.0  !  97-06  (G. Madec)  new architecture of call
+      !!   8.2  !  97-06  (G. Madec, M. Imbard, G. Roullet)  free surface
+      !!   8.2  !  99-02  (G. Madec, N. Grima)  hpg implicit
+      !!   8.2  !  00-07  (J-M Molines, M. Imbard)  Open Bondary Conditions
+      !!   9.0  !  02-06  (G. Madec)  free form, suppress macro-tasking
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kstp   ! ocean time-step index
+
+      !! * local declarations
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+      indic = 1                    ! reset to no error condition
+
+      CALL day( kstp )             ! Calendar
+
+      CALL dta_dyn( kstp )          ! Interpolation of the dynamical fields
+
+#if defined key_passivetrc
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! N.B. ua, va, ta, sa arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+
+                             CALL trc_stp( kstp, indic)           ! time-stepping
+
+
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control, diagnostics and outputs
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                                            ! Time loop: control and print
+                       CALL stp_ctl( kstp )
+
+
+   END SUBROUTINE stp
+
+   !!======================================================================
+END MODULE step
Index: trunk/NEMO/OFF_SRC/stpctl.F90
===================================================================
--- trunk/NEMO/OFF_SRC/stpctl.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/stpctl.F90	(revision 325)
@@ -0,0 +1,69 @@
+MODULE stpctl
+   !!==============================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  gross check of the ocean time stepping
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC stp_ctl           ! routine called by step.F90
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE stp_ctl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!              - Print it each 50 time steps
+      !!              - Print solver statistics in numsol 
+      !!              - Stop the run IF problem for the solver ( indec < 0 )
+      !!
+      !! History :
+      !!        !  91-03  ()
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)
+      !!        !  97-06  (A.M. Treguier)
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+      ENDIF
+
+      ! save the current time step in numstp
+      ! ------------------------------------
+      IF(lwp) WRITE(numstp,9100) kt
+      IF(lwp) REWIND(numstp)
+9100  FORMAT(1x, i8)
+
+
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: trunk/NEMO/OFF_SRC/trc_oce.F90
===================================================================
--- trunk/NEMO/OFF_SRC/trc_oce.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/trc_oce.F90	(revision 325)
@@ -0,0 +1,29 @@
+MODULE trc_oce
+   !!======================================================================
+   !!                      ***  MODULE  trc_oce  ***
+   !! Ocean passive tracer  :  share SMS/Ocean variables
+   !!======================================================================
+   !! History :
+   !!   9.0  !  04-03  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+#if defined key_passivetrc && defined key_trc_pisces
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+   USE sms , ONLY :  &
+      etot3    =>   etot3   !!:  Biological fluxes for light
+   !! Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_sms = .TRUE. 
+#else
+   !!----------------------------------------------------------------------
+   !! Default option                         No Biological fluxes for light          
+   !!----------------------------------------------------------------------
+   USE par_oce
+   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_sms = .FALSE. 
+   REAL(wp), PUBLIC , DIMENSION (jpi,jpj,jpk) :: &
+      etot3
+#endif
+
+END MODULE trc_oce
Index: trunk/NEMO/OFF_SRC/trcstp.F90
===================================================================
--- trunk/NEMO/OFF_SRC/trcstp.F90	(revision 325)
+++ trunk/NEMO/OFF_SRC/trcstp.F90	(revision 325)
@@ -0,0 +1,23 @@
+MODULE trcstp
+   !!======================================================================
+   !!                       ***  MODULE trcstp  ***
+   !!  Dummy module
+   !! Time-stepping    : time loop of opa for passive tracer
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   Default key                                     No passive tracers
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_stp( kt )        ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_stp
+
+   !!======================================================================
+END MODULE trcstp
Index: trunk/NEMO/OFF_SRC/vectopt_loop_substitute.h90
===================================================================
--- trunk/NEMO/OFF_SRC/vectopt_loop_substitute.h90	(revision 325)
+++ trunk/NEMO/OFF_SRC/vectopt_loop_substitute.h90	(revision 325)
@@ -0,0 +1,18 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop starting and inding indices 
+   !!      to allow unrolling of do-loop using CPP macro.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+   !! $Header$ 
+   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
+   !!----------------------------------------------------------------------
+#if defined key_vectopt_loop
+#  define fs_2     1
+#  define fs_jpim1 jpi
+#else
+#  define fs_2     2
+#  define fs_jpim1 jpim1
+#endif
