Changeset 11380 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src

Timestamp:

2019-07-31T15:56:02+02:00 (5 years ago)

Author:

girrmann

Message:

dev_r10984_HPC-13 : adding extra halos in dyn_spg_ts is now possible, only works with a single halo when used with tide or bdy, see #2308

Location:

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src

Files:

• ICE/ice.F90 (modified) (6 diffs)
• ICE/icecor.F90 (modified) (5 diffs)
• ICE/icedia.F90 (modified) (4 diffs)
• ICE/icedyn.F90 (modified) (4 diffs)
• ICE/icedyn_adv.F90 (modified) (1 diff)
• ICE/icedyn_rhg.F90 (modified) (1 diff)
• ICE/icedyn_rhg_evp.F90 (modified) (20 diffs)
• ICE/icesbc.F90 (modified) (3 diffs)
• ICE/icestp.F90 (modified) (1 diff)
• ICE/iceupdate.F90 (modified) (2 diffs)
• ICE/icevar.F90 (modified) (6 diffs)
• ICE/icewri.F90 (modified) (4 diffs)
• OCE/BDY/bdy_oce.F90 (modified) (3 diffs)
• OCE/BDY/bdydyn.F90 (modified) (1 diff)
• OCE/BDY/bdydyn2d.F90 (modified) (18 diffs)
• OCE/BDY/bdydyn3d.F90 (modified) (2 diffs)
• OCE/BDY/bdyice.F90 (modified) (3 diffs)
• OCE/BDY/bdyini.F90 (modified) (28 diffs)
• OCE/BDY/bdylib.F90 (modified) (5 diffs)
• OCE/BDY/bdytra.F90 (modified) (3 diffs)
• OCE/DIA/diadct.F90 (modified) (7 diffs)
• OCE/DIA/diaharm.F90 (modified) (11 diffs)
• OCE/DYN/dynspg_ts.F90 (modified) (48 diffs)
• OCE/DYN/sshwzv.F90 (modified) (1 diff)
• OCE/IOM/iom.F90 (modified) (5 diffs)
• OCE/LBC/lbc_lnk_multi_generic.h90 (modified) (2 diffs)
• OCE/LBC/mpp_lnk_generic.h90 (modified) (20 diffs)
• OCE/LBC/mppini.F90 (modified) (1 diff)
• OCE/nemogcm.F90 (modified) (5 diffs)
• OCE/oce.F90 (modified) (2 diffs)
• OCE/par_oce.F90 (modified) (1 diff)
• OCE/step.F90 (modified) (1 diff)
• OCE/timing.F90 (modified) (2 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/ice.F90

@@ -102 +102 @@
    !! vt_i        |      -      |    Total ice vol. per unit area | m     |
    !! vt_s        |      -      |    Total snow vol. per unit ar. | m     |
-   !! st_i        |      -      |    Total Sea ice salt content   | pss.m |
    !! sm_i        |      -      |    Mean sea ice salinity        | pss   |
    !! tm_i        |      -      |    Mean sea ice temperature     | K     |
@@ -136 +135 @@
    REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice
    LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016 
+   LOGICAL , PUBLIC ::   ln_landfast_home !: landfast ice parameterizationfrom home made 
    REAL(wp), PUBLIC ::   rn_depfra        !:    fraction of ocean depth that ice must reach to initiate landfast ice
    REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home) 
@@ -252 +252 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                        [kg.m-2.s-1]
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)        [s-1]
+
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1]
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice bottom melt                     [pss.kg.m-2.s-1 => g.m-2.s-1]
@@ -307 +309 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity                          (m/s)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area                 (m)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   st_i         !: Total ice salinity content                              (pss.m)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration)
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area
@@ -408 +409 @@
          &      wfx_bog    (jpi,jpj) , wfx_dyn   (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,           &
          &      wfx_res    (jpi,jpj) , wfx_sni   (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,           &
-         &      rn_amax_2d (jpi,jpj) ,                                                                       &
+         &      afx_tot    (jpi,jpj) , rn_amax_2d(jpi,jpj),                                                  &
          &      qsb_ice_bot(jpi,jpj) , qlead     (jpi,jpj) ,                                                 &
          &      sfx_res    (jpi,jpj) , sfx_bri   (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  &
@@ -428 +429 @@
       ii = ii + 1
       ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) ,                                   &
-         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  &
-         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) ,  &
-         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,  &
+         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  &
+         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s (jpi,jpj) ,  &
+         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s (jpi,jpj) ,  &
          &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj)            , STAT=ierr(ii) )
 

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icecor.F90

@@ -84 +84 @@
       !                             !-----------------------------------------------------
       IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        !
-         !                          !-----------------------------------------------------
+      !                             !-----------------------------------------------------
          zzc = rhoi * r1_rdtice
          DO jl = 1, jpl
@@ -117 +117 @@
             END DO
          END DO
-         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )
+         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )            ! lateral boundary conditions
       ENDIF
 
+!!gm I guess the trends are only out on demand 
+!!   So please, only do this is it exite an iom_use of on a these variables
+!!   furthermore, only allocate the diag_ arrays in this case 
+!!   and do the iom_put here so that it is only a local allocation
+!!gm 
       !                             !-----------------------------------------------------
       SELECT CASE( kn )             !  Diagnostics                                       !
@@ -138 +143 @@
          END DO
          !                       ! concentration tendency (dynamics)
-         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 
-            zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
-            CALL iom_put( 'afxdyn' , zafx )
-         ENDIF
+         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
+         afx_tot(:,:) = zafx(:,:)
+         IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) )
          !
       CASE( 2 )                        !--- thermo trend diagnostics & ice aging
@@ -160 +164 @@
          END DO
          !                       ! concentration tendency (total + thermo)
-         IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN 
-            zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice
-            CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice )
-            CALL iom_put( 'afxtot' , zafx )
-         ENDIF
+         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice
+         afx_tot(:,:) = afx_tot(:,:) + zafx(:,:)
+         IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) )
+         IF( iom_use('afxtot') )   CALL iom_put( 'afxtot' , afx_tot(:,:) )
          !
       END SELECT
@@ -171 +174 @@
       IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
       IF( ln_ctl         )   CALL ice_prt3D   ('icecor')                                                             ! prints
-      IF( ln_icectl .AND. kn == 2 ) &
-         &                   CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints
+      IF( ln_icectl .AND. kn == 2 )   CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                   ! prints
       IF( ln_timing      )   CALL timing_stop ('icecor')                                                             ! timing
       !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedia.F90

@@ -34 +34 @@
    PUBLIC   ice_dia_init   ! called in icestp.F90
 
-   REAL(wp), SAVE ::   z1_e1e2  ! inverse of the ocean area
-   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini                    ! initial volume, salt and heat contents
+   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents
    REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends
    
@@ -81 +80 @@
       ENDIF
 
-      IF( kt == nit000 ) THEN
-         z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) )
-      ENDIF
+!!gm glob_sum includes a " * tmask_i ", so remove  " * tmask(:,:,1) "
+
+      ! ----------------------- !
+      ! 1 -  Contents !
+      ! ----------------------- !
+      zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9                  ! ice volume (km3)
+      zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9                  ! snow volume (km3)
+      zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6                  ! area (km2)
+      zbg_isal = glob_sum( 'icedia', SUM( sv_i(:,:,:), dim=3 ) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3)
+      zbg_item = glob_sum( 'icedia', et_i * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J)
+      zbg_stem = glob_sum( 'icedia', et_s * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J)
       
-      ! ----------------------- !
-      ! 1 -  Contents           !
-      ! ----------------------- !
-      IF(  iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. &
-         & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN
-
-         zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice volume (km3)
-         zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9  ! snow volume (km3)
-         zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6  ! area (km2)
-         zbg_isal = glob_sum( 'icedia', st_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3)
-         zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J)
-         zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J)
-
-         CALL iom_put( 'ibgvol_tot'  , zbg_ivol ) 
-         CALL iom_put( 'sbgvol_tot'  , zbg_svol ) 
-         CALL iom_put( 'ibgarea_tot' , zbg_area ) 
-         CALL iom_put( 'ibgsalt_tot' , zbg_isal ) 
-         CALL iom_put( 'ibgheat_tot' , zbg_item ) 
-         CALL iom_put( 'sbgheat_tot' , zbg_stem ) 
- 
-      ENDIF
-
       ! ---------------------------!
       ! 2 - Trends due to forcing  !
       ! ---------------------------!
-      ! they must be kept outside an IF(iom_use) because of the call to dia_rst below
       z_frc_volbot = r1_rau0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean 
       z_frc_voltop = r1_rau0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm
@@ -122 +106 @@
       frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J
       frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J
-
-      CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
-      CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
-      CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)   
-      CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)   
-      CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)   
-
-      IF(  iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN
-         CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ice/snw/ocean      (W/m2)
-         CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ocean(below ice)   (W/m2) 
-      ENDIF
-      
-      ! ---------------------------------- !
-      ! 3 -  Content variations and drifts !
-      ! ---------------------------------- !
-      IF(  iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN
             
-         zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3) 
-         zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss)
-         zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J)
-         !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check)
-         
-         zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot )
-         zdiff_sal = zdiff_sal - frc_sal
-         zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop )
-         
-         CALL iom_put( 'ibgvolume' , zdiff_vol )   ! ice/snow volume  drift            (km3 equivalent ocean water)         
-         CALL iom_put( 'ibgsaltco' , zdiff_sal )   ! ice salt content drift            (psu*km3 equivalent ocean water)
-         CALL iom_put( 'ibgheatco' , zdiff_tem )   ! ice/snow heat content drift       (1.e20 J)
-         !
-      ENDIF
-      
+      ! ----------------------- !
+      ! 3 -  Content variations !
+      ! ----------------------- !
+      zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3) 
+      zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss)
+      zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J)
+      !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check)
+
+      ! ----------------------- !
+      ! 4 -  Drifts             !
+      ! ----------------------- !
+      zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot )
+      zdiff_sal = zdiff_sal - frc_sal
+      zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop )
+
+      ! ----------------------- !
+      ! 5 - Diagnostics writing !
+      ! ----------------------- !
+!!gm I don't understand the division by the ocean surface (i.e. glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt )
+!!   and its multiplication bu kt ! is it really what we want ? what is this quantity ?
+!!   IF it is really what we want, compute it at kt=nit000, not 3 time by time-step !
+!!   kt*rdt  : you mean rdtice ?
+!!gm
+      !
+      IF( iom_use('ibgvolume')    )   CALL iom_put( 'ibgvolume' , zdiff_vol     )   ! ice/snow volume  drift            (km3 equivalent ocean water)         
+      IF( iom_use('ibgsaltco')    )   CALL iom_put( 'ibgsaltco' , zdiff_sal     )   ! ice salt content drift            (psu*km3 equivalent ocean water)
+      IF( iom_use('ibgheatco')    )   CALL iom_put( 'ibgheatco' , zdiff_tem     )   ! ice/snow heat content drift       (1.e20 J)
+      IF( iom_use('ibgheatfx')    )   CALL iom_put( 'ibgheatfx' ,               &   ! ice/snow heat flux drift          (W/m2)
+         &                                                     zdiff_tem /glob_sum( 'icedia', e1e2t(:,:) * 1.e-20 * kt*rdt ) )
+
+      IF( iom_use('ibgfrcvoltop') )   CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
+      IF( iom_use('ibgfrcvolbot') )   CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
+      IF( iom_use('ibgfrcsal')    )   CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)   
+      IF( iom_use('ibgfrctemtop') )   CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)   
+      IF( iom_use('ibgfrctembot') )   CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)   
+      IF( iom_use('ibgfrchfxtop') )   CALL iom_put( 'ibgfrchfxtop' ,            &   ! heat on top of ice/snw/ocean      (W/m2) 
+         &                                                          frc_temtop / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt  )
+      IF( iom_use('ibgfrchfxbot') )   CALL iom_put( 'ibgfrchfxbot' ,            &   ! heat on top of ocean(below ice)   (W/m2) 
+         &                                                          frc_tembot / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt  )
+
+      IF( iom_use('ibgvol_tot' )  )   CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                       (km3)
+      IF( iom_use('sbgvol_tot' )  )   CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                      (km3)
+      IF( iom_use('ibgarea_tot')  )   CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                         (km2)
+      IF( iom_use('ibgsalt_tot')  )   CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content             (pss*km3)
+      IF( iom_use('ibgheat_tot')  )   CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                 (1.e20 J)
+      IF( iom_use('sbgheat_tot')  )   CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                (1.e20 J)
+      !
       IF( lrst_ice )   CALL ice_dia_rst( 'WRITE', kt_ice )
       !
@@ -248 +248 @@
             vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:)  ! ice/snow volume (kg/m2)
             tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                ! ice/snow heat content (J)
-            sal_loc_ini(:,:) = rhoi * st_i(:,:)                     ! ice salt content (pss*kg/m2)
+            sal_loc_ini(:,:) = rhoi * SUM( sv_i(:,:,:), dim=3 )     ! ice salt content (pss*kg/m2)
          ENDIF
          !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn.F90

@@ -163 +163 @@
             END DO
             CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. )
-            ! output
-            CALL iom_put( 'icediv' , zdivu_i )
-
+            CALL iom_put( "icediv" , zdivu_i(:,:) )
             DEALLOCATE( zdivu_i )
 
@@ -221 +219 @@
       NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  &
          &             rn_ishlat ,                                                           &
-         &             ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile
+         &             ln_landfast_L16, ln_landfast_home, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile
       !!-------------------------------------------------------------------
       !
@@ -244 +242 @@
          WRITE(numout,*) '      lateral boundary condition for sea ice dynamics        rn_ishlat       = ', rn_ishlat
          WRITE(numout,*) '      Landfast: param from Lemieux 2016                      ln_landfast_L16 = ', ln_landfast_L16
+         WRITE(numout,*) '      Landfast: param from home made                         ln_landfast_home= ', ln_landfast_home
          WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_depfra       = ', rn_depfra
          WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_icebfr       = ', rn_icebfr
@@ -270 +269 @@
       ENDIF
       !                                      !--- Landfast ice
-      IF( .NOT.ln_landfast_L16 )   tau_icebfr(:,:) = 0._wp
+      IF( .NOT.ln_landfast_L16 .AND. .NOT.ln_landfast_home )   tau_icebfr(:,:) = 0._wp
+      !
+      IF ( ln_landfast_L16 .AND. ln_landfast_home ) THEN
+         CALL ctl_stop( 'ice_dyn_init: choose one and only one landfast parameterization (ln_landfast_L16 or ln_landfast_home)' )
+      ENDIF
       !
       CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn_adv.F90

@@ -100 +100 @@
       diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice
       diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice
-      IF( iom_use('icemtrp') )   CALL iom_put( 'icemtrp' ,  diag_trp_vi * rhoi          )   ! ice mass transport
-      IF( iom_use('snwmtrp') )   CALL iom_put( 'snwmtrp' ,  diag_trp_vs * rhos          )   ! snw mass transport
-      IF( iom_use('salmtrp') )   CALL iom_put( 'salmtrp' ,  diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s)
-      IF( iom_use('dihctrp') )   CALL iom_put( 'dihctrp' , -diag_trp_ei                 )   ! advected ice heat content (W/m2)
-      IF( iom_use('dshctrp') )   CALL iom_put( 'dshctrp' , -diag_trp_es                 )   ! advected snw heat content (W/m2)
+      IF( iom_use('icemtrp') )   CALL iom_put( "icemtrp" , diag_trp_vi * rhoi          )   ! ice mass transport
+      IF( iom_use('snwmtrp') )   CALL iom_put( "snwmtrp" , diag_trp_vs * rhos          )   ! snw mass transport
+      IF( iom_use('salmtrp') )   CALL iom_put( "salmtrp" , diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s)
+      IF( iom_use('dihctrp') )   CALL iom_put( "dihctrp" , -diag_trp_ei                )   ! advected ice heat content (W/m2)
+      IF( iom_use('dshctrp') )   CALL iom_put( "dshctrp" , -diag_trp_es                )   ! advected snw heat content (W/m2)
 
       ! controls

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn_rhg.F90

@@ -69 +69 @@
          WRITE(numout,*)'ice_dyn_rhg: sea-ice rheology'
          WRITE(numout,*)'~~~~~~~~~~~'
+      ENDIF
+      !
+      IF( ln_landfast_home ) THEN      !-- Landfast ice parameterization
+         tau_icebfr(:,:) = 0._wp
+         DO jl = 1, jpl
+            WHERE( h_i(:,:,jl) > ht_n(:,:) * rn_depfra )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr
+         END DO
       ENDIF
       !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn_rhg_evp.F90

@@ -112 +112 @@
       REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i  , pdivu_i   , pdelta_i      !
       !!
+      LOGICAL, PARAMETER ::   ll_bdy_substep = .TRUE. ! temporary option to call bdy at each sub-time step (T)
+      !                                                                              or only at the main time step (F)
       INTEGER ::   ji, jj       ! dummy loop indices
       INTEGER ::   jter         ! local integers
@@ -135 +137 @@
       !
       REAL(wp), DIMENSION(jpi,jpj) ::   zdt_m                           ! (dt / ice-snow_mass) on T points
-      REAL(wp), DIMENSION(jpi,jpj) ::   zaU  , zaV                      ! ice fraction on U/V points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zaU   , zaV                     ! ice fraction on U/V points
       REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points
       REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points
+      REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ib , ztauV_ib             ! ice-bottom stress at U-V points (landfast param)
+      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points
       REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                           
+      REAL(wp), DIMENSION(jpi,jpj) ::   zfU   , zfV                     ! internal stresses
       !
       REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear
@@ -146 +152 @@
       !                                                                 !    ocean surface (ssh_m) if ice is not embedded
       !                                                                 !    ice bottom surface if ice is embedded   
-      REAL(wp), DIMENSION(jpi,jpj) ::   zfU  , zfV                      ! internal stresses
-      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU, zspgV                    ! surface pressure gradient at U/V points
-      REAL(wp), DIMENSION(jpi,jpj) ::   zCorU, zCorV                    ! Coriolis stress array
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_ai, ztauy_ai              ! ice-atm. stress at U-V points
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! ice-ocean stress at U-V points
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_bi, ztauy_bi              ! ice-OceanBottom stress at U-V points (landfast)
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast)
-      !
-      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays
-      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence
+      REAL(wp), DIMENSION(jpi,jpj) ::   zCorx, zCory                    ! Coriolis stress array
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! Ocean-to-ice stress array
+      !
+      REAL(wp), DIMENSION(jpi,jpj) ::   zswitchU, zswitchV              ! dummy arrays
+      REAL(wp), DIMENSION(jpi,jpj) ::   zmaskU, zmaskV                  ! mask for ice presence
       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask, zwf                     ! mask at F points for the ice
 
@@ -162 +163 @@
       REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small
       !! --- diags
-      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00
+      REAL(wp), DIMENSION(jpi,jpj) ::   zswi
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3
       !! --- SIMIP diags
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig1      ! Average normal stress in sea ice   
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig2      ! Maximum shear stress in sea ice
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dx   ! X-direction sea-surface tilt term (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dy   ! X-direction sea-surface tilt term (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstrx   ! X-direction coriolis stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstry   ! Y-direction coriolis stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstrx   ! X-direction internal stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstry   ! Y-direction internal stress (N/m2)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_utau_oi   ! X-direction ocean-ice stress
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_vtau_oi   ! Y-direction ocean-ice stress  
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s)
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s)
@@ -253 +264 @@
 
       ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010)
-      IF( ln_landfast_L16 ) THEN   ;   zkt = rn_tensile
-      ELSE                         ;   zkt = 0._wp
+      IF( ln_landfast_L16 .OR. ln_landfast_home ) THEN   ;   zkt = rn_tensile
+      ELSE                                               ;   zkt = 0._wp
       ENDIF
       !
@@ -297 +308 @@
             
             ! Drag ice-atm.
-            ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
-            ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
+            zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj)
+            zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj)
 
             ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points
@@ -305 +316 @@
 
             ! masks
-            zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
-            zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
+            zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice
+            zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice
 
             ! switches
-            IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp
-            ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF
-            IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp
-            ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF
+            IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zswitchU(ji,jj) = 0._wp
+            ELSE                                                   ;   zswitchU(ji,jj) = 1._wp   ;   ENDIF
+            IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zswitchV(ji,jj) = 0._wp
+            ELSE                                                   ;   zswitchV(ji,jj) = 1._wp   ;   ENDIF
 
          END DO
@@ -328 +339 @@
                ! ice-bottom stress at U points
                zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj)
-               ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
+               zTauU_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) )
                ! ice-bottom stress at V points
                zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj)
-               ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
+               zTauV_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) )
                ! ice_bottom stress at T points
                zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj)
-               tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
+               tau_icebfr(ji,jj) = rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) )
             END DO
          END DO
          CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. )
          !
-      ELSE                               !-- no landfast
+      ELSEIF( ln_landfast_home ) THEN          !-- Home made
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
-               ztaux_base(ji,jj) = 0._wp
-               ztauy_base(ji,jj) = 0._wp
+               zTauU_ib(ji,jj) = tau_icebfr(ji,jj)
+               zTauV_ib(ji,jj) = tau_icebfr(ji,jj)
+            END DO
+         END DO
+         !
+      ELSE                                     !-- no landfast
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zTauU_ib(ji,jj) = 0._wp
+               zTauV_ib(ji,jj) = 0._wp
             END DO
          END DO
       ENDIF
+      IF( iom_use('tau_icebfr') )   CALL iom_put( 'tau_icebfr', tau_icebfr(:,:) )
 
       !------------------------------------------------------------------------------!
@@ -484 +504 @@
                   !                 !--- tau_bottom/v_ice
                   zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
-                  zTauB = ztauy_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
+                  zTauB = - zTauV_ib(ji,jj) / zvel
                   !
                   !                 !--- Coriolis at V-points (energy conserving formulation)
-                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                  zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
                      &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
                      &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
                   !
                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
                   !
                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztauy_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
                   !
                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zTauE + zTauO * v_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
+                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
+                     &                                  + zTauE + zTauO * v_ice(ji,jj)                                            & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  ) / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &                 + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
+                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           ) * zmaskV(ji,jj)
                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zTauE + zTauO * v_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )   * zmsk00y(ji,jj)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * v_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            ) * zmaskV(ji,jj)
                   ENDIF
                END DO
@@ -522 +540 @@
             CALL agrif_interp_ice( 'V' )
 #endif
-            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
+            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'V' )
             !
             DO jj = 2, jpjm1
@@ -534 +552 @@
                   !                 !--- tau_bottom/u_ice
                   zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-                  zTauB = ztaux_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+                  zTauB = - zTauU_ib(ji,jj) / zvel
                   !
                   !                 !--- Coriolis at U-points (energy conserving formulation)
-                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
                      &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
                      &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
                   !
                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
                   !
                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztaux_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
                   !
                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zTauE + zTauO * u_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &            )   * zmsk00x(ji,jj)
+                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  ) / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )              & ! static friction => slow decrease to v=0
+                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &            ) * zmaskU(ji,jj)
                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zTauE + zTauO * u_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &            )   * zmsk00x(ji,jj)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &            ) * zmaskU(ji,jj)
                   ENDIF
                END DO
@@ -572 +588 @@
             CALL agrif_interp_ice( 'U' )
 #endif
-            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
+            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'U' )
             !
          ELSE ! odd iterations
@@ -586 +602 @@
                   !                 !--- tau_bottom/u_ice
                   zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) )
-                  zTauB = ztaux_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj)
+                  zTauB = - zTauU_ib(ji,jj) / zvel
                   !
                   !                 !--- Coriolis at U-points (energy conserving formulation)
-                  zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
+                  zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  &
                      &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  &
                      &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) )
                   !
                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
+                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj)
                   !
                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztaux_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
                   !
                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zTauE + zTauO * u_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
-                        &            )   * zmsk00x(ji,jj)
+                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  ) / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )              & ! static friction => slow decrease to v=0
+                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
+                     &            ) * zmaskU(ji,jj)
                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zTauE + zTauO * u_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )   * zmsk00x(ji,jj)
+                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * u_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )        &  ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            ) * zmaskU(ji,jj)
                   ENDIF
                END DO
@@ -624 +638 @@
             CALL agrif_interp_ice( 'U' )
 #endif
-            IF( ln_bdy )   CALL bdy_ice_dyn( 'U' )
+            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'U' )
             !
             DO jj = 2, jpjm1
@@ -636 +650 @@
                   !                 !--- tau_bottom/v_ice
                   zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) )
-                  zTauB = ztauy_base(ji,jj) / zvel
-                  !                 !--- OceanBottom-to-Ice stress
-                  ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj)
+                  zTauB = - zTauV_ib(ji,jj) / zvel
                   !
                   !                 !--- Coriolis at v-points (energy conserving formulation)
-                  zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
+                  zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  &
                      &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  &
                      &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) )
                   !
                   !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io
-                  zTauE = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
+                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj)
                   !
                   !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction
-                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE + ztauy_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
+                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) )
                   !
                   IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017)
-                     v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity
-                        &                                  + zTauE + zTauO * v_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
-                        &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
-                        &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &           )   * zmsk00y(ji,jj)
+                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity
+                     &                                  + zTauE + zTauO * v_ice(ji,jj)                                            & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                  ) / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast
+                     &                 + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0
+                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &           ) * zmaskV(ji,jj)
                   ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009)
-                     v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity
-                        &                                     + zTauE + zTauO * v_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
-                        &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast
-                        &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0
-                        &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
-                        &            )   * zmsk00y(ji,jj)
+                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             &  ! previous velocity
+                     &                                     + zTauE + zTauO * v_ice(ji,jj)                             &  ! F + tau_ia + Coriolis + spg + tau_io(only ocean part)
+                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             &  ! m/dt + tau_io(only ice part) + landfast
+                     &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  &  ! static friction => slow decrease to v=0
+                     &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )        &  ! v_ice = v_oce/100 if mass < zmmin & conc < zamin
+                     &            ) * zmaskV(ji,jj)
                   ENDIF
                END DO
@@ -674 +686 @@
             CALL agrif_interp_ice( 'V' )
 #endif
-            IF( ln_bdy )   CALL bdy_ice_dyn( 'V' )
+            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'V' )
             !
          ENDIF
@@ -689 +701 @@
       END DO                                              !  end loop over jter  !
       !                                                   ! ==================== !
+      !
+      IF( ln_bdy .AND. .NOT.ll_bdy_substep ) THEN
+         CALL bdy_ice_dyn( 'U' )
+         CALL bdy_ice_dyn( 'V' )
+      ENDIF
       !
       !------------------------------------------------------------------------------!
@@ -747 +764 @@
       DO jj = 1, jpj
          DO ji = 1, jpi
-            zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
+            zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
          END DO
       END DO
 
-      ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- !
-      IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. &
-         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN
-         !
-         CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., &
-            &                                  ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. )
-         !
-         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 )
-         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 )
-         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 )
-         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 )
-         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 )
-         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 )
-      ENDIF
-       
       ! --- divergence, shear and strength --- !
-      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence
-      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear
-      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength
-
-      ! --- stress tensor --- !
-      IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN
+      IF( iom_use('icediv') )   CALL iom_put( "icediv" , pdivu_i (:,:) * zswi(:,:) )   ! divergence
+      IF( iom_use('iceshe') )   CALL iom_put( "iceshe" , pshear_i(:,:) * zswi(:,:) )   ! shear
+      IF( iom_use('icestr') )   CALL iom_put( "icestr" , strength(:,:) * zswi(:,:) )   ! Ice strength
+
+      ! --- charge ellipse --- !
+      IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') ) THEN
          !
          ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) )
@@ -778 +780 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1
-               zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
-                  &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
-                  &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) )
+               zdum1 = ( zswi(ji-1,jj) * pstress12_i(ji-1,jj) + zswi(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point
+                  &      zswi(ji  ,jj) * pstress12_i(ji  ,jj) + zswi(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  &
+                  &    / MAX( 1._wp, zswi(ji-1,jj) + zswi(ji,jj-1) + zswi(ji,jj) + zswi(ji-1,jj-1) )
 
                zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress  
 
-               zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) )
+               zdum2 = zswi(ji,jj) / MAX( 1._wp, strength(ji,jj) )
 
 !!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002)
@@ -797 +799 @@
          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. )
          !
-         CALL iom_put( 'isig1' , zsig1 )
-         CALL iom_put( 'isig2' , zsig2 )
-         CALL iom_put( 'isig3' , zsig3 )
-         !
-         ! Stress tensor invariants (normal and shear stress N/m)
-         IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,       ( zs1(:,:) + zs2(:,:) )                       * zmsk00(:,:) ) ! Normal stress
-         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress
-
+         IF( iom_use('isig1') )   CALL iom_put( "isig1" , zsig1 )
+         IF( iom_use('isig2') )   CALL iom_put( "isig2" , zsig2 )
+         IF( iom_use('isig3') )   CALL iom_put( "isig3" , zsig3 )
+         !
          DEALLOCATE( zsig1 , zsig2 , zsig3 )
       ENDIF
       
       ! --- SIMIP --- !
-      IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. &
-         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN
-         !
-         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., &
-            &                                  zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. )
-
-         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x)
-         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y)
-         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x)
-         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y)
-         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x)
-         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y)
-      ENDIF
-
-      IF(  iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. &
-         & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN
-         !
-         ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , &
-            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) )
-         !
+      IF ( iom_use( 'normstr'  ) .OR. iom_use( 'sheastr'  ) .OR. iom_use( 'dssh_dx'  ) .OR. iom_use( 'dssh_dy'  ) .OR. &
+         & iom_use( 'corstrx'  ) .OR. iom_use( 'corstry'  ) .OR. iom_use( 'intstrx'  ) .OR. iom_use( 'intstry'  ) .OR. &
+         & iom_use( 'utau_oi'  ) .OR. iom_use( 'vtau_oi'  ) .OR. iom_use( 'xmtrpice' ) .OR. iom_use( 'ymtrpice' ) .OR. &
+         & iom_use( 'xmtrpsnw' ) .OR. iom_use( 'ymtrpsnw' ) .OR. iom_use( 'xatrp'    ) .OR. iom_use( 'yatrp'    ) ) THEN
+
+         ALLOCATE( zdiag_sig1     (jpi,jpj) , zdiag_sig2     (jpi,jpj) , zdiag_dssh_dx  (jpi,jpj) , zdiag_dssh_dy  (jpi,jpj) ,  &
+            &      zdiag_corstrx  (jpi,jpj) , zdiag_corstry  (jpi,jpj) , zdiag_intstrx  (jpi,jpj) , zdiag_intstry  (jpi,jpj) ,  &
+            &      zdiag_utau_oi  (jpi,jpj) , zdiag_vtau_oi  (jpi,jpj) , zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) ,  &
+            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp    (jpi,jpj) , zdiag_yatrp    (jpi,jpj) )
+         
          DO jj = 2, jpjm1
             DO ji = 2, jpim1
+               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
+               
+               ! Stress tensor invariants (normal and shear stress N/m)
+               zdiag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * rswitch                                 ! normal stress
+               zdiag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * rswitch   ! shear stress
+               
+               ! Stress terms of the momentum equation (N/m2)
+               zdiag_dssh_dx(ji,jj) = zspgU(ji,jj) * rswitch     ! sea surface slope stress term
+               zdiag_dssh_dy(ji,jj) = zspgV(ji,jj) * rswitch
+               
+               zdiag_corstrx(ji,jj) = zCorx(ji,jj) * rswitch     ! Coriolis stress term
+               zdiag_corstry(ji,jj) = zCory(ji,jj) * rswitch
+               
+               zdiag_intstrx(ji,jj) = zfU(ji,jj)   * rswitch     ! internal stress term
+               zdiag_intstry(ji,jj) = zfV(ji,jj)   * rswitch
+               
+               zdiag_utau_oi(ji,jj) = ztaux_oi(ji,jj) * rswitch  ! oceanic stress
+               zdiag_vtau_oi(ji,jj) = ztauy_oi(ji,jj) * rswitch
+               
                ! 2D ice mass, snow mass, area transport arrays (X, Y)
-               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj)
-               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj)
-
+               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * rswitch
+               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch
+               
                zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component
                zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   ''
-
+               
                zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component
                zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   ''
-
+               
                zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component
                zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   ''
-
-            END DO
-         END DO
-
-         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., &
-            &                                  zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., &
-            &                                  zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. )
-
-         CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s)
-         CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport 
-         CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s)
-         CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport
-         CALL iom_put( 'xatrp'    , zdiag_xatrp     )   ! X-component of ice area transport
-         CALL iom_put( 'yatrp'    , zdiag_yatrp     )   ! Y-component of ice area transport
-
-         DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , &
-            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp )
+               
+            END DO
+         END DO
+         
+         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_sig1   , 'T',  1., zdiag_sig2   , 'T',  1.,   &
+            &                zdiag_dssh_dx, 'U', -1., zdiag_dssh_dy, 'V', -1.,   &
+            &                zdiag_corstrx, 'U', -1., zdiag_corstry, 'V', -1.,   & 
+            &                zdiag_intstrx, 'U', -1., zdiag_intstry, 'V', -1.    )
+                  
+         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_utau_oi  , 'U', -1., zdiag_vtau_oi  , 'V', -1.,   &
+            &                zdiag_xmtrp_ice, 'U', -1., zdiag_xmtrp_snw, 'U', -1.,   &
+            &                zdiag_xatrp    , 'U', -1., zdiag_ymtrp_ice, 'V', -1.,   &
+            &                zdiag_ymtrp_snw, 'V', -1., zdiag_yatrp    , 'V', -1.    )
+         
+         IF( iom_use('normstr' ) )   CALL iom_put( 'normstr'  ,  zdiag_sig1(:,:)      )   ! Normal stress
+         IF( iom_use('sheastr' ) )   CALL iom_put( 'sheastr'  ,  zdiag_sig2(:,:)      )   ! Shear stress
+         IF( iom_use('dssh_dx' ) )   CALL iom_put( 'dssh_dx'  ,  zdiag_dssh_dx(:,:)   )   ! Sea-surface tilt term in force balance (x)
+         IF( iom_use('dssh_dy' ) )   CALL iom_put( 'dssh_dy'  ,  zdiag_dssh_dy(:,:)   )   ! Sea-surface tilt term in force balance (y)
+         IF( iom_use('corstrx' ) )   CALL iom_put( 'corstrx'  ,  zdiag_corstrx(:,:)   )   ! Coriolis force term in force balance (x)
+         IF( iom_use('corstry' ) )   CALL iom_put( 'corstry'  ,  zdiag_corstry(:,:)   )   ! Coriolis force term in force balance (y)
+         IF( iom_use('intstrx' ) )   CALL iom_put( 'intstrx'  ,  zdiag_intstrx(:,:)   )   ! Internal force term in force balance (x)
+         IF( iom_use('intstry' ) )   CALL iom_put( 'intstry'  ,  zdiag_intstry(:,:)   )   ! Internal force term in force balance (y)
+         IF( iom_use('utau_oi' ) )   CALL iom_put( 'utau_oi'  ,  zdiag_utau_oi(:,:)   )   ! Ocean stress term in force balance (x)
+         IF( iom_use('vtau_oi' ) )   CALL iom_put( 'vtau_oi'  ,  zdiag_vtau_oi(:,:)   )   ! Ocean stress term in force balance (y)
+         IF( iom_use('xmtrpice') )   CALL iom_put( 'xmtrpice' ,  zdiag_xmtrp_ice(:,:) )   ! X-component of sea-ice mass transport (kg/s)
+         IF( iom_use('ymtrpice') )   CALL iom_put( 'ymtrpice' ,  zdiag_ymtrp_ice(:,:) )   ! Y-component of sea-ice mass transport 
+         IF( iom_use('xmtrpsnw') )   CALL iom_put( 'xmtrpsnw' ,  zdiag_xmtrp_snw(:,:) )   ! X-component of snow mass transport (kg/s)
+         IF( iom_use('ymtrpsnw') )   CALL iom_put( 'ymtrpsnw' ,  zdiag_ymtrp_snw(:,:) )   ! Y-component of snow mass transport
+         IF( iom_use('xatrp'   ) )   CALL iom_put( 'xatrp'    ,  zdiag_xatrp(:,:)     )   ! X-component of ice area transport
+         IF( iom_use('yatrp'   ) )   CALL iom_put( 'yatrp'    ,  zdiag_yatrp(:,:)     )   ! Y-component of ice area transport
+
+         DEALLOCATE( zdiag_sig1      , zdiag_sig2      , zdiag_dssh_dx   , zdiag_dssh_dy   ,  &
+            &        zdiag_corstrx   , zdiag_corstry   , zdiag_intstrx   , zdiag_intstry   ,  &
+            &        zdiag_utau_oi   , zdiag_vtau_oi   , zdiag_xmtrp_ice , zdiag_ymtrp_ice ,  &
+            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp     , zdiag_yatrp     )
 
       ENDIF

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icesbc.F90

@@ -114 +114 @@
       INTEGER, INTENT(in) ::   ksbc   ! flux formulation (user defined, bulk or Pure Coupled)
       !
-      INTEGER  ::   ji, jj, jl      ! dummy loop index
-      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
-      REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
-      REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace
+      INTEGER  ::   ji, jj, jl                                ! dummy loop index
+      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky
+      REAL(wp), DIMENSION(jpi,jpj)     ::   zalb              ! 2D workspace
       !!--------------------------------------------------------------------
       !
@@ -127 +126 @@
          WRITE(numout,*)'~~~~~~~~~~~~~~~'
       ENDIF
-
-      ! get missing value from xml
-      CALL iom_miss_val( "icetemp", zmiss_val )
 
       ! --- cloud-sky and overcast-sky ice albedos --- !
@@ -156 +152 @@
 
       !--- output ice albedo and surface albedo ---!
-      IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN
-
-         ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) )
-
-         WHERE( at_i_b <= epsi06 )
-            zmsk00(:,:) = 0._wp
-            zalb  (:,:) = rn_alb_oce
-         ELSEWHERE
-            zmsk00(:,:) = 1._wp            
-            zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
+      IF( iom_use('icealb') ) THEN
+         WHERE( at_i_b <= epsi06 )   ;   zalb(:,:) = rn_alb_oce
+         ELSEWHERE                   ;   zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b
          END WHERE
-         ! ice albedo
-         CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )
-         ! ice+ocean albedo
+         CALL iom_put( "icealb" , zalb(:,:) )
+      ENDIF
+      IF( iom_use('albedo') ) THEN
          zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b )
-         CALL iom_put( 'albedo' , zalb )
-
-         DEALLOCATE( zalb, zmsk00 )
-
+         CALL iom_put( "albedo" , zalb(:,:) )
       ENDIF
       !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icestp.F90

@@ -425 +425 @@
       wfx_err_sub(:,:) = 0._wp
       !
+      afx_tot(:,:) = 0._wp   ;
+      !
       diag_heat(:,:) = 0._wp ;   diag_sice(:,:) = 0._wp
       diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/iceupdate.F90

@@ -198 +198 @@
       ! --- salt fluxes [kg/m2/s] --- !
       !                           ! sfxice =  sfxbog + sfxbom + sfxsum + sfxsni + sfxopw + sfxres + sfxdyn + sfxbri + sfxsub + sfxlam
-      IF( iom_use('sfxice'  ) )   CALL iom_put( 'sfxice', sfx     * 1.e-03 )   ! salt flux from total ice growth/melt
-      IF( iom_use('sfxbog'  ) )   CALL iom_put( 'sfxbog', sfx_bog * 1.e-03 )   ! salt flux from bottom growth
-      IF( iom_use('sfxbom'  ) )   CALL iom_put( 'sfxbom', sfx_bom * 1.e-03 )   ! salt flux from bottom melting
-      IF( iom_use('sfxsum'  ) )   CALL iom_put( 'sfxsum', sfx_sum * 1.e-03 )   ! salt flux from surface melting
-      IF( iom_use('sfxlam'  ) )   CALL iom_put( 'sfxlam', sfx_lam * 1.e-03 )   ! salt flux from lateral melting
-      IF( iom_use('sfxsni'  ) )   CALL iom_put( 'sfxsni', sfx_sni * 1.e-03 )   ! salt flux from snow ice formation
-      IF( iom_use('sfxopw'  ) )   CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 )   ! salt flux from open water formation
-      IF( iom_use('sfxdyn'  ) )   CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting
-      IF( iom_use('sfxbri'  ) )   CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 )   ! salt flux from brines
-      IF( iom_use('sfxres'  ) )   CALL iom_put( 'sfxres', sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes
-      IF( iom_use('sfxsub'  ) )   CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 )   ! salt flux from sublimation
+      IF( iom_use('sfxice'  ) )   CALL iom_put( "sfxice", sfx     * 1.e-03 )   ! salt flux from total ice growth/melt
+      IF( iom_use('sfxbog'  ) )   CALL iom_put( "sfxbog", sfx_bog * 1.e-03 )   ! salt flux from bottom growth
+      IF( iom_use('sfxbom'  ) )   CALL iom_put( "sfxbom", sfx_bom * 1.e-03 )   ! salt flux from bottom melting
+      IF( iom_use('sfxsum'  ) )   CALL iom_put( "sfxsum", sfx_sum * 1.e-03 )   ! salt flux from surface melting
+      IF( iom_use('sfxlam'  ) )   CALL iom_put( "sfxlam", sfx_lam * 1.e-03 )   ! salt flux from lateral melting
+      IF( iom_use('sfxsni'  ) )   CALL iom_put( "sfxsni", sfx_sni * 1.e-03 )   ! salt flux from snow ice formation
+      IF( iom_use('sfxopw'  ) )   CALL iom_put( "sfxopw", sfx_opw * 1.e-03 )   ! salt flux from open water formation
+      IF( iom_use('sfxdyn'  ) )   CALL iom_put( "sfxdyn", sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting
+      IF( iom_use('sfxbri'  ) )   CALL iom_put( "sfxbri", sfx_bri * 1.e-03 )   ! salt flux from brines
+      IF( iom_use('sfxres'  ) )   CALL iom_put( "sfxres", sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes
+      IF( iom_use('sfxsub'  ) )   CALL iom_put( "sfxsub", sfx_sub * 1.e-03 )   ! salt flux from sublimation
 
       ! --- mass fluxes [kg/m2/s] --- !
-      CALL iom_put( 'emp_oce', emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice)
-      CALL iom_put( 'emp_ice', emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice)
+      IF( iom_use('emp_oce' ) )   CALL iom_put( "emp_oce", emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice)
+      IF( iom_use('emp_ice' ) )   CALL iom_put( "emp_ice", emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice)
 
       !                           ! vfxice = vfxbog + vfxbom + vfxsum + vfxsni + vfxopw + vfxdyn + vfxres + vfxlam + vfxpnd
-      CALL iom_put( 'vfxice'    , wfx_ice     )   ! mass flux from total ice growth/melt
-      CALL iom_put( 'vfxbog'    , wfx_bog     )   ! mass flux from bottom growth
-      CALL iom_put( 'vfxbom'    , wfx_bom     )   ! mass flux from bottom melt 
-      CALL iom_put( 'vfxsum'    , wfx_sum     )   ! mass flux from surface melt 
-      CALL iom_put( 'vfxlam'    , wfx_lam     )   ! mass flux from lateral melt 
-      CALL iom_put( 'vfxsni'    , wfx_sni     )   ! mass flux from snow-ice formation
-      CALL iom_put( 'vfxopw'    , wfx_opw     )   ! mass flux from growth in open water
-      CALL iom_put( 'vfxdyn'    , wfx_dyn     )   ! mass flux from dynamics (ridging)
-      CALL iom_put( 'vfxres'    , wfx_res     )   ! mass flux from undiagnosed processes 
-      CALL iom_put( 'vfxpnd'    , wfx_pnd     )   ! mass flux from melt ponds
-      CALL iom_put( 'vfxsub'    , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.)
-      CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean      
-
-      IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations  
+      IF( iom_use('vfxice'  ) )   CALL iom_put( "vfxice" , wfx_ice )   ! mass flux from total ice growth/melt
+      IF( iom_use('vfxbog'  ) )   CALL iom_put( "vfxbog" , wfx_bog )   ! mass flux from bottom growth
+      IF( iom_use('vfxbom'  ) )   CALL iom_put( "vfxbom" , wfx_bom )   ! mass flux from bottom melt 
+      IF( iom_use('vfxsum'  ) )   CALL iom_put( "vfxsum" , wfx_sum )   ! mass flux from surface melt 
+      IF( iom_use('vfxlam'  ) )   CALL iom_put( "vfxlam" , wfx_lam )   ! mass flux from lateral melt 
+      IF( iom_use('vfxsni'  ) )   CALL iom_put( "vfxsni" , wfx_sni )   ! mass flux from snow-ice formation
+      IF( iom_use('vfxopw'  ) )   CALL iom_put( "vfxopw" , wfx_opw )   ! mass flux from growth in open water
+      IF( iom_use('vfxdyn'  ) )   CALL iom_put( "vfxdyn" , wfx_dyn )   ! mass flux from dynamics (ridging)
+      IF( iom_use('vfxres'  ) )   CALL iom_put( "vfxres" , wfx_res )   ! mass flux from undiagnosed processes 
+      IF( iom_use('vfxpnd'  ) )   CALL iom_put( "vfxpnd" , wfx_pnd )   ! mass flux from melt ponds
+      IF( iom_use('vfxsub'  ) )   CALL iom_put( "vfxsub" , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.)
+      IF( iom_use('vfxsub_err') ) CALL iom_put( "vfxsub_err", wfx_err_sub )   ! "excess" of sublimation sent to ocean      
+
+      IF ( iom_use( "vfxthin" ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations  
          WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog
          ELSEWHERE                                     ; z2d = 0._wp
          END WHERE
-         CALL iom_put( 'vfxthin', wfx_opw + z2d )
-      ENDIF
-
-      !                            ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum
-      CALL iom_put( 'vfxsnw'     , wfx_snw     )   ! mass flux from total snow growth/melt
-      CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum )   ! mass flux from snow melt at the surface
-      CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation 
-      CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging) 
-      CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.) 
-      CALL iom_put( 'vfxsnw_pre' , wfx_spr     )   ! snow precip
+         CALL iom_put( "vfxthin", wfx_opw + z2d )
+      ENDIF
+
+      !                              ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum
+      IF( iom_use('vfxsnw'     ) )   CALL iom_put( "vfxsnw"     , wfx_snw     )   ! mass flux from total snow growth/melt
+      IF( iom_use('vfxsnw_sum' ) )   CALL iom_put( "vfxsnw_sum" , wfx_snw_sum )   ! mass flux from snow melt at the surface
+      IF( iom_use('vfxsnw_sni' ) )   CALL iom_put( "vfxsnw_sni" , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation 
+      IF( iom_use('vfxsnw_dyn' ) )   CALL iom_put( "vfxsnw_dyn" , wfx_snw_dyn )   ! mass flux from dynamics (ridging) 
+      IF( iom_use('vfxsnw_sub' ) )   CALL iom_put( "vfxsnw_sub" , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.) 
+      IF( iom_use('vfxsnw_pre' ) )   CALL iom_put( "vfxsnw_pre" , wfx_spr     )   ! snow precip
 
       ! --- heat fluxes [W/m2] --- !
       !                              ! qt_atm_oi - qt_oce_ai = hfxdhc - ( dihctrp + dshctrp )
-      IF( iom_use('qsr_oce'    ) )   CALL iom_put( 'qsr_oce'    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface
-      IF( iom_use('qns_oce'    ) )   CALL iom_put( 'qns_oce'    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface
-      IF( iom_use('qsr_ice'    ) )   CALL iom_put( 'qsr_ice'    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface
-      IF( iom_use('qns_ice'    ) )   CALL iom_put( 'qns_ice'    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface
-      IF( iom_use('qtr_ice_bot') )   CALL iom_put( 'qtr_ice_bot', SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice
-      IF( iom_use('qtr_ice_top') )   CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface
-      IF( iom_use('qt_oce'     ) )   CALL iom_put( 'qt_oce'     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )
-      IF( iom_use('qt_ice'     ) )   CALL iom_put( 'qt_ice'     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice )
-      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm) 
-      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 
-      IF( iom_use('qemp_oce'   ) )   CALL iom_put( 'qemp_oce'   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean
-      IF( iom_use('qemp_ice'   ) )   CALL iom_put( 'qemp_ice'   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice
+      IF( iom_use('qsr_oce'    ) )   CALL iom_put( "qsr_oce"    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface
+      IF( iom_use('qns_oce'    ) )   CALL iom_put( "qns_oce"    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface
+      IF( iom_use('qsr_ice'    ) )   CALL iom_put( "qsr_ice"    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface
+      IF( iom_use('qns_ice'    ) )   CALL iom_put( "qns_ice"    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface
+      IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice
+      IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface
+      IF( iom_use('qt_oce'     ) )   CALL iom_put( "qt_oce"     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce )
+      IF( iom_use('qt_ice'     ) )   CALL iom_put( "qt_ice"     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice )
+      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( "qt_oce_ai"  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm) 
+      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( "qt_atm_oi"  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce) 
+      IF( iom_use('qemp_oce'   ) )   CALL iom_put( "qemp_oce"   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean
+      IF( iom_use('qemp_ice'   ) )   CALL iom_put( "qemp_ice"   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice
 
       ! heat fluxes from ice transformations
-      !                            ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr )
-      CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth 
-      CALL iom_put ('hfxbom'     , hfx_bom     )   ! heat flux used for ice bottom melt
-      CALL iom_put ('hfxsum'     , hfx_sum     )   ! heat flux used for ice surface melt
-      CALL iom_put ('hfxopw'     , hfx_opw     )   ! heat flux used for ice formation in open water
-      CALL iom_put ('hfxdif'     , hfx_dif     )   ! heat flux used for ice temperature change
-      CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt 
-      CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion (included in qt_oce_ai)
+      !                              ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr )
+      IF( iom_use('hfxbog'     ) )   CALL iom_put ("hfxbog"     , hfx_bog             )   ! heat flux used for ice bottom growth 
+      IF( iom_use('hfxbom'     ) )   CALL iom_put ("hfxbom"     , hfx_bom             )   ! heat flux used for ice bottom melt
+      IF( iom_use('hfxsum'     ) )   CALL iom_put ("hfxsum"     , hfx_sum             )   ! heat flux used for ice surface melt
+      IF( iom_use('hfxopw'     ) )   CALL iom_put ("hfxopw"     , hfx_opw             )   ! heat flux used for ice formation in open water
+      IF( iom_use('hfxdif'     ) )   CALL iom_put ("hfxdif"     , hfx_dif             )   ! heat flux used for ice temperature change
+      IF( iom_use('hfxsnw'     ) )   CALL iom_put ("hfxsnw"     , hfx_snw             )   ! heat flux used for snow melt 
+      IF( iom_use('hfxerr'     ) )   CALL iom_put ("hfxerr"     , hfx_err_dif         )   ! heat flux error after heat diffusion (included in qt_oce_ai)
 
       ! heat fluxes associated with mass exchange (freeze/melt/precip...)
-      CALL iom_put ('hfxthd'     , hfx_thd     )   !  
-      CALL iom_put ('hfxdyn'     , hfx_dyn     )   !  
-      CALL iom_put ('hfxres'     , hfx_res     )   !  
-      CALL iom_put ('hfxsub'     , hfx_sub     )   !  
-      CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content 
+      IF( iom_use('hfxthd'     ) )   CALL iom_put ("hfxthd"     , hfx_thd             )   !  
+      IF( iom_use('hfxdyn'     ) )   CALL iom_put ("hfxdyn"     , hfx_dyn             )   !  
+      IF( iom_use('hfxres'     ) )   CALL iom_put ("hfxres"     , hfx_res             )   !  
+      IF( iom_use('hfxsub'     ) )   CALL iom_put ("hfxsub"     , hfx_sub             )   !  
+      IF( iom_use('hfxspr'     ) )   CALL iom_put ("hfxspr"     , hfx_spr             )   ! Heat flux from snow precip heat content 
 
       ! other heat fluxes
-      IF( iom_use('hfxsensib'  ) )   CALL iom_put( 'hfxsensib'  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux
-      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( 'hfxcndbot'  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux
-      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( 'hfxcndtop'  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux
+      IF( iom_use('hfxsensib'  ) )   CALL iom_put( "hfxsensib"  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux
+      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( "hfxcndbot"  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux
+      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( "hfxcndtop"  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux
 
       ! diags
-      CALL iom_put ('hfxdhc'     , diag_heat   )   ! Heat content variation in snow and ice 
+      IF( iom_use('hfxdhc'     ) )   CALL iom_put ("hfxdhc"     , diag_heat           )   ! Heat content variation in snow and ice 
       !
       ! controls
@@ -413 +413 @@
       !! ** Method  :   use of IOM library
       !!----------------------------------------------------------------------
-      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! 'READ'/'WRITE' flag
+      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag
       INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step
       !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icevar.F90

@@ -32 +32 @@
    !!                        - vt_s(jpi,jpj)
    !!                        - at_i(jpi,jpj)
-   !!                        - st_i(jpi,jpj)
    !!                        - et_s(jpi,jpj)  total snow heat content
    !!                        - et_i(jpi,jpj)  total ice thermal content 
@@ -105 +104 @@
       !
       !                                      ! integrated values
-      vt_i(:,:) =       SUM( v_i (:,:,:)           , dim=3 )
-      vt_s(:,:) =       SUM( v_s (:,:,:)           , dim=3 )
-      st_i(:,:) =       SUM( sv_i(:,:,:)           , dim=3 )
-      at_i(:,:) =       SUM( a_i (:,:,:)           , dim=3 )
-      et_s(:,:)  = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 )
-      et_i(:,:)  = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 )
+      vt_i(:,:) =       SUM( v_i(:,:,:)           , dim=3 )
+      vt_s(:,:) =       SUM( v_s(:,:,:)           , dim=3 )
+      at_i(:,:) =       SUM( a_i(:,:,:)           , dim=3 )
+      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 )
+      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 )
       !
       at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds
@@ -140 +138 @@
          tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:)
          om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:)
-         sm_i (:,:) =      st_i(:,:)                          * z1_vt_i(:,:)
+         sm_i (:,:) = SUM( sv_i(:,:,:)              , dim=3 ) * z1_vt_i(:,:)
          !
          tm_i(:,:) = 0._wp
@@ -265 +263 @@
       !
       ! integrated values 
-      vt_i (:,:) = SUM( v_i , dim=3 )
-      vt_s (:,:) = SUM( v_s , dim=3 )
-      at_i (:,:) = SUM( a_i , dim=3 )
+      vt_i (:,:) = SUM( v_i, dim=3 )
+      vt_s (:,:) = SUM( v_s, dim=3 )
+      at_i (:,:) = SUM( a_i, dim=3 )
       !
    END SUBROUTINE ice_var_glo2eqv
@@ -535 +533 @@
 
       ! to be sure that at_i is the sum of a_i(jl)
-      at_i (:,:) = SUM( a_i (:,:,:), dim=3 )
-      vt_i (:,:) = SUM( v_i (:,:,:), dim=3 )
-!!clem add?
-!      vt_s (:,:) = SUM( v_s (:,:,:), dim=3 )
-!      st_i (:,:) = SUM( sv_i(:,:,:), dim=3 )
-!      et_s(:,:)  = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 )
-!      et_i(:,:)  = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 )
-!!clem
+      at_i (:,:) = SUM( a_i(:,:,:), dim=3 )
+      vt_i (:,:) = SUM( v_i(:,:,:), dim=3 )
 
       ! open water = 1 if at_i=0
@@ -1093 +1085 @@
          !                              ! ---------------------- !
          CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:) )
-!!         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:), &
-!!            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) )
+!!$         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:), &
+!!$            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) )
          !                              ! ---------------------- !
       ELSEIF( jpl == 1 ) THEN           ! output cat = 1         !
          !                              ! ---------------------- !
-         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1) )
-!!         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1), &
-!!            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) )         
+         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1) )         
+!!$         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1), &
+!!$            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) )         
          !                              ! ----------------------- !
       ELSE                              ! input cat /= output cat !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icewri.F90

@@ -50 +50 @@
       INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices
       REAL(wp) ::   z2da, z2db, zrho1, zrho2
-      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
-      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast                     ! 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast !  2D workspace
       REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask
       REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zmsk00l, zmsksnl               ! cat masks
@@ -59 +58 @@
       REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
       !!-------------------------------------------------------------------
-      !
+
       IF( ln_timing )   CALL timing_start('icewri')
-
-      ! get missing value from xml
-      CALL iom_miss_val( 'icetemp', zmiss_val )
 
       ! brine volume
@@ -89 +85 @@
       ! Standard outputs
       !-----------------
-      zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau0
+      zrho1 = ( rau0 - rhoi ) * r1_rau0; zrho2 = rhos * r1_rau0
       ! masks
-      CALL iom_put( 'icemask'  , zmsk00 )   ! ice mask 0%
-      CALL iom_put( 'icemask05', zmsk05 )   ! ice mask 5%
-      CALL iom_put( 'icemask15', zmsk15 )   ! ice mask 15%
-      CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0) 
+      IF( iom_use('icemask'  ) )   CALL iom_put( "icemask"  , zmsk00              )   ! ice mask 0%
+      IF( iom_use('icemask05') )   CALL iom_put( "icemask05", zmsk05              )   ! ice mask 5%
+      IF( iom_use('icemask15') )   CALL iom_put( "icemask15", zmsk15              )   ! ice mask 15%
       !
       ! general fields
-      IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area 
-      IF( iom_use('snwmass' ) )   CALL iom_put( 'snwmass', vt_s * rhos * zmsksn )                                           ! Snow mass per cell area
-      IF( iom_use('iceconc' ) )   CALL iom_put( 'iceconc', at_i        * zmsk00 )                                           ! ice concentration
-      IF( iom_use('icevolu' ) )   CALL iom_put( 'icevolu', vt_i        * zmsk00 )                                           ! ice volume = mean ice thickness over the cell
-      IF( iom_use('icethic' ) )   CALL iom_put( 'icethic', hm_i        * zmsk00 )                                           ! ice thickness
-      IF( iom_use('snwthic' ) )   CALL iom_put( 'snwthic', hm_s        * zmsk00 )                                           ! snw thickness
-      IF( iom_use('icebrv'  ) )   CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 )                                           ! brine volume
-      IF( iom_use('iceage'  ) )   CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) )          ! ice age
-      IF( iom_use('icehnew' ) )   CALL iom_put( 'icehnew', ht_i_new             )                                           ! new ice thickness formed in the leads
-      IF( iom_use('snwvolu' ) )   CALL iom_put( 'snwvolu', vt_s        * zmsksn )                                           ! snow volume
-      IF( iom_use('icefrb'  ) ) THEN                                                                                        ! Ice freeboard
+      IF( iom_use('icemass'  ) )   CALL iom_put( "icemass", rhoi * vt_i * zmsk00  )   ! Ice mass per cell area 
+      IF( iom_use('snwmass'  ) )   CALL iom_put( "snwmass", rhos * vt_s * zmsksn  )   ! Snow mass per cell area
+      IF( iom_use('icepres'  ) )   CALL iom_put( "icepres", zmsk00                )   ! Ice presence (1 or 0) 
+      IF( iom_use('iceconc'  ) )   CALL iom_put( "iceconc", at_i  * zmsk00        )   ! ice concentration
+      IF( iom_use('icevolu'  ) )   CALL iom_put( "icevolu", vt_i  * zmsk00        )   ! ice volume = mean ice thickness over the cell
+      IF( iom_use('icethic'  ) )   CALL iom_put( "icethic", hm_i  * zmsk00        )   ! ice thickness
+      IF( iom_use('snwthic'  ) )   CALL iom_put( "snwthic", hm_s  * zmsk00        )   ! snw thickness
+      IF( iom_use('icebrv'   ) )   CALL iom_put( "icebrv" , bvm_i * zmsk00 * 100. )   ! brine volume
+      IF( iom_use('iceage'   ) )   CALL iom_put( "iceage" , om_i  * zmsk15 / rday )   ! ice age
+      IF( iom_use('icehnew'  ) )   CALL iom_put( "icehnew", ht_i_new              )   ! new ice thickness formed in the leads
+      IF( iom_use('snwvolu'  ) )   CALL iom_put( "snwvolu", vt_s  * zmsksn        )   ! snow volume
+      IF( iom_use('icefrb') ) THEN
          z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                         
          WHERE( z2d < 0._wp )   z2d = 0._wp
-                                  CALL iom_put( 'icefrb' , z2d * zmsk00         )
+                                   CALL iom_put( "icefrb" , z2d * zmsk00          )   ! Ice freeboard
       ENDIF
+      !
       ! melt ponds
-      IF( iom_use('iceapnd' ) )   CALL iom_put( 'iceapnd', at_ip  * zmsk00      )                                           ! melt pond total fraction
-      IF( iom_use('icevpnd' ) )   CALL iom_put( 'icevpnd', vt_ip  * zmsk00      )                                           ! melt pond total volume per unit area
+      IF( iom_use('iceapnd'  ) )   CALL iom_put( "iceapnd", at_ip  * zmsk00       )   ! melt pond total fraction
+      IF( iom_use('icevpnd'  ) )   CALL iom_put( "icevpnd", vt_ip  * zmsk00       )   ! melt pond total volume per unit area
+      !
       ! salt
-      IF( iom_use('icesalt' ) )   CALL iom_put( 'icesalt', sm_i                 * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity
-      IF( iom_use('icesalm' ) )   CALL iom_put( 'icesalm', st_i * rhoi * 1.0e-3 * zmsk00 )                                  ! Mass of salt in sea ice per cell area
+      IF( iom_use('icesalt'  ) )   CALL iom_put( "icesalt", sm_i  * zmsk00        )   ! mean ice salinity
+      IF( iom_use('icesalm'  ) )   CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoi * 1.0e-3 * zmsk00 )   ! Mass of salt in sea ice per cell area
+
       ! heat
-      IF( iom_use('icetemp' ) )   CALL iom_put( 'icetemp', ( tm_i  - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! ice mean temperature
-      IF( iom_use('snwtemp' ) )   CALL iom_put( 'snwtemp', ( tm_s  - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) )      ! snw mean temperature
-      IF( iom_use('icettop' ) )   CALL iom_put( 'icettop', ( tm_su - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! temperature at the ice surface
-      IF( iom_use('icetbot' ) )   CALL iom_put( 'icetbot', ( t_bo  - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! temperature at the ice bottom
-      IF( iom_use('icetsni' ) )   CALL iom_put( 'icetsni', ( tm_si - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! temperature at the snow-ice interface
-      IF( iom_use('icehc'   ) )   CALL iom_put( 'icehc'  ,  -et_i          * zmsk00 )                                       ! ice heat content
-      IF( iom_use('snwhc'   ) )   CALL iom_put( 'snwhc'  ,  -et_s          * zmsksn )                                       ! snow heat content
+      IF( iom_use('icetemp'  ) )   CALL iom_put( "icetemp", ( tm_i  - rt0 ) * zmsk00 )   ! ice mean temperature
+      IF( iom_use('snwtemp'  ) )   CALL iom_put( "snwtemp", ( tm_s  - rt0 ) * zmsksn )   ! snw mean temperature
+      IF( iom_use('icettop'  ) )   CALL iom_put( "icettop", ( tm_su - rt0 ) * zmsk00 )   ! temperature at the ice surface
+      IF( iom_use('icetbot'  ) )   CALL iom_put( "icetbot", ( t_bo  - rt0 ) * zmsk00 )   ! temperature at the ice bottom
+      IF( iom_use('icetsni'  ) )   CALL iom_put( "icetsni", ( tm_si - rt0 ) * zmsk00 )   ! temperature at the snow-ice interface
+      IF( iom_use('icehc'    ) )   CALL iom_put( "icehc"  ,  -et_i          * zmsk00 )   ! ice heat content
+      IF( iom_use('snwhc'    ) )   CALL iom_put( "snwhc"  ,  -et_s          * zmsksn )   ! snow heat content
+
       ! momentum
-      IF( iom_use('uice'    ) )   CALL iom_put( 'uice'   , u_ice    )                                                       ! ice velocity u
-      IF( iom_use('vice'    ) )   CALL iom_put( 'vice'   , v_ice    )                                                       ! ice velocity v
-      !
-      IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity
+      IF( iom_use('uice'     ) )   CALL iom_put( "uice"   , u_ice                 )   ! ice velocity u component
+      IF( iom_use('vice'     ) )   CALL iom_put( "vice"   , v_ice                 )   ! ice velocity v component
+      IF( iom_use('utau_ai'  ) )   CALL iom_put( "utau_ai", utau_ice * zmsk00     )   ! Wind stress term in force balance (x)
+      IF( iom_use('vtau_ai'  ) )   CALL iom_put( "vtau_ai", vtau_ice * zmsk00     )   ! Wind stress term in force balance (y)
+
+      IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN 
+        ! module of ice velocity
          DO jj = 2 , jpjm1
             DO ji = 2 , jpim1
-               z2da  = u_ice(ji,jj) + u_ice(ji-1,jj)
-               z2db  = v_ice(ji,jj) + v_ice(ji,jj-1)
+               z2da  = ( u_ice(ji,jj) + u_ice(ji-1,jj) )
+               z2db  = ( v_ice(ji,jj) + v_ice(ji,jj-1) )
                z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
            END DO
          END DO
          CALL lbc_lnk( 'icewri', z2d, 'T', 1. )
-         CALL iom_put( 'icevel', z2d )
-
-         WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp                                      ! record presence of fast ice
+         IF( iom_use('icevel') )   CALL iom_put( "icevel" , z2d )
+
+        ! record presence of fast ice
+         WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp
          ELSEWHERE                                                ; zfast(:,:) = 0._wp
          END WHERE
-         CALL iom_put( 'fasticepres', zfast )
+         IF( iom_use('fasticepres') )   CALL iom_put( "fasticepres" , zfast )
       ENDIF
 
       ! --- category-dependent fields --- !
-      IF( iom_use('icemask_cat' ) )   CALL iom_put( 'icemask_cat' ,                  zmsk00l                                   ) ! ice mask 0%
-      IF( iom_use('iceconc_cat' ) )   CALL iom_put( 'iceconc_cat' , a_i            * zmsk00l                                   ) ! area for categories
-      IF( iom_use('icethic_cat' ) )   CALL iom_put( 'icethic_cat' , h_i            * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories
-      IF( iom_use('snwthic_cat' ) )   CALL iom_put( 'snwthic_cat' , h_s            * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories
-      IF( iom_use('icesalt_cat' ) )   CALL iom_put( 'icesalt_cat' , s_i            * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories
-      IF( iom_use('iceage_cat'  ) )   CALL iom_put( 'iceage_cat'  , o_i / rday     * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice age
-      IF( iom_use('icetemp_cat' ) )   CALL iom_put( 'icetemp_cat' , ( SUM( t_i, dim=3 ) * r1_nlay_i - rt0 ) &
-         &                                                                         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature
-      IF( iom_use('snwtemp_cat' ) )   CALL iom_put( 'snwtemp_cat' , ( SUM( t_s, dim=3 ) * r1_nlay_s - rt0 ) &
-         &                                                                         * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature
-      IF( iom_use('icettop_cat' ) )   CALL iom_put( 'icettop_cat' , ( t_su - rt0 ) * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! surface temperature
-      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume
-      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories
-      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories
-      IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories
+      IF( iom_use('icemask_cat' ) )   CALL iom_put( "icemask_cat" , zmsk00l                                                    )   ! ice mask 0%
+      IF( iom_use('iceconc_cat' ) )   CALL iom_put( "iceconc_cat" , a_i * zmsk00l                                              )   ! area for categories
+      IF( iom_use('icethic_cat' ) )   CALL iom_put( "icethic_cat" , h_i * zmsk00l                                              )   ! thickness for categories
+      IF( iom_use('snwthic_cat' ) )   CALL iom_put( "snwthic_cat" , h_s * zmsksnl                                              )   ! snow depth for categories
+      IF( iom_use('icesalt_cat' ) )   CALL iom_put( "icesalt_cat" , s_i * zmsk00l                                              )   ! salinity for categories
+      IF( iom_use('iceage_cat'  ) )   CALL iom_put( "iceage_cat"  , o_i * zmsk00l / rday                                       )   ! ice age
+      IF( iom_use('icetemp_cat' ) )   CALL iom_put( "icetemp_cat" , ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zmsk00l )   ! ice temperature
+      IF( iom_use('snwtemp_cat' ) )   CALL iom_put( "snwtemp_cat" , ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zmsksnl )   ! snow temperature
+      IF( iom_use('icettop_cat' ) )   CALL iom_put( "icettop_cat" , ( t_su - rt0 ) * zmsk00l                                   )   ! surface temperature
+      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( "icebrv_cat"  ,   bv_i * 100.  * zmsk00l                                   )   ! brine volume
+      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( "iceapnd_cat" ,   a_ip         * zmsk00l                                   )   ! melt pond frac for categories
+      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( "icehpnd_cat" ,   h_ip         * zmsk00l                                   )   ! melt pond frac for categories
+      IF( iom_use('iceafpnd_cat') )   CALL iom_put( "iceafpnd_cat",   a_ip_frac    * zmsk00l                                   )   ! melt pond frac for categories
 
       !------------------
@@ -168 +170 @@
       !------------------
       ! trends
-      IF( iom_use('dmithd') )   CALL iom_put( 'dmithd', - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics
-      IF( iom_use('dmidyn') )   CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi                                        ) ! Sea-ice mass change from dynamics(kg/m2/s)
-      IF( iom_use('dmiopw') )   CALL iom_put( 'dmiopw', - wfx_opw                                                             ) ! Sea-ice mass change through growth in open water
-      IF( iom_use('dmibog') )   CALL iom_put( 'dmibog', - wfx_bog                                                             ) ! Sea-ice mass change through basal growth
-      IF( iom_use('dmisni') )   CALL iom_put( 'dmisni', - wfx_sni                                                             ) ! Sea-ice mass change through snow-to-ice conversion
-      IF( iom_use('dmisum') )   CALL iom_put( 'dmisum', - wfx_sum                                                             ) ! Sea-ice mass change through surface melting
-      IF( iom_use('dmibom') )   CALL iom_put( 'dmibom', - wfx_bom                                                             ) ! Sea-ice mass change through bottom melting
-      IF( iom_use('dmtsub') )   CALL iom_put( 'dmtsub', - wfx_sub                                                             ) ! Sea-ice mass change through evaporation and sublimation
-      IF( iom_use('dmssub') )   CALL iom_put( 'dmssub', - wfx_snw_sub                                                         ) ! Snow mass change through sublimation
-      IF( iom_use('dmisub') )   CALL iom_put( 'dmisub', - wfx_ice_sub                                                         ) ! Sea-ice mass change through sublimation
-      IF( iom_use('dmsspr') )   CALL iom_put( 'dmsspr', - wfx_spr                                                             ) ! Snow mass change through snow fall
-      IF( iom_use('dmsssi') )   CALL iom_put( 'dmsssi',   wfx_sni*rhos*r1_rhoi                                                ) ! Snow mass change through snow-to-ice conversion
-      IF( iom_use('dmsmel') )   CALL iom_put( 'dmsmel', - wfx_snw_sum                                                         ) ! Snow mass change through melt
-      IF( iom_use('dmsdyn') )   CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs                                    ) ! Snow mass change through dynamics(kg/m2/s)
-      
+      IF( iom_use('dmithd') )   CALL iom_put( "dmithd", - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics
+      IF( iom_use('dmidyn') )   CALL iom_put( "dmidyn", - wfx_dyn + rhoi * diag_trp_vi      )   ! Sea-ice mass change from dynamics(kg/m2/s)
+      IF( iom_use('dmiopw') )   CALL iom_put( "dmiopw", - wfx_opw                           )   ! Sea-ice mass change through growth in open water
+      IF( iom_use('dmibog') )   CALL iom_put( "dmibog", - wfx_bog                           )   ! Sea-ice mass change through basal growth
+      IF( iom_use('dmisni') )   CALL iom_put( "dmisni", - wfx_sni                           )   ! Sea-ice mass change through snow-to-ice conversion
+      IF( iom_use('dmisum') )   CALL iom_put( "dmisum", - wfx_sum                           )   ! Sea-ice mass change through surface melting
+      IF( iom_use('dmibom') )   CALL iom_put( "dmibom", - wfx_bom                           )   ! Sea-ice mass change through bottom melting
+      IF( iom_use('dmtsub') )   CALL iom_put( "dmtsub", - wfx_sub                           )   ! Sea-ice mass change through evaporation and sublimation
+      IF( iom_use('dmssub') )   CALL iom_put( "dmssub", - wfx_snw_sub                       )   ! Snow mass change through sublimation
+      IF( iom_use('dmisub') )   CALL iom_put( "dmisub", - wfx_ice_sub                       )   ! Sea-ice mass change through sublimation
+      IF( iom_use('dmsspr') )   CALL iom_put( "dmsspr", - wfx_spr                           )   ! Snow mass change through snow fall
+      IF( iom_use('dmsssi') )   CALL iom_put( "dmsssi",   wfx_sni*rhos*r1_rhoi              )   ! Snow mass change through snow-to-ice conversion
+      IF( iom_use('dmsmel') )   CALL iom_put( "dmsmel", - wfx_snw_sum                       )   ! Snow mass change through melt
+      IF( iom_use('dmsdyn') )   CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhos * diag_trp_vs  )   ! Snow mass change through dynamics(kg/m2/s)
+
       ! Global ice diagnostics
-      IF(  iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. &
-         & iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN
-         !
-         WHERE( ff_t(:,:) > 0._wp )   ;   z2d(:,:) = 1._wp
-         ELSEWHERE                    ;   z2d(:,:) = 0.
-         END WHERE
-         !
-         IF( iom_use('NH_icearea') )   zdiag_area_nh = glob_sum( 'icewri', at_i *           z2d   * e1e2t * 1.e-12 )
-         IF( iom_use('NH_icevolu') )   zdiag_volu_nh = glob_sum( 'icewri', vt_i *           z2d   * e1e2t * 1.e-12 )
-         IF( iom_use('NH_iceextt') )   zdiag_extt_nh = glob_sum( 'icewri',                  z2d   * e1e2t * 1.e-12 * zmsk15 )
-         !
-         IF( iom_use('SH_icearea') )   zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 )
-         IF( iom_use('SH_icevolu') )   zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 )
-         IF( iom_use('SH_iceextt') )   zdiag_extt_sh = glob_sum( 'icewri',        ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 )
-         !
-         CALL iom_put( 'NH_icearea' , zdiag_area_nh )
-         CALL iom_put( 'NH_icevolu' , zdiag_volu_nh )
-         CALL iom_put( 'NH_iceextt' , zdiag_extt_nh )
-         CALL iom_put( 'SH_icearea' , zdiag_area_sh )
-         CALL iom_put( 'SH_icevolu' , zdiag_volu_sh )
-         CALL iom_put( 'SH_iceextt' , zdiag_extt_sh )
+      IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') )   THEN   ! NH diagnostics
+         !
+         WHERE( ff_t > 0._wp )   ;   zmsk00(:,:) = 1.0e-12
+         ELSEWHERE               ;   zmsk00(:,:) = 0.
+         END WHERE 
+         zdiag_area_nh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )
+         zdiag_volu_nh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )
+         !
+         WHERE( ff_t > 0._wp .AND. at_i > 0.15 )   ; zmsk00(:,:) = 1.0e-12
+         ELSEWHERE                                 ; zmsk00(:,:) = 0.
+         END WHERE 
+         zdiag_extt_nh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) )
+         !
+         IF( iom_use('NH_icearea') )   CALL iom_put( "NH_icearea" ,  zdiag_area_nh )
+         IF( iom_use('NH_icevolu') )   CALL iom_put( "NH_icevolu" ,  zdiag_volu_nh )
+         IF( iom_use('NH_iceextt') )   CALL iom_put( "NH_iceextt" ,  zdiag_extt_nh )
          !
       ENDIF
+      !
+      IF( iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') )   THEN   ! SH diagnostics
+         !
+         WHERE( ff_t < 0._wp ); zmsk00(:,:) = 1.0e-12; 
+         ELSEWHERE            ; zmsk00(:,:) = 0.
+         END WHERE 
+         zdiag_area_sh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 
+         zdiag_volu_sh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )
+         !
+         WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zmsk00(:,:) = 1.0e-12
+         ELSEWHERE                              ; zmsk00(:,:) = 0.
+         END WHERE 
+         zdiag_extt_sh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) )
+         !
+         IF( iom_use('SH_icearea') ) CALL iom_put( "SH_icearea", zdiag_area_sh )
+         IF( iom_use('SH_icevolu') ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )
+         IF( iom_use('SH_iceextt') ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )
+         !
+      ENDIF 
       !
 !!CR      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
 !!CR      !     IF( kindic < 0 )   CALL ice_wri_state( 'output.abort' )
 !!CR      !     not yet implemented
-!!gm  idem for the ocean...  Ask Seb how to get rid of ioipsl....
+!!gm  idem for the ocean...  Ask Seb how to get read of ioipsl....
       !
       IF( ln_timing )  CALL timing_stop('icewri')

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdy_oce.F90

@@ -15 +15 @@
    IMPLICIT NONE
    PUBLIC
+
 
    INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets
@@ -122 +123 @@
                                                                           !: =1 => some data to be read in from data files
 !$AGRIF_DO_NOT_TREAT
-   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
-   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process)
+   ! regular :  interior domain + global halo || extended : interior domain + global halo + halo extension for time-splitting
+   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy_reg, idx_bdy_xtd    !: bdy indices (local process)
+   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy_reg, dta_bdy_xtd    !: bdy external data (local process)
+   ! pointers to switch between regular and extended, _save for the OBC_INDEX not currently used
+   TYPE(OBC_INDEX), DIMENSION(:)     , POINTER     ::   idx_bdy, idx_bdy_save       !: bdy indices (local process)
+   TYPE(OBC_DATA) , DIMENSION(:)     , POINTER     ::   dta_bdy, dta_bdy_save       !: bdy external data (local process)
 !$AGRIF_END_DO_NOT_TREAT
-   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdy      !: mark needed communication for given boundary, grid and neighbour
-   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdy      !:  when searching in any direction
-   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyint   !: mark needed communication for given boundary, grid and neighbour
-   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyint   !:  when searching towards the interior of the computational domain
-   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour
-   LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain
+   ! regular :  interior domain + global halo
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdy_reg      !: mark com for given boundary, grid, neighbour and rim
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdy_reg      !:  when searching in any direction
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyint_reg   !: mark com for given boundary, grid, neighbour and rim
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyint_reg   !:  when searching towards the interior of the domain
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyext_reg   !: mark com for given boundary, grid, neighbour and rim
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyext_reg   !:  when searching towards the exterior of the domain
+   ! extended : interior domain + global halo + halo extension for time-splitting
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdy_xtd      !: mark com for given boundary, grid, neighbour and rim
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdy_xtd      !:  when searching in any direction
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyint_xtd   !: mark com for given boundary, grid, neighbour and rim
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyint_xtd   !:  when searching towards the interior of the domain
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyext_xtd   !: mark com for given boundary, grid, neighbour and rim
+   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyext_xtd   !:  when searching towards the exterior of the domain
+   ! pointers to switch between regular and extended, _save for the logical array not currently used
+   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdy   , lsend_bdy_save
+   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdy   , lrecv_bdy_save
+   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdyint, lsend_bdyint_save
+   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdyint, lrecv_bdyint_save
+   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdyext, lsend_bdyext_save
+   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdyext, lrecv_bdyext_save
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -158 +178 @@
    END FUNCTION bdy_oce_alloc
 
+
+   SUBROUTINE swap_bdyptr
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE  swap_bdyptr  ***
+      !!         
+      !! ** Purpose :   swap all pointers for bdy treatment
+      !!----------------------------------------------------------------------
+      CALL swap_obciptr(idx_bdy     , idx_bdy_save     )
+      CALL swap_obcdptr(dta_bdy     , dta_bdy_save     )
+      CALL swap_lptr   (lsend_bdy   , lsend_bdy_save   )
+      CALL swap_lptr   (lrecv_bdy   , lrecv_bdy_save   )
+      CALL swap_lptr   (lsend_bdyint, lsend_bdyint_save)
+      CALL swap_lptr   (lrecv_bdyint, lrecv_bdyint_save)
+      CALL swap_lptr   (lsend_bdyext, lsend_bdyext_save)
+      CALL swap_lptr   (lrecv_bdyext, lrecv_bdyext_save)
+      !
+   END SUBROUTINE swap_bdyptr
+
+
+   SUBROUTINE swap_lptr( ptr1, ptr2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE swap_lptr  ***
+      !!         
+      !! ** Purpose :   swap logical pointers
+      !! ** Method  :   use temporary pointer to save the target
+      !!----------------------------------------------------------------------      
+      LOGICAL, DIMENSION(:,:,:,:), POINTER, INTENT(inout)   :: ptr1, ptr2
+      LOGICAL, DIMENSION(:,:,:,:), POINTER                  :: ptrtmp
+      !!----------------------------------------------------------------------
+      ptrtmp => ptr1
+      ptr1 => ptr2
+      ptr2 => ptrtmp
+   END SUBROUTINE swap_lptr
+
+
+   SUBROUTINE swap_obciptr( ptr1, ptr2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE swap_obciptr  ***
+      !!         
+      !! ** Purpose :   swap pointers on OBC_INDEX types
+      !! ** Method  :   use temporary pointer to save the target
+      !!----------------------------------------------------------------------      
+      TYPE(OBC_INDEX), DIMENSION(:), POINTER, INTENT(inout)   :: ptr1, ptr2
+      TYPE(OBC_INDEX), DIMENSION(:), POINTER                  :: ptrtmp
+      !!----------------------------------------------------------------------
+      ptrtmp => ptr1
+      ptr1 => ptr2
+      ptr2 => ptrtmp
+   END SUBROUTINE swap_obciptr
+
+
+   SUBROUTINE swap_obcdptr( ptr1, ptr2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE swap_obcdptr  ***
+      !!         
+      !! ** Purpose :   swap pointers on OBC_DATA types
+      !! ** Method  :   use temporary pointer to save the target
+      !!----------------------------------------------------------------------      
+      TYPE(OBC_DATA), DIMENSION(:), POINTER, INTENT(inout)   :: ptr1, ptr2
+      TYPE(OBC_DATA), DIMENSION(:), POINTER                  :: ptrtmp
+      !!----------------------------------------------------------------------
+      ptrtmp => ptr1
+      ptr1 => ptr2
+      ptr2 => ptrtmp
+   END SUBROUTINE swap_obcdptr
+
    !!======================================================================
 END MODULE bdy_oce

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdydyn.F90

@@ -97 +97 @@
       !-------------------------------------------------------
 
-      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha )
+      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha, 1, jpi, 1, jpj )
 
       IF( ll_dyn3d )   CALL bdy_dyn3d( kt )

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdydyn2d.F90

@@ -36 +36 @@
 CONTAINS
 
-   SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh  )
+   SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh           &
+        &              , kdbi, kdei, kdbj, kdej, ldcomall, pumask, pvmask, khlcom   )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn2d  ***
@@ -43 +44 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER,                      INTENT(in) ::   kt   ! Main time step counter
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh
+      INTEGER,                                            INTENT(in   ) ::   kt   ! Main time step counter
+      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d 
+      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pub2d, pvb2d
+      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   phur, phvr
+      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pssh
+      INTEGER ,                                           INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array
+      LOGICAL , OPTIONAL,                                 INTENT(in   ) ::   ldcomall   ! communicate with all neighbours
+      REAL(wp), OPTIONAL, DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pumask  ! optional mask for extended domain
+      REAL(wp), OPTIONAL, DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pvmask  !     -     - 
+      INTEGER , OPTIONAL,                                 INTENT(in   ) ::   khlcom  ! number of halos to communicate
       !!
       INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index
@@ -64 +70 @@
                CYCLE
             CASE('frs')   ! treat the whole boundary at once
-               IF( llrim0 )   CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d )
+               IF( llrim0 )   CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d,   &
+                    & kdbi, kdei, kdbj, kdej, pumask=pumask, pvmask=pvmask )
             CASE('flather')
-               CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0 )
+               CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0,   &
+                    & kdbi, kdei, kdbj, kdej )
             CASE('orlanski')
                CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, &
-                    & pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo=.false. )
+                    & pua2d, pva2d, pub2d, pvb2d, .false., llrim0, kdbi, kdei, kdbj, kdej )
             CASE('orlanski_npo')
                CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, &
-                    & pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo=.true.  )
+                    & pua2d, pva2d, pub2d, pvb2d, .true. , llrim0, kdbi, kdei, kdbj, kdej  )
             CASE DEFAULT
                CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' )
             END SELECT
-         ENDDO
+         END DO
          !
          IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0
@@ -101 +109 @@
             END SELECT
          END DO
+         IF( PRESENT(ldcomall) ) THEN
+            IF( ldcomall ) THEN   ! if ldcomall is present and true   then communicate with all neighbours
+               CALL lbc_lnk_multi( 'bdydyn2d',  pua2d, 'U',  1.,  pva2d, 'V',  1., kfillmode=jpfillnothing, khlcom=khlcom )
+               CYCLE
+            END IF
+         END IF
          IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
+            CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,ldsend=llsend2, ldrecv=llrecv2, khlcom=khlcom )
          END IF
          IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
+            CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,ldsend=llsend3, ldrecv=llrecv3, khlcom=khlcom )
          END IF
          !
@@ -112 +126 @@
    END SUBROUTINE bdy_dyn2d
 
-   SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d )
+   SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d, kdbi, kdei, kdbj, kdej, pumask, pvmask )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_dyn2d_frs  ***
@@ -123 +137 @@
       !!               topography. Tellus, 365-382.
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
-      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
+      TYPE(OBC_INDEX),                          INTENT(in   ) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),                           INTENT(in   ) ::   dta  ! OBC external data
+      INTEGER,                                  INTENT(in   ) ::   ib_bdy  ! BDY set index
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d
+      INTEGER ,                                                     INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array
+      REAL(wp), OPTIONAL, TARGET, DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(in   ) ::   pumask  ! optional mask for extended domain
+      REAL(wp), OPTIONAL, TARGET, DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(in   ) ::   pvmask  !     -     - 
       !!
       INTEGER  ::   jb             ! dummy loop indices
       INTEGER  ::   ii, ij, igrd   ! local integers
       REAL(wp) ::   zwgt           ! boundary weight
+      REAL(wp), POINTER, DIMENSION(:,:,:)      :: pmask         ! land/sea mask for field
       !!----------------------------------------------------------------------
       !
       igrd = 2                      ! Relaxation of zonal velocity
+      IF( PRESENT(pumask) ) THEN   ;   pmask => pumask
+      ELSE                         ;   pmask => umask
+      END IF
       DO jb = 1, idx%nblen(igrd)
          ii   = idx%nbi(jb,igrd)
          ij   = idx%nbj(jb,igrd)
          zwgt = idx%nbw(jb,igrd)
-         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1)
+         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * pmask(ii,ij,1)
       END DO
       !
       igrd = 3                      ! Relaxation of meridional velocity
+      IF( PRESENT(pvmask) ) THEN   ;   pmask => pvmask
+      ELSE                         ;   pmask => vmask
+      END IF
       DO jb = 1, idx%nblen(igrd)
          ii   = idx%nbi(jb,igrd)
          ij   = idx%nbj(jb,igrd)
          zwgt = idx%nbw(jb,igrd)
-         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1)
+         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * pmask(ii,ij,1)
       END DO 
       !
@@ -152 +176 @@
 
 
-   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0 )
+   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr, ldrim0   &
+        &                  , kdbi, kdei, kdbj, kdej   )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_dyn2d_fla  ***
@@ -171 +196 @@
       !!              continental shelf. Mem. Soc. R. Sci. Liege, Ser. 6,10, 141-164.     
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
-      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr
-      LOGICAL                     , INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
+      TYPE(OBC_INDEX),                          INTENT(in   ) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),                           INTENT(in   ) ::   dta  ! OBC external data
+      INTEGER,                                  INTENT(in   ) ::   ib_bdy  ! BDY set index
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pssh, phur, phvr
+      LOGICAL                                 , INTENT(in   ) ::   ldrim0   ! indicate if rim 0 is treated
+      INTEGER ,                                 INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array
+      !!
       INTEGER  ::   ibeg, iend                       ! length of rim to be treated (rim 0 or rim 1)
       INTEGER  ::   jb, igrd                         ! dummy loop indices
@@ -185 +212 @@
       REAL(wp) ::   zfla                             ! Flather correction
       REAL(wp) ::   z1_2                             ! 
-      REAL(wp), DIMENSION(jpi,jpj) ::   sshdta       ! 2D version of dta%ssh
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej) ::   sshdta       ! 2D version of dta%ssh
       !!----------------------------------------------------------------------
 
@@ -196 +223 @@
       ! Fill temporary array with ssh data (here we use spgu with the alias sshdta):
       igrd = 1
-      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
+      IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
       ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)
       END IF
@@ -211 +238 @@
       !             ! remember that flagu=-1 if normal velocity direction is outward
       !             ! I think we should rather use after ssh ?
-      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
+      IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
       ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)
       END IF
@@ -225 +252 @@
             !
             ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received
-            IF( iiTrim > jpi .OR. iiToce > jpi .OR. iiUoce > jpi .OR. iiUoce < 1 )   CYCLE   
+            IF( iiTrim > kdei .OR. iiToce > kdei .OR. iiUoce > kdei .OR. iiUoce < kdbi )   CYCLE   
             !
             zfla = dta%u2d(jb) - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iiToce,ij) - sshdta(iiTrim,ij) )
@@ -237 +264 @@
       igrd = 3      ! Flather bc on v-velocity
       !             ! remember that flagv=-1 if normal velocity direction is outward
-      IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
+      IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)
       ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)
       END IF
@@ -251 +278 @@
             !
             ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received
-            IF( ijTrim > jpj .OR. ijToce > jpj .OR. ijVoce > jpj .OR. ijVoce < 1 )   CYCLE
+            IF( ijTrim > kdej .OR. ijToce > kdej .OR. ijVoce > kdej .OR. ijVoce < kdbj )   CYCLE
             !
             zfla = dta%v2d(jb) - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii,ijToce) - sshdta(ii,ijTrim) )
@@ -264 +291 @@
 
 
-   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo )
+   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, ld_npo, ldrim0, kdbi, kdei, kdbj, kdej )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  ***
@@ -275 +302 @@
       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)    
       !!----------------------------------------------------------------------
-      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices
-      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data
-      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d 
-      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version
-      LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
-      INTEGER  ::   ib, igrd                               ! dummy loop indices
-      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices
+      TYPE(OBC_INDEX),                          INTENT(in   ) ::   idx      ! OBC indices
+      TYPE(OBC_DATA),                           INTENT(in   ) ::   dta      ! OBC external data
+      INTEGER,                                  INTENT(in   ) ::   ib_bdy   ! number of current open boundary set
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pub2d, pvb2d 
+      LOGICAL,                                  INTENT(in   ) ::   ld_npo   ! flag for NPO version
+      LOGICAL,                                  INTENT(in   ) ::   ldrim0   ! indicate if rim 0 is treated
+      INTEGER ,                                 INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array
+      INTEGER  ::   ib, igrd               ! dummy loop indices
+      INTEGER  ::   ii, ij, iibm1, ijbm1   ! indices
       !!----------------------------------------------------------------------
       !
       igrd = 2      ! Orlanski bc on u-velocity; 
       !            
-      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, llrim0, ll_npo )
+      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ldrim0, ld_npo )
 
       igrd = 3      ! Orlanski bc on v-velocity
       !  
-      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, llrim0, ll_npo )
+      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ldrim0, ld_npo )
       !
    END SUBROUTINE bdy_dyn2d_orlanski
 
 
-   SUBROUTINE bdy_ssh( zssh )
+   SUBROUTINE bdy_ssh( zssh, kdbi, kdei, kdbj, kdej, ldcomall, pmask, khlcom )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_ssh  ***
@@ -304 +332 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn
+      INTEGER ,                                   INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of ssh array
+      LOGICAL , OPTIONAL,                         INTENT(in   ) ::   ldcomall   ! communicate with all neighbours
+      REAL(wp), OPTIONAL, DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(in)  ::   pmask  ! optional mask for extended domain
+      INTEGER , OPTIONAL,                                   INTENT(in)  ::   khlcom  ! number of halos to communicate
       !!
       INTEGER ::   ib_bdy, ir      ! bdy index, rim index
       INTEGER ::   ibeg, iend      ! length of rim to be treated (rim 0 or rim 1)
+      INTEGER ::   ihl             ! thickness of halo
       LOGICAL ::   llrim0          ! indicate if rim 0 is treated
       LOGICAL, DIMENSION(4) :: llsend1, llrecv1  ! indicate how communications are to be carried out
       !!----------------------------------------------------------------------
       llsend1(:) = .false.   ;   llrecv1(:) = .false.
+      !
       DO ir = 1, 0, -1   ! treat rim 1 before rim 0
          IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF
@@ -318 +352 @@
          END IF
          DO ib_bdy = 1, nb_bdy
-            CALL bdy_nmn( idx_bdy(ib_bdy), 1, zssh, llrim0 )   ! zssh is masked
+            CALL bdy_nmn( idx_bdy(ib_bdy), 1, kdbi, kdei, kdbj, kdej, 1, zssh, ldrim0=llrim0, pmask=pmask )   ! zssh is masked
             llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points
             llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points
          END DO
          IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0
-         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+                                                ! N.B. ihl>1 is not enough as values are usually wrong on extended domain
+         IF( PRESENT(ldcomall) ) THEN
+            IF( ldcomall ) THEN   ! if ldcomall is present and true
+               CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., kfillmode=jpfillnothing, khlcom=khlcom )   ! com with all neighbours
+            END IF
+         ELSEIF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
+            CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., kfillmode=jpfillnothing, ldsend=llsend1, ldrecv=llrecv1, khlcom=khlcom )
          END IF
       END DO

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdydyn3d.F90

@@ -97 +97 @@
          !
          IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
+            CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing, ldsend=llsend2, ldrecv=llrecv2 )
          END IF
          IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
+            CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing, ldsend=llsend3, ldrecv=llrecv3 )
          END IF
       END DO   ! ir
@@ -387 +387 @@
       igrd = 2      ! Neumann bc on u-velocity; 
       !            
-      CALL bdy_nmn( idx, igrd, ua, llrim0 )   ! ua is masked
+      CALL bdy_nmn( idx, igrd, 1, jpi, 1, jpj, 1, ua, llrim0 )   ! ua is masked
 
       igrd = 3      ! Neumann bc on v-velocity
       !  
-      CALL bdy_nmn( idx, igrd, va, llrim0 )   ! va is masked
+      CALL bdy_nmn( idx, igrd, 1, jpi, 1, jpj, 1, va, llrim0 )   ! va is masked
       !
    END SUBROUTINE bdy_dyn3d_nmn

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdyice.F90

@@ -96 +96 @@
                  &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. &
                  &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                &
-                 &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      )
+                 &                      , kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1    )
             ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk
-            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
-            CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1 )
+            CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1 )
          END IF
       END DO   ! ir
@@ -418 +418 @@
             END DO
             IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction
-               CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )
+               CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,ldsend=llsend2, ldrecv=llrecv2 )
             END IF
          CASE ( 'V' )
@@ -432 +432 @@
             END DO
             IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction
-               CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )
+               CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,ldsend=llsend3, ldrecv=llrecv3 )
             END IF
          END SELECT

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdyini.F90

@@ -37 +37 @@
 
    INTEGER, PARAMETER ::   jp_nseg = 100   ! 
+   INTEGER  ::   ihl                                    ! number of halos to be communicated
    ! Straight open boundary segment parameters:
    INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs 
@@ -70 +71 @@
          &             ln_vol, nn_volctl, nn_rimwidth
          !
-      INTEGER  ::   ios                 ! Local integer output status for namelist read
+      INTEGER  ::   ios                     ! Local integer output status for namelist read
+      INTEGER  :: idbi, idbj, idei, idej    ! start/end of the subdomain for extended and regular bdy treatment
       !!----------------------------------------------------------------------
 
@@ -105 +107 @@
 
       IF( nb_bdy == 0 ) ln_bdy = .FALSE.
-      
+
+      IF( nn_hlts > 1 .AND. MOD(nn_hlts,2)==0 ) THEN
+         WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to   ',nn_hlts   &
+              &        ,'   in namelist, is here set to   ', nn_hlts-1 ,'   must be odd'
+         CALL ctl_warn( ctmp1 )
+         nn_hlts = nn_hlts - 1
+      END IF
+      !
+      IF( nn_hlts > 1 .AND. ln_tide ) THEN
+         WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to   ',nn_hlts   &
+              &        ,'   in namelist, is here set to 1 for compatibility with tide treatment'
+         CALL ctl_warn( ctmp1 )
+         nn_hlts = 1
+      END IF
+      !
+      IF( nn_hlts > 1 .AND. ln_bdy ) THEN
+         WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to   ',nn_hlts   &
+              &        ,'   in namelist, is here set to 1 for compatibility with boundary treatment'
+         CALL ctl_warn( ctmp1 )
+         nn_hlts = 1
+      END IF
       ! -----------------------------------------
       ! unstructured open boundaries use control
@@ -115 +137 @@
          !
          ! Open boundaries definition (arrays and masks)
-         CALL bdy_def
+         ! extended : interior domain + global halo + halo extension for time-splitting
+         idbi = 1   - nn_hlts   ;   idbj = 1   - nn_hlts
+         idei = jpi + nn_hlts   ;   idej = jpj + nn_hlts
+         idx_bdy      => idx_bdy_xtd
+         dta_bdy      => dta_bdy_xtd
+         lsend_bdy    => lsend_bdy_xtd(:,:,:,:)
+         lrecv_bdy    => lrecv_bdy_xtd(:,:,:,:)
+         lsend_bdyint => lsend_bdyint_xtd(:,:,:,:)
+         lrecv_bdyint => lrecv_bdyint_xtd(:,:,:,:)
+         lsend_bdyext => lsend_bdyext_xtd(:,:,:,:)
+         lrecv_bdyext => lrecv_bdyext_xtd(:,:,:,:)
+         CALL bdy_def( idbi, idbj, idei, idej, .true. )
+         CALL swap_bdyptr
+         ! regular : interior domain + global halo
+         idbi = 1      ;   idbj = 1          ;   idei = jpi      ;   idej = jpj
+         idx_bdy      => idx_bdy_reg
+         dta_bdy      => dta_bdy_reg
+         lsend_bdy    => lsend_bdy_reg(:,:,:,:)
+         lrecv_bdy    => lrecv_bdy_reg(:,:,:,:)
+         lsend_bdyint => lsend_bdyint_reg(:,:,:,:)
+         lrecv_bdyint => lrecv_bdyint_reg(:,:,:,:)
+         lsend_bdyext => lsend_bdyext_reg(:,:,:,:)
+         lrecv_bdyext => lrecv_bdyext_reg(:,:,:,:)
+         CALL bdy_def( idbi, idbj, idei, idej )
+         ! current bdy treated is regular
+         !
          IF( ln_meshmask )   CALL bdy_meshwri()
          !
@@ -134 +181 @@
 
 
-   SUBROUTINE bdy_def
+   SUBROUTINE bdy_def( idbi, idbj, idei, idej, ldxtd )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE bdy_init  ***
@@ -144 +191 @@
       !!
       !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries
-      !!----------------------------------------------------------------------      
+      !!----------------------------------------------------------------------    
+      INTEGER          , INTENT(in)  :: idbi, idbj, idei, idej   ! start/end of the subdomain for extended and regular bdy treatment
+      LOGICAL, OPTIONAL, INTENT(in)  :: ldxtd                    ! indicate if extended domain is treated (for time splitting)
       INTEGER  ::   ib_bdy, ii, ij, igrd, ib, ir, iseg     ! dummy loop indices
       INTEGER  ::   icount, icountr, icountr0, ibr_max     ! local integers
-      INTEGER  ::   ilen1                                  !   -       -
       INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       -
-      INTEGER  ::   jpbdta                                 !   -       -
+      INTEGER  ::   jpbdta, ilen1                          !   -       -
       INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       -
       INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3           !   -       -
       INTEGER  ::   iibe, ijbe, iibi, ijbi                 !   -       -
+      INTEGER  ::   iint1, iout1, iint2, iout2             !   -       -
       INTEGER  ::   flagu, flagv                           ! short cuts
       INTEGER  ::   nbdyind, nbdybeg, nbdyend
+      INTEGER  ::   ihl                                    ! total number of halos ( with added halos for time splitting)
       INTEGER              , DIMENSION(4)             ::   kdimsz
       INTEGER              , DIMENSION(jpbgrd,jp_bdy) ::   nblendta          ! Length of index arrays 
@@ -162 +212 @@
       REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zz_read                 ! work space for 2D global boundary data
       REAL(wp), POINTER    , DIMENSION(:,:)     ::   zmask                   ! pointer to 2D mask fields
-      REAL(wp)             , DIMENSION(jpi,jpj) ::   zfmask   ! temporary fmask array excluding coastal boundary condition (shlat)
-      REAL(wp)             , DIMENSION(jpi,jpj) ::   ztmask, zumask, zvmask  ! temporary u/v mask array
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zfmask   ! temporary fmask array excluding coastal boundary condition (shlat)
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmask, zumask, zvmask  ! temporary u/v mask array
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zbdytmask, zbdyumask, zbdyvmask  ! temporary u/v mask array
       !!----------------------------------------------------------------------
       !
       cgrid = (/'t','u','v'/)
 
+      ihl = nn_hls
+      IF( PRESENT(ldxtd) ) THEN   ;   IF( ldxtd )   ihl = nn_hls + nn_hlts   ;   ENDIF
+
+      ALLOCATE( zfmask(idbi:idei,idbj:idej), ztmask(idbi:idei,idbj:idej) &
+           &  , zumask(idbi:idei,idbj:idej), zvmask(idbi:idei,idbj:idej) )
+
+      ALLOCATE( zbdytmask(idbi:idei,idbj:idej), zbdyumask(idbi:idei,idbj:idej), zbdyvmask(idbi:idei,idbj:idej) )
       ! -----------------------------------------
       ! Check and write out namelist parameters
@@ -488 +546 @@
       !------------------------------------------------------
       !
-      iwe = mig(1)
-      ies = mig(jpi)
-      iso = mjg(1) 
-      ino = mjg(jpj) 
+      iwe = idbi + nimpp - 1
+      ies = idei + nimpp - 1
+      iso = idbj + njmpp - 1
+      ino = idej + njmpp - 1
       !
       DO ib_bdy = 1, nb_bdy
@@ -551 +609 @@
                      !
                      icount = icount  + 1
-                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1   ! global to local indexes
-                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1   ! global to local indexes
+                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- (1+nimpp-1)+1   ! global to local indexes
+                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- (1+njmpp-1)+1   ! global to local indexes
                      idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy)
                      idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
@@ -579 +637 @@
                ! check if point has to be sent     to   a neighbour
                ! W neighbour and on the inner left  side
-               IF( ii == 2     .and. (nbondi == 0 .or. nbondi ==  1) )   lsend_bdy(ib_bdy,igrd,1,ir) = .true.
+               IF( ii == idbi + 1 .and. (nbondi == 0 .or. nbondi ==  1) )   lsend_bdy(ib_bdy,igrd,1,ir) = .true.
                ! E neighbour and on the inner right side
-               IF( ii == jpi-1 .and. (nbondi == 0 .or. nbondi == -1) )   lsend_bdy(ib_bdy,igrd,2,ir) = .true.
+               IF( ii == idei - 1 .and. (nbondi == 0 .or. nbondi == -1) )   lsend_bdy(ib_bdy,igrd,2,ir) = .true.
                ! S neighbour and on the inner down side
-               IF( ij == 2     .and. (nbondj == 0 .or. nbondj ==  1) )   lsend_bdy(ib_bdy,igrd,3,ir) = .true.
+               IF( ij == idbj + 1 .and. (nbondj == 0 .or. nbondj ==  1) )   lsend_bdy(ib_bdy,igrd,3,ir) = .true.
                ! N neighbour and on the inner up   side
-               IF( ij == jpj-1 .and. (nbondj == 0 .or. nbondj == -1) )   lsend_bdy(ib_bdy,igrd,4,ir) = .true.
+               IF( ij == idej - 1 .and. (nbondj == 0 .or. nbondj == -1) )   lsend_bdy(ib_bdy,igrd,4,ir) = .true.
                !
                ! check if point has to be received from a neighbour
                ! W neighbour and on the outter left  side
-               IF( ii == 1     .and. (nbondi == 0 .or. nbondi ==  1) )   lrecv_bdy(ib_bdy,igrd,1,ir) = .true.
+               IF( ii == idbi .and. (nbondi == 0 .or. nbondi ==  1) )   lrecv_bdy(ib_bdy,igrd,1,ir) = .true.
                ! E neighbour and on the outter right side
-               IF( ii == jpi   .and. (nbondi == 0 .or. nbondi == -1) )   lrecv_bdy(ib_bdy,igrd,2,ir) = .true.
+               IF( ii == idei .and. (nbondi == 0 .or. nbondi == -1) )   lrecv_bdy(ib_bdy,igrd,2,ir) = .true.
                ! S neighbour and on the outter down side
-               IF( ij == 1     .and. (nbondj == 0 .or. nbondj ==  1) )   lrecv_bdy(ib_bdy,igrd,3,ir) = .true.
+               IF( ij == idbj .and. (nbondj == 0 .or. nbondj ==  1) )   lrecv_bdy(ib_bdy,igrd,3,ir) = .true.
                ! N neighbour and on the outter up   side
-               IF( ij == jpj   .and. (nbondj == 0 .or. nbondj == -1) )   lrecv_bdy(ib_bdy,igrd,4,ir) = .true.
+               IF( ij == idej .and. (nbondj == 0 .or. nbondj == -1) )   lrecv_bdy(ib_bdy,igrd,4,ir) = .true.
                !
             END DO
@@ -633 +691 @@
       ! ------------------------------------------
 
-      ztmask(:,:) = tmask(:,:,1)   ;   zumask(:,:) = umask(:,:,1)   ;   zvmask(:,:) = vmask(:,:,1)
+      ztmask(1:jpi,1:jpj) = tmask(1:jpi,1:jpj,1)
+      zumask(1:jpi,1:jpj) = umask(1:jpi,1:jpj,1)
+      zvmask(1:jpi,1:jpj) = vmask(1:jpi,1:jpj,1)
       ! For the flagu/flagv calculation below we require a version of fmask without
       ! the land boundary condition (shlat) included:
-      DO ij = 1, jpjm1
-         DO ii = 1, jpim1
+      DO ij = 1, idej - 1
+         DO ii = 1, idei - 1
             zfmask(ii,ij) =  ztmask(ii,ij  ) * ztmask(ii+1,ij  )   &
                &           * ztmask(ii,ij+1) * ztmask(ii+1,ij+1)
          END DO
       END DO
-      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )
+      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1., khlcom = ihl )
 
       ! Read global 2D mask at T-points: bdytmask
@@ -648 +708 @@
       ! bdytmask = 1  on the computational domain AND on open boundaries
       !          = 0  elsewhere   
-
-      bdytmask(:,:) = ssmask(:,:)
+      zbdytmask(1:jpi,1:jpj) = ssmask(1:jpi,1:jpj)
 
       ! Derive mask on U and V grid from mask on T grid
-      DO ij = 1, jpjm1
-         DO ii = 1, jpim1
-            bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1,ij  )
-            bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)  
+      DO ij = 1, idej - 1
+         DO ii = 1, idei - 1
+            zbdyumask(ii,ij) = zbdytmask(ii,ij) * zbdytmask(ii+1,ij  )
+            zbdyvmask(ii,ij) = zbdytmask(ii,ij) * zbdytmask(ii  ,ij+1)  
          END DO
       END DO
-      CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1., bdyvmask, 'V', 1. )   ! Lateral boundary cond.
+      CALL lbc_lnk_multi( 'bdyini', zbdytmask, 'T', 1., zbdyumask, 'U', 1., zbdyvmask, 'V', 1., khlcom = ihl )   ! Lateral boundary cond.
 
       ! bdy masks are now set to zero on rim 0 points:
       DO ib_bdy = 1, nb_bdy
          DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(1)   ! extent of rim 0
-            bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp
+            zbdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp
          END DO
          DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(2)   ! extent of rim 0
-            bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp
+            zbdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp
          END DO
          DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(3)   ! extent of rim 0
-            bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp
+            zbdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp
          END DO
       END DO
-
-      CALL bdy_rim_treat( zumask, zvmask, zfmask, .true. )   ! compute flagu, flagv, ntreat on rim 0
+      ! compute flagu, flagv, ntreat on rim 0
+      CALL bdy_rim_treat( zumask, zvmask, zfmask, zbdytmask, zbdyumask, zbdyvmask, .true., idbi, idei, idbj, idej, ldxtd )
 
       ! ------------------------------------
@@ -699 +758 @@
          END DO
       END DO
-      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )
+      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1., khlcom = ihl )
 
       ! bdy masks are now set to zero on rim1 points:
       DO ib_bdy = 1, nb_bdy
          DO ib = idx_bdy(ib_bdy)%nblenrim0(1) + 1,  idx_bdy(ib_bdy)%nblenrim(1)   ! extent of rim 1
-            bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp
+            zbdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp
          END DO
          DO ib = idx_bdy(ib_bdy)%nblenrim0(2) + 1,  idx_bdy(ib_bdy)%nblenrim(2)   ! extent of rim 1
-            bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp
+            zbdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp
          END DO
          DO ib = idx_bdy(ib_bdy)%nblenrim0(3) + 1,  idx_bdy(ib_bdy)%nblenrim(3)   ! extent of rim 1
-            bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp
+            zbdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp
          END DO
       END DO
-
-      CALL bdy_rim_treat( zumask, zvmask, zfmask, .false. )   ! compute flagu, flagv, ntreat on rim 1
+      ! compute flagu, flagv, ntreat on rim 1
+      CALL bdy_rim_treat( zumask, zvmask, zfmask, zbdytmask, zbdyumask, zbdyvmask, .false., idbi, idei, idbj, idej, ldxtd )
       !
       ! Check which boundaries might need communication
@@ -743 +802 @@
                !      <--    (o exterior)     -->  
                ! (1)  o|x         OR    (2)   x|o
-               !       |___                 ___| 
-               IF( iibi == 0     .OR. ii1 == 0     .OR. ii2 == 0     .OR. ii3 == 0     )   lrecv_bdyint(ib_bdy,igrd,1,ir) = .true.
-               IF( iibi == jpi+1 .OR. ii1 == jpi+1 .OR. ii2 == jpi+1 .OR. ii3 == jpi+1 )   lrecv_bdyint(ib_bdy,igrd,2,ir) = .true.  
-               IF( iibe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,1,ir) = .true.
-               IF( iibe == jpi+1                                                       )   lrecv_bdyext(ib_bdy,igrd,2,ir) = .true.  
+               !       |___                 ___|
+               iout1 = idbi-1   ;   iout2 = idei+1
+               IF( iibi == iout1 .OR. ii1 == iout1 .OR. ii2 == iout1 .OR. ii3 == iout1 )  lrecv_bdyint(ib_bdy,igrd,1,ir)=.true.
+               IF( iibi == iout2 .OR. ii1 == iout2 .OR. ii2 == iout2 .OR. ii3 == iout2 )  lrecv_bdyint(ib_bdy,igrd,2,ir)=.true.
+               IF( iibe == iout1                                                       )  lrecv_bdyext(ib_bdy,igrd,1,ir)=.true.
+               IF( iibe == iout2                                                       )  lrecv_bdyext(ib_bdy,igrd,2,ir)=.true. 
                ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo
                ! :¨¨¨¨¨|¨¨-->    |                                             |    <--¨¨|¨¨¨¨¨: 
                ! :     |  x:o    |    neighbour limited by ... would need o    |    o:x  |     :
                ! :.....|_._:_____|   (1) W neighbour         E neighbour (2)   |_____:_._|.....:
-               IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. &
-                  & ( iibi == 3     .OR. ii1 == 3     .OR. ii2 == 3     .OR. ii3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,1,ir)=.true.
-               IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. &
-                  & ( iibi == jpi-2 .OR. ii1 == jpi-2 .OR. ii2 == jpi-2 .OR. ii3 == jpi-2) )   lsend_bdyint(ib_bdy,igrd,2,ir)=.true.
-               IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. iibe == 3     )   lsend_bdyext(ib_bdy,igrd,1,ir)=.true.
-               IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. iibe == jpi-2 )   lsend_bdyext(ib_bdy,igrd,2,ir)=.true.
+               iout1 = idbi+2*ihl   ;   iint1 = iout1-1   ;   iout2 = idei-2*ihl   ;   iint2 = iout2+1
+               IF( ii == iint1 .AND. (nbondi== 1 .OR. nbondi==0) .AND. &
+                 & (iibi == iout1 .OR. ii1 == iout1 .OR. ii2 == iout1 .OR. ii3 == iout1) )  lsend_bdyint(ib_bdy,igrd,1,ir)=.true.
+               IF( ii == iint2 .AND. (nbondi==-1 .OR. nbondi==0) .AND. &
+                 & (iibi == iout2 .OR. ii1 == iout2 .OR. ii2 == iout2 .OR. ii3 == iout2) )  lsend_bdyint(ib_bdy,igrd,2,ir)=.true.
+               IF( ii == iint1 .AND. (nbondi== 1 .OR. nbondi==0) .AND. iibe == iout1     )  lsend_bdyext(ib_bdy,igrd,1,ir)=.true.
+               IF( ii == iint2 .AND. (nbondi==-1 .OR. nbondi==0) .AND. iibe == iout2     )  lsend_bdyext(ib_bdy,igrd,2,ir)=.true.
                !
                ! search neighbour in the north/south direction   
@@ -764 +825 @@
                !  |   |___x___|   OR    |  |   x   |
                !  v       o           (4)  |       |
-               IF( ijbi == 0     .OR. ij1 == 0     .OR. ij2 == 0     .OR. ij3 == 0     )   lrecv_bdyint(ib_bdy,igrd,3,ir) = .true.
-               IF( ijbi == jpj+1 .OR. ij1 == jpj+1 .OR. ij2 == jpj+1 .OR. ij3 == jpj+1 )   lrecv_bdyint(ib_bdy,igrd,4,ir) = .true.
-               IF( ijbe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,3,ir) = .true.
-               IF( ijbe == jpj+1                                                       )   lrecv_bdyext(ib_bdy,igrd,4,ir) = .true.
+               iout1 = idbj-1   ;   iout2 = idej+1
+               IF( ijbi == iout1 .OR. ij1 == iout1 .OR. ij2 == iout1 .OR. ij3 == iout1 )  lrecv_bdyint(ib_bdy,igrd,3,ir)=.true.
+               IF( ijbi == iout2 .OR. ij1 == iout2 .OR. ij2 == iout2 .OR. ij3 == iout2 )  lrecv_bdyint(ib_bdy,igrd,4,ir)=.true.
+               IF( ijbe == iout1                                                       )  lrecv_bdyext(ib_bdy,igrd,3,ir)=.true.
+               IF( ijbe == iout2                                                       )  lrecv_bdyext(ib_bdy,igrd,4,ir)=.true.
                ! Check if neighbour has its rim parallel to its mpi subdomain     _________  border and next to its halo
                !   ^  |    o    |                                                :         : 
                !   |  |¨¨¨¨x¨¨¨¨|   neighbour limited by ... would need o     |  |....x....|
                !      :_________:  (3) S neighbour          N neighbour (4)   v  |    o    |   
-               IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. &
-                  & ( ijbi == 3     .OR. ij1 == 3     .OR. ij2 == 3     .OR. ij3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,3,ir)=.true.
-               IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. &
-                  & ( ijbi == jpj-2 .OR. ij1 == jpj-2 .OR. ij2 == jpj-2 .OR. ij3 == jpj-2) )   lsend_bdyint(ib_bdy,igrd,4,ir)=.true.
-               IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. ijbe == 3     )   lsend_bdyext(ib_bdy,igrd,3,ir)=.true.
-               IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. ijbe == jpj-2 )   lsend_bdyext(ib_bdy,igrd,4,ir)=.true.
+               iout1 = idbj+2*ihl   ;   iint1 = iout1-1   ;   iout2 = idej-2*ihl   ;   iint2 = iout2+1
+               IF( ij == iint1 .AND. (nbondj== 1 .OR. nbondj==0) .AND. &
+                 & (ijbi == iout1 .OR. ij1 == iout1 .OR. ij2 == iout1 .OR. ij3 == iout1) )  lsend_bdyint(ib_bdy,igrd,3,ir)=.true.
+               IF( ij == iint2 .AND. (nbondj==-1 .OR. nbondj==0) .AND. &
+                 & (ijbi == iout2 .OR. ij1 == iout2 .OR. ij2 == iout2 .OR. ij3 == iout2) )  lsend_bdyint(ib_bdy,igrd,4,ir)=.true.
+               IF( ij == iint1 .AND. (nbondj== 1 .OR. nbondj==0) .AND. ijbe == iout1     )  lsend_bdyext(ib_bdy,igrd,3,ir)=.true.
+               IF( ij == iint2 .AND. (nbondj==-1 .OR. nbondj==0) .AND. ijbe == iout2     )  lsend_bdyext(ib_bdy,igrd,4,ir)=.true.
             END DO
          END DO
@@ -799 +862 @@
       END DO
       !
-      DEALLOCATE( nbidta, nbjdta, nbrdta )
+      ! initialize bdyXmask for global use
+      bdytmask(1:jpi,1:jpj) = zbdytmask(1:jpi,1:jpj)
+      bdyumask(1:jpi,1:jpj) = zbdyumask(1:jpi,1:jpj)
+      bdyvmask(1:jpi,1:jpj) = zbdyvmask(1:jpi,1:jpj)
+      !
+      DEALLOCATE( nbidta, nbjdta, nbrdta, zfmask, ztmask, zumask, zvmask, zbdytmask, zbdyumask, zbdyvmask )
       !
    END SUBROUTINE bdy_def
 
 
-   SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, lrim0 )
+   SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, pbdytmask, pbdyumask, pbdyvmask, lrim0, idbi, idei, idbj, idej, ldxtd )
       !!----------------------------------------------------------------------
       !!                 ***  ROUTINE bdy_rim_treat  ***
@@ -821 +889 @@
       !!                - and look at the ocean neighbours to compute ntreat
       !!----------------------------------------------------------------------
-      REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in   ) :: pfmask   ! temporary fmask excluding coastal boundary condition (shlat)
-      REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in   ) :: pumask, pvmask   ! temporary t/u/v mask array
-      LOGICAL                             , INTENT (in   ) :: lrim0    ! .true. -> rim 0   .false. -> rim 1
+      REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in   ) :: pfmask   ! temporary fmask excluding coastal boundary condition (shlat)
+      REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in   ) :: pumask, pvmask   ! temporary t/u/v mask array
+      REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in   ) :: pbdytmask, pbdyumask, pbdyvmask   
+      LOGICAL                             , INTENT(in   ) :: lrim0    ! .true. -> rim 0   .false. -> rim 1
+      INTEGER                             , INTENT(in   ) :: idbi, idbj, idei, idej    ! start/end of the subdomain 
+                                                                                   ! for extended and regular bdy treatment
+      LOGICAL, OPTIONAL                   , INTENT(in   ) :: ldxtd    ! number of halos added to nn_hls for time splitting
+      !
       INTEGER  ::   ib_bdy, ii, ij, igrd, ib, icount       ! dummy loop indices
-      INTEGER  ::   i_offset, j_offset, inn                ! local integer
+      INTEGER  ::   i_offset, j_offset, inn, ihl           ! local integer
       INTEGER  ::   ibeg, iend                             ! local integer
       LOGICAL  ::   llnon, llson, llean, llwen             ! local logicals indicating the presence of a ocean neighbour
@@ -831 +904 @@
       REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars
       CHARACTER(LEN=1), DIMENSION(jpbgrd)     ::   cgrid
-      REAL(wp)        , DIMENSION(jpi,jpj)    ::   ztmp
+      REAL(wp)        , DIMENSION(idbi:idei,idbj:idej)    ::   ztmp
       !!----------------------------------------------------------------------
 
       cgrid = (/'t','u','v'/)
+      ihl = nn_hls
+      IF( PRESENT(ldxtd) ) THEN   ;   IF( ldxtd )   ihl = nn_hls + nn_hlts   ;   ENDIF
 
       DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components
@@ -844 +919 @@
          DO igrd = 1, jpbgrd 
             SELECT CASE( igrd )
-               CASE( 1 )   ;   zmask => pumask     ;   i_offset = 0
-               CASE( 2 )   ;   zmask => bdytmask   ;   i_offset = 1
-               CASE( 3 )   ;   zmask => pfmask     ;   i_offset = 0
+               CASE( 1 )   ;   zmask => pumask      ;   i_offset = 0
+               CASE( 2 )   ;   zmask => pbdytmask   ;   i_offset = 1
+               CASE( 3 )   ;   zmask => pfmask      ;   i_offset = 0
             END SELECT 
             icount = 0
@@ -858 +933 @@
                ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
                ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE
+               IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej )  CYCLE
                zwfl = zmask(ii+i_offset-1,ij)
                zefl = zmask(ii+i_offset  ,ij)
@@ -873 +948 @@
                   ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy
                CALL ctl_stop( ctmp1 )
-            ENDIF 
+            ENDIF
             SELECT CASE( igrd )
-               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. ) 
-               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. ) 
-               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. ) 
-            END SELECT 
+               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl ) 
+               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl ) 
+               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl )
+            END SELECT
             DO ib = ibeg, iend
                ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -892 +967 @@
          DO igrd = 1, jpbgrd 
             SELECT CASE( igrd )
-               CASE( 1 )   ;   zmask => pvmask     ;   j_offset = 0
-               CASE( 2 )   ;   zmask => pfmask     ;   j_offset = 0
-               CASE( 3 )   ;   zmask => bdytmask   ;   j_offset = 1
+               CASE( 1 )   ;   zmask => pvmask      ;   j_offset = 0
+               CASE( 2 )   ;   zmask => pfmask      ;   j_offset = 0
+               CASE( 3 )   ;   zmask => pbdytmask   ;   j_offset = 1
             END SELECT 
             icount = 0
@@ -906 +981 @@
                ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
                ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE
+               IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej )  CYCLE
                zsfl = zmask(ii,ij+j_offset-1)
                znfl = zmask(ii,ij+j_offset  )
@@ -923 +998 @@
             ENDIF
             SELECT CASE( igrd )
-               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. ) 
-               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. ) 
-               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. ) 
-            END SELECT 
+               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl ) 
+               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl ) 
+               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl ) 
+            END SELECT
             DO ib = ibeg, iend
                ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -939 +1014 @@
          DO igrd = 1, jpbgrd
             SELECT CASE( igrd )
-               CASE( 1 )   ;   zmask => bdytmask 
-               CASE( 2 )   ;   zmask => bdyumask 
-               CASE( 3 )   ;   zmask => bdyvmask 
+               CASE( 1 )   ;   zmask => pbdytmask 
+               CASE( 2 )   ;   zmask => pbdyumask 
+               CASE( 3 )   ;   zmask => pbdyvmask 
             END SELECT
             ztmp(:,:) = -999._wp
@@ -952 +1027 @@
                ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
                ij = idx_bdy(ib_bdy)%nbj(ib,igrd)
-               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE
+               IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej )  CYCLE
                llnon = zmask(ii  ,ij+1) == 1.  
                llson = zmask(ii  ,ij-1) == 1. 
@@ -1011 +1086 @@
             END DO
             SELECT CASE( igrd )
-               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. ) 
-               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. ) 
-               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. ) 
-            END SELECT 
+               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl ) 
+               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl ) 
+               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl ) 
+            END SELECT
             DO ib = ibeg, iend
                ii = idx_bdy(ib_bdy)%nbi(ib,igrd)
@@ -1040 +1115 @@
       INTEGER, INTENT(  out)      ::   ii1, ij1, ii2, ij2, ii3, ij3
       !!----------------------------------------------------------------------
-      SELECT CASE( itreat )   ! points that will be used by bdy routines, -1 will be discarded
+      SELECT CASE( itreat )   ! points that will be used by bdy routines, -99 will be discarded
          !               !               !     _____     !     _____     
          !  1 |   o      !  2  o   |     !  3 | x        !  4     x |    
          !    |_x_ _     !    _ _x_|     !    |   o      !      o   |
-      CASE( 1 )    ;   ii1 = ii+1   ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 2 )    ;   ii1 = ii-1   ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 3 )    ;   ii1 = ii+1   ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 4 )    ;   ii1 = ii-1   ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
+      CASE( 1 )    ;   ii1 = ii+1   ;   ij1 = ij+1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
+      CASE( 2 )    ;   ii1 = ii-1   ;   ij1 = ij+1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
+      CASE( 3 )    ;   ii1 = ii+1   ;   ij1 = ij-1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
+      CASE( 4 )    ;   ii1 = ii-1   ;   ij1 = ij-1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
          !    |          !         |     !      o        !    ______                   ! or incomplete corner
          ! 5  | x o      ! 6   o x |     ! 7  __x__      ! 8    x                      !  7  ____ o
          !    |          !         |     !               !      o                      !         |x___
-      CASE( 5 )    ;   ii1 = ii+1   ;   ij1 = ij     ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 6 )    ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 7 )    ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 8 )    ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1
+      CASE( 5 )    ;   ii1 = ii+1   ;   ij1 = ij     ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
+      CASE( 6 )    ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
+      CASE( 7 )    ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
+      CASE( 8 )    ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99
          !        o      !        o      !    _____|     !       |_____  
          !  9 ____x o    ! 10   o x___   ! 11     x o    ! 12   o x      
          !         |     !       |       !        o      !        o      
-      CASE( 9  )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
-      CASE( 10 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 11 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1
-      CASE( 12 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1
+      CASE( 9  )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99
+      CASE( 10 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99
+      CASE( 11 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99
+      CASE( 12 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99
          !    |_  o      !        o  _|  !     ¨¨|_|¨¨   !       o         
          ! 13  _| x o    !  14  o x |_   !  15  o x o    ! 16  o x o       
          !    |   o      !        o   |  !        o      !    __|¨|__ 
-      CASE( 13 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1   
-      CASE( 14 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1 
+      CASE( 13 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1 
+      CASE( 14 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1
       CASE( 15 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij-1   ;   ii3 = ii+1   ;   ij3 = ij   
       CASE( 16 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij+1   ;   ii3 = ii+1   ;   ij3 = ij

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdylib.F90

@@ -449 +449 @@
    END SUBROUTINE bdy_orlanski_3d
 
-   SUBROUTINE bdy_nmn( idx, igrd, phia, lrim0 )
+   SUBROUTINE bdy_nmn( idx, igrd, idbi, idei, idbj, idej, ipk, phia, ldrim0, pmask )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_nmn  ***
@@ -463 +463 @@
       !!                                                   !      o      
       !!----------------------------------------------------------------------
-      INTEGER,                    INTENT(in   )  ::   igrd     ! grid index
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked
-      TYPE(OBC_INDEX),            INTENT(in   )  ::   idx      ! OBC indices
-      LOGICAL, OPTIONAL,          INTENT(in   )  ::   lrim0    ! indicate if rim 0 is treated
-      !! 
+      TYPE(OBC_INDEX),                              INTENT(in   )  ::   idx    ! OBC indices
+      INTEGER ,                                     INTENT(in   )  ::   igrd   ! grid index
+      INTEGER ,                                     INTENT(in   )  ::   idbi, idei, idbj, idej, ipk   ! size of phia array
+      REAL(wp), DIMENSION(idbi:idei,idbj:idej,ipk), INTENT(inout)  ::   phia   ! model after 3D field (to be updated), must be masked
+      LOGICAL , OPTIONAL,                                           INTENT(in   )  ::   ldrim0   ! indicate if rim 0 is treated
+      REAL(wp), OPTIONAL, TARGET, DIMENSION(idbi:idei,idbj:idej,1), INTENT(in   )  ::   pmask    ! optional mask for extended domain
+      !!                                                                                         ! always 2d : used by dyn_spg_ts
       REAL(wp) ::   zweight
       REAL(wp), POINTER, DIMENSION(:,:,:)      :: zmask         ! land/sea mask for field
@@ -477 +479 @@
       !!----------------------------------------------------------------------
       !
-      ipkm1 = MAX( SIZE(phia,3) - 1, 1 ) 
-      !
-      SELECT CASE(igrd)
+      ipkm1 = MAX( ipk-1, 1 ) 
+      !
+      IF( PRESENT(pmask) ) THEN
+                       zmask => pmask   ! mask for extended domain   ! N.B. do not specify (:,:,:) as it does not work for arrays 
+      ELSE                                                           !      with LBOUND < 1
+         SELECT CASE(igrd)
          CASE(1)   ;   zmask => tmask(:,:,:)
          CASE(2)   ;   zmask => umask(:,:,:)
          CASE(3)   ;   zmask => vmask(:,:,:)
          CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' )
-      END SELECT
-      !
-      IF( PRESENT(lrim0) ) THEN
-         IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
-         ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
+         END SELECT
+      END IF
+      !
+      IF( PRESENT(ldrim0) ) THEN
+         IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0
+         ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1
          END IF
-      ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both
+      ELSE                   ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both
       END IF
       !
@@ -500 +506 @@
          SELECT CASE( itreat )
          CASE( 1:8 )
-            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE
+            IF( ii1 < idbi .OR. ii1 > idei .OR. ij1 < idbj .OR. ij1 > idej )   CYCLE
             DO ik = 1, ipkm1
                IF( zmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)  
             END DO
          CASE( 9:12 )
-            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE
-            IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE
+            IF( ii1 < idbi .OR. ii1 > idei .OR. ij1 < idbj .OR. ij1 > idej )   CYCLE
+            IF( ii2 < idbi .OR. ii2 > idei .OR. ij2 < idbj .OR. ij2 > idej )   CYCLE
             DO ik = 1, ipkm1
                zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik)
@@ -512 +518 @@
             END DO
          CASE( 13:16 )
-            IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE
-            IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE
-            IF( ii3 < 1 .OR. ii3 > jpi .OR. ij3 < 1 .OR. ij3 > jpj )   CYCLE
+            IF( ii1 < idbi .OR. ii1 > idei .OR. ij1 < idbj .OR. ij1 > idej )   CYCLE
+            IF( ii2 < idbi .OR. ii2 > idei .OR. ij2 < idbj .OR. ij2 > idej )   CYCLE
+            IF( ii3 < idbi .OR. ii3 > idei .OR. ij3 < idbj .OR. ij3 > idej )   CYCLE
             DO ik = 1, ipkm1
                zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) + zmask(ii3,ij3,ik)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdytra.F90

@@ -73 +73 @@
                CASE('specified'   )   ! treat the whole rim      at once
                   IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
-               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn), llrim0 )   ! tsa masked
+               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd, 1,jpi, 1,jpj, 1, tsa(:,:,:,jn), llrim0 )  !tsa masked
                CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), &
                     & zdta(jn)%tra, llrim0, ll_npo=.false. )
@@ -98 +98 @@
          END DO
          IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1 )
          END IF
          !
@@ -126 +126 @@
       igrd = 1                       ! Everything is at T-points here
       IF(      jpa == jp_tem ) THEN
-         CALL bdy_nmn( idx, igrd, pta, llrim0 )
+         CALL bdy_nmn( idx, igrd, 1,jpi, 1,jpj, 1, pta, llrim0 )
       ELSE IF( jpa == jp_sal ) THEN
          IF( .NOT. llrim0 )   RETURN

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DIA/diadct.F90

@@ -11 +11 @@
    !!            3.4  ! 09/2011 (C Bricaud)
    !!----------------------------------------------------------------------
-   !!
+#if defined key_diadct
+   !!----------------------------------------------------------------------
+   !!   'key_diadct' :
+   !!----------------------------------------------------------------------
    !!----------------------------------------------------------------------
    !!   dia_dct      :  Compute the transport through a sec.
@@ -39 +42 @@
 
    PUBLIC   dia_dct      ! routine called by step.F90
-   PUBLIC   dia_dct_init ! routine called by nemogcm.F90
-
-   !                         !!** namelist variables **
-   LOGICAL, PUBLIC ::   ln_diadct     ! Calculate transport thru a section or not
-   INTEGER         ::   nn_dct        ! Frequency of computation
-   INTEGER         ::   nn_dctwri     ! Frequency of output
-   INTEGER         ::   nn_secdebug   ! Number of the section to debug
+   PUBLIC   dia_dct_init ! routine called by opa.F90
+   PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90 
+   PRIVATE  readsec
+   PRIVATE  removepoints
+   PRIVATE  transport
+   PRIVATE  dia_dct_wri
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag
+
+   INTEGER :: nn_dct        ! Frequency of computation
+   INTEGER :: nn_dctwri     ! Frequency of output
+   INTEGER :: nn_secdebug   ! Number of the section to debug
    
    INTEGER, PARAMETER :: nb_class_max  = 10
@@ -96 +104 @@
 CONTAINS
  
-   INTEGER FUNCTION diadct_alloc() 
-      !!---------------------------------------------------------------------- 
-      !!                   ***  FUNCTION diadct_alloc  *** 
-      !!---------------------------------------------------------------------- 
-
-      ALLOCATE( transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), &
-         &      transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=diadct_alloc ) 
-
-      CALL mpp_sum( 'diadct', diadct_alloc ) 
-      IF( diadct_alloc /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 
-
-   END FUNCTION diadct_alloc
+  INTEGER FUNCTION diadct_alloc() 
+     !!---------------------------------------------------------------------- 
+     !!                   ***  FUNCTION diadct_alloc  *** 
+     !!---------------------------------------------------------------------- 
+     INTEGER :: ierr(2) 
+     !!---------------------------------------------------------------------- 
+
+     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) ) 
+     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(2) ) 
+
+     diadct_alloc = MAXVAL( ierr ) 
+     IF( diadct_alloc /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 
+ 
+  END FUNCTION diadct_alloc 
+
 
    SUBROUTINE dia_dct_init
@@ -119 +130 @@
       INTEGER  ::   ios                 ! Local integer output status for namelist read
       !!
-      NAMELIST/nam_diadct/ln_diadct, nn_dct, nn_dctwri, nn_secdebug
+      NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug
       !!---------------------------------------------------------------------
 
-     REWIND( numnam_ref )              ! Namelist nam_diadct in reference namelist : Diagnostic: transport through sections
-     READ  ( numnam_ref, nam_diadct, IOSTAT = ios, ERR = 901)
-901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadct in reference namelist' )
-
-     REWIND( numnam_cfg )              ! Namelist nam_diadct in configuration namelist : Diagnostic: transport through sections
-     READ  ( numnam_cfg, nam_diadct, IOSTAT = ios, ERR = 902 )
-902  IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diadct in configuration namelist' )
-     IF(lwm) WRITE ( numond, nam_diadct )
+     REWIND( numnam_ref )              ! Namelist namdct in reference namelist : Diagnostic: transport through sections
+     READ  ( numnam_ref, namdct, IOSTAT = ios, ERR = 901)
+901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist' )
+
+     REWIND( numnam_cfg )              ! Namelist namdct in configuration namelist : Diagnostic: transport through sections
+     READ  ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 )
+902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist' )
+     IF(lwm) WRITE ( numond, namdct )
 
      IF( lwp ) THEN
@@ -135 +146 @@
         WRITE(numout,*) "diadct_init: compute transports through sections "
         WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
-        WRITE(numout,*) "       Calculate transport thru sections: ln_diadct = ", ln_diadct
-        WRITE(numout,*) "       Frequency of computation:          nn_dct    = ", nn_dct
-        WRITE(numout,*) "       Frequency of write:                nn_dctwri = ", nn_dctwri
+        WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct
+        WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri
 
         IF      ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN
@@ -145 +155 @@
         ELSE                              ; WRITE(numout,*)"       Wrong value for nn_secdebug : ",nn_secdebug
         ENDIF
+
+        IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0)  &
+          &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' )
+
      ENDIF
 
-     IF( ln_diadct ) THEN
-        ! control
-        IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0)  &
-           &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' )
-
-        ! allocate dia_dct arrays
-        IF( diadct_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' )
-
-        !Read section_ijglobal.diadct
-        CALL readsec
-
-        !open output file
-        IF( lwm ) THEN
-           CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-           CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-           CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
-        ENDIF
-
-        ! Initialise arrays to zero 
-        transports_3d(:,:,:,:)=0.0 
-        transports_2d(:,:,:)  =0.0 
-        !
+     !Read section_ijglobal.diadct
+     CALL readsec
+
+     !open output file
+     IF( lwm ) THEN
+        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
+        CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. )
      ENDIF
+
+     ! Initialise arrays to zero 
+     transports_3d(:,:,:,:)=0.0 
+     transports_2d(:,:,:)  =0.0 
      !
   END SUBROUTINE dia_dct_init
@@ -1235 +1239 @@
    END FUNCTION interp
 
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Dummy module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .FALSE.    !: diamht flag
+   PUBLIC 
+   !! $Id$
+CONTAINS
+
+   SUBROUTINE dia_dct_init          ! Dummy routine
+      IMPLICIT NONE
+      WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?'
+   END SUBROUTINE dia_dct_init
+
+   SUBROUTINE dia_dct( kt )         ! Dummy routine
+      IMPLICIT NONE
+      INTEGER, INTENT( in ) :: kt   ! ocean time-step index
+      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt
+   END SUBROUTINE dia_dct
+#endif
+
    !!======================================================================
 END MODULE diadct

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DIA/diaharm.F90

@@ -5 +5 @@
    !!======================================================================
    !! History :  3.1  !  2007  (O. Le Galloudec, J. Chanut)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_diaharm
+   !!----------------------------------------------------------------------
+   !!   'key_diaharm'
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
@@ -22 +26 @@
    IMPLICIT NONE
    PRIVATE
+
+   LOGICAL, PUBLIC, PARAMETER :: lk_diaharm  = .TRUE.
    
    INTEGER, PARAMETER :: jpincomax    = 2.*jpmax_harmo
@@ -27 +33 @@
 
    !                         !!** namelist variables **
-   LOGICAL, PUBLIC ::   ln_diaharm    ! Choose tidal harmonic output or not
-   INTEGER         ::   nit000_han    ! First time step used for harmonic analysis
-   INTEGER         ::   nitend_han    ! Last time step used for harmonic analysis
-   INTEGER         ::   nstep_han     ! Time step frequency for harmonic analysis
-   INTEGER         ::   nb_ana        ! Number of harmonics to analyse
+   INTEGER ::   nit000_han    ! First time step used for harmonic analysis
+   INTEGER ::   nitend_han    ! Last time step used for harmonic analysis
+   INTEGER ::   nstep_han     ! Time step frequency for harmonic analysis
+   INTEGER ::   nb_ana        ! Number of harmonics to analyse
 
    INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name
@@ -48 +53 @@
    CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   tname   ! Names of tidal constituents ('M2', 'K1',...)
 
-   PUBLIC   dia_harm        ! routine called by step.F90
-   PUBLIC   dia_harm_init   ! routine called by nemogcm.F90
+   PUBLIC   dia_harm   ! routine called by step.F90
 
    !!----------------------------------------------------------------------
@@ -67 +71 @@
       !!
       !!--------------------------------------------------------------------
-      INTEGER ::   jh, nhan, ji
+      INTEGER :: jh, nhan, jk, ji
       INTEGER ::   ios                 ! Local integer output status for namelist read
 
-      NAMELIST/nam_diaharm/ ln_diaharm, nit000_han, nitend_han, nstep_han, tname
+      NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname
       !!----------------------------------------------------------------------
 
@@ -78 +82 @@
          WRITE(numout,*) '~~~~~~~ '
       ENDIF
+      !
+      IF( .NOT. ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis')
+      !
+      CALL tide_init_Wave
       !
       REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis
@@ -88 +96 @@
       !
       IF(lwp) THEN
-         WRITE(numout,*) 'Tidal diagnostics = ', ln_diaharm
-         WRITE(numout,*) '   First time step used for analysis:         nit000_han= ', nit000_han
-         WRITE(numout,*) '   Last  time step used for analysis:         nitend_han= ', nitend_han
-         WRITE(numout,*) '   Time step frequency for harmonic analysis: nstep_han = ', nstep_han
+         WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han
+         WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han
+         WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han
       ENDIF
 
-      IF( ln_diaharm .AND. .NOT.ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis')
-
-      IF( ln_diaharm ) THEN
-
-         CALL tide_init_Wave
-         !
-         ! Basic checks on harmonic analysis time window:
-         ! ----------------------------------------------
-         IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   &
-            &                                       ' restart capability not implemented' )
-         IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   &
-            &                                       'restart capability not implemented' )
-
-         IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   &
-            &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' )
-         !
-         nb_ana = 0
-         DO jh=1,jpmax_harmo
-            DO ji=1,jpmax_harmo
-               IF(TRIM(tname(jh)) == Wave(ji)%cname_tide) THEN
-                  nb_ana=nb_ana+1
-               ENDIF
-            END DO
-         END DO
-         !
-         IF(lwp) THEN
-            WRITE(numout,*) '        Namelist nam_diaharm'
-            WRITE(numout,*) '        nb_ana    = ', nb_ana
-            CALL flush(numout)
-         ENDIF
-         !
-         IF (nb_ana > jpmax_harmo) THEN
-            WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo'
-            WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo
-            CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 )
-         ENDIF
-
-         ALLOCATE(name    (nb_ana))
-         DO jh=1,nb_ana
-            DO ji=1,jpmax_harmo
-               IF (TRIM(tname(jh)) ==  Wave(ji)%cname_tide) THEN
-                  name(jh) = ji
-                  EXIT
-               END IF
-            END DO
-         END DO
-
-         ! Initialize frequency array:
-         ! ---------------------------
-         ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) )
-
-         CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana )
-
-         IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency '
-
-         DO jh = 1, nb_ana
-            IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh)
-         END DO
-
-         ! Initialize temporary arrays:
-         ! ----------------------------
-         ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) )
-         ana_temp(:,:,:,:) = 0._wp
-
+      ! Basic checks on harmonic analysis time window:
+      ! ----------------------------------------------
+      IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   &
+         &                                       ' restart capability not implemented' )
+      IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   &
+         &                                       'restart capability not implemented' )
+
+      IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   &
+         &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' )
+
+      nb_ana = 0
+      DO jk=1,jpmax_harmo
+         DO ji=1,jpmax_harmo
+            IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN
+               nb_ana=nb_ana+1
+            ENDIF
+         END DO
+      END DO
+      !
+      IF(lwp) THEN
+         WRITE(numout,*) '        Namelist nam_diaharm'
+         WRITE(numout,*) '        nb_ana    = ', nb_ana
+         CALL flush(numout)
       ENDIF
+      !
+      IF (nb_ana > jpmax_harmo) THEN
+         WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo'
+         WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo
+         CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 )
+      ENDIF
+
+      ALLOCATE(name    (nb_ana))
+      DO jk=1,nb_ana
+       DO ji=1,jpmax_harmo
+          IF (TRIM(tname(jk)) ==  Wave(ji)%cname_tide) THEN
+             name(jk) = ji
+             EXIT
+          END IF
+       END DO
+      END DO
+
+      ! Initialize frequency array:
+      ! ---------------------------
+      ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) )
+
+      CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana )
+
+      IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency '
+
+      DO jh = 1, nb_ana
+        IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh)
+      END DO
+
+      ! Initialize temporary arrays:
+      ! ----------------------------
+      ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) )
+      ana_temp(:,:,:,:) = 0._wp
 
    END SUBROUTINE dia_harm_init
@@ -178 +177 @@
       !!--------------------------------------------------------------------
       IF( ln_timing )   CALL timing_start('dia_harm')
+      !
+      IF( kt == nit000 )   CALL dia_harm_init
       !
       IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN
@@ -421 +422 @@
       INTEGER, INTENT(in) ::   init 
       !
-      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jh1_sd, jh2_sd
+      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd
       REAL(wp)                        :: zval1, zval2, zx1
       REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2
@@ -433 +434 @@
          ztmp3(:,:) = 0._wp
          !
-         DO jh1_sd = 1, nsparse
-            DO jh2_sd = 1, nsparse
-               nisparse(jh2_sd) = nisparse(jh2_sd)
-               njsparse(jh2_sd) = njsparse(jh2_sd)
-               IF( nisparse(jh2_sd) == nisparse(jh1_sd) ) THEN
-                  ztmp3(njsparse(jh1_sd),njsparse(jh2_sd)) = ztmp3(njsparse(jh1_sd),njsparse(jh2_sd))  &
-                     &                                     + valuesparse(jh1_sd)*valuesparse(jh2_sd)
+         DO jk1_sd = 1, nsparse
+            DO jk2_sd = 1, nsparse
+               nisparse(jk2_sd) = nisparse(jk2_sd)
+               njsparse(jk2_sd) = njsparse(jk2_sd)
+               IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN
+                  ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  &
+                     &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd)
                ENDIF
             END DO
@@ -514 +515 @@
    END SUBROUTINE SUR_DETERMINE
 
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm = .FALSE.
+CONTAINS
+   SUBROUTINE dia_harm ( kt )     ! Empty routine
+      INTEGER, INTENT( IN ) :: kt  
+      WRITE(*,*) 'dia_harm: you should not have seen this print'
+   END SUBROUTINE dia_harm
+#endif
+
    !!======================================================================
 END MODULE diaharm

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DYN/dynspg_ts.F90

@@ -64 +64 @@
    USE diatmb          ! Top,middle,bottom output
 
-   USE iom   ! to remove
 
    IMPLICIT NONE
@@ -78 +77 @@
    REAL(wp),SAVE :: rdtbt       ! Barotropic time step
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwz                ! ff_f/h at F points
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ftnw, ftne         ! triad of coriolis parameter
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ftsw, ftse         ! (only used with een vorticity scheme)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::  wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz                ! ff_f/h at F points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne         ! triad of coriolis parameter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse         ! (only used with een vorticity scheme)
+
+   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b          !: Half step fluxes (ln_bt_fw=T)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_bf  , vn_bf          !: Asselin filtered half step fluxes (ln_bt_fw=T)
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0_xtd    , hu_0_xtd    , hv_0_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::                 hu_n_xtd    , hv_n_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t_xtd, r1_e1e2u_xtd, r1_e1e2v_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e2u_xtd   , e1v_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1u_xtd, r1_e2v_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask_xtd, ssumask_xtd, ssvmask_xtd
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_t_xtd   ! used in ENT scheme
+
+#if defined key_agrif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes 
+#endif
 
    REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! local ratios
@@ -101 +124 @@
       !!                  ***  routine dyn_spg_ts_alloc  ***
       !!----------------------------------------------------------------------
-      INTEGER :: ierr(3)
+      INTEGER :: ierr(6)
+      INTEGER :: idbi, idei, idbj, idej   ! lower/upper bounds of extended arrays
       !!----------------------------------------------------------------------
       ierr(:) = 0
-      !
-      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) )
-      IF( ln_dynvor_een .OR. ln_dynvor_eeT )   &
-         &     ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , ftsw(jpi,jpj) , ftse(jpi,jpj), STAT=ierr(2)   )
+      idbi = 1   - nn_hlts   ;   idbj = 1   - nn_hlts
+      idei = jpi + nn_hlts   ;   idej = jpj + nn_hlts
+      !
+      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(idbi:idei,idbj:idej), STAT=ierr(1) )
+      IF( ln_dynvor_een .OR. ln_dynvor_eeT ) THEN
+         ALLOCATE( ftnw(idbi:idei,idbj:idej) , ftne(idbi:idei,idbj:idej) , ftsw(idbi:idei,idbj:idej) , ftse(idbi:idei,idbj:idej) &
+         &                                      , STAT=ierr(2) )
+      ELSEIF( ln_dynvor_enT ) THEN
+         ALLOCATE( ff_t_xtd(idbi:idei,idbj:idej), STAT=ierr(2) )
+      END IF
          !
       ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj)                    , STAT=ierr(3) )
+      ALLOCATE( ssha_e(idbi:idei,idbj:idej), sshn_e(idbi:idei,idbj:idej), sshb_e(idbi:idei,idbj:idej), sshbb_e(idbi:idei,idbj:idej) &
+         &      , ua_e(idbi:idei,idbj:idej),   un_e(idbi:idei,idbj:idej),   ub_e(idbi:idei,idbj:idej),   ubb_e(idbi:idei,idbj:idej) &
+         &      , va_e(idbi:idei,idbj:idej),   vn_e(idbi:idei,idbj:idej),   vb_e(idbi:idei,idbj:idej),   vbb_e(idbi:idei,idbj:idej) &
+         &      , hu_e(idbi:idei,idbj:idej),  hur_e(idbi:idei,idbj:idej),   hv_e(idbi:idei,idbj:idej),   hvr_e(idbi:idei,idbj:idej) &
+         &      , STAT=ierr(4) )
+         !
+      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj)     , STAT=ierr(5) )
+
+#if defined key_agrif
+      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(5) )
+#endif
+      ALLOCATE( ht_0_xtd    (idbi:idei,idbj:idej), hu_0_xtd    (idbi:idei,idbj:idej), hv_0_xtd    (idbi:idei,idbj:idej) &
+         &    , r1_e1e2t_xtd(idbi:idei,idbj:idej), r1_e1e2u_xtd(idbi:idei,idbj:idej), r1_e1e2v_xtd(idbi:idei,idbj:idej) &
+         &    , ssmask_xtd  (idbi:idei,idbj:idej), ssumask_xtd (idbi:idei,idbj:idej), ssvmask_xtd (idbi:idei,idbj:idej) &
+         &    , e1e2t_xtd   (idbi:idei,idbj:idej), e2u_xtd     (idbi:idei,idbj:idej), e1v_xtd     (idbi:idei,idbj:idej) &
+         &    , r1_e1u_xtd  (idbi:idei,idbj:idej), r1_e2v_xtd  (idbi:idei,idbj:idej)                                    &
+         &    , STAT=ierr(6) )
       !
       dyn_spg_ts_alloc = MAXVAL( ierr(:) )
@@ -146 +193 @@
       INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
       !
-      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices
+      INTEGER  ::   ji, jj, jk, jm        ! dummy loop indices
       LOGICAL  ::   ll_fw_start           ! =T : forward integration 
       LOGICAL  ::   ll_init               ! =T : special startup of 2d equations
@@ -155 +202 @@
       REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      -
       REAL(wp) ::   zun_save, zvn_save              !   -      -
-      REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc
-      REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg
-      REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e
-      REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e
-      REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points
-      REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV         ! fluxes
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zu_trd, zssh_frc
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zv_trd
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zhU   , zhV
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: hu_n_xtd, hv_n_xtd
+      !
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zu_spg , zv_spg
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zu_frc , zv_frc
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsshu_a, zhup2_e, zhtp2_e
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsshv_a, zhvp2_e, zsshp2_e
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zCdU_u , zCdU_v   ! top/bottom stress at u- & v-points
+
       !
       REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_wd_dl = .True. 
@@ -170 +224 @@
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points
       REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask
-      !!----------------------------------------------------------------------
-      !
+
+
+      INTEGER  :: idbi, idei, idbj, idej   ! lower/upper bounds of extended arrays
+      INTEGER  :: ixtd                     ! number of halos over which the solution is currently correct
+      INTEGER  :: ibi, iei, ibj, iej       ! lower and upper bounds over which the solution is currently correct
+      !!----------------------------------------------------------------------
+      !
+
+
       IF( ln_wd_il ) ALLOCATE( zcpx(jpi,jpj), zcpy(jpi,jpj) )
       !                                         !* Allocate temporary arrays
-      IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj))
+      IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj) )
+      
+      idbi = 1   - nn_hlts   ;   idbj = 1   - nn_hlts
+      idei = jpi + nn_hlts   ;   idej = jpj + nn_hlts
+      !                                  ! allocate local arrays
+      ALLOCATE( zu_spg  (idbi:idei,idbj:idej), zv_spg  (idbi:idei,idbj:idej)  &
+         &    , zsshu_a (idbi:idei,idbj:idej), zsshv_a (idbi:idei,idbj:idej)  &
+         &    , zhup2_e (idbi:idei,idbj:idej), zhvp2_e (idbi:idei,idbj:idej)  &
+         &    ,  zCdU_u (idbi:idei,idbj:idej), zCdU_v  (idbi:idei,idbj:idej)  &
+         &    , zhtp2_e (idbi:idei,idbj:idej), zsshp2_e(idbi:idei,idbj:idej)  & 
+         &    , zu_trd  (idbi:idei,idbj:idej), zu_frc  (idbi:idei,idbj:idej)  &
+         &    , zv_trd  (idbi:idei,idbj:idej), zv_frc  (idbi:idei,idbj:idej)  &
+         &    , zhU     (idbi:idei,idbj:idej), zhV     (idbi:idei,idbj:idej)  &
+         &    , zssh_frc(idbi:idei,idbj:idej)                                 )
+      !                                  ! allocate redundant arrays
+      ALLOCATE( hu_n_xtd(idbi:idei,idbj:idej), hv_n_xtd(idbi:idei,idbj:idej)  )
       !
       zmdi=1.e+20                               !  missing data indicator for masking
@@ -227 +303 @@
       !                                   !=  zu_frc =  1/H e3*d/dt(Ua)  =!  (Vertical mean of Ua, the 3D trends)
       !                                   !  ---------------------------  !
-      zu_frc(:,:) = SUM( e3u_n(:,:,:) * ua(:,:,:) * umask(:,:,:) , DIM=3 ) * r1_hu_n(:,:)
-      zv_frc(:,:) = SUM( e3v_n(:,:,:) * va(:,:,:) * vmask(:,:,:) , DIM=3 ) * r1_hv_n(:,:)
+      zu_frc(1:jpi,1:jpj) = SUM( e3u_n(:,:,:) * ua(:,:,:) * umask(:,:,:) , DIM=3 ) * r1_hu_n(:,:)
+      zv_frc(1:jpi,1:jpj) = SUM( e3v_n(:,:,:) * va(:,:,:) * vmask(:,:,:) , DIM=3 ) * r1_hv_n(:,:)
       !
       !
       !                                   !=  Ua => baroclinic trend  =!   (remove its vertical mean)
       DO jk = 1, jpkm1                    !  ------------------------  !
-         ua(:,:,jk) = ( ua(:,:,jk) - zu_frc(:,:) ) * umask(:,:,jk)
-         va(:,:,jk) = ( va(:,:,jk) - zv_frc(:,:) ) * vmask(:,:,jk)
+         ua(:,:,jk) = ( ua(:,:,jk) - zu_frc(1:jpi,1:jpj) ) * umask(:,:,jk)
+         va(:,:,jk) = ( va(:,:,jk) - zv_frc(1:jpi,1:jpj) ) * vmask(:,:,jk)
       END DO
       
@@ -243 +319 @@
       !                                   !  -------------------------------------------------  !
       !
-      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init   ! Set zwz, the barotropic Coriolis force coefficient
-      !       ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes
+      ! Set zwz, the barotropic Coriolis force coefficient
+      ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes
+      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2d_init( idbi, idei, idbj, idej )
       !
       !                                         !* 2D Coriolis trends
-      zhU(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
-      zhV(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column
-      !
-      CALL dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,  &   ! <<== in
-         &                               zu_trd, zv_trd   )   ! ==>> out
+      zhU(1:jpi,1:jpj) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes 
+      zhV(1:jpi,1:jpj) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column
+      !
+      !                            ! ht_n, hu_n, hv_n, un_b, vn_b are of size    1:jpi      1:jpj
+      !                            ! zhU, zhV, zu_trd, zv_trd     are of size idbi:idei  idbj:idej
+      CALL dyn_cor_2d( ht_n, hu_n, hv_n, un_b, vn_b, zhU, zhV,  1   , jpi , 1   ,  jpj   &   ! <<== in
+         &                                   , zu_trd, zv_trd,  idbi, idei, idbj, idej   )   ! ==>> out
       !
       IF( .NOT.ln_linssh ) THEN                 !* surface pressure gradient   (variable volume only)
@@ -285 +364 @@
       !                                   !=  Add bottom stress contribution from baroclinic velocities  =!
       !                                   !  -----------------------------------------------------------  !
-      CALL dyn_drg_init( zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients
+      CALL drg_init( idbi, idei, idbj, idej,  zu_frc, zv_frc,  zCdU_u, zCdU_v )   ! also provide the barotropic drag coefficients
+      !                                                                           ! arrays are computed on inner domain
       !
       !                                   !=  Add atmospheric pressure forcing  =!
@@ -335 +415 @@
       !                                   ! ---------------------------------------------------  !
       IF (ln_bt_fw) THEN                          ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2)
-         zssh_frc(:,:) = r1_rau0 * ( emp(:,:)             - rnf(:,:)              + fwfisf(:,:)                  )
+         zssh_frc(1:jpi,1:jpj) = r1_rau0 * ( emp(:,:)             - rnf(:,:)              + fwfisf(:,:)                  )
       ELSE                                        ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW)
          zztmp = r1_rau0 * r1_2
-         zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:)  )
+         zssh_frc(1:jpi,1:jpj) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:)  )
       ENDIF
       !                                   !=  Add Stokes drift divergence  =!   (if exist)
       IF( ln_sdw ) THEN                   !  -----------------------------  !
-         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:)
+         zssh_frc(1:jpi,1:jpj) = zssh_frc(1:jpi,1:jpj) + div_sd(:,:)
       ENDIF
       !
@@ -349 +429 @@
       !                                   !  ------------------------------------  !
       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
-         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:)
+         zssh_frc(1:jpi,1:jpj) = zssh_frc(1:jpi,1:jpj) - ssh_iau(:,:)
       ENDIF
 #endif
@@ -357 +437 @@
          IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt )
 #endif
+
+
       !
       ! -----------------------------------------------------------------------
@@ -366 +448 @@
       !                                             ! ==================== !  
       ! Initialize barotropic variables:      
-      IF( ll_init )THEN
+      IF( ll_init ) THEN
          sshbb_e(:,:) = 0._wp
          ubb_e  (:,:) = 0._wp
@@ -376 +458 @@
       !
       IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0)
-         zhup2_e(:,:) = hu_n(:,:)
-         zhvp2_e(:,:) = hv_n(:,:)
-         zhtp2_e(:,:) = ht_n(:,:)
+         zhtp2_e(1:jpi,1:jpj) = ht_n(1:jpi,1:jpj)
+         zhup2_e(1:jpi,1:jpj) = hu_n(1:jpi,1:jpj) 
+         zhvp2_e(1:jpi,1:jpj) = hv_n(1:jpi,1:jpj)
       ENDIF
       !
       IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                    
-         sshn_e(:,:) =    sshn(:,:)            
-         un_e  (:,:) =    un_b(:,:)            
-         vn_e  (:,:) =    vn_b(:,:)
-         !
-         hu_e  (:,:) =    hu_n(:,:)       
-         hv_e  (:,:) =    hv_n(:,:) 
-         hur_e (:,:) = r1_hu_n(:,:)    
-         hvr_e (:,:) = r1_hv_n(:,:)
+         sshn_e(1:jpi,1:jpj) =    sshn(1:jpi,1:jpj)
+         un_e  (1:jpi,1:jpj) =    un_b(1:jpi,1:jpj)
+         vn_e  (1:jpi,1:jpj) =    vn_b(1:jpi,1:jpj)
+         !
+         hu_e  (1:jpi,1:jpj) =    hu_n(1:jpi,1:jpj)
+         hv_e  (1:jpi,1:jpj) =    hv_n(1:jpi,1:jpj)
+         hur_e (1:jpi,1:jpj) = r1_hu_n(1:jpi,1:jpj)
+         hvr_e (1:jpi,1:jpj) = r1_hv_n(1:jpi,1:jpj)
       ELSE                                ! CENTRED integration: start from BEFORE fields
-         sshn_e(:,:) =    sshb(:,:)
-         un_e  (:,:) =    ub_b(:,:)         
-         vn_e  (:,:) =    vb_b(:,:)
-         !
-         hu_e  (:,:) =    hu_b(:,:)       
-         hv_e  (:,:) =    hv_b(:,:) 
-         hur_e (:,:) = r1_hu_b(:,:)    
-         hvr_e (:,:) = r1_hv_b(:,:)
-      ENDIF
+         sshn_e(1:jpi,1:jpj) =    sshb(1:jpi,1:jpj)
+         un_e  (1:jpi,1:jpj) =    ub_b(1:jpi,1:jpj)
+         vn_e  (1:jpi,1:jpj) =    vb_b(1:jpi,1:jpj)
+         !
+         hu_e  (1:jpi,1:jpj) =    hu_b(1:jpi,1:jpj)
+         hv_e  (1:jpi,1:jpj) =    hv_b(1:jpi,1:jpj)
+         hur_e (1:jpi,1:jpj) = r1_hu_b(1:jpi,1:jpj)
+         hvr_e (1:jpi,1:jpj) = r1_hv_b(1:jpi,1:jpj)
+      ENDIF
+      !
+      hu_n_xtd(1:jpi,1:jpj) = hu_n(1:jpi,1:jpj)
+      hv_n_xtd(1:jpi,1:jpj) = hv_n(1:jpi,1:jpj)
+      !
+      !
+      !                                   !  Extend arrays 
+      !                                   ! --------------
+      !
+      IF( ln_linssh ) THEN
+         CALL lbc_lnk_multi( 'dynspg_ts', hu_n_xtd, 'U', -1._wp,   hv_n_xtd, 'V', -1._wp   &
+              &                         , zCdU_u  , 'U', -1._wp,   zCdU_v  , 'V', -1._wp   &
+              &                         , zu_frc  , 'U', -1._wp,   zv_frc  , 'V', -1._wp   &
+              &                         ,  un_e   , 'U', -1._wp,   vn_e    , 'V', -1._wp   &
+              &                         ,  hu_e   , 'U', -1._wp,   hv_e    , 'V', -1._wp   &
+              &                         ,  hur_e  , 'U', -1._wp,   hvr_e   , 'V', -1._wp   &
+              &  , zhtp2_e , 'T',  1._wp,  zhup2_e, 'U', -1._wp,   zhvp2_e , 'V', -1._wp   &
+              &  , zssh_frc, 'T',  1._wp,  sshn_e , 'T',  1._wp,   khlcom = nn_hls+nn_hlts )
+      ELSE
+         CALL lbc_lnk_multi( 'dynspg_ts', hu_n_xtd, 'U', -1._wp,   hv_n_xtd, 'V', -1._wp   &
+              &                         , zCdU_u  , 'U', -1._wp,   zCdU_v  , 'V', -1._wp   &
+              &                         , zu_frc  , 'U', -1._wp,   zv_frc  , 'V', -1._wp   &
+              &                         ,  un_e   , 'U', -1._wp,   vn_e    , 'V', -1._wp   &
+              &                         ,  hu_e   , 'U', -1._wp,   hv_e    , 'V', -1._wp   &
+              &                         ,  hur_e  , 'U', -1._wp,   hvr_e   , 'V', -1._wp   &
+              &  , zssh_frc, 'T',  1._wp,  sshn_e , 'T',  1._wp,   khlcom = nn_hls+nn_hlts )
+      END IF
       !
       ! Initialize sums:
@@ -413 +521 @@
          zuwdav2 (:,:) = 0._wp 
          zvwdav2 (:,:) = 0._wp   
-      END IF 
-
+      END IF
+
+      ixtd = nn_hls + nn_hlts   ! solution is now correct over the whole domain (interior + regular halos + time splitting halos)
+      ibi = 1   - nn_hlts   ;   ibj = 1   - nn_hlts
+      iei = jpi + nn_hlts   ;   iej = jpj + nn_hlts
       !                                             ! ==================== !
-      DO jn = 1, icycle                             !  sub-time-step loop  !
+      DO jm = 1, icycle                             !  sub-time-step loop  !
          !                                          ! ==================== !
          !
-         l_full_nf_update = jn == icycle   ! false: disable full North fold update (performances) for jn = 1 to icycle-1
+         l_full_nf_update = jm == icycle   ! false: disable full North fold update (performances) for jm = 1 to icycle-1
          !
          !                    !==  Update the forcing ==! (BDY and tides)
          !
-         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, kt_offset= noffset+1 )
-         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, kt_offset= noffset   )
-         !
-         !                    !==  extrapolation at mid-step  ==!   (jn+1/2)
+         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jm, kt_offset= noffset+1 )
+         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jm, kt_offset= noffset   )
+         !
+         !                    !==  extrapolation at mid-step  ==!   (jm+1/2)
          !
          !                       !* Set extrapolation coefficients for predictor step:
-         IF ((jn<3).AND.ll_init) THEN      ! Forward           
+         IF( (jm<3) .AND. ll_init ) THEN      ! Forward           
            za1 = 1._wp                                          
            za2 = 0._wp                        
@@ -439 +550 @@
          ENDIF
          !
-         !                       !* Extrapolate barotropic velocities at mid-step (jn+1/2)
+         !                       !* Extrapolate barotropic velocities at mid-step (jm+1/2)
          !--        m+1/2               m                m-1           m-2       --!
          !--       u      = (3/2+beta) u   -(1/2+2beta) u      + beta u          --!
          !-------------------------------------------------------------------------!
-         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:)
-         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:)
+         ua_e(ibi:iei,ibj:iej) = za1 * un_e(ibi:iei,ibj:iej) + za2 * ub_e(ibi:iei,ibj:iej) + za3 * ubb_e(ibi:iei,ibj:iej)
+         va_e(ibi:iei,ibj:iej) = za1 * vn_e(ibi:iei,ibj:iej) + za2 * vb_e(ibi:iei,ibj:iej) + za3 * vbb_e(ibi:iei,ibj:iej)
 
          IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only)
             !                                             !  ------------------
-            ! Extrapolate Sea Level at step jit+0.5:
+            !                    !* Extrapolate Sea Level at mid-step (jm+1/2)
             !--         m+1/2                 m                  m-1             m-2       --!
             !--      ssh      = (3/2+beta) ssh   -(1/2+2beta) ssh      + beta ssh          --!
             !--------------------------------------------------------------------------------!
-            zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:)
-            
+            zsshp2_e(ibi:iei,ibj:iej) =  za1 * sshn_e (ibi:iei,ibj:iej)  +  za2 * sshb_e(ibi:iei,ibj:iej)   &
+                 &                    +  za3 * sshbb_e(ibi:iei,ibj:iej)
             ! set wetting & drying mask at tracer points for this barotropic mid-step
             IF( ln_wd_dl )   CALL wad_tmsk( zsshp2_e, ztwdmask )
             !
             !                          ! ocean t-depth at mid-step
-            zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:)
+            zhtp2_e(ibi:iei,ibj:iej) = ht_0_xtd(ibi:iei,ibj:iej) + zsshp2_e(ibi:iei,ibj:iej)
             !
-            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk)
-            DO jj = 1, jpj
-               DO ji = 1, jpim1   ! not jpi-column
-                  zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        &
-                       &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  &
-                       &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
-               END DO
-            END DO
-            DO jj = 1, jpjm1        ! not jpj-row
-               DO ji = 1, jpi
-                  zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        &
-                       &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  &
-                       &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
+            !                          ! ocean u- and v-depth at mid-step
+            DO jj = ibj, iej-1      ! not last column, not last row
+               DO ji = ibi, iei-1
+                  zhup2_e(ji,jj) = hu_0_xtd(ji,jj) + r1_2 * r1_e1e2u_xtd(ji,jj)                 &
+                       &                           * (  e1e2t_xtd(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                       &                              + e1e2t_xtd(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask_xtd(ji,jj)
+                  zhvp2_e(ji,jj) = hv_0_xtd(ji,jj) + r1_2 * r1_e1e2v_xtd(ji,jj)                 &
+                       &                           * (  e1e2t_xtd(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                       &                              + e1e2t_xtd(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask_xtd(ji,jj)
                END DO
             END DO
@@ -478 +585 @@
          ENDIF
          !
-         !                    !==  after SSH  ==!   (jn+1)
+         !                    !==  after SSH  ==!   (jm+1)
          !
          !                             ! update (ua_e,va_e) to enforce volume conservation at open boundaries
          !                             ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d
-         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e )
+         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jm, ua_e, va_e, zhup2_e, zhvp2_e )
          !
          !                             ! resulting flux at mid-step (not over the full domain)
-         zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column
-         zhV(1:jpi  ,1:jpjm1) = e1v(1:jpi  ,1:jpjm1) * va_e(1:jpi  ,1:jpjm1) * zhvp2_e(1:jpi  ,1:jpjm1)   ! not jpj-row
+         zhU(ibi:iei-1,ibj:iej-1) = e2u_xtd(ibi:iei-1,ibj:iej-1) * ua_e(ibi:iei-1,ibj:iej-1) * zhup2_e(ibi:iei-1,ibj:iej-1)
+         zhV(ibi:iei-1,ibj:iej-1) = e1v_xtd(ibi:iei-1,ibj:iej-1) * va_e(ibi:iei-1,ibj:iej-1) * zhvp2_e(ibi:iei-1,ibj:iej-1)
          !
 #if defined key_agrif
@@ -524 +631 @@
             !
          ENDIF    
-         !
-         !
-         !     Compute Sea Level at step jit+1
-         !--           m+1        m                               m+1/2          --!
-         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --!
-         !-------------------------------------------------------------------------!
-         DO jj = 2, jpjm1        ! INNER domain                             
-            DO ji = 2, jpim1
-               zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj)
-               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj)
-            END DO
-         END DO
-         !
-         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
-         !
-         !                             ! Sum over sub-time-steps to compute advective velocities
-         za2 = wgtbtp2(jn)             ! zhU, zhV hold fluxes extrapolated at jn+0.5
-         un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:)
-         vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:)
          ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc=True) 
          IF ( ln_wd_dl_bc ) THEN
@@ -548 +636 @@
             zvwdav2(1:jpi  ,1:jpjm1) = zvwdav2(1:jpi  ,1:jpjm1) + za2 * zvwdmask(1:jpi  ,1:jpjm1)   ! not jpj-row
          END IF
+         !                             
+         ! Sum over sub-time-steps to compute advective velocities (only correct on interior domain)
+         za2 = wgtbtp2(jm)             ! zhU, zhV hold fluxes extrapolated at jm+1/2
+         un_adv(1:jpi,1:jpj) = un_adv(1:jpi,1:jpj) + za2 * zhU(1:jpi,1:jpj) * r1_e2u(1:jpi,1:jpj)
+         vn_adv(1:jpi,1:jpj) = vn_adv(1:jpi,1:jpj) + za2 * zhV(1:jpi,1:jpj) * r1_e1v(1:jpi,1:jpj)
+         !
+         !
+         !     Compute Sea Level at step jit+1
+         !--           m+1        m                               m+1/2          --!
+         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --!
+         !-------------------------------------------------------------------------!
+         ! correct domain reduction
+         ixtd = ixtd - 1
+         ibi = ibi + 1   ;   ibj = ibj + 1
+         iei = iei - 1   ;   iej = iej - 1
+         DO jj = ibj, iej
+            DO ji = ibi, iei
+               zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t_xtd(ji,jj)
+               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask_xtd(ji,jj)
+            END DO
+         END DO
+         !
+         IF( nn_hlts == 0 ) THEN
+            CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
+            ixtd = nn_hls + nn_hlts   ! solution is now correct over the whole domain
+            ibi = 1   - nn_hlts   ;   ibj = 1   - nn_hlts
+            iei = jpi + nn_hlts   ;   iej = jpj + nn_hlts
+         END IF
+
          !
          ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T)
-         IF( ln_bdy )   CALL bdy_ssh( ssha_e )
+         IF( ln_bdy ) THEN
+            CALL swap_bdyptr   ! bdy treatment is now done on extended domain
+            CALL bdy_ssh( ssha_e, idbi, idei, idbj, idej, ldcomall=.true., pmask=ssmask_xtd, khlcom=nn_hls+nn_hlts )
+            CALL swap_bdyptr   ! bdy treatment is now done on regular domain
+         END IF
+
 #if defined key_agrif
-         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn )
+         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jm )
 #endif
-         !  
-         ! Sea Surface Height at u-,v-points (vvl case only)
-         IF( .NOT.ln_linssh ) THEN                                
-            DO jj = 2, jpjm1   ! INNER domain, will be extended to whole domain later
-               DO ji = 2, jpim1      ! NO Vector Opt.
-                  zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
-                  zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    &
-                     &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
-                     &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
-               END DO
-            END DO
-         ENDIF   
          !         
          ! Half-step back interpolation of SSH for surface pressure computation at step jit+1/2
-         !--            m+1/2           m+1              m               m-1              m-2     --!
-         !--        ssh'    =  za0 * ssh     +  za1 * ssh   +  za2 * ssh      +  za3 * ssh        --!
-         !------------------------------------------------------------------------------------------!
-         CALL ts_bck_interp( jn, ll_init, za0, za1, za2, za3 )   ! coeficients of the interpolation
-         zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:)   &
-            &          + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:)
+         !--          m+1/2             m+1              m              m-1              m-2     --!
+         !--      ssh'      =  za0 * ssh     +  za1 * ssh   +  za2 * ssh     +  za3 * ssh        --!
+         !-----------------------------------------------------------------------------------------!
+         CALL ts_bck_interp( jm, ll_init, za0, za1, za2, za3 )   ! coeficients of the interpolation
+         zsshp2_e(ibi:iei,ibj:iej) =  za0 * ssha_e(ibi:iei,ibj:iej)  +  za1 * sshn_e (ibi:iei,ibj:iej)   &
+            &                      +  za2 * sshb_e(ibi:iei,ibj:iej)  +  za3 * sshbb_e(ibi:iei,ibj:iej)
+         !
+         !
+         ! Sea Surface Height at u-,v-points (vvl case only)
+         IF( .NOT.ln_linssh ) THEN
+            DO jj = ibj, iej-1
+               DO ji = ibi, iei-1
+                  zsshu_a(ji,jj) = r1_2 * ssumask_xtd(ji,jj) * r1_e1e2u_xtd(ji,jj)    &
+                     &                  * ( e1e2t_xtd(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                     &                  +   e1e2t_xtd(ji+1,jj  )  * ssha_e(ji+1,jj  ) )
+                  zsshv_a(ji,jj) = r1_2 * ssvmask_xtd(ji,jj) * r1_e1e2v_xtd(ji,jj)    &
+                     &                  * ( e1e2t_xtd(ji  ,jj  )  * ssha_e(ji  ,jj  ) &
+                     &                  +   e1e2t_xtd(ji  ,jj+1)  * ssha_e(ji  ,jj+1) )
+               END DO
+            END DO
+         ENDIF
          !
          !                             ! Surface pressure gradient
          zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor
-         DO jj = 2, jpjm1                            
-            DO ji = 2, jpim1
-               zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj)
-               zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj)
+         DO jj = ibj, iej-1
+            DO ji = ibi, iei-1
+               zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u_xtd(ji,jj)
+               zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v_xtd(ji,jj)
             END DO
          END DO
@@ -592 +715 @@
          !
          ! Add Coriolis trend:
-         ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated
+         ! - zwz array used in dyn_cor_2d or triads normally depend on sea level with ln_linssh=F and should be updated
          ! at each time step. We however keep them constant here for optimization.
-         ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated)
-         CALL dyn_cor_2d( zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   )
+         ! - Recall that zhU and zhV hold fluxes at jm+1/2 (extrapolated not backward interpolated)
+         ! - zu_trd_xtd and zv_trd_xtd are only correct on (ibi+1:iei-1,ibj+1:iej-1)
+         ! NOTE : input flux arguments have to be correct (ibi:iei,ibj:iej) -> a lbc call between input arguments computation
+         !        and this call without fluxes (typically after ssh at step m+1 computation) would not yield correct results 
+         CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e,  ua_e, va_e,  zhU, zhV  , idbi, idei, idbj, idej   &
+              &                                           , zu_trd, zv_trd   , idbi, idei, idbj, idej   )
          !
          ! Add tidal astronomical forcing if defined
+         ! pot_astro is correct on 1:jpi,1:jpj
          IF ( ln_tide .AND. ln_tide_pot ) THEN
             DO jj = 2, jpjm1
@@ -610 +738 @@
 !jth do implicitly instead
          IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO jj = ibj, iej
+               DO ji = ibi, iei
                   zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj)
                   zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj)
@@ -624 +752 @@
          !--  u     =             u   + delta_t' * \         (1-r)*g * grad_x( ssh') -         f * k vect u      +     frc /    --!
          !--                                                                                                                    --!
-         !--                             FLUX FORM                                                                              --!
+         !--                               FLUX FORM                                                                            --!
          !--  m+1   __1__  /  m    m               /  m+1/2                             m+1/2              m+1/2    n      \ \  --!
          !-- u    =   m+1 |  h  * u   + delta_t' * \ h     * (1-r)*g * grad_x( ssh') - h     * f * k vect u      + h * frc /  | --!
          !--         h     \                                                                                                 /  --!
          !------------------------------------------------------------------------------------------------------------------------!
+         ! correct domain reduction
+         ixtd = ixtd - 1
+         ibi = ibi + 1   ;   ibj = ibj + 1
+         iei = iei - 1   ;   iej = iej - 1
+         !
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
+            DO jj = ibj, iej
+               DO ji = ibi, iei
                   ua_e(ji,jj) = (                                 un_e(ji,jj)   & 
                             &     + rdtbt * (                   zu_spg(ji,jj)   &
                             &                                 + zu_trd(ji,jj)   &
                             &                                 + zu_frc(ji,jj) ) & 
-                            &   ) * ssumask(ji,jj)
+                            &   ) * ssumask_xtd(ji,jj)
 
                   va_e(ji,jj) = (                                 vn_e(ji,jj)   &
@@ -642 +775 @@
                             &                                 + zv_trd(ji,jj)   &
                             &                                 + zv_frc(ji,jj) ) &
-                            &   ) * ssvmask(ji,jj)
+                            &   ) * ssvmask_xtd(ji,jj)
                END DO
             END DO
             !
          ELSE                           !* Flux form
-            DO jj = 2, jpjm1
-               DO ji = 2, jpim1
-                  !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
-                  !                    ! backward interpolated depth used in spg terms at jn+1/2
-                  zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
-                       &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
-                  zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    &
-                       &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj)
-                  !                    ! inverse depth at jn+1
-                  z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
-                  z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
+            DO jj = ibj, iej
+               DO ji = ibi, iei
+                  !                    ! hu_e, hv_e hold depth at jm,  zhup2_e, zhvp2_e hold extrapolated depth at jm+1/2
+                  !                    ! backward interpolated depth used in spg terms at jm+1/2
+                  zhu_bck = hu_0_xtd(ji,jj) + r1_2*r1_e1e2u_xtd(ji,jj) * &
+                       &   ( e1e2t_xtd(ji  ,jj) * zsshp2_e(ji  ,jj)  &
+                       &   + e1e2t_xtd(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask_xtd(ji,jj)
+                  zhv_bck = hv_0_xtd(ji,jj) + r1_2*r1_e1e2v_xtd(ji,jj) * &
+                       &   ( e1e2t_xtd(ji,jj  ) * zsshp2_e(ji,jj  )  &
+                       &   + e1e2t_xtd(ji,jj+1) * zsshp2_e(ji,jj+1) ) * ssvmask_xtd(ji,jj)
+                  !                    ! inverse depth at jm+1
+                  z1_hu = ssumask_xtd(ji,jj) / ( hu_0_xtd(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask_xtd(ji,jj) )
+                  z1_hv = ssvmask_xtd(ji,jj) / ( hv_0_xtd(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask_xtd(ji,jj) )
                   !
-                  ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
-                       &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   !
-                       &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   !
-                       &                       +  hu_n  (ji,jj) * zu_frc (ji,jj)  )   ) * z1_hu
+                  ua_e(ji,jj) = (               hu_e  (ji,jj)       *    un_e (ji,jj)        & 
+                       &            + rdtbt * (  zhu_bck            * zu_spg(ji,jj)  &   !
+                       &                       + zhup2_e(ji,jj) * zu_trd(ji,jj)  &   !
+                       &                       + hu_n_xtd   (ji,jj) * zu_frc(ji,jj)  )   ) * z1_hu
                   !
-                  va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      &
-                       &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   !
-                       &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
-                       &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv
+                  va_e(ji,jj) = (               hv_e  (ji,jj)       *    vn_e (ji,jj)        &
+                       &            + rdtbt * (  zhv_bck            * zv_spg(ji,jj)  &   !
+                       &                       + zhvp2_e(ji,jj) * zv_trd(ji,jj)  &   !
+                       &                       + hv_n_xtd   (ji,jj) * zv_frc(ji,jj)  )   ) * z1_hv
                END DO
             END DO
@@ -681 +816 @@
          ENDIF
        
-         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only)
-            hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1)
-            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) )
-            hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1)
-            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) )
-            CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  &
-                 &                         , hu_e , 'U', -1._wp, hv_e , 'V', -1._wp  &
-                 &                         , hur_e, 'U', -1._wp, hvr_e, 'V', -1._wp  )
-         ELSE
-            CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  )
-         ENDIF
-         !
-         !
-         !                                                 ! open boundaries
-         IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e )
+         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only) and inverse depth
+            hu_e (ibi:iei,ibj:iej) = hu_0_xtd(ibi:iei,ibj:iej) + zsshu_a(ibi:iei,ibj:iej)
+            hv_e (ibi:iei,ibj:iej) = hv_0_xtd(ibi:iei,ibj:iej) + zsshv_a(ibi:iei,ibj:iej)
+            hur_e(ibi:iei,ibj:iej) = ssumask_xtd(ibi:iei,ibj:iej) / ( hu_e(ibi:iei,ibj:iej) + 1._wp - ssumask_xtd(ibi:iei,ibj:iej) )
+            hvr_e(ibi:iei,ibj:iej) = ssvmask_xtd(ibi:iei,ibj:iej) / ( hv_e(ibi:iei,ibj:iej) + 1._wp - ssvmask_xtd(ibi:iei,ibj:iej) )
+         ENDIF
+         
+         IF( ixtd == 0 ) THEN
+            IF( .NOT. ln_linssh ) THEN
+               CALL lbc_lnk_multi( 'dynspg_ts', ua_e  , 'U', -1._wp, va_e   , 'V', -1._wp      &   ! after
+                    &                         , un_e  , 'U', -1._wp, vn_e   , 'V', -1._wp      &   ! now
+                    &                         , ub_e  , 'U', -1._wp, vb_e   , 'V', -1._wp      &   ! before
+                    &                         , ubb_e , 'U', -1._wp, vbb_e  , 'V', -1._wp      &   ! before before
+                    &                         , ssha_e, 'T',  1._wp, sshn_e , 'T',  1._wp      &   ! after, now
+                    &                         , sshb_e, 'T',  1._wp, sshbb_e, 'T',  1._wp      &   ! before, before before
+                    &                         , hu_e  , 'U', -1._wp, hv_e   , 'V', -1._wp      &
+                    &                         , hur_e , 'U', -1._wp, hvr_e  , 'V', -1._wp      &
+                    &                         , khlcom = nn_hls+nn_hlts                        )
+            ELSE
+               CALL lbc_lnk_multi( 'dynspg_ts', ua_e  , 'U', -1._wp, va_e   , 'V', -1._wp      &   ! after
+                    &                         , un_e  , 'U', -1._wp, vn_e   , 'V', -1._wp      &   ! now
+                    &                         , ub_e  , 'U', -1._wp, vb_e   , 'V', -1._wp      &   ! before
+                    &                         , ubb_e , 'U', -1._wp, vbb_e  , 'V', -1._wp      &   ! before before
+                    &                         , ssha_e, 'T',  1._wp, sshn_e , 'T',  1._wp      &   ! after, now
+                    &                         , sshb_e, 'T',  1._wp, sshbb_e, 'T',  1._wp      &   ! before, before before
+                    &                         , khlcom = nn_hls+nn_hlts                        )
+            END IF
+            ixtd = nn_hls + nn_hlts   ! solution is now correct over the whole domain
+            ibi = 1   - nn_hlts   ;   ibj = 1   - nn_hlts
+            iei = jpi + nn_hlts   ;   iej = jpj + nn_hlts
+         END IF
+         !
+         !
+         !                ! open boundaries
+         !                ! bdy treatment is here done on regular domain (nn_hlts forced to 1 if ln_bdy or ln_tides)
+         IF( ln_bdy )   CALL bdy_dyn2d( jm, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e, idbi, idei, idbj, idej       &
+                                &     , ldcomall=.true., pumask=ssumask_xtd, pvmask=ssvmask_xtd, khlcom=nn_hls+nn_hlts )
 #if defined key_agrif                                                           
-         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif
+         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jm )  ! Agrif
 #endif
          !                                             !* Swap
@@ -715 +872 @@
          !                                             !* Sum over whole bt loop
          !                                             !  ----------------------
-         za1 = wgtbtp1(jn)                                    
+         za1 = wgtbtp1(jm)                                    
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities
-            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) 
-            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) 
+               ua_b(1:jpi,1:jpj) = ua_b(1:jpi,1:jpj) + za1 * ua_e(1:jpi,1:jpj) 
+               va_b(1:jpi,1:jpj) = va_b(1:jpi,1:jpj) + za1 * va_e(1:jpi,1:jpj) 
          ELSE                                       ! Sum transports
             IF ( .NOT.ln_wd_dl ) THEN  
-               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:)
-               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:)
+               ua_b(1:jpi,1:jpj) = ua_b(1:jpi,1:jpj) + za1 * ua_e(1:jpi,1:jpj) * hu_e(1:jpi,1:jpj)
+               va_b(1:jpi,1:jpj) = va_b(1:jpi,1:jpj) + za1 * va_e(1:jpi,1:jpj) * hv_e(1:jpi,1:jpj)
             ELSE 
-               ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:)
-               va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:)
+               ua_b(1:jpi,1:jpj) = ua_b(1:jpi,1:jpj) + za1 * ua_e(1:jpi,1:jpj) * hu_e(1:jpi,1:jpj) * zuwdmask(1:jpi,1:jpj)
+               va_b(1:jpi,1:jpj) = va_b(1:jpi,1:jpj) + za1 * va_e(1:jpi,1:jpj) * hv_e(1:jpi,1:jpj) * zvwdmask(1:jpi,1:jpj)
             END IF 
          ENDIF
          !                                          ! Sum sea level
-         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:)
+         ssha(1:jpi,1:jpj) = ssha(1:jpi,1:jpj) + za1 * ssha_e(1:jpi,1:jpj)
 
          !                                                 ! ==================== !
@@ -737 +894 @@
       ! Phase 3. update the general trend with the barotropic trend
       ! -----------------------------------------------------------------------------
+      ! Correction on regular halos
+      CALL lbc_lnk_multi( 'dynspg_ts',  un_adv, 'U', -1._wp,  vn_adv, 'V', -1._wp   &
+           &                         ,  ua_b  , 'U', -1._wp,  va_b  , 'V', -1._wp   &
+           &                         ,  ssha  , 'T', -1._wp                         )
       !
       ! Set advection velocity correction:
@@ -783 +944 @@
                   &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) )
             END DO
-         END DO
-         CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions
+         END DO                             ! Boundary conditions
+         CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp, khlcom=nn_hls+nn_hlts )   ! change array used?
          !
          DO jk=1,jpkm1
@@ -791 +952 @@
          END DO
          ! Save barotropic velocities not transport:
-         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) )
-         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) )
+         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(1:jpi,1:jpj) + 1._wp - ssumask(:,:) )
+         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(1:jpi,1:jpj) + 1._wp - ssvmask(:,:) )
       ENDIF
 
@@ -841 +1002 @@
       ENDIF
       !
+
+      ! deallocate temporary arrays
+      DEALLOCATE( zu_trd  , zv_trd     &
+         &    ,   zu_frc  , zv_frc     &
+         &    ,   zu_spg  , zv_spg     &
+         &    ,   zsshu_a , zsshv_a    &
+         &    ,   zhup2_e , zhvp2_e    &
+         &    ,   zCdU_u  , zCdU_v     &
+         &    ,   zhU     , zhV        &
+         &    ,   zssh_frc, zsshp2_e   &
+         &    ,   zhtp2_e              &
+         &    ,   hu_n_xtd, hv_n_xtd   )
+      !
    END SUBROUTINE dyn_spg_ts
 
@@ -850 +1024 @@
       !! ** Purpose : Set time-splitting weights for temporal averaging (or not)
       !!----------------------------------------------------------------------
-      LOGICAL, INTENT(in) ::   ll_av      ! temporal averaging=.true.
-      LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true.
-      INTEGER, INTENT(inout) :: jpit      ! cycle length    
+      LOGICAL, INTENT(in   ) ::   ll_av      ! temporal averaging=.true.
+      LOGICAL, INTENT(in   ) ::   ll_fw      ! forward time splitting =.true.
+      INTEGER, INTENT(inout) ::   jpit       ! cycle length    
       REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights
                                                          zwgt2    ! Secondary weights
       
-      INTEGER ::  jic, jn, ji                      ! temporary integers
+      INTEGER ::  jic, jm, ji                      ! temporary integers
       REAL(wp) :: za1, za2
       !!----------------------------------------------------------------------
@@ -880 +1054 @@
 
               CASE( 1 )  ! Boxcar, width = nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+                 DO jm = 1, 3*nn_baro
+                    za1 = ABS(float(jm-jic))/float(nn_baro) 
                     IF (za1 < 0.5_wp) THEN
-                      zwgt1(jn) = 1._wp
-                      jpit = jn
+                      zwgt1(jm) = 1._wp
+                      jpit = jm
                     ENDIF
                  ENDDO
 
               CASE( 2 )  ! Boxcar, width = 2 * nn_baro
-                 DO jn = 1, 3*nn_baro
-                    za1 = ABS(float(jn-jic))/float(nn_baro) 
+                 DO jm = 1, 3*nn_baro
+                    za1 = ABS(float(jm-jic))/float(nn_baro) 
                     IF (za1 < 1._wp) THEN
-                      zwgt1(jn) = 1._wp
-                      jpit = jn
+                      zwgt1(jm) = 1._wp
+                      jpit = jm
                     ENDIF
                  ENDDO
@@ -905 +1079 @@
     
       ! Set secondary weights
-      DO jn = 1, jpit
-        DO ji = jn, jpit
-             zwgt2(jn) = zwgt2(jn) + zwgt1(ji)
+      DO jm = 1, jpit
+        DO ji = jm, jpit
+             zwgt2(jm) = zwgt2(jm) + zwgt1(ji)
         END DO
       END DO
@@ -914 +1088 @@
       za1 = 1._wp / SUM(zwgt1(1:jpit))
       za2 = 1._wp / SUM(zwgt2(1:jpit))
-      DO jn = 1, jpit
-        zwgt1(jn) = zwgt1(jn) * za1
-        zwgt2(jn) = zwgt2(jn) * za2
+      DO jm = 1, jpit
+        zwgt1(jm) = zwgt1(jm) * za1
+        zwgt2(jm) = zwgt2(jm) * za2
       END DO
       !
@@ -1111 +1285 @@
       ENDIF
       !
+      ! initialize extended scale factors
+      ht_0_xtd    (1:jpi,1:jpj) = ht_0    (1:jpi,1:jpj)
+      hu_0_xtd    (1:jpi,1:jpj) = hu_0    (1:jpi,1:jpj)
+      hv_0_xtd    (1:jpi,1:jpj) = hv_0    (1:jpi,1:jpj)
+      r1_e1e2t_xtd(1:jpi,1:jpj) = r1_e1e2t(1:jpi,1:jpj)
+      r1_e1e2u_xtd(1:jpi,1:jpj) = r1_e1e2u(1:jpi,1:jpj)
+      r1_e1e2v_xtd(1:jpi,1:jpj) = r1_e1e2v(1:jpi,1:jpj)
+      e1e2t_xtd   (1:jpi,1:jpj) = e1e2t   (1:jpi,1:jpj)
+      ssmask_xtd  (1:jpi,1:jpj) = ssmask  (1:jpi,1:jpj)
+      ssumask_xtd (1:jpi,1:jpj) = ssumask (1:jpi,1:jpj)
+      ssvmask_xtd (1:jpi,1:jpj) = ssvmask (1:jpi,1:jpj)
+      e2u_xtd     (1:jpi,1:jpj) = e2u     (1:jpi,1:jpj)
+      e1v_xtd     (1:jpi,1:jpj) = e1v     (1:jpi,1:jpj)
+      r1_e1u_xtd  (1:jpi,1:jpj) = r1_e1u  (1:jpi,1:jpj)
+      r1_e2v_xtd  (1:jpi,1:jpj) = r1_e2v  (1:jpi,1:jpj)
+      !
+      CALL lbc_lnk_multi( 'dynspg_ts', ht_0_xtd    , 'T',  1._wp,  hu_0_xtd    , 'U', -1._wp,  hv_0_xtd    , 'V', -1._wp   &
+           &                         , r1_e1e2t_xtd, 'T',  1._wp,  r1_e1e2u_xtd, 'U', -1._wp,  r1_e1e2v_xtd, 'V', -1._wp   &
+           &                         , ssmask_xtd  , 'T',  1._wp,  ssumask_xtd , 'U', -1._wp,  ssvmask_xtd , 'V', -1._wp   &
+           &                         , e1e2t_xtd   , 'T',  1._wp,      e2u_xtd , 'U', -1._wp,      e1v_xtd , 'V', -1._wp   &
+           &                         ,                              r1_e1u_xtd , 'U', -1._wp,   r1_e2v_xtd , 'V', -1._wp   &
+           &                         , khlcom = nn_hls+nn_hlts                                                             )
+      IF( ln_dynvor_enT ) THEN
+         ff_t_xtd (1:jpi,1:jpj) = ff_t    (1:jpi,1:jpj)
+         CALL lbc_lnk_multi( 'dynspg_ts', ff_t_xtd , 'F', -1._wp,   khlcom = nn_hls+nn_hlts  )
+      END IF
+         
+      !
    END SUBROUTINE dyn_spg_ts_init
 
    
-   SUBROUTINE dyn_cor_2d_init
+   SUBROUTINE dyn_cor_2d_init( kdbi, kdei, kdbj, kdej )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE dyn_cor_2d_init  ***
@@ -1128 +1330 @@
       !! Compute zwz = f / ( height of the water colomn )
       !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   ) :: kdbi, kdei, kdbj, kdej
       INTEGER  ::   ji ,jj, jk              ! dummy loop indices
       REAL(wp) ::   z1_ht
@@ -1137 +1340 @@
          SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point
          CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    &
-                       &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
+            DO jj = 1, jpj-1
+               DO ji = 1, jpi-1
+                  zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +   &
+                       &           ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp  
                   IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj)
                END DO
             END DO
          CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask)
-            DO jj = 1, jpjm1
-               DO ji = 1, jpim1
-                  zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      &
+            DO jj = 1, jpj-1
+               DO ji = 1, jpi-1
+                  zwz(ji,jj) =               (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      &
                        &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   &
                        &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      &
@@ -1155 +1358 @@
             END DO
          END SELECT
-         CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp )
-         !
-         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
-         DO jj = 2, jpj
-            DO ji = 2, jpi
+         !
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
                ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1)
                ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  )
@@ -1166 +1367 @@
             END DO
          END DO
+         CALL lbc_lnk_multi( 'dynspg_ts', ftne, 'F', 1._wp, ftnw, 'F', 1._wp                          &
+              &                         , ftse, 'F', 1._wp, ftsw, 'F', 1._wp, khlcom = nn_hls+nn_hlts )
          !
       CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme)
-         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp
          DO jj = 2, jpj
             DO ji = 2, jpi
@@ -1178 +1380 @@
             END DO
          END DO
+         CALL lbc_lnk_multi( 'dynspg_ts', ftne, 'F', 1._wp, ftnw, 'F', 1._wp                          &
+              &                         , ftse, 'F', 1._wp, ftsw, 'F', 1._wp, khlcom = nn_hls+nn_hlts )
          !
       CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT !
@@ -1223 +1427 @@
             END DO
          END DO
-         CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp )
-         ! JC: TBC. hf should be greater than 0 
-         DO jj = 1, jpj
-            DO ji = 1, jpi
+         ! JC: TBC. hf should be greater than 0
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
                IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj)
             END DO
          END DO
-         zwz(:,:) = ff_f(:,:) * zwz(:,:)
+         zwz(2:jpim1,2:jpjm1) = ff_f(2:jpim1,2:jpjm1) * zwz(2:jpim1,2:jpjm1)
+         CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp, khlcom = nn_hls+nn_hlts )
       END SELECT
       
@@ -1237 +1441 @@
 
 
-   SUBROUTINE dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,    zu_trd, zv_trd   )
+   SUBROUTINE dyn_cor_2d( phgtt, phgtu, phgtv, pun, pvn, phU, phV, kdbi , kdei , kdbj , kdej ,  pu_trd, pv_trd   &
+        &                                                        , kdbi2, kdei2, kdbj2, kdej2                    )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE dyn_cor_2d  ***
       !!
       !! ** Purpose : Compute u and v coriolis trends
-      !!----------------------------------------------------------------------
-      INTEGER  ::   ji ,jj                             ! dummy loop indices
-      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      -
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: hu_n, hv_n, un_b, vn_b, zhU, zhV
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd
+      !!
+      !!              kdXX2 are useful in the initialisation where some arrays are not over the whole domain
+      !!              and some are
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(kdbi :kdei ,kdbj :kdej ), INTENT(in   ) :: phgtt, phgtu, phgtv, pun, pvn   ! height, speed
+      INTEGER ,                                     INTENT(in   ) :: kdbi , kdei , kdbj , kdej       ! arrays size
+      REAL(wp), DIMENSION(kdbi2:kdei2,kdbj2:kdej2), INTENT(in   ) :: phU, phV   ! flux
+      REAL(wp), DIMENSION(kdbi2:kdei2,kdbj2:kdej2), INTENT(  out) :: pu_trd, pv_trd
+      INTEGER ,                                     INTENT(in   ) :: kdbi2, kdei2, kdbj2, kdej2      ! arrays size
+      INTEGER  ::   ji, jj                             ! dummy loop indices
+      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   ! local integer
       !!----------------------------------------------------------------------
       SELECT CASE( nvor_scheme )
       CASE( np_ENT )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = 2, jpim1
-               z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) )
-               z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) )
-               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    &
-                  &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   &
-                  &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   )
+         DO jj = kdbj+1, kdej-1
+            DO ji = kdbi+1, kdei-1
+               z1_hu = ssumask_xtd(ji,jj) / ( phgtu(ji,jj) + 1._wp - ssumask_xtd(ji,jj) )
+               z1_hv = ssvmask_xtd(ji,jj) / ( phgtv(ji,jj) + 1._wp - ssvmask_xtd(ji,jj) )
+               pu_trd(ji,jj) = + r1_4 * r1_e1e2u_xtd(ji,jj) * z1_hu                   &
+                  &               * (  e1e2t_xtd(ji+1,jj)*phgtt(ji+1,jj)*ff_t_xtd(ji+1,jj) * ( pvn(ji+1,jj) + pvn(ji+1,jj-1) )   &
+                  &                  + e1e2t_xtd(ji  ,jj)*phgtt(ji  ,jj)*ff_t_xtd(ji  ,jj) * ( pvn(ji  ,jj) + pvn(ji  ,jj-1) )   )
                   !
-               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    &
-                  &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   & 
-                  &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   ) 
+               pv_trd(ji,jj) = - r1_4 * r1_e1e2v_xtd(ji,jj) * z1_hv                   &
+                  &               * (  e1e2t_xtd(ji,jj+1)*phgtt(ji,jj+1)*ff_t_xtd(ji,jj+1) * ( pun(ji,jj+1) + pun(ji-1,jj+1) )   & 
+                  &                  + e1e2t_xtd(ji,jj  )*phgtt(ji,jj  )*ff_t_xtd(ji,jj  ) * ( pun(ji,jj  ) + pun(ji-1,jj  ) )   ) 
             END DO  
-         END DO  
+         END DO
          !         
       CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj)
-               zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj)
-               zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
+         DO jj = kdbj+1, kdej-1
+            DO ji = kdbi+1, kdei-1
+               zy1 = ( phV(ji,jj-1) + phV(ji+1,jj-1) ) * r1_e1u_xtd(ji,jj)
+               zy2 = ( phV(ji,jj  ) + phV(ji+1,jj  ) ) * r1_e1u_xtd(ji,jj)
+               zx1 = ( phU(ji-1,jj) + phU(ji-1,jj+1) ) * r1_e2v_xtd(ji,jj)
+               zx2 = ( phU(ji  ,jj) + phU(ji  ,jj+1) ) * r1_e2v_xtd(ji,jj)
                ! energy conserving formulation for planetary vorticity term
-               zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
-               zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+               pu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               pv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
             END DO
          END DO
          !
       CASE( np_ENS )                ! enstrophy conserving scheme (f-point)
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) &
-                 &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj)
-               zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) &
-                 &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj)
-               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
-               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
-            END DO
-         END DO
-         !
-      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)         
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vector opt.
-               zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) &
-                &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) &
-                &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) &
-                &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) )
-               zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) &
-                &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) &
-                &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) &
-                &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) )
+         DO jj = kdbj+1, kdej-1
+            DO ji = kdbi+1, kdei-1
+               zy1 =   r1_8 * ( phV(ji  ,jj-1) + phV(ji+1,jj-1) &
+                 &            + phV(ji  ,jj  ) + phV(ji+1,jj  ) ) * r1_e1u_xtd(ji,jj)
+               zx1 = - r1_8 * ( phU(ji-1,jj  ) + phU(ji-1,jj+1) &
+                 &            + phU(ji  ,jj  ) + phU(ji  ,jj+1) ) * r1_e2v_xtd(ji,jj)
+               pu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) )
+               pv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) )
+            END DO
+         END DO
+         !
+      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)
+         DO jj = kdbj+1, kdej-1
+            DO ji = kdbi+1, kdei-1
+               pu_trd(ji,jj) = + r1_12 * r1_e1u_xtd(ji,jj) * (  ftne(ji,jj  ) * phV(ji  ,jj  ) &
+                &                                             + ftnw(ji+1,jj) * phV(ji+1,jj  ) &
+                &                                             + ftse(ji,jj  ) * phV(ji  ,jj-1) &
+                &                                             + ftsw(ji+1,jj) * phV(ji+1,jj-1) )
+               pv_trd(ji,jj) = - r1_12 * r1_e2v_xtd(ji,jj) * (  ftsw(ji,jj+1) * phU(ji-1,jj+1) &
+                &                                             + ftse(ji,jj+1) * phU(ji  ,jj+1) &
+                &                                             + ftnw(ji,jj  ) * phU(ji-1,jj  ) &
+                &                                             + ftne(ji,jj  ) * phU(ji  ,jj  ) )
             END DO
          END DO
@@ -1305 +1516 @@
       END SELECT
       !
-   END SUBROUTINE dyn_cor_2D
+   END SUBROUTINE dyn_cor_2d
 
 
@@ -1448 +1659 @@
 
 
-   SUBROUTINE dyn_drg_init( pu_RHSi, pv_RHSi, pCdU_u, pCdU_v )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE dyn_drg_init  ***
+   SUBROUTINE drg_init( kdbi, kdei, kdbj, kdej, pu_frc, pv_frc, pCdU_u, pCdU_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE drg_init  ***
       !!                    
       !! ** Purpose : - add the baroclinic top/bottom drag contribution to 
@@ -1458 +1669 @@
       !! ** Method  :   computation done over the INNER domain only 
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pu_RHSi, pv_RHSi   ! baroclinic part of the barotropic RHS
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pCdU_u , pCdU_v    ! barotropic drag coefficients
+      INTEGER ,                                 INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! arrays size
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pu_frc, pv_frc    ! baroclinic part of the barotropic RHS
+      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(  out) ::   pCdU_u , pCdU_v   ! barotropic drag coefficients
       !
       INTEGER  ::   ji, jj   ! dummy loop indices
@@ -1514 +1726 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
+               pu_frc(ji,jj) = pu_frc(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 & 
                     &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  )
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
+               pv_frc(ji,jj) = pv_frc(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 & 
                     &                              r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  )
             END DO
@@ -1524 +1736 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
+               pu_frc(ji,jj) = pu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zu_i(ji,jj)
+               pv_frc(ji,jj) = pv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zv_i(ji,jj)
             END DO
          END DO
@@ -1560 +1772 @@
          DO jj = 2, jpjm1
             DO ji = 2, jpim1    ! INNER domain
-               pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
-               pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
-            END DO
-         END DO
-         !
-      ENDIF
-      !
-   END SUBROUTINE dyn_drg_init
-
-   SUBROUTINE ts_bck_interp( jn, ll_init,       &   ! <== in
+               pu_frc(ji,jj) = pu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zu_i(ji,jj)
+               pv_frc(ji,jj) = pv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zv_i(ji,jj)
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+   END SUBROUTINE drg_init
+
+
+   SUBROUTINE ts_bck_interp( km, ld_init,       &   ! <== in
       &                      za0, za1, za2, za3 )   ! ==> out
       !!----------------------------------------------------------------------
-      INTEGER ,INTENT(in   ) ::   jn                   ! index of sub time step
-      LOGICAL ,INTENT(in   ) ::   ll_init              !
+      INTEGER ,INTENT(in   ) ::   km                   ! index of sub time step
+      LOGICAL ,INTENT(in   ) ::   ld_init              !
       REAL(wp),INTENT(  out) ::   za0, za1, za2, za3   ! Half-step back interpolation coefficient
       !
@@ -1579 +1792 @@
       !!----------------------------------------------------------------------
       !                             ! set Half-step back interpolation coefficient
-      IF    ( jn==1 .AND. ll_init ) THEN   !* Forward-backward
+      IF    ( km==1 .AND. ld_init ) THEN   !* Forward-backward
          za0 = 1._wp                        
          za1 = 0._wp                           
          za2 = 0._wp
          za3 = 0._wp
-      ELSEIF( jn==2 .AND. ll_init ) THEN   !* AB2-AM3 Coefficients; bet=0 ; gam=-1/6 ; eps=1/12
+      ELSEIF( km==2 .AND. ld_init ) THEN   !* AB2-AM3 Coefficients; bet=0 ; gam=-1/6 ; eps=1/12
          za0 = 1.0833333333333_wp                 ! za0 = 1-gam-eps
          za1 =-0.1666666666666_wp                 ! za1 = gam

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DYN/sshwzv.F90

@@ -113 +113 @@
          IF( ln_bdy ) THEN
             CALL lbc_lnk( 'sshwzv', ssha, 'T', 1. )    ! Not sure that's necessary
-            CALL bdy_ssh( ssha )             ! Duplicate sea level across open boundaries
+            CALL bdy_ssh( ssha, 1, jpi, 1, jpj )       ! Duplicate sea level across open boundaries
          ENDIF
       ENDIF

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/IOM/iom.F90

@@ -58 +58 @@
    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get
    PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
-   PUBLIC iom_use, iom_context_finalize, iom_miss_val
+   PUBLIC iom_use, iom_context_finalize
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -1671 +1671 @@
       CHARACTER(LEN=*), INTENT(in) ::   cdname
       REAL(wp)        , INTENT(in) ::   pfield0d
-!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
+      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson
 #if defined key_iomput
-!!clem      zz(:,:)=pfield0d
-!!clem      CALL xios_send_field(cdname, zz)
-      CALL xios_send_field(cdname, (/pfield0d/)) 
+      zz(:,:)=pfield0d
+      CALL xios_send_field(cdname, zz)
+      !CALL xios_send_field(cdname, (/pfield0d/)) 
 #else
       IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings
@@ -2391 +2391 @@
    !!   NOT 'key_iomput'                               a few dummy routines
    !!----------------------------------------------------------------------
+
    SUBROUTINE iom_setkt( kt, cdname )
       INTEGER         , INTENT(in)::   kt 
@@ -2405 +2406 @@
 
    LOGICAL FUNCTION iom_use( cdname )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
       CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !!----------------------------------------------------------------------
 #if defined key_iomput
       iom_use = xios_field_is_active( cdname )
@@ -2412 +2416 @@
 #endif
    END FUNCTION iom_use
-
-   SUBROUTINE iom_miss_val( cdname, pmiss_val )
-      CHARACTER(LEN=*), INTENT(in ) ::   cdname
-      REAL(wp)        , INTENT(out) ::   pmiss_val   
-#if defined key_iomput
-      ! get missing value
-      CALL xios_get_field_attr( cdname, default_value = pmiss_val )
-#else
-      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings
-#endif
-   END SUBROUTINE iom_miss_val
-  
+   
    !!======================================================================
 END MODULE iom

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90

@@ -15 +15 @@
 #endif
 
-   SUBROUTINE ROUTINE_MULTI( cdname                                                                             &
-      &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   &
-      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   &
-      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      &
-      &                    , kfillmode, pfillval, lsend, lrecv, ihlcom )
+   SUBROUTINE ROUTINE_MULTI( cdname                                                                              &
+      &                    , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4  &
+      &                    , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8  &
+      &                    , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12 &
+      &                    , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16 &
+      &                    , pt17, cdna17, psgn17, pt18, cdna18, psgn18, pt19, cdna19, psgn19, pt20, cdna20, psgn20 &
+      &                    , kfillmode, pfillval, ldsend, ldrecv, khlcom )
       !!---------------------------------------------------------------------
       CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine
       ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) :: pt1     ! arrays on which the lbc is applied
       ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , pt10  , pt11
+      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt12  , pt13  , pt14  , pt15  , pt16  , pt17  , pt18  , pt19  , pt20
       CHARACTER(len=1)                     , INTENT(in   ) :: cdna1   ! nature of pt2D. array grid-points
       CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11
+      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna12, cdna13, cdna14, cdna15, cdna16, cdna17, cdna18, cdna19, cdna20
       REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold
       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11
+      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn12, psgn13, psgn14, psgn15, psgn16, psgn17, psgn18, psgn19, psgn20
       INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant)
       REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries)
-      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out
-      INTEGER            , OPTIONAL        , INTENT(in   ) :: ihlcom         ! number of ranks and rows to be communicated
+      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: ldsend, ldrecv   ! indicate how communications are to be carried out
+      INTEGER            , OPTIONAL        , INTENT(in   ) :: khlcom           ! number of ranks and rows to be communicated
       !!
       INTEGER                          ::   kfld        ! number of elements that will be attributed
-      PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array
-      CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points
-      REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary
+      PTR_TYPE         , DIMENSION(20) ::   ptab_ptr    ! pointer array
+      CHARACTER(len=1) , DIMENSION(20) ::   cdna_ptr    ! nature of ptab_ptr grid-points
+      REAL(wp)         , DIMENSION(20) ::   psgn_ptr    ! sign used across the north fold boundary
       !!---------------------------------------------------------------------
       !
@@ -55 +60 @@
       IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
       IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn12) )   CALL ROUTINE_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn13) )   CALL ROUTINE_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn14) )   CALL ROUTINE_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn15) )   CALL ROUTINE_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn16) )   CALL ROUTINE_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn17) )   CALL ROUTINE_LOAD( pt17, cdna17, psgn17, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn18) )   CALL ROUTINE_LOAD( pt18, cdna18, psgn18, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn19) )   CALL ROUTINE_LOAD( pt19, cdna19, psgn19, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
+      IF( PRESENT(psgn20) )   CALL ROUTINE_LOAD( pt20, cdna20, psgn20, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
       !
-      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom )
+      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, ldsend, ldrecv, khlcom )
       !
    END SUBROUTINE ROUTINE_MULTI

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/LBC/mpp_lnk_generic.h90

@@ -7 +7 @@
 #      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
+#      define I_SIZE(ptab)             SIZE(ptab(1)%pt2d,1)
+#      define J_SIZE(ptab)             SIZE(ptab(1)%pt2d,2)
 #      define K_SIZE(ptab)             1
 #      define L_SIZE(ptab)             1
@@ -13 +15 @@
 #      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D)                , INTENT(inout) ::   ptab(f)
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
+#      define I_SIZE(ptab)             SIZE(ptab(1)%pt3d,1)
+#      define J_SIZE(ptab)             SIZE(ptab(1)%pt3d,2)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
 #      define L_SIZE(ptab)             1
@@ -19 +23 @@
 #      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
 #      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
+#      define I_SIZE(ptab)             SIZE(ptab(1)%pt4d,1)
+#      define J_SIZE(ptab)             SIZE(ptab(1)%pt4d,2)
 #      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
 #      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
@@ -26 +32 @@
 #   define NAT_IN(k)                cd_nat
 #   define SGN_IN(k)                psgn
+#   define I_SIZE(ptab)             SIZE(ptab,1)
+#   define J_SIZE(ptab)             SIZE(ptab,2)
 #   define F_SIZE(ptab)             1
 #   define OPT_K(k)                 
@@ -46 +54 @@
 
 #if defined MULTI
-   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom )
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, ldsend, ldrecv, khlcom )
       INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays
 #else
-   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv, ihlcom )
+   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, ldsend, ldrecv, khlcom )
 #endif
       ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
@@ -57 +65 @@
       INTEGER ,             OPTIONAL, INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
       REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
-      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc
-      INTEGER              ,OPTIONAL, INTENT(in   ) ::   ihlcom        ! number of ranks and rows to be communicated
+      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   ldsend, ldrecv  ! communication with other 4 proc
+      INTEGER              ,OPTIONAL, INTENT(in   ) ::   khlcom        ! number of ranks and rows to be communicated
       !
       INTEGER  ::    ji,  jj,  jk,  jl,  jf      ! dummy loop indices
@@ -80 +88 @@
       ! ----------------------------------------- !
       !
+      ipi = I_SIZE(ptab)
+      ipj = J_SIZE(ptab)
       ipk = K_SIZE(ptab)   ! 3rd dimension
       ipl = L_SIZE(ptab)   ! 4th    -
       ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
       !
-      IF( PRESENT(ihlcom) ) THEN   ;   ihl = ihlcom
-      ELSE                         ;   ihl = 1
+      IF( PRESENT(khlcom) ) THEN   ;   ihl = khlcom
+      ELSE                         ;   ihl = nn_hls
       END IF
       !
       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. )
       !
-      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN
-         llsend_we = lsend(1)   ;   llsend_ea = lsend(2)   ;   llsend_so = lsend(3)   ;   llsend_no = lsend(4)
-         llrecv_we = lrecv(1)   ;   llrecv_ea = lrecv(2)   ;   llrecv_so = lrecv(3)   ;   llrecv_no = lrecv(4)
-      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN
-         WRITE(ctmp1,*) ' E R R O R : Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv'
+      IF     ( PRESENT(ldsend) .AND. PRESENT(ldrecv) ) THEN
+         llsend_we = ldsend(1)   ;   llsend_ea = ldsend(2)   ;   llsend_so = ldsend(3)   ;   llsend_no = ldsend(4)
+         llrecv_we = ldrecv(1)   ;   llrecv_ea = ldrecv(2)   ;   llrecv_so = ldrecv(3)   ;   llrecv_no = ldrecv(4)
+      ELSE IF( PRESENT(ldsend) .OR.  PRESENT(ldrecv) ) THEN
+         WRITE(ctmp1,*) ' E R R O R : Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments ldsend or ldrecv'
          WRITE(ctmp2,*) ' ========== '
          CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' )
@@ -149 +159 @@
       !
       ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg
-      isize = ihl * jpj * ipk * ipl * ipf      
+      isize = ihl * ipj * ipk * ipl * ipf      
       !
       ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent
-      IF( llsend_we )   ALLOCATE( zsnd_we(ihl,jpj,ipk,ipl,ipf) )
-      IF( llsend_ea )   ALLOCATE( zsnd_ea(ihl,jpj,ipk,ipl,ipf) )
-      IF( llrecv_we )   ALLOCATE( zrcv_we(ihl,jpj,ipk,ipl,ipf) )
-      IF( llrecv_ea )   ALLOCATE( zrcv_ea(ihl,jpj,ipk,ipl,ipf) )
+      IF( llsend_we )   ALLOCATE( zsnd_we(ihl,ipj,ipk,ipl,ipf) )
+      IF( llsend_ea )   ALLOCATE( zsnd_ea(ihl,ipj,ipk,ipl,ipf) )
+      IF( llrecv_we )   ALLOCATE( zrcv_we(ihl,ipj,ipk,ipl,ipf) )
+      IF( llrecv_ea )   ALLOCATE( zrcv_ea(ihl,ipj,ipk,ipl,ipf) )
       !
       IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI
          ishift = ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! ihl + 1 -> 2*ihl
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -165 +175 @@
       !
       IF(llsend_ea  ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI
-         ishift = jpi - 2 * ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         ishift = ipi - 2 * ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*ihl + 1 -> jpi - ihl
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -193 +203 @@
       CASE ( jpfillnothing )               ! no filling 
       CASE ( jpfillmpi   )                 ! use data received by MPI 
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> ihl
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillperio )                 ! use east-weast periodicity
-         ishift2 = jpi - 2 * ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         ishift2 = ipi - 2 * ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -204 +214 @@
          DO jf = 1, ipf                               ! number of arrays to be treated
             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point
-               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf)
                END DO   ;   END DO   ;   END DO   ;   END DO
@@ -212 +222 @@
          DO jf = 1, ipf                               ! number of arrays to be treated
             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point
-               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
                   ARRAY_IN(ji,jj,jk,jl,jf) = zland
                END DO;   END DO   ;   END DO   ;   END DO
@@ -221 +231 @@
       ! 2.2 fill eastern halo
       ! ---------------------
-      ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi 
+      ishift = ipi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi 
       SELECT CASE ( ifill_ea )
       CASE ( jpfillnothing )               ! no filling 
       CASE ( jpfillmpi   )                 ! use data received by MPI 
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - ihl + 1 -> jpi
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillperio )                 ! use east-weast periodicity
          ishift2 = ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillcopy  )                 ! filling with inner domain values
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillcst   )                 ! filling with constant value
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ipj   ;   DO ji = 1, ihl
             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -264 +274 @@
       ! ---------------------------------------------------- !
       !
-      IF( llsend_so )   ALLOCATE( zsnd_so(jpi,ihl,ipk,ipl,ipf) )
-      IF( llsend_no )   ALLOCATE( zsnd_no(jpi,ihl,ipk,ipl,ipf) )
-      IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,ihl,ipk,ipl,ipf) )
-      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,ihl,ipk,ipl,ipf) )
-      !
-      isize = jpi * ihl * ipk * ipl * ipf      
+      IF( llsend_so )   ALLOCATE( zsnd_so(ipi,ihl,ipk,ipl,ipf) )
+      IF( llsend_no )   ALLOCATE( zsnd_no(ipi,ihl,ipk,ipl,ipf) )
+      IF( llrecv_so )   ALLOCATE( zrcv_so(ipi,ihl,ipk,ipl,ipf) )
+      IF( llrecv_no )   ALLOCATE( zrcv_no(ipi,ihl,ipk,ipl,ipf) )
+      !
+      isize = ipi * ihl * ipk * ipl * ipf      
 
       ! allocate local temporary arrays to be sent/received. Fill arrays to be sent
       IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI
          ishift = ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! ihl+1 -> 2*ihl
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -280 +290 @@
       !
       IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI
-         ishift = jpj - 2 * ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         ishift = ipj - 2 * ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*ihl+1 -> jpj-ihl
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -307 +317 @@
       CASE ( jpfillnothing )               ! no filling 
       CASE ( jpfillmpi   )                 ! use data received by MPI 
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> ihl
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillperio )                 ! use north-south periodicity
-         ishift2 = jpj - 2 * ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         ishift2 = ipj - 2 * ihl
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -318 +328 @@
          DO jf = 1, ipf                               ! number of arrays to be treated
             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point
-               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ihl+1,jk,jl,jf)
                END DO   ;   END DO   ;   END DO   ;   END DO
@@ -326 +336 @@
          DO jf = 1, ipf                               ! number of arrays to be treated
             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point
-               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
+               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi 
                   ARRAY_IN(ji,jj,jk,jl,jf) = zland
                END DO;   END DO   ;   END DO   ;   END DO
@@ -335 +345 @@
       ! 5.2 fill northern halo
       ! ----------------------
-      ishift = jpj - ihl                ! fill halo from jj = jpj-ihl+1 to jpj 
+      ishift = ipj - ihl                ! fill halo from jj = jpj-ihl+1 to jpj 
       SELECT CASE ( ifill_no )
       CASE ( jpfillnothing )               ! no filling 
       CASE ( jpfillmpi   )                 ! use data received by MPI 
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-ihl+1 -> jpj
          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillperio )                 ! use north-south periodicity
          ishift2 = ihl
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillcopy  )                 ! filling with inner domain values
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf)
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
       CASE ( jpfillcst   )                 ! filling with constant value
-         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi
+         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, ipi
             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland
          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO
@@ -389 +399 @@
 #undef SGN_IN
 #undef ARRAY_IN
+#undef I_SIZE
+#undef J_SIZE
 #undef K_SIZE
 #undef L_SIZE

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/LBC/mppini.F90

@@ -168 +168 @@
            &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
            &             ln_vol, nn_volctl, nn_rimwidth
-      NAMELIST/nammpp/ jpni, jpnj, ln_nnogather
+      NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, nn_hlts
       !!----------------------------------------------------------------------
       !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/nemogcm.F90

@@ -59 +59 @@
    USE diaobs         ! Observation diagnostics       (dia_obs_init routine)
    USE diacfl         ! CFL diagnostics               (dia_cfl_init routine)
-   USE diaharm        ! tidal harmonics diagnostics  (dia_harm_init routine)
    USE step           ! NEMO time-stepping                 (stp     routine)
    USE icbini         ! handle bergs, initialisation
@@ -473 +472 @@
       IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics
                            CALL dia_ptr_init    ! Poleward TRansports initialization
-                           CALL dia_dct_init    ! Sections tranports
+      IF( lk_diadct    )   CALL dia_dct_init    ! Sections tranports
                            CALL dia_hsb_init    ! heat content, salt content and volume budgets
                            CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends
@@ -479 +478 @@
                            CALL dia_tmb_init    ! TMB outputs
                            CALL dia_25h_init    ! 25h mean  outputs
-                           CALL dia_harm_init   ! tidal harmonics outputs
-     IF( ln_diaobs    )    CALL dia_obs( nit000-1 )   ! Observation operator for restart
+      IF( ln_diaobs    )   CALL dia_obs( nit000-1 )   ! Observation operator for restart
 
       !                                      ! Assimilation increments
@@ -641 +639 @@
       USE trc_oce   , ONLY : trc_oce_alloc
       USE bdy_oce   , ONLY : bdy_oce_alloc
+#if defined key_diadct 
+      USE diadct    , ONLY : diadct_alloc 
+#endif 
       !
       INTEGER :: ierr
@@ -652 +653 @@
       ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization)
       !
+#if defined key_diadct 
+      ierr = ierr + diadct_alloc ()    ! 
+#endif 
+      !
       CALL mpp_sum( 'nemogcm', ierr )
       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/oce.F90

@@ -38 +38 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
 
-   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  !
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b           !: Half step fluxes (ln_bt_fw=T)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_bf  , vn_bf           !: Asselin filtered half step fluxes (ln_bt_fw=T)
-#if defined key_agrif
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes 
-#endif
    !
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
@@ -104 +91 @@
       ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(3) )
          !
-      ALLOCATE( ssha_e(jpi,jpj),  sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), &
-         &        ua_e(jpi,jpj),    un_e(jpi,jpj),   ub_e(jpi,jpj),   ubb_e(jpi,jpj), &
-         &        va_e(jpi,jpj),    vn_e(jpi,jpj),   vb_e(jpi,jpj),   vbb_e(jpi,jpj), &
-         &        hu_e(jpi,jpj),   hur_e(jpi,jpj),   hv_e(jpi,jpj),   hvr_e(jpi,jpj), STAT=ierr(4) )
-         !
-      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj)      , STAT=ierr(6) )
-#if defined key_agrif
-      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(6) )
-#endif
-         !
       oce_alloc = MAXVAL( ierr )
       IF( oce_alloc /= 0 )   CALL ctl_stop( 'STOP', 'oce_alloc: failed to allocate arrays' )

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/par_oce.F90

@@ -75 +75 @@
    INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
    INTEGER, PUBLIC, PARAMETER ::   nn_hls = 1   !: halo width (applies to both rows and columns)
+   INTEGER, PUBLIC            ::   nn_hlts      !: added halo width for time splitting
 
    !!----------------------------------------------------------------------

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/step.F90

@@ -217 +217 @@
       IF( ln_diacfl  )   CALL dia_cfl ( kstp )        ! Courant number diagnostics
       IF( lk_diahth  )   CALL dia_hth ( kstp )        ! Thermocline depth (20 degres isotherm depth)
-      IF( ln_diadct  )   CALL dia_dct ( kstp )        ! Transports
+      IF( lk_diadct  )   CALL dia_dct ( kstp )        ! Transports
                          CALL dia_ar5 ( kstp )        ! ar5 diag
-      IF( ln_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
+      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
                          CALL dia_wri ( kstp )        ! ocean model: outputs
       !

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/timing.F90

@@ -657 +657 @@
          ! Compute cpu/elapsed ratio
          zall_ratio(:) = all_ctime(:) / all_etime(:)
-         ztot_ratio    = SUM(all_ctime(:))/SUM(all_etime(:))
-         zavg_ratio    = SUM(zall_ratio(:))/REAL(jpnij,wp)
+         ztot_ratio    = SUM(zall_ratio(:))
+         zavg_ratio    = ztot_ratio/REAL(jpnij,wp)
          zmax_ratio    = MAXVAL(zall_ratio(:))
          zmin_ratio    = MINVAL(zall_ratio(:))   
@@ -667 +667 @@
          cllignes(2)='1x,"--------------------",//,'
          cllignes(3)='1x,"Process Rank |"," Elapsed Time (s) |"," CPU Time (s) |"," Ratio CPU/Elapsed",/,'
-         cllignes(4)='      (4x,i6,4x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
-         WRITE(cllignes(4)(1:6),'(I6)') jpnij
+         cllignes(4)='    (1x,i4,9x,"|",f12.3,6x,"|",f12.3,2x,"|",4x,f7.3,/),'
+         WRITE(cllignes(4)(1:4),'(I4)') jpnij
          cllignes(5)='1x,"Total        |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'
          cllignes(6)='1x,"Minimum      |",f12.3,6x,"|",F12.3,2x,"|",4x,f7.3,/,'