Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/eosbn2.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/eosbn2.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/eosbn2.F90	(revision 14986)
@@ -578,4 +578,14 @@
 
    SUBROUTINE eos_insitu_pot_2d( pts, prhop )
+      !!
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      !                                                     ! 2 : salinity               [psu]
+      REAL(dp), DIMENSION(:,:)  , INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !!
+      CALL eos_insitu_pot_2d_t( pts, is_tile(pts), prhop, is_tile(prhop) )
+   END SUBROUTINE eos_insitu_pot_2d
+
+
+   SUBROUTINE eos_insitu_pot_2d_t( pts, ktts, prhop, ktrhop )
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE eos_insitu_pot  ***
@@ -590,7 +600,8 @@
       !!
       !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
+      INTEGER                              , INTENT(in   ) ::   ktts, ktrhop
+      REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celsius]
       !                                                                ! 2 : salinity               [psu]
-      REAL(dp), DIMENSION(jpi,jpj     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      REAL(dp), DIMENSION(A2D_T(ktrhop)   ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
       !
       INTEGER  ::   ji, jj, jk, jsmp             ! dummy loop indices
@@ -607,26 +618,26 @@
       CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==!
          !
-            DO_2D( 1, 1, 1, 1 )
-               !
-               zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
-               zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
-               ztm = tmask(ji,jj,1)                                         ! tmask
-               !
-               zn0 = (((((EOS060*zt   &
-                  &   + EOS150*zs+EOS050)*zt   &
-                  &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
-                  &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
-                  &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
-                  &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
-                  &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
-                  !
-               !
-               prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface
-               !
-            END_2D
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            !
+            zt  = pts (ji,jj,jp_tem) * r1_T0                           ! temperature
+            zs  = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 )   ! square root salinity
+            ztm = tmask(ji,jj,1)                                         ! tmask
+            !
+            zn0 = (((((EOS060*zt   &
+               &   + EOS150*zs+EOS050)*zt   &
+               &   + (EOS240*zs+EOS140)*zs+EOS040)*zt   &
+               &   + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt   &
+               &   + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt   &
+               &   + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt   &
+               &   + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000
+               !
+            !
+            prhop(ji,jj) = zn0 * ztm                           ! potential density referenced at the surface
+            !
+         END_2D
 
       CASE( np_seos )                !==  simplified EOS  ==!
          !
-         DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             zt  = pts  (ji,jj,jp_tem) - 10._wp
             zs  = pts  (ji,jj,jp_sal) - 35._wp
@@ -647,5 +658,5 @@
       IF( ln_timing )   CALL timing_stop('eos-pot')
       !
-   END SUBROUTINE eos_insitu_pot_2d
+   END SUBROUTINE eos_insitu_pot_2d_t
 
 
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv.F90	(revision 14986)
@@ -18,5 +18,5 @@
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary after extended haloes development
+   ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
    USE domtile
    USE domvvl         ! variable vertical scale factors
@@ -25,7 +25,5 @@
    USE traadv_cen     ! centered scheme            (tra_adv_cen  routine)
    USE traadv_fct     ! FCT      scheme            (tra_adv_fct  routine)
-   USE traadv_fct_lf  ! FCT      scheme            (tra_adv_fct  routine - loop fusion version)
    USE traadv_mus     ! MUSCL    scheme            (tra_adv_mus  routine)
-   USE traadv_mus_lf  ! MUSCL    scheme            (tra_adv_mus  routine - loop fusion version)
    USE traadv_ubs     ! UBS      scheme            (tra_adv_ubs  routine)
    USE traadv_qck     ! QUICKEST scheme            (tra_adv_qck  routine)
@@ -61,12 +59,12 @@
    LOGICAL ::   ln_traadv_qck    ! QUICKEST scheme flag
 
-   INTEGER ::   nadv             ! choice of the type of advection scheme
+   INTEGER, PUBLIC ::   nadv             ! choice of the type of advection scheme
    !                             ! associated indices:
-   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection
-   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme
-   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
-   INTEGER, PARAMETER ::   np_MUS     = 3   ! MUSCL scheme
-   INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
-   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_NO_adv  = 0   ! no T-S advection
+   INTEGER, PARAMETER, PUBLIC ::   np_CEN     = 1   ! 2nd/4th order centered scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_MUS     = 3   ! MUSCL scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
+   INTEGER, PARAMETER, PUBLIC ::   np_QCK     = 5   ! QUICK scheme
 
    !! * Substitutions
@@ -94,8 +92,8 @@
       !
       INTEGER ::   ji, jj, jk   ! dummy loop index
-      ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zuu, zvv, zww   ! 3D workspace
       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds
-      ! TEMP: [tiling] This change not necessary after extra haloes development
+      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       LOGICAL :: lskip
       !!----------------------------------------------------------------------
@@ -105,17 +103,15 @@
       lskip = .FALSE.
 
-      ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) )
       ENDIF
 
-      ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia)
-      IF( nadv /= np_CEN .OR. (nadv == np_CEN .AND. nn_cen_h == 4) .OR. ln_ldfeiv_dia )  THEN
-         IF( ln_tile ) THEN
-            IF( ntile == 1 ) THEN
-               CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
-            ELSE
-               lskip = .TRUE.
-            ENDIF
+      ! TEMP: [tiling] These changes not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( ln_tile .AND. nadv == np_FCT )  THEN
+         IF( ntile == 1 ) THEN
+            CALL dom_tile_stop( ldhold=.TRUE. )
+         ELSE
+            lskip = .TRUE.
          ENDIF
       ENDIF
@@ -123,5 +119,5 @@
          !                                         !==  effective transport  ==!
          IF( ln_wave .AND. ln_sdw )  THEN
-            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * ( uu(ji,jj,jk,Kmm) + usd(ji,jj,jk) )
                zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * ( vv(ji,jj,jk,Kmm) + vsd(ji,jj,jk) )
@@ -129,5 +125,5 @@
             END_3D
          ELSE
-            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zuu(ji,jj,jk) = e2u  (ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)               ! eulerian transport only
                zvv(ji,jj,jk) = e1v  (ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)
@@ -137,5 +133,5 @@
          !
          IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
-            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+            DO_3D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
                zuu(ji,jj,jk) = zuu(ji,jj,jk) + un_td(ji,jj,jk)
                zvv(ji,jj,jk) = zvv(ji,jj,jk) + vn_td(ji,jj,jk)
@@ -143,5 +139,5 @@
          ENDIF
          !
-         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom
             zvv(ji,jj,jpk) = 0._wp
@@ -149,14 +145,11 @@
          END_2D
          !
-         ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
          IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
-            &              CALL ldf_eiv_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), &
-            &                                'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
-         !
-         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu(A2D(nn_hls),:), zvv(A2D(nn_hls),:), zww(A2D(nn_hls),:), &
-            &                                'TRA', Kmm       )   ! add the mle transport (if necessary)
-         !
-         ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
-         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+            &              CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs )   ! add the eiv transport (if necessary)
+         !
+         IF( ln_mle    )   CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm       )   ! add the mle transport (if necessary)
+         !
+         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
             CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport
             CALL iom_put( "vocetr_eff", zvv )
@@ -164,8 +157,8 @@
          ENDIF
          !
-   !!gm ???
-         ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
+!!gm ???
+         ! TEMP: [tiling] This copy-in not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
          CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) )                                    ! diagnose the effective MSF
-   !!gm ???
+!!gm ???
          !
 
@@ -179,37 +172,12 @@
          !
          CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
-            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1._wp )
             CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v )
          CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order
-            IF (nn_hls.EQ.2) THEN
-               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp, pts(:,:,:,:,Kmm), 'T', 1._wp)
-               CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1._wp, zvv(:,:,:), 'V', -1._wp, zww(:,:,:), 'W', 1._wp)
-#if defined key_loop_fusion
-               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-#else
                CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-#endif
-            ELSE
-               CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-            END IF
          CASE ( np_MUS )                                 ! MUSCL
-            IF (nn_hls.EQ.2) THEN
-                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp)
-#if defined key_loop_fusion
-                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
-#else
                 CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
-#endif
-            ELSE
-                CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups )
-            END IF
          CASE ( np_UBS )                                 ! UBS
-            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp)
             CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   )
          CASE ( np_QCK )                                 ! QUICKEST
-            IF (nn_hls.EQ.2) THEN
-               CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1._wp, zvv(:,:,:), 'V', -1._wp)
-               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1._wp)
-            END IF
             CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
          !
@@ -226,7 +194,6 @@
          ENDIF
 
-         ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_adv_*) and if XIOS has subdomain support (ldf_eiv_dia)
-         IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )
-
+         ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+         IF( ln_tile .AND. .NOT. l_istiled ) CALL dom_tile_start( ldhold=.TRUE. )
       ENDIF
       !                                              ! print mean trends (used for debugging)
@@ -234,6 +201,6 @@
          &                                  tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
 
-      ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
-      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain
          DEALLOCATE( zuu, zvv, zww )
       ENDIF
@@ -307,4 +274,8 @@
         CALL ctl_stop( 'tra_adv_init: FCT scheme, choose 2nd or 4th order' )
       ENDIF
+      ! TEMP: [tiling] This change not necessary after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      IF( ln_traadv_fct .AND. ln_tile ) THEN
+         CALL ctl_warn( 'tra_adv_init: FCT scheme does not yet work with tiling' )
+      ENDIF
       IF( ln_traadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN     ! UBS
         CALL ctl_stop( 'tra_adv_init: UBS scheme, choose 2nd or 4th order' )
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen.F90	(revision 14986)
@@ -23,4 +23,7 @@
    USE trc_oce        ! share passive tracers/Ocean variables
    USE lib_mpp        ! MPP library
+#if defined key_loop_fusion
+   USE traadv_cen_lf  ! centered scheme            (tra_adv_cen  routine - loop fusion version)
+#endif
 
    IMPLICIT NONE
@@ -72,5 +75,5 @@
       INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
       INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
@@ -83,5 +86,8 @@
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_cen_lf    ( kt, nit000, cdtype, pU, pV, pW, Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
@@ -120,5 +126,5 @@
                ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
             END_3D
-            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond.
+            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond.
             !
             DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes
@@ -132,5 +138,5 @@
                zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v
             END_3D
-            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1._wp , zwy, 'V', -1._wp )
+            IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', zwx, 'U', -1._wp , zwy, 'V', -1._wp )
             !
          CASE DEFAULT
@@ -185,4 +191,5 @@
       END DO
       !
+#endif
    END SUBROUTINE tra_adv_cen
 
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen_lf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen_lf.F90	(revision 14986)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_cen_lf.F90	(revision 14986)
@@ -0,0 +1,187 @@
+MODULE traadv_cen_lf
+   !!======================================================================
+   !!                     ***  MODULE  traadv_cen  ***
+   !! Ocean  tracers:   advective trend (2nd/4th order centered)
+   !!======================================================================
+   !! History :  3.7  ! 2014-05  (G. Madec)  original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen   : update the tracer trend with the advection trends using a centered or scheme (2nd or 4th order)
+   !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain
+   USE eosbn2         ! equation of state
+   USE traadv_fct     ! acces to routine interp_4th_cpt
+   USE trd_oce        ! trends: ocean variables
+   USE trdtra         ! trends manager: tracers
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   !
+   USE in_out_manager ! I/O manager
+   USE iom            ! IOM library
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_cen_lf   ! called by traadv.F90
+
+   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
+
+   LOGICAL ::   l_trd   ! flag to compute trends
+   LOGICAL ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL ::   l_hst   ! flag to compute heat/salt transport
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: traadv_cen.F90 14776 2021-04-30 12:33:41Z mocavero $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_cen_lf( kt, kit000, cdtype, pU, pV, pW,     &
+      &                    Kmm, pt, kjpt, Krhs, kn_cen_h, kn_cen_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_cen  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a 2nd or 4th order scheme
+      !!               using now fields (leap-frog scheme).
+      !!       kn_cen_h = 2  ==>> 2nd order centered scheme on the horizontal
+      !!                = 4  ==>> 4th order    -        -       -      -
+      !!       kn_cen_v = 2  ==>> 2nd order centered scheme on the vertical
+      !!                = 4  ==>> 4th order COMPACT  scheme     -      -
+      !!
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - poleward advective heat and salt transport (l_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs       ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                                  , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme)
+      INTEGER                                  , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme)
+      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   ierr             ! local integer
+      REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars
+      REAL(wp) ::   zC2t_v, zC4t_v   !   -      -
+      REAL(wp) ::   ztu_im1, ztu_ip1 !   -      -
+      REAL(wp) ::   ztv_jm1, ztv_jp1 !   -      -
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwx, zwy, zwz, ztw
+      !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == kit000 )  THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'tra_adv_cen : centered advection scheme on ', cdtype, ' order h/v =', kn_cen_h,'/', kn_cen_v
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+         ENDIF
+         !                          ! set local switches
+         l_trd = .FALSE.
+         l_hst = .FALSE.
+         l_ptr = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )       l_trd = .TRUE.
+         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )    l_ptr = .TRUE.
+         IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+            &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
+      ENDIF
+      !
+      !
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom vertical flux set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         SELECT CASE( kn_cen_h )       !--  Horizontal fluxes  --!
+         !
+         CASE(  2  )                         !* 2nd order centered
+            DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm) )
+               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) )
+            END_3D
+            !
+         CASE(  4  )                         !* 4th order centered
+            DO_3D( 1, 0, 1, 0, 1, jpkm1 )           ! Horizontal advective fluxes
+               ztu_im1 = ( pt(ji,jj  ,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk)
+               ztu_ip1 = ( pt(ji+2,jj  ,jk,jn,Kmm) - pt(ji+1,jj,jk,jn,Kmm) ) * umask(ji+1,jj,jk)
+               ztv_jm1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk)
+               ztv_jp1 = ( pt(ji,jj+2,jk,jn,Kmm) - pt(ji,jj+1,jk,jn,Kmm) ) * vmask(ji,jj+1,jk)
+               !
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! C2 interpolation of T at u- & v-points (x2)
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                  ! C4 interpolation of T at u- & v-points (x2)
+               zC4t_u =  zC2t_u + r1_6 * ( ztu_im1 - ztu_ip1 )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv_jm1 - ztv_jp1 )
+               !                                                  ! C4 fluxes
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v
+            END_3D
+            !
+         CASE DEFAULT
+            CALL ctl_stop( 'traadv_cen: wrong value for nn_cen' )
+         END SELECT
+         !
+         SELECT CASE( kn_cen_v )       !--  Vertical fluxes  --!   (interior)
+         !
+         CASE(  2  )                         !* 2nd order centered
+            DO_3D( 0, 0, 0, 0, 2, jpk )
+               zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) * wmask(ji,jj,jk)
+            END_3D
+            !
+         CASE(  4  )                         !* 4th order compact
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )      ! ztw = interpolated value of T at w-point
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               zwz(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+            END_3D
+            !
+         END SELECT
+         !
+         IF( ln_linssh ) THEN                !* top value   (linear free surf. only as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO_2D( 1, 1, 1, 1 )
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)
+               END_2D
+            ELSE                                   ! no ice-shelf cavities (only ocean surface)
+               DO_2D( 1, 1, 1, 1 )
+                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)
+               END_2D
+            ENDIF
+         ENDIF
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !--  Divergence of advective fluxes  --!
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)    &
+               &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    &
+               &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    &
+               &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) &
+               &                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
+         !                               ! trend diagnostics
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
+         ENDIF
+         !                                 ! "Poleward" heat and salt transports
+         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+         !                                 !  heat and salt transport
+         IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_cen_lf
+
+   !!======================================================================
+END MODULE traadv_cen_lf
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_fct.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_fct.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_fct.F90	(revision 14986)
@@ -34,6 +34,4 @@
    PUBLIC   tra_adv_fct        ! called by traadv.F90
    PUBLIC   interp_4th_cpt     ! called by traadv_cen.F90
-   PUBLIC   tridia_solver      ! called by traadv_fct_lf.F90
-   PUBLIC   nonosc             ! called by traadv_fct_lf.F90 - key_agrif
 
    LOGICAL  ::   l_trd   ! flag to compute trends
@@ -82,5 +80,5 @@
       INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
@@ -97,5 +95,8 @@
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_fct_lf ( kt, nit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
@@ -138,5 +139,5 @@
       ! If adaptive vertical advection, check if it is needed on this PE at this time
       IF( ln_zad_Aimp ) THEN
-         IF( MAXVAL( ABS( wi(A2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE.
+         IF( MAXVAL( ABS( wi(A2D(1),:) ) ) > 0._wp ) ll_zAimp = .TRUE.
       END IF
       ! If active adaptive vertical advection, build tridiagonal matrix
@@ -164,4 +165,618 @@
             zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji  ,jj+1,jk,jn,Kbb) )
          END_3D
+         !                               !* upstream tracer flux in the k direction *!
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
+            zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
+            zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
+            zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk)
+         END_3D
+         IF( ln_linssh ) THEN               ! top ocean value (only in linear free surface as zwz has been w-masked)
+            IF( ln_isfcav ) THEN                        ! top of the ice-shelf cavities and at the ocean surface
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface
+               END_2D
+            ELSE                                        ! no cavities: only at the ocean surface
+               DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
+               END_2D
+            ENDIF
+         ENDIF
+         !
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme
+            !                               ! total intermediate advective trends
+            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+               &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+            !                               ! update and guess with monotonic sheme
+            pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
+               &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
+            zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
+               &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
+
+         IF ( ll_zAimp ) THEN
+            CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 )
+            !
+            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes
+            END_3D
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
+                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
+            !
+         END IF
+         !
+         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)
+         !
+         !        !==  anti-diffusive flux : high order minus low order  ==!
+         !
+         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
+               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk)
+            END_3D
+            !
+         CASE(  4  )                   !- 4th order centered
+            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv(:,:,jpk) = 0._wp
+            DO jk = 1, jpkm1                 ! Laplacian
+               DO_2D( 1, 0, 1, 0 )                 ! 1st derivative (gradient)
+                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+               END_2D
+               DO_2D( 0, 0, 0, 0 )                 ! 2nd derivative * 1/ 6
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+               END_2D
+            END DO
+            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility
+            CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                        ! C4 minus upstream advective fluxes
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu(ji,jj,jk) - zltu(ji+1,jj,jk)   &
+                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility
+                             &                          ) - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv(ji,jj,jk) - zltv(ji,jj+1,jk)   &
+                             &                                     )                                     & ! bracket for halo 1 - halo 2 compatibility
+                             &                          ) - zwy(ji,jj,jk)
+            END_3D
+            !
+         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
+            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
+            ztv(:,:,jpk) = 0._wp
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient)
+               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+            END_3D
+            IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes
+               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2)
+               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
+               !                                                  ! C4 interpolation of T at u- & v-points (x2)
+               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+               !                                                  ! C4 minus upstream advective fluxes
+               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
+               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
+            END_3D
+            IF (nn_hls==2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
+         END SELECT
+         !
+         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
+         !
+         CASE(  2  )                   !- 2nd order centered
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
+                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
+            END_3D
+            !
+         CASE(  4  )                   !- 4th order COMPACT
+            CALL interp_4th_cpt( CASTWP(pt(:,:,:,jn,Kmm)) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
+            END_3D
+            !
+         END SELECT
+         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
+            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
+         ENDIF
+         !
+         IF (nn_hls==1) THEN
+            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp )
+            CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp )
+         ELSE
+            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
+         END IF
+         !
+         IF ( ll_zAimp ) THEN
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme
+               !                                                ! total intermediate advective trends
+               ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+            END_3D
+            !
+            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
+            !
+            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+            END_3D
+         END IF
+         !
+         !        !==  monotonicity algorithm  ==!
+         !
+         CALL nonosc( Kmm, CASTWP(pt(:,:,:,jn,Kbb)), zwx, zwy, zwz, zwi, p2dt )
+         !
+         !        !==  final trend with corrected fluxes  ==!
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+               &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm)
+            zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+         END_3D
+         !
+         IF ( ll_zAimp ) THEN
+            !
+            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
+               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
+               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
+               ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
+               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic
+            END_3D
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
+                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
+         END IF
+         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  !
+            !
+            IF( l_trd ) THEN              ! trend diagnostics
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, CASTWP(pt(:,:,:,jn,Kmm)) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, CASTWP(pt(:,:,:,jn,Kmm)) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, CASTWP(pt(:,:,:,jn,Kmm)) )
+            ENDIF
+            !                             ! heat/salt transport
+            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) )
+            !
+         ENDIF
+         IF( l_ptr ) THEN              ! "Poleward" transports
+            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes
+            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
+         ENDIF
+         !
+      END DO                     ! end of tracer loop
+      !
+      IF ( ll_zAimp ) THEN
+         DEALLOCATE( zwdia, zwinf, zwsup )
+      ENDIF
+      IF( l_trd .OR. l_hst ) THEN
+         DEALLOCATE( ztrdx, ztrdy, ztrdz )
+      ENDIF
+      IF( l_ptr ) THEN
+         DEALLOCATE( zptry )
+      ENDIF
+      !
+#endif
+   END SUBROUTINE tra_adv_fct
+
+
+   SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream
+      !!       scheme and the before field by a nonoscillatory algorithm
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in   ) ::   Kmm             ! time level index
+      REAL(wp)                        , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pbef            ! before field
+      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(in   ) ::   paft            ! after field
+      REAL(dp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
+      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
+      REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo
+      !!----------------------------------------------------------------------
+      !
+      zbig  = 1.e+40_dp
+      zrtrn = 1.e-15_dp
+      zbetup(:,:,:) = 0._dp   ;   zbetdo(:,:,:) = 0._dp
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+         zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
+            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) )  )
+         zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
+            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) )  )
+      END_3D
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+
+            ! search maximum in neighbourhood
+            zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+               &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
+               &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
+               &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
+
+            ! search minimum in neighbourhood
+            zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
+               &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
+               &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
+               &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
+
+            ! positive part of the flux
+            zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+               & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+               & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+
+            ! negative part of the flux
+            zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+               & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+               & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+
+            ! up & down beta terms
+            zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
+            zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
+            zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
+         END_2D
+      END DO
+      IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp, ld4only= .TRUE. )   ! lateral boundary cond. (unchanged sign)
+
+      ! 3. monotonic flux in the i & j direction (paa & pbb)
+      ! ----------------------------------------
+      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+         zcu =       ( 0.5  + SIGN( 0.5_wp , CASTWP(paa(ji,jj,jk)) ) )
+         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
+
+         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+         zcv =       ( 0.5  + SIGN( 0.5_wp , CASTWP(pbb(ji,jj,jk)) ) )
+         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+         za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
+         zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
+         zc =       ( 0.5  + SIGN( 0.5_wp , CASTWP(pcc(ji,jj,jk+1)) ) )
+         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
+      END_3D
+      !
+   END SUBROUTINE nonosc
+
+
+   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt_org  ***
+      !!
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
+      !
+      INTEGER :: ji, jj, jk   ! dummy loop integers
+      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )       !==  build the three diagonal matrix  ==!
+         zwd (ji,jj,jk) = 4._wp
+         zwi (ji,jj,jk) = 1._wp
+         zws (ji,jj,jk) = 1._wp
+         zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         !
+         IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
+            zwd (ji,jj,jk) = 1._wp
+            zwi (ji,jj,jk) = 0._wp
+            zws (ji,jj,jk) = 0._wp
+            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+         ENDIF
+      END_3D
+      !
+      jk = 2                                    ! Switch to second order centered at top
+      DO_2D( 1, 1, 1, 1 )
+         zwd (ji,jj,jk) = 1._wp
+         zwi (ji,jj,jk) = 0._wp
+         zws (ji,jj,jk) = 0._wp
+         zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
+      END_2D
+      !
+      !                       !==  tridiagonal solve  ==!
+      DO_2D( 1, 1, 1, 1 )           ! first recurrence
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( 1, 1, 1, 1 )           ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+
+      DO_2D( 1, 1, 1, 1 )           ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( 1, 1, 1, 1, jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE interp_4th_cpt_org
+
+
+   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interp_4th_cpt  ***
+      !!
+      !! **  Purpose :   Compute the interpolation of tracer at w-point
+      !!
+      !! **  Method  :   4th order compact interpolation
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point
+      REAL(wp),DIMENSION(A2D(nn_hls)    ,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   ikt, ikb     ! local integers
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt
+      !!----------------------------------------------------------------------
+      !
+      !                      !==  build the three diagonal matrix & the RHS  ==!
+      !
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )    ! interior (from jk=3 to jpk-1)
+         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
+         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
+         zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
+         zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
+            &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
+      END_3D
+      !
+!!gm
+!      SELECT CASE( kbc )               !* boundary condition
+!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom
+!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom
+!      END SELECT
+!!gm
+      !
+      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case
+         zwd(:,:,2) = 1._wp  ;  zwi(:,:,2) = 0._wp  ;  zws(:,:,2) = 0._wp  ;  zwrm(:,:,2) = 0._wp
+      END IF
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! 2nd order centered at top & bottom
+         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
+         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point
+         !
+         zwd (ji,jj,ikt) = 1._wp          ! top
+         zwi (ji,jj,ikt) = 0._wp
+         zws (ji,jj,ikt) = 0._wp
+         zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) )
+         !
+         zwd (ji,jj,ikb) = 1._wp          ! bottom
+         zwi (ji,jj,ikb) = 0._wp
+         zws (ji,jj,ikb) = 0._wp
+         zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )
+      END_2D
+      !
+      !                       !==  tridiagonal solver  ==!
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         zwt(ji,jj,2) = zwd(ji,jj,2)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
+         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,2) = zwrm(ji,jj,2)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
+         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE interp_4th_cpt
+
+
+   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tridia_solver  ***
+      !!
+      !! **  Purpose :   solve a symmetric 3diagonal system
+      !!
+      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk )
+      !!
+      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 )
+      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 )
+      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 )
+      !!             (        ...          )( ... )   ( ...  )
+      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k )
+      !!
+      !!        M is decomposed in the product of an upper and lower triangular matrix.
+      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL
+      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal).
+      !!        The solution is pta.
+      !!        The 3d array zwt is used as a work space array.
+      !!----------------------------------------------------------------------
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pD, pU, pL    ! 3-diagonal matrix
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pRHS          ! Right-Hand-Side
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   pt_out        !!gm field at level=F(klev)
+      INTEGER                    , INTENT(in   ) ::   klev          ! =1 pt_out at w-level
+      !                                                             ! =0 pt at t-level
+      INTEGER ::   ji, jj, jk   ! dummy loop integers
+      INTEGER ::   kstart       ! local indices
+      REAL(wp),DIMENSION(A2D(nn_hls),jpk) ::   zwt   ! 3D work array
+      !!----------------------------------------------------------------------
+      !
+      kstart =  1  + klev
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
+         zwt(ji,jj,kstart) = pD(ji,jj,kstart)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
+         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
+      END_3D
+      !
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
+      END_2D
+      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
+         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
+      END_3D
+
+      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
+         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+      END_2D
+      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 )
+         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+      END_3D
+      !
+   END SUBROUTINE tridia_solver
+
+#if defined key_loop_fusion
+#define tracer_flux_i(out,zfp,zfm,ji,jj,jk) \
+        zfp = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ; \
+        zfm = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) ; \
+        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji+1,jj,jk,jn,Kbb) )
+
+#define tracer_flux_j(out,zfp,zfm,ji,jj,jk) \
+        zfp = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) ; \
+        zfm = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) ; \
+        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji,jj+1,jk,jn,Kbb) )
+
+   SUBROUTINE tra_adv_fct_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,       &
+      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_fct  ***
+      !!
+      !! **  Purpose :   Compute the now trend due to total advection of tracers
+      !!               and add it to the general trend of tracer equations
+      !!
+      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
+      !!               (choice through the value of kn_fct)
+      !!               - on the vertical the 4th order is a compact scheme
+      !!               - corrected flux (monotonic correction)
+      !!
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
+      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
+      !
+      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices
+      REAL(wp) ::   ztra                                     ! local scalar
+      REAL(wp) ::   zwx_im1, zfp_ui, zfp_ui_m1, zfp_vj, zfp_vj_m1, zfp_wk, zC2t_u, zC4t_u   !   -      -
+      REAL(wp) ::   zwy_jm1, zfm_ui, zfm_ui_m1, zfm_vj, zfm_vj_m1, zfm_wk, zC2t_v, zC4t_v   !   -      -
+      REAL(wp) ::   ztu, ztv, ztu_im1, ztu_ip1, ztv_jm1, ztv_jp1
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx_3d, zwy_3d, zwz, ztw, zltu_3d, zltv_3d
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup
+      LOGICAL  ::   ll_zAimp                                 ! flag to apply adaptive implicit vertical advection
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_fct_lf : FCT advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+      !! -- init to 0
+      zwx_3d(:,:,:) = 0._wp
+      zwy_3d(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      zwi(:,:,:) = 0._wp
+      !
+      l_trd = .FALSE.            ! set local switches
+      l_hst = .FALSE.
+      l_ptr = .FALSE.
+      ll_zAimp = .FALSE.
+      IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE.
+      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  &
+         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
+      !
+      IF( l_trd .OR. l_hst )  THEN
+         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) )
+         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
+      ENDIF
+      !
+      IF( l_ptr ) THEN
+         ALLOCATE( zptry(jpi,jpj,jpk) )
+         zptry(:,:,:) = 0._wp
+      ENDIF
+      !
+      ! If adaptive vertical advection, check if it is needed on this PE at this time
+      IF( ln_zad_Aimp ) THEN
+         IF( MAXVAL( ABS( wi(:,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE.
+      END IF
+      ! If active adaptive vertical advection, build tridiagonal matrix
+      IF( ll_zAimp ) THEN
+         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk))
+         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   &
+            &                               / e3t(ji,jj,jk,Krhs)
+            zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t(ji,jj,jk,Krhs)
+            zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs)
+         END_3D
+      END IF
+      !
+      DO jn = 1, kjpt            !==  loop over the tracers  ==!
+         !
+         !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
          !                               !* upstream tracer flux in the k direction *!
          DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
@@ -182,15 +797,27 @@
          ENDIF
          !
-         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )   !* trend and after field with monotonic scheme
-            !                               ! total intermediate advective trends
-            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-               &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
-               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
-            !                               ! update and guess with monotonic sheme
-            pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
-               &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
-            zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
-               &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
-         END_3D
+         !                    !* upstream tracer flux in the i and j direction
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj-1
+               tracer_flux_i(zwx_3d(1,jj,jk),zfp_ui,zfm_ui,1,jj,jk)
+               tracer_flux_j(zwy_3d(1,jj,jk),zfp_vj,zfm_vj,1,jj,jk)
+            END DO
+            DO ji = 1, jpi-1
+               tracer_flux_i(zwx_3d(ji,1,jk),zfp_ui,zfm_ui,ji,1,jk)
+               tracer_flux_j(zwy_3d(ji,1,jk),zfp_vj,zfm_vj,ji,1,jk)
+            END DO
+            DO_2D( 1, 1, 1, 1 )
+               tracer_flux_i(zwx_3d(ji,jj,jk),zfp_ui,zfm_ui,ji,jj,jk)
+               tracer_flux_i(zwx_im1,zfp_ui_m1,zfm_ui_m1,ji-1,jj,jk)
+               tracer_flux_j(zwy_3d(ji,jj,jk),zfp_vj,zfm_vj,ji,jj,jk)
+               tracer_flux_j(zwy_jm1,zfp_vj_m1,zfm_vj_m1,ji,jj-1,jk)
+               ztra = - ( zwx_3d(ji,jj,jk) - zwx_im1 + zwy_3d(ji,jj,jk) - zwy_jm1 + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) * r1_e1e2t(ji,jj)
+               !                               ! update and guess with monotonic sheme
+               pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
+                  &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
+               zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
+                  &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
+            END_2D
+         END DO
 
          IF ( ll_zAimp ) THEN
@@ -198,5 +825,5 @@
             !
             ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
-            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
                zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
                zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
@@ -212,8 +839,8 @@
          !
          IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes)
-            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
+            ztrdx(:,:,:) = zwx_3d(:,:,:)   ;   ztrdy(:,:,:) = zwy_3d(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
          END IF
          !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( l_ptr )   zptry(:,:,:) = zwy(:,:,:)
+         IF( l_ptr )   zptry(:,:,:) = zwy_3d(:,:,:)
          !
          !        !==  anti-diffusive flux : high order minus low order  ==!
@@ -222,53 +849,58 @@
          !
          CASE(  2  )                   !- 2nd order centered
-            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
-               zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk)
-               zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk)
+            DO_3D( 2, 1, 2, 1, 1, jpkm1 )
+               zwx_3d(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx_3d(ji,jj,jk)
+               zwy_3d(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy_3d(ji,jj,jk)
             END_3D
             !
          CASE(  4  )                   !- 4th order centered
-            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
-            zltv(:,:,jpk) = 0._wp
-            DO jk = 1, jpkm1                 ! Laplacian
-               DO_2D( 1, 0, 1, 0 )                 ! 1st derivative (gradient)
-                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
-                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
-               END_2D
-               DO_2D( 0, 0, 0, 0 )                 ! 2nd derivative * 1/ 6
-                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
-                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
+            zltu_3d(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
+            zltv_3d(:,:,jpk) = 0._wp
+            !                          ! Laplacian
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )                 ! 2nd derivative * 1/ 6
+                  !             ! 1st derivative (gradient)
+                  ztu = ( pt(ji+1,jj,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
+                  ztu_im1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk)
+                  ztv = ( pt(ji,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
+                  ztv_jm1 = ( pt(ji,jj,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk)
+                  !             ! 2nd derivative * 1/ 6
+                  zltu_3d(ji,jj,jk) = (  ztu + ztu_im1  ) * r1_6
+                  zltv_3d(ji,jj,jk) = (  ztv + ztv_jm1  ) * r1_6
                END_2D
             END DO
-            CALL lbc_lnk( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
-            !
-            DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+            ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility
+            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', -1.0_wp , zltv_3d, 'T', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+            !
+            DO_3D( 2, 1, 2, 1, 1, jpkm1 )
                zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points
                zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
                !                                                        ! C4 minus upstream advective fluxes
-               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)
-               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)
-            END_3D
-            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp, zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + ( zltu_3d(ji,jj,jk) - zltu_3d(ji+1,jj,jk)   &
+                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility
+                             &                             ) - zwx_3d(ji,jj,jk)
+               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + ( zltv_3d(ji,jj,jk) - zltv_3d(ji,jj+1,jk)   &
+                             &                                        )                                           & ! bracket for halo 1 - halo 2 compatibility
+                             &                             ) - zwy_3d(ji,jj,jk)
+            END_3D
             !
          CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
-            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
-            ztv(:,:,jpk) = 0._wp
-            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )    ! 1st derivative (gradient)
-               ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
-               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
-            END_3D
-            IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
-            !
             DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes
+               ztu_im1 = ( pt(ji  ,jj  ,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk)
+               ztu_ip1 = ( pt(ji+2,jj  ,jk,jn,Kmm) - pt(ji+1,jj,jk,jn,Kmm) ) * umask(ji+1,jj,jk)
+
+               ztv_jm1 = ( pt(ji,jj  ,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk)
+               ztv_jp1 = ( pt(ji,jj+2,jk,jn,Kmm) - pt(ji,jj+1,jk,jn,Kmm) ) * vmask(ji,jj+1,jk)
                zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2)
                zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
                !                                                  ! C4 interpolation of T at u- & v-points (x2)
-               zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) )
-               zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) )
+               zC4t_u =  zC2t_u + r1_6 * ( ztu_im1 - ztu_ip1 )
+               zC4t_v =  zC2t_v + r1_6 * ( ztv_jm1 - ztv_jp1 )
                !                                                  ! C4 minus upstream advective fluxes
-               zwx(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)
-               zwy(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)
-            END_3D
-            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx_3d(ji,jj,jk)
+               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk)
+            END_3D
+            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
             !
          END SELECT
@@ -277,5 +909,5 @@
          !
          CASE(  2  )                   !- 2nd order centered
-            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
                zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
                   &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
@@ -283,6 +915,6 @@
             !
          CASE(  4  )                   !- 4th order COMPACT
-            CALL interp_4th_cpt( CASTWP(pt(:,:,:,jn,Kmm)) , ztw )   ! zwt = COMPACT interpolation of T at w-point
-            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
                zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
             END_3D
@@ -293,16 +925,11 @@
          ENDIF
          !
-         IF (nn_hls.EQ.1) THEN
-            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp )
-            CALL lbc_lnk( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp )
-         ELSE
-            CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
-         END IF
+         CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
          !
          IF ( ll_zAimp ) THEN
-            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !* trend and after field with monotonic scheme
+            DO_3D( 1, 1, 1, 1, 1, jpkm1 )    !* trend and after field with monotonic scheme
                !                                                ! total intermediate advective trends
-               ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-                  &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+               ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   &
+                  &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   &
                   &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
                ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
@@ -311,5 +938,5 @@
             CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
             !
-            DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
                zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
                zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
@@ -320,11 +947,11 @@
          !        !==  monotonicity algorithm  ==!
          !
-         CALL nonosc( Kmm, CASTWP(pt(:,:,:,jn,Kbb)), zwx, zwy, zwz, zwi, p2dt )
+         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt )
          !
          !        !==  final trend with corrected fluxes  ==!
          !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-            ztra = - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
-               &      + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+            ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   &
+               &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   &
                &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
             pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm)
@@ -346,13 +973,14 @@
             END_3D
          END IF
+         ! NOT TESTED - NEED l_trd OR l_hst TRUE
          IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport
-            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< add anti-diffusive fluxes
-            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  !     to upstream fluxes
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx_3d(:,:,:)  ! <<< add anti-diffusive fluxes
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy_3d(:,:,:)  !     to upstream fluxes
             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  !
             !
             IF( l_trd ) THEN              ! trend diagnostics
-               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, CASTWP(pt(:,:,:,jn,Kmm)) )
-               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, CASTWP(pt(:,:,:,jn,Kmm)) )
-               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, CASTWP(pt(:,:,:,jn,Kmm)) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) )
+               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) )
             ENDIF
             !                             ! heat/salt transport
@@ -360,6 +988,7 @@
             !
          ENDIF
+         ! NOT TESTED - NEED l_ptr TRUE
          IF( l_ptr ) THEN              ! "Poleward" transports
-            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< add anti-diffusive fluxes
+            zptry(:,:,:) = zptry(:,:,:) + zwy_3d(:,:,:)  ! <<< add anti-diffusive fluxes
             CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
          ENDIF
@@ -377,300 +1006,6 @@
       ENDIF
       !
-   END SUBROUTINE tra_adv_fct
-
-
-   SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc  ***
-      !!
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream
-      !!       scheme and the before field by a nonoscillatory algorithm
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!----------------------------------------------------------------------
-      INTEGER                         , INTENT(in   ) ::   Kmm             ! time level index
-      REAL(wp)                        , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pbef            ! before field
-      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(in   ) ::   paft            ! after field
-      REAL(dp), DIMENSION(A2D(nn_hls)    ,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      INTEGER  ::   ikm1         ! local integer
-      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
-      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
-      REAL(dp), DIMENSION(A2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo
-      !!----------------------------------------------------------------------
-      !
-      zbig  = 1.e+40_dp
-      zrtrn = 1.e-15_dp
-      zbetup(:,:,:) = 0._dp   ;   zbetdo(:,:,:) = 0._dp
-
-      ! Search local extrema
-      ! --------------------
-      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
-      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
-         zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
-            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) )  )
-         zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ),   &
-            &                  paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) )  )
-      END_3D
-
-      DO jk = 1, jpkm1
-         ikm1 = MAX(jk-1,1)
-         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
-
-            ! search maximum in neighbourhood
-            zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
-               &        zbup(ji-1,jj  ,jk  ), zbup(ji+1,jj  ,jk  ),   &
-               &        zbup(ji  ,jj-1,jk  ), zbup(ji  ,jj+1,jk  ),   &
-               &        zbup(ji  ,jj  ,ikm1), zbup(ji  ,jj  ,jk+1)  )
-
-            ! search minimum in neighbourhood
-            zdo = MIN(  zbdo(ji  ,jj  ,jk  ),   &
-               &        zbdo(ji-1,jj  ,jk  ), zbdo(ji+1,jj  ,jk  ),   &
-               &        zbdo(ji  ,jj-1,jk  ), zbdo(ji  ,jj+1,jk  ),   &
-               &        zbdo(ji  ,jj  ,ikm1), zbdo(ji  ,jj  ,jk+1)  )
-
-            ! positive part of the flux
-            zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
-               & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
-               & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
-
-            ! negative part of the flux
-            zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
-               & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
-               & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
-
-            ! up & down beta terms
-            zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
-            zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt
-            zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt
-         END_2D
-      END DO
-      IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign)
-
-      ! 3. monotonic flux in the i & j direction (paa & pbb)
-      ! ----------------------------------------
-      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
-         zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
-         zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
-         zcu =       ( 0.5  + SIGN( 0.5_wp , CASTWP(paa(ji,jj,jk)) ) )
-         paa(ji,jj,jk) = paa(ji,jj,jk) * ( zcu * zau + ( 1._wp - zcu) * zbu )
-
-         zav = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
-         zbv = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
-         zcv =       ( 0.5  + SIGN( 0.5_wp , CASTWP(pbb(ji,jj,jk)) ) )
-         pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zcv * zav + ( 1._wp - zcv) * zbv )
-
-      ! monotonic flux in the k direction, i.e. pcc
-      ! -------------------------------------------
-         za = MIN( 1., zbetdo(ji,jj,jk+1), zbetup(ji,jj,jk) )
-         zb = MIN( 1., zbetup(ji,jj,jk+1), zbetdo(ji,jj,jk) )
-         zc =       ( 0.5  + SIGN( 0.5_wp , CASTWP(pcc(ji,jj,jk+1)) ) )
-         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb )
-      END_3D
-      !
-   END SUBROUTINE nonosc
-
-
-   SUBROUTINE interp_4th_cpt_org( pt_in, pt_out )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interp_4th_cpt_org  ***
-      !!
-      !! **  Purpose :   Compute the interpolation of tracer at w-point
-      !!
-      !! **  Method  :   4th order compact interpolation
-      !!----------------------------------------------------------------------
-      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! now tracer fields
-      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   pt_out   ! now tracer field interpolated at w-pts
-      !
-      INTEGER :: ji, jj, jk   ! dummy loop integers
-      REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt
-      !!----------------------------------------------------------------------
-
-      DO_3D( 1, 1, 1, 1, 3, jpkm1 )       !==  build the three diagonal matrix  ==!
-         zwd (ji,jj,jk) = 4._wp
-         zwi (ji,jj,jk) = 1._wp
-         zws (ji,jj,jk) = 1._wp
-         zwrm(ji,jj,jk) = 3._wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
-         !
-         IF( tmask(ji,jj,jk+1) == 0._wp) THEN   ! Switch to second order centered at bottom
-            zwd (ji,jj,jk) = 1._wp
-            zwi (ji,jj,jk) = 0._wp
-            zws (ji,jj,jk) = 0._wp
-            zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
-         ENDIF
-      END_3D
-      !
-      jk = 2                                    ! Switch to second order centered at top
-      DO_2D( 1, 1, 1, 1 )
-         zwd (ji,jj,jk) = 1._wp
-         zwi (ji,jj,jk) = 0._wp
-         zws (ji,jj,jk) = 0._wp
-         zwrm(ji,jj,jk) = 0.5 * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) )
-      END_2D
-      !
-      !                       !==  tridiagonal solve  ==!
-      DO_2D( 1, 1, 1, 1 )           ! first recurrence
-         zwt(ji,jj,2) = zwd(ji,jj,2)
-      END_2D
-      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
-         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
-      END_3D
-      !
-      DO_2D( 1, 1, 1, 1 )           ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         pt_out(ji,jj,2) = zwrm(ji,jj,2)
-      END_2D
-      DO_3D( 1, 1, 1, 1, 3, jpkm1 )
-         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
-      END_3D
-
-      DO_2D( 1, 1, 1, 1 )           ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
-         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-      END_2D
-      DO_3DS( 1, 1, 1, 1, jpk-2, 2, -1 )
-         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-      END_3D
-      !
-   END SUBROUTINE interp_4th_cpt_org
-
-
-   SUBROUTINE interp_4th_cpt( pt_in, pt_out )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE interp_4th_cpt  ***
-      !!
-      !! **  Purpose :   Compute the interpolation of tracer at w-point
-      !!
-      !! **  Method  :   4th order compact interpolation
-      !!----------------------------------------------------------------------
-      REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pt_in    ! field at t-point
-      REAL(wp),DIMENSION(A2D(nn_hls)    ,jpk), INTENT(  out) ::   pt_out   ! field interpolated at w-point
-      !
-      INTEGER ::   ji, jj, jk   ! dummy loop integers
-      INTEGER ::   ikt, ikb     ! local integers
-      REAL(wp),DIMENSION(A2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt
-      !!----------------------------------------------------------------------
-      !
-      !                      !==  build the three diagonal matrix & the RHS  ==!
-      !
-      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )    ! interior (from jk=3 to jpk-1)
-         zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp                 !       diagonal
-         zwi (ji,jj,jk) =         wmask(ji,jj,jk)                         ! lower diagonal
-         zws (ji,jj,jk) =         wmask(ji,jj,jk)                         ! upper diagonal
-         zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk)                     &   ! RHS
-            &           *       ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) )
-      END_3D
-      !
-!!gm
-!      SELECT CASE( kbc )               !* boundary condition
-!      CASE( np_NH   )   ! Neumann homogeneous at top & bottom
-!      CASE( np_CEN2 )   ! 2nd order centered  at top & bottom
-!      END SELECT
-!!gm
-      !
-      IF ( ln_isfcav ) THEN            ! set level two values which may not be set in ISF case
-         zwd(:,:,2) = 1._wp  ;  zwi(:,:,2) = 0._wp  ;  zws(:,:,2) = 0._wp  ;  zwrm(:,:,2) = 0._wp
-      END IF
-      !
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! 2nd order centered at top & bottom
-         ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point
-         ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point
-         !
-         zwd (ji,jj,ikt) = 1._wp          ! top
-         zwi (ji,jj,ikt) = 0._wp
-         zws (ji,jj,ikt) = 0._wp
-         zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,ikt-1) + pt_in(ji,jj,ikt) )
-         !
-         zwd (ji,jj,ikb) = 1._wp          ! bottom
-         zwi (ji,jj,ikb) = 0._wp
-         zws (ji,jj,ikb) = 0._wp
-         zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,ikb-1) + pt_in(ji,jj,ikb) )
-      END_2D
-      !
-      !                       !==  tridiagonal solver  ==!
-      !
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
-         zwt(ji,jj,2) = zwd(ji,jj,2)
-      END_2D
-      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
-         zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1)
-      END_3D
-      !
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         pt_out(ji,jj,2) = zwrm(ji,jj,2)
-      END_2D
-      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 )
-         pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
-      END_3D
-
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
-         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-      END_2D
-      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 )
-         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-      END_3D
-      !
-   END SUBROUTINE interp_4th_cpt
-
-
-   SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tridia_solver  ***
-      !!
-      !! **  Purpose :   solve a symmetric 3diagonal system
-      !!
-      !! **  Method  :   solve M.t_out = RHS(t)  where M is a tri diagonal matrix ( jpk*jpk )
-      !!
-      !!             ( D_1 U_1  0   0   0  )( t_1 )   ( RHS_1 )
-      !!             ( L_2 D_2 U_2  0   0  )( t_2 )   ( RHS_2 )
-      !!             (  0  L_3 D_3 U_3  0  )( t_3 ) = ( RHS_3 )
-      !!             (        ...          )( ... )   ( ...  )
-      !!             (  0   0   0  L_k D_k )( t_k )   ( RHS_k )
-      !!
-      !!        M is decomposed in the product of an upper and lower triangular matrix.
-      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL
-      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal).
-      !!        The solution is pta.
-      !!        The 3d array zwt is used as a work space array.
-      !!----------------------------------------------------------------------
-      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pD, pU, pL    ! 3-diagonal matrix
-      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pRHS          ! Right-Hand-Side
-      REAL(wp),DIMENSION(A2D(nn_hls),jpk), INTENT(  out) ::   pt_out        !!gm field at level=F(klev)
-      INTEGER                    , INTENT(in   ) ::   klev          ! =1 pt_out at w-level
-      !                                                             ! =0 pt at t-level
-      INTEGER ::   ji, jj, jk   ! dummy loop integers
-      INTEGER ::   kstart       ! local indices
-      REAL(wp),DIMENSION(A2D(nn_hls),jpk) ::   zwt   ! 3D work array
-      !!----------------------------------------------------------------------
-      !
-      kstart =  1  + klev
-      !
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                         !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1
-         zwt(ji,jj,kstart) = pD(ji,jj,kstart)
-      END_2D
-      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
-         zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1)
-      END_3D
-      !
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                        !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
-         pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart)
-      END_2D
-      DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 )
-         pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1)
-      END_3D
-
-      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )                       !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk
-         pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
-      END_2D
-      DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 )
-         pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk)
-      END_3D
-      !
-   END SUBROUTINE tridia_solver
-
+   END SUBROUTINE tra_adv_fct_lf
+#endif
    !!======================================================================
 END MODULE traadv_fct
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_fct_lf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_fct_lf.F90	(revision 14930)
+++ 	(revision )
@@ -1,553 +1,0 @@
-MODULE traadv_fct_lf
-   !!==============================================================================
-   !!                       ***  MODULE  traadv_fct  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend (2nd/4th order Flux Corrected Transport method)
-   !!==============================================================================
-   !! History :  3.7  !  2015-09  (L. Debreu, G. Madec)  original code (inspired from traadv_tvd.F90)
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!  tra_adv_fct-lf : update the tracer trend with a 3D advective trends using a 2nd or 4th order FCT scheme
-   !!                   with sub-time-stepping in the vertical direction - loop fusion version
-   !!  nonosc_lf      : compute monotonic tracer fluxes by a non-oscillatory algorithm - loop fusion version 
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE dom_oce        ! ocean space and time domain
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends
-   USE diaptr         ! poleward transport diagnostics
-   USE diaar5         ! AR5 diagnostics
-   USE phycst  , ONLY : rho0_rcp
-   USE zdf_oce , ONLY : ln_zad_Aimp
-   !
-   USE in_out_manager ! I/O manager
-   USE iom            ! 
-   USE lib_mpp        ! MPP library
-   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-   USE traadv_fct
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_fct_lf     ! called by traadv.F90
-
-   LOGICAL  ::   l_trd   ! flag to compute trends
-   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
-   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport
-   REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
-
-   !                                        ! tridiag solver associated indices:
-   INTEGER, PARAMETER ::   np_NH   = 0   ! Neumann homogeneous boundary condition
-   INTEGER, PARAMETER ::   np_CEN2 = 1   ! 2nd order centered  boundary condition
-
-   !! * Substitutions
-#  include "do_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
-
-#define tracer_flux_i(out,zfp,zfm,ji,jj,jk) \
-        zfp = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ; \
-        zfm = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) ; \
-        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji+1,jj,jk,jn,Kbb) )
-
-#define tracer_flux_j(out,zfp,zfm,ji,jj,jk) \
-        zfp = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) ; \
-        zfm = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) ; \
-        out = 0.5 * ( zfp * pt(ji,jj,jk,jn,Kbb) + zfm * pt(ji,jj+1,jk,jn,Kbb) )
-
-#define search_in_neighbour(out,OP,vec,ji,jj,jk) \
-        out = OP(vec(ji,jj,jk),vec(ji-1,jj,jk),vec(ji+1,jj,jk), \
-        vec(ji,jj-1,jk),vec(ji,jj+1,jk),vec(ji,jj,MAX(jk-1,1)),vec(ji,jj,jk+1))
-
-#define pos_part_of_flux(ji,jj,jk,out) \
-        out = MAX(0.,paa_in(ji-1,jj,jk)) - MIN(0.,paa_in(ji,jj,jk)) \
-        + MAX(0.,pbb_in(ji,jj-1,jk)) - MIN(0.,pbb_in(ji,jj,jk)) \
-        + MAX(0.,pcc_in(ji,jj,jk+1)) - MIN(0.,pcc_in(ji,jj,jk)) 
-
-#define neg_part_of_flux(ji,jj,jk,out) \
-        out = MAX( 0.,paa_in(ji,jj,jk) ) - MIN( 0., paa_in(ji-1,jj,jk)) \
-        + MAX( 0.,pbb_in(ji,jj,jk) ) - MIN( 0., pbb_in(ji,jj-1,jk)) \
-        + MAX( 0.,pcc_in(ji,jj,jk) ) - MIN( 0., pcc_in(ji,jj,jk+1))
-
-#define beta_terms(bt,betup,betdo,up,pos,do,neg,ji,jj,jk) \
-        bt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt ; \
-        betup = ( up            - paft(ji,jj,jk) ) / ( pos + zrtrn ) * bt ; \
-        betdo = ( paft(ji,jj,jk) - do            ) / ( neg + zrtrn ) * bt
-
-#define monotonic_flux(a,b,c,betup_p1,betdo_p1,vec,vec_in,jk) \
-        a = MIN( 1._wp, zbetdo(ji,jj), betup_p1 ) ; \
-        b = MIN( 1._wp, zbetup(ji,jj), betdo_p1 ) ; \
-        c = ( 0.5_wp  + SIGN( 0.5_wp , vec_in(ji,jj,jk) ) ) ; \
-        vec(ji,jj,jk) = vec_in(ji,jj,jk) * ( c * a + ( 1._wp - c) * b )
-
-#define monotonic_flux_k(a,b,c,betup,betdo,vec,vec_in,jk) \
-        a = MIN( 1._wp, betdo, zbetup_ptr(ji,jj) ) ; \
-        b = MIN( 1._wp, betup, zbetdo_ptr(ji,jj) ) ; \
-        c = ( 0.5 + SIGN( 0.5_wp , vec_in(ji,jj,jk) ) ) ; \
-        vec(ji,jj,jk) = vec_in(ji,jj,jk) * ( c * a + ( 1._wp - c) * b )
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: traadv_fct.F90 13660 2020-10-22 10:47:32Z francesca $
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_fct_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,       &
-      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v )
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE tra_adv_fct  ***
-      !! 
-      !! **  Purpose :   Compute the now trend due to total advection of tracers
-      !!               and add it to the general trend of tracer equations
-      !!
-      !! **  Method  : - 2nd or 4th FCT scheme on the horizontal direction
-      !!               (choice through the value of kn_fct)
-      !!               - on the vertical the 4th order is a compact scheme 
-      !!               - corrected flux (monotonic correction) 
-      !!
-      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
-      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T)
-      !!             - poleward advective heat and salt transport (ln_diaptr=T)
-      !!----------------------------------------------------------------------
-      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
-      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
-      INTEGER                                  , INTENT(in   ) ::   kn_fct_h        ! order of the FCT scheme (=2 or 4)
-      INTEGER                                  , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4)
-      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(inout) ::   pU, pV, pW      ! 3 ocean volume flux components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
-      !
-      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices  
-      REAL(wp) ::   ztra                                     ! local scalar
-      REAL(wp) ::   zwx_im1, zfp_ui, zfp_ui_m1, zfp_vj, zfp_vj_m1, zfp_wk, zC2t_u, zC4t_u   !   -      -
-      REAL(wp) ::   zwy_jm1, zfm_ui, zfm_ui_m1, zfm_vj, zfm_vj_m1, zfm_wk, zC2t_v, zC4t_v   !   -      -
-      REAL(wp) ::   ztu_im1, ztu_ip1, ztv_jm1, ztv_jp1  
-      REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zwi, zwx_3d, zwy_3d, zwz, ztw, zltu_3d, zltv_3d, ztu, ztv
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz, zptry
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zwinf, zwdia, zwsup
-      LOGICAL  ::   ll_zAimp                                 ! flag to apply adaptive implicit vertical advection
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv_fct_lf : FCT advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-      ENDIF
-      !! -- init to 0
-      zwx_3d(:,:,:) = 0._wp
-      zwy_3d(:,:,:) = 0._wp
-      zwz(:,:,:) = 0._wp
-      zwi(:,:,:) = 0._wp
-      !
-      l_trd = .FALSE.            ! set local switches
-      l_hst = .FALSE.
-      l_ptr = .FALSE.
-      ll_zAimp = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra  ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
-      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) )    l_ptr = .TRUE. 
-      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR.  &
-         &                         iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
-      !
-      IF( l_trd .OR. l_hst )  THEN
-         ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) )
-         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
-      ENDIF
-      !
-      IF( l_ptr ) THEN  
-         ALLOCATE( zptry(jpi,jpj,jpk) )
-         zptry(:,:,:) = 0._wp
-      ENDIF
-      !
-      ! If adaptive vertical advection, check if it is needed on this PE at this time
-      IF( ln_zad_Aimp ) THEN
-         IF( MAXVAL( ABS( wi(:,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE.
-      END IF
-      ! If active adaptive vertical advection, build tridiagonal matrix
-      IF( ll_zAimp ) THEN
-         ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk))
-         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
-            zwdia(ji,jj,jk) =  1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) )   &
-            &                               / e3t(ji,jj,jk,Krhs)
-            zwinf(ji,jj,jk) =  p2dt * MIN( wi(ji,jj,jk  ) , 0._wp ) / e3t(ji,jj,jk,Krhs)
-            zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs)
-         END_3D
-      END IF
-      !
-      DO jn = 1, kjpt            !==  loop over the tracers  ==!
-         !
-         !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
-         !                               !* upstream tracer flux in the k direction *!
-         DO_3D( 1, 1, 1, 1, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
-            zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
-            zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
-            zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk)
-         END_3D
-         IF( ln_linssh ) THEN               ! top ocean value (only in linear free surface as zwz has been w-masked)
-            IF( ln_isfcav ) THEN                        ! top of the ice-shelf cavities and at the ocean surface
-               DO_2D( 1, 1, 1, 1 )
-                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface 
-               END_2D
-            ELSE                                        ! no cavities: only at the ocean surface
-               DO_2D( 1, 1, 1, 1 )
-                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
-               END_2D
-            ENDIF
-         ENDIF
-         !               
-         !                    !* upstream tracer flux in the i and j direction 
-         DO jk = 1, jpkm1
-            DO jj = 1, jpj-1
-               tracer_flux_i(zwx_3d(1,jj,jk),zfp_ui,zfm_ui,1,jj,jk)
-               tracer_flux_j(zwy_3d(1,jj,jk),zfp_vj,zfm_vj,1,jj,jk)
-            END DO
-            DO ji = 1, jpi-1
-               tracer_flux_i(zwx_3d(ji,1,jk),zfp_ui,zfm_ui,ji,1,jk)
-               tracer_flux_j(zwy_3d(ji,1,jk),zfp_vj,zfm_vj,ji,1,jk)
-            END DO
-            DO_2D( 1, 1, 1, 1 )
-               tracer_flux_i(zwx_3d(ji,jj,jk),zfp_ui,zfm_ui,ji,jj,jk)
-               tracer_flux_i(zwx_im1,zfp_ui_m1,zfm_ui_m1,ji-1,jj,jk)
-               tracer_flux_j(zwy_3d(ji,jj,jk),zfp_vj,zfm_vj,ji,jj,jk)
-               tracer_flux_j(zwy_jm1,zfp_vj_m1,zfm_vj_m1,ji,jj-1,jk)
-               ztra = - ( zwx_3d(ji,jj,jk) - zwx_im1 + zwy_3d(ji,jj,jk) - zwy_jm1 + zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) * r1_e1e2t(ji,jj)
-               !                               ! update and guess with monotonic sheme
-               pt(ji,jj,jk,jn,Krhs) =                   pt(ji,jj,jk,jn,Krhs) +       ztra   &
-                  &                                  / e3t(ji,jj,jk,Kmm ) * tmask(ji,jj,jk)
-               zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) &
-                  &                                  / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
-            END_2D
-         END DO
-         
-         IF ( ll_zAimp ) THEN
-            CALL tridia_solver( zwdia, zwsup, zwinf, zwi, zwi , 0 )
-            !
-            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ;
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
-               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
-               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
-               ztw(ji,jj,jk) =  0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
-               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! update vertical fluxes
-            END_3D
-            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
-                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
-            END_3D
-            !
-         END IF
-         !                
-         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes)
-            ztrdx(:,:,:) = zwx_3d(:,:,:)   ;   ztrdy(:,:,:) = zwy_3d(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:)
-         END IF
-         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
-         IF( l_ptr )   zptry(:,:,:) = zwy_3d(:,:,:) 
-         !
-         !        !==  anti-diffusive flux : high order minus low order  ==!
-         !
-         SELECT CASE( kn_fct_h )    !* horizontal anti-diffusive fluxes
-         !
-         CASE(  2  )                   !- 2nd order centered
-            DO_3D( 2, 1, 2, 1, 1, jpkm1 )
-               zwx_3d(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx_3d(ji,jj,jk)
-               zwy_3d(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy_3d(ji,jj,jk)
-            END_3D
-            !
-         CASE(  4  )                   !- 4th order centered
-            zltu_3d(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
-            zltv_3d(:,:,jpk) = 0._wp
-            DO jk = 1, jpkm1                 ! Laplacian
-               DO_2D( 1, 0, 1, 0 )                 ! 1st derivative (gradient)
-                  ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk)
-                  ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk)
-               END_2D
-               DO_2D( 0, 0, 0, 0 )                 ! 2nd derivative * 1/ 6
-                  zltu_3d(ji,jj,jk) = (  ztu(ji,jj,jk) + ztu(ji-1,jj,jk)  ) * r1_6
-                  zltv_3d(ji,jj,jk) = (  ztv(ji,jj,jk) + ztv(ji,jj-1,jk)  ) * r1_6
-               END_2D
-            END DO
-            CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
-!            !
-            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )
-               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points
-               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
-               !                                                        ! C4 minus upstream advective fluxes 
-               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu_3d(ji,jj,jk) - zltu_3d(ji+1,jj,jk) ) - zwx_3d(ji,jj,jk)
-               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv_3d(ji,jj,jk) - zltv_3d(ji,jj+1,jk) ) - zwy_3d(ji,jj,jk)
-            END_3D
-            !
-            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
-         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
-            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes
-               ztu_im1 = ( pt(ji  ,jj  ,jk,jn,Kmm) - pt(ji-1,jj,jk,jn,Kmm) ) * umask(ji-1,jj,jk)
-               ztu_ip1 = ( pt(ji+2,jj  ,jk,jn,Kmm) - pt(ji+1,jj,jk,jn,Kmm) ) * umask(ji+1,jj,jk)
-
-               ztv_jm1 = ( pt(ji,jj  ,jk,jn,Kmm) - pt(ji,jj-1,jk,jn,Kmm) ) * vmask(ji,jj-1,jk)
-               ztv_jp1 = ( pt(ji,jj+2,jk,jn,Kmm) - pt(ji,jj+1,jk,jn,Kmm) ) * vmask(ji,jj+1,jk)
-
-               zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm)   ! 2 x C2 interpolation of T at u- & v-points (x2)
-               zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm)
-               !                                                  ! C4 interpolation of T at u- & v-points (x2)
-               zC4t_u =  zC2t_u + r1_6 * ( ztu_im1 - ztu_ip1 )
-               zC4t_v =  zC2t_v + r1_6 * ( ztv_jm1 - ztv_jp1 )
-               !                                                  ! C4 minus upstream advective fluxes 
-               zwx_3d(ji,jj,jk) =  0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx_3d(ji,jj,jk)
-               zwy_3d(ji,jj,jk) =  0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy_3d(ji,jj,jk)
-            END_3D
-            CALL lbc_lnk( 'traadv_fct', zwx_3d, 'U', -1.0_wp , zwy_3d, 'V', -1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
-            !
-         END SELECT
-         !                      
-         SELECT CASE( kn_fct_v )    !* vertical anti-diffusive fluxes (w-masked interior values)
-         !
-         CASE(  2  )                   !- 2nd order centered
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
-               zwz(ji,jj,jk) =  (  pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
-                  &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk)
-            END_3D
-            !
-         CASE(  4  )                   !- 4th order COMPACT
-            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )   ! zwt = COMPACT interpolation of T at w-point
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
-               zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)
-            END_3D
-            !
-         END SELECT
-         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0
-            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked
-         ENDIF
-         !         
-         CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp)
-         !
-         IF ( ll_zAimp ) THEN
-            DO_3D( 1, 1, 1, 1, 1, jpkm1 )    !* trend and after field with monotonic scheme
-               !                                                ! total intermediate advective trends
-               ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   &
-                  &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   &
-                  &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
-               ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
-            END_3D
-            !
-            CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 )
-            !
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )       ! Interior value ( multiplied by wmask)
-               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
-               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
-               zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk)
-            END_3D
-         END IF
-         !
-         !        !==  monotonicity algorithm  ==!
-         !
-#if defined key_agrif
-         CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt )
-#else
-         CALL nonosc_lf( Kmm, pt(:,:,:,jn,Kbb), zwx_3d, zwy_3d, zwz, zwi, p2dt )
-#endif
-         !
-         !        !==  final trend with corrected fluxes  ==!
-         !
-         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-            ztra = - (  zwx_3d(ji,jj,jk) - zwx_3d(ji-1,jj  ,jk  )   &
-               &      + zwy_3d(ji,jj,jk) - zwy_3d(ji  ,jj-1,jk  )   &
-               &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj)
-            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm)
-            zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk)
-         END_3D
-         !
-         IF ( ll_zAimp ) THEN
-            !
-            ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp
-            DO_3D( 0, 0, 0, 0, 2, jpkm1 )      ! Interior value ( multiplied by wmask)
-               zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) )
-               zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) )
-               ztw(ji,jj,jk) = - 0.5 * e1e2t(ji,jj) * ( zfp_wk * zwi(ji,jj,jk) + zfm_wk * zwi(ji,jj,jk-1) ) * wmask(ji,jj,jk)
-               zwz(ji,jj,jk) = zwz(ji,jj,jk) + ztw(ji,jj,jk) ! Update vertical fluxes for trend diagnostic
-            END_3D
-            DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-               pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) &
-                  &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
-            END_3D
-         END IF         
-         ! NOT TESTED - NEED l_trd OR l_hst TRUE 
-         IF( l_trd .OR. l_hst ) THEN   ! trend diagnostics // heat/salt transport
-            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx_3d(:,:,:)  ! <<< add anti-diffusive fluxes 
-            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy_3d(:,:,:)  !     to upstream fluxes
-            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  !
-            !
-            IF( l_trd ) THEN              ! trend diagnostics
-               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) )
-               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) )
-               CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) )
-            ENDIF
-            !                             ! heat/salt transport
-            IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) )
-            !
-         ENDIF
-         ! NOT TESTED - NEED l_ptr TRUE 
-         IF( l_ptr ) THEN              ! "Poleward" transports
-            zptry(:,:,:) = zptry(:,:,:) + zwy_3d(:,:,:)  ! <<< add anti-diffusive fluxes
-            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) )
-         ENDIF
-         !
-      END DO                     ! end of tracer loop
-      !
-      IF ( ll_zAimp ) THEN
-         DEALLOCATE( zwdia, zwinf, zwsup )
-      ENDIF
-      IF( l_trd .OR. l_hst ) THEN 
-         DEALLOCATE( ztrdx, ztrdy, ztrdz )
-      ENDIF
-      IF( l_ptr ) THEN 
-         DEALLOCATE( zptry )
-      ENDIF
-      !
-   END SUBROUTINE tra_adv_fct_lf
-
-   SUBROUTINE nonosc_lf( Kmm, pbef, paa, pbb, pcc, paft, p2dt )
-      !!---------------------------------------------------------------------
-      !!                    ***  ROUTINE nonosc  ***
-      !!     
-      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
-      !!       scheme and the before field by a nonoscillatory algorithm 
-      !!
-      !! **  Method  :   ... ???
-      !!       warning : pbef and paft must be masked, but the boundaries
-      !!       conditions on the fluxes are not necessary zalezak (1979)
-      !!       drange (1995) multi-dimensional forward-in-time and upstream-
-      !!       in-space based differencing for fluid
-      !!----------------------------------------------------------------------
-      INTEGER                          , INTENT(in   ) ::   Kmm             ! time level index 
-      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   paa_in, pbb_in, pcc_in   ! monotonic fluxes in the 3 directions
-      !
-      REAL(dp), DIMENSION (jpi,jpj,jpk) :: zbup, zbdo
-      !
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(dp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn    ! local scalars
-      REAL(dp) ::   zau, zbu, zcu, zav, zbv, zcv, zup, zdo            !   -      -
-      REAL(dp) ::   zbt_ip1, zpos_ip1, zneg_ip1, zup_ip1, zdo_ip1, zbetup_ip1, zbetdo_ip1 
-      REAL(dp) ::   zbt_jp1, zpos_jp1, zneg_jp1, zup_jp1, zdo_jp1, zbetup_jp1, zbetdo_jp1
-      REAL(dp), TARGET, DIMENSION(jpi,jpj) :: zbetup_buf, zbetdo_buf, zbetup_ptr_buf, zbetdo_ptr_buf
-      REAL(dp), POINTER, DIMENSION(:,:) :: tmp, zbetup, zbetdo, zbetup_ptr, zbetdo_ptr
-      !!----------------------------------------------------------------------
-      !
-      zbig  = 1.e+40_dp
-      zrtrn = 1.e-15_dp
-
-      paa_in(:,:,:) = paa(:,:,:)
-      pbb_in(:,:,:) = pbb(:,:,:)
-      pcc_in(:,:,:) = pcc(:,:,:)
-      ! Search local extrema
-      ! --------------------
-      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
-      zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask - zbig * ( 1._wp - tmask )  )
-      zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   &
-         &        paft * tmask + zbig * ( 1._wp - tmask )  )
-
-      zbetup => zbetup_buf
-      zbetdo => zbetdo_buf
-      zbetup_ptr => zbetup_ptr_buf
-      zbetdo_ptr => zbetdo_ptr_buf
-
-      DO_2D( 1, 0, 1, 0 )
-
-        ! search maximum in neighbourhood
-        search_in_neighbour(zup,MAX,zbup,ji,jj,1)
-        search_in_neighbour(zup_ip1,MAX,zbup,ji+1,jj,1)
-        search_in_neighbour(zup_jp1,MAX,zbup,ji,jj+1,1)
-
-        ! search minimum in neighbourhood
-        search_in_neighbour(zdo,MIN,zbdo,ji,jj,1)
-        search_in_neighbour(zdo_ip1,MIN,zbdo,ji+1,jj,1)
-        search_in_neighbour(zdo_jp1,MIN,zbdo,ji,jj+1,1)
-
-        ! positive part of the flux
-        pos_part_of_flux(ji,jj,1,zpos)
-        pos_part_of_flux(ji+1,jj,1,zpos_ip1)
-        pos_part_of_flux(ji,jj+1,1,zpos_jp1)
-
-        ! negative part of the flux
-        neg_part_of_flux(ji,jj,1,zneg)
-        neg_part_of_flux(ji+1,jj,1,zneg_ip1)
-        neg_part_of_flux(ji,jj+1,1,zneg_jp1)
-
-        ! up & down beta terms
-        beta_terms(zbt,zbetup(ji,jj),zbetdo(ji,jj),zup,zpos,zdo,zneg,ji,jj,1)
-        beta_terms(zbt_ip1,zbetup_ip1,zbetdo_ip1,zup_ip1,zpos_ip1,zdo_ip1,zneg_ip1,ji+1,jj,1)
-        beta_terms(zbt_jp1,zbetup_jp1,zbetdo_jp1,zup_jp1,zpos_jp1,zdo_jp1,zneg_jp1,ji,jj+1,1)
-
-        ! 3. monotonic flux in the i & j (paa & pbb)
-        ! ----------------------------------------
-        monotonic_flux(zau,zbu,zcu,zbetup_ip1,zbetdo_ip1,paa,paa_in,1)
-        monotonic_flux(zav,zbv,zcv,zbetup_jp1,zbetdo_jp1,pbb,pbb_in,1)
-
-      END_2D
-      tmp => zbetup_ptr
-      zbetup_ptr => zbetup
-      zbetup => tmp
-
-      tmp => zbetdo_ptr
-      zbetdo_ptr => zbetdo
-      zbetdo => tmp
-
-      DO jk = 2, jpk-1
-         DO_2D( 1, 0, 1, 0 )
-
-            ! search maximum in neighbourhood
-            search_in_neighbour(zup,MAX,zbup,ji,jj,jk)
-            search_in_neighbour(zup_ip1,MAX,zbup,ji+1,jj,jk)
-            search_in_neighbour(zup_jp1,MAX,zbup,ji,jj+1,jk)
-
-            ! search minimum in neighbourhood
-            search_in_neighbour(zdo,MIN,zbdo,ji,jj,jk)
-            search_in_neighbour(zdo_ip1,MIN,zbdo,ji+1,jj,jk)
-            search_in_neighbour(zdo_jp1,MIN,zbdo,ji,jj+1,jk)
-
-            ! positive part of the flux
-            pos_part_of_flux(ji,jj,jk,zpos)
-            pos_part_of_flux(ji+1,jj,jk,zpos_ip1)
-            pos_part_of_flux(ji,jj+1,jk,zpos_jp1)
-
-            ! negative part of the flux
-            neg_part_of_flux(ji,jj,jk,zneg)
-            neg_part_of_flux(ji+1,jj,jk,zneg_ip1)
-            neg_part_of_flux(ji,jj+1,jk,zneg_jp1)
-
-            ! up & down beta terms
-            beta_terms(zbt,zbetup(ji,jj),zbetdo(ji,jj),zup,zpos,zdo,zneg,ji,jj,jk)
-            beta_terms(zbt_ip1,zbetup_ip1,zbetdo_ip1,zup_ip1,zpos_ip1,zdo_ip1,zneg_ip1,ji+1,jj,jk)
-            beta_terms(zbt_jp1,zbetup_jp1,zbetdo_jp1,zup_jp1,zpos_jp1,zdo_jp1,zneg_jp1,ji,jj+1,jk)
-
-            ! 3. monotonic flux in the i & j (paa & pbb)
-            ! ----------------------------------------
-            monotonic_flux(zau,zbu,zcu,zbetup_ip1,zbetdo_ip1,paa,paa_in,jk)
-            monotonic_flux(zav,zbv,zcv,zbetup_jp1,zbetdo_jp1,pbb,pbb_in,jk)
-
-            ! monotonic flux in the k direction, i.e. pcc
-            ! -------------------------------------------
-            monotonic_flux_k(za,zb,zc,zbetup(ji,jj),zbetdo(ji,jj),pcc,pcc_in,jk)
-         END_2D
-         tmp => zbetup_ptr
-         zbetup_ptr => zbetup
-         zbetup => tmp
-
-         tmp => zbetdo_ptr
-         zbetdo_ptr => zbetdo
-         zbetdo => tmp
-      END DO
-      !
-      DO_2D( 1, 0, 1, 0 )
-        ! monotonic flux in the k direction, i.e. pcc
-        ! -------------------------------------------
-        monotonic_flux_k(za,zb,zc,0._dp,0._dp,pcc,pcc_in,jpk)
-      END_2D
-   END SUBROUTINE nonosc_lf
-
-END MODULE traadv_fct_lf
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_mus.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_mus.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_mus.F90	(revision 14986)
@@ -82,5 +82,5 @@
       LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
@@ -94,5 +94,5 @@
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
@@ -140,10 +140,8 @@
             zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
          END_3D
-         ! lateral boundary conditions   (changed sign)
-         IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )
          !                                !-- Slopes of tracer
          zslpx(:,:,jpk) = 0._wp                 ! bottom values
          zslpy(:,:,jpk) = 0._wp
-         DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
             zslpx(ji,jj,jk) =                       ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
                &            * ( 0.25 + SIGN( 0.25_wp, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
@@ -152,5 +150,5 @@
          END_3D
          !
-         DO_3D( nn_hls-1, 1, nn_hls-1, 1, 1, jpkm1 )    !-- Slopes limitation
+         DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )    !-- Slopes limitation
             zslpx(ji,jj,jk) = SIGN( 1.0_wp, zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
                &                                                     2.*ABS( zwx  (ji-1,jj,jk) ),   &
@@ -160,6 +158,8 @@
                &                                                     2.*ABS( zwy  (ji,jj  ,jk) ) )
          END_3D
-         !
-         DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes
+         ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility
+         IF ( nn_hls==1 ) CALL lbc_lnk( 'traadv_mus', zslpx, 'T', -1.0_wp , zslpy, 'T', -1.0_wp )   ! lateral boundary conditions   (changed sign)
+         !
+         DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !-- MUSCL horizontal advective fluxes
             ! MUSCL fluxes
             z0u = SIGN( 0.5_wp, pU(ji,jj,jk) )
@@ -177,5 +177,4 @@
             zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
          END_3D
-         IF ( nn_hls.EQ.1 ) CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp )   ! lateral boundary conditions   (changed sign)
          !
          DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_mus_lf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_mus_lf.F90	(revision 14930)
+++ 	(revision )
@@ -1,289 +1,0 @@
-MODULE traadv_mus_lf
-   !!======================================================================
-   !!                       ***  MODULE  traadv_mus  ***
-   !! Ocean  tracers:  horizontal & vertical advective trend
-   !!======================================================================
-   !! History :       !  2000-06  (A.Estublier)  for passive tracers
-   !!                 !  2001-08  (E.Durand, G.Madec)  adapted for T & S
-   !!   NEMO     1.0  !  2002-06  (G. Madec)  F90: Free form and module
-   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
-   !!            3.4  !  2012-06  (P. Oddo, M. Vichi) include the upstream where needed
-   !!            3.7  !  2015-09  (G. Madec) add the ice-shelf cavities boundary condition
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   tra_adv_mus   : update the tracer trend with the horizontal
-   !!                   and vertical advection trends using MUSCL scheme
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and active tracers
-   USE trc_oce        ! share passive tracers/Ocean variables
-   USE dom_oce        ! ocean space and time domain
-   USE trd_oce        ! trends: ocean variables
-   USE trdtra         ! tracers trends manager
-   USE sbcrnf         ! river runoffs
-   USE diaptr         ! poleward transport diagnostics
-   USE diaar5         ! AR5 diagnostics
-
-   !
-   USE iom            ! XIOS library
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distribued memory computing
-   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
-
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   tra_adv_mus_lf   ! routine called by traadv.F90
-   
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits
-   !                                                           !  and in closed seas (orca 2 and 1 configurations)
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index
-   
-   LOGICAL  ::   l_trd   ! flag to compute trends
-   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
-   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport
-
-   !! * Substitutions
-#  include "do_loop_substitute.h90"
-#  include "domzgr_substitute.h90"
-
-#define initial_slop_i(out, ji) \
-        out = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
-
-#define initial_slop_j(out, jj) \
-        out = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
-
-#define initial_slop_k(out, jk) \
-        out = tmask(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
-
-#define tracer_slop(out, zzw, zzwm1) \
-        out = ( zzw + zzwm1 ) * ( 0.25 + SIGN( 0.25_wp, zzw * zzwm1 ) )
-
-#define limitation_slop(out, zzslp, zzwm1, zzw) \
-        out = SIGN( 1.0_wp, zzslp ) * MIN( ABS( zzslp ), 2.*ABS( zzwm1 ), 2.*ABS( zzw ) )
-
-#define vertical_adv_flux_i(out, jk, slp, slp1) \
-        z0u = SIGN( 0.5_wp, pU(ji,jj,jk) ) ; \
-        zalpha = 0.5 - z0u ; \
-        zu  = z0u - 0.5 * pU(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) ; \
-        zzwx = pt(ji+1,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * slp1 ; \
-        zzwy = pt(ji  ,jj,jk,jn,Kbb) + xind(ji,jj,jk) * zu * slp ; \
-        out = pU(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-
-#define vertical_adv_flux_j(out, jk, slp, slp1) \
-        z0v = SIGN( 0.5_wp, pV(ji,jj,jk) ) ; \
-        zalpha = 0.5 - z0v ; \
-        zv  = z0v - 0.5 * pV(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) ; \
-        zzwx = pt(ji,jj+1,jk,jn,Kbb) + xind(ji,jj,jk) * zv * slp1 ; \
-        zzwy = pt(ji,jj  ,jk,jn,Kbb) + xind(ji,jj,jk) * zv * slp ; \
-        out = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
-
-#define vertical_adv_flux(out, jk, slp, slp1) \
-        z0w = SIGN( 0.5_wp, pW(ji,jj,jk+1) ) ; \
-        zalpha = 0.5 + z0w ; \
-        zw  = z0w - 0.5 * pW(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,Kmm) ; \
-        zzwx = pt(ji,jj,jk+1,jn,Kbb) + xind(ji,jj,jk) * zw * slp1 ; \
-        zzwy = pt(ji,jj,jk  ,jn,Kbb) + xind(ji,jj,jk) * zw * slp ; \
-        out = pW(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk) 
-
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id: traadv_mus.F90 13619 2020-10-16 08:41:21Z francesca $ 
-   !! Software governed by the CeCILL license (see ./LICENSE)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE tra_adv_mus_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,             &
-      &                    Kbb, Kmm, pt, kjpt, Krhs, ld_msc_ups )
-      !!----------------------------------------------------------------------
-      !!                    ***  ROUTINE tra_adv_mus  ***
-      !!
-      !! ** Purpose :   Compute the now trend due to total advection of tracers
-      !!              using a MUSCL scheme (Monotone Upstream-centered Scheme for
-      !!              Conservation Laws) and add it to the general tracer trend.
-      !!
-      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
-      !!              ld_msc_ups=T : 
-      !!
-      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
-      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
-      !!             - poleward advective heat and salt transport (ln_diaptr=T)
-      !!
-      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
-      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
-      !!----------------------------------------------------------------------
-      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
-      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
-      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
-      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
-      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
-      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl
-      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
-      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components
-      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
-      !
-      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::   ierr             ! local integer
-      REAL(wp) ::   zu, z0u, zw , zalpha   ! local scalars
-      REAL(wp) ::   zv, z0v, z0w           !   -      -
-      REAL(wp) ::   zzwx, zzwxm1, zzwxp1, zzwy, zzwym1, zzwyp1
-      REAL(wp) ::   zzslpx, zzslpxp1, zzslpy, zzslpyp1
-      REAL(wp), TARGET, DIMENSION(jpi,jpj) :: zzwz_buf, zzwzp1_buf, zzwzp2_buf
-      REAL(wp), TARGET, DIMENSION(jpi,jpj) :: zzslpz_buf, zzslpzp1_buf
-      REAL(wp), POINTER, DIMENSION(:,:)    :: tmp, zzwz_ptr, zzwzp1_ptr, zzwzp2_ptr
-      REAL(wp), POINTER, DIMENSION(:,:)    :: zzslpz_ptr, zzslpzp1_ptr 
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwz, zwx, zwy   ! 3D workspace
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == kit000 )  THEN
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
-         IF(lwp) WRITE(numout,*) '        : mixed up-stream           ', ld_msc_ups
-         IF(lwp) WRITE(numout,*) '~~~~~~~'
-         IF(lwp) WRITE(numout,*)
-         !
-         ! Upstream / MUSCL scheme indicator
-         !
-         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr )
-         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed
-         !
-         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked)
-            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
-            upsmsk(:,:) = 0._wp                             ! not upstream by default
-            !
-            DO jk = 1, jpkm1
-               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed
-                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows)
-                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area
-            END DO
-         ENDIF 
-         !
-      ENDIF 
-      !      
-      l_trd = .FALSE.
-      l_hst = .FALSE.
-      l_ptr = .FALSE.
-      IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
-      IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE. 
-      IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
-         &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
-      !
-         zzwz_ptr => zzwz_buf
-         zzwzp1_ptr => zzwzp1_buf
-         zzwzp2_ptr => zzwzp2_buf
-         zzslpz_ptr => zzslpz_buf
-         zzslpzp1_ptr => zzslpzp1_buf
-         !
-      DO jn = 1, kjpt            !==  loop over the tracers  ==!
-         !
-         zwx(:,:,jpk) = 0._wp                   ! bottom values
-         zwy(:,:,jpk) = 0._wp
-         zwz(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions
-         zwz(:,:,jpk) = 0._wp
-         !                          !* Horizontal advective fluxes
-         !
-         !!----------------------------------------------------------------------
-         DO_3D( 1, 0, 1, 0, 1, jpkm1 )
-            !-- first guess of the slopes
-            initial_slop_i(zzwxm1, ji-1)
-            initial_slop_i(zzwx, ji)
-            initial_slop_i(zzwxp1, ji+1)
-
-            initial_slop_j(zzwym1, jj-1)
-            initial_slop_j(zzwy, jj)
-            initial_slop_j(zzwyp1, jj+1)
-            !-- Slopes of tracer
-            tracer_slop(zzslpx, zzwx, zzwxm1) 
-            tracer_slop(zzslpxp1, zzwxp1, zzwx) 
-            tracer_slop(zzslpy, zzwy, zzwym1) 
-            tracer_slop(zzslpyp1, zzwyp1, zzwy) 
-            !-- Slopes limitation
-            limitation_slop(zzslpx, zzslpx, zzwxm1, zzwx)
-            limitation_slop(zzslpxp1, zzslpxp1, zzwx, zzwxp1)
-            limitation_slop(zzslpy, zzslpy, zzwym1, zzwy)
-            limitation_slop(zzslpyp1, zzslpyp1, zzwy, zzwyp1)
-            !-- MUSCL horizontal advective fluxes
-            vertical_adv_flux_i(zwx(ji,jj,jk), jk, zzslpx, zzslpxp1) 
-            vertical_adv_flux_j(zwy(ji,jj,jk), jk, zzslpy, zzslpyp1) 
-         END_3D
-         !
-         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !-- Tracer advective trend
-            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk)       &
-            &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     &
-            &                                     * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
-         END_3D
-         !                          !* Vertical advective fluxes
-         DO_2D( 0, 0, 0, 0 ) 
-            !-- first guess of the slopes
-            initial_slop_k(zzwz_ptr(ji,jj), 2)
-            initial_slop_k(zzwzp1_ptr(ji,jj), 3)
-            !-- Slopes of tracer
-            tracer_slop(zzslpz_ptr(ji,jj), zzwz_ptr(ji,jj), zzwzp1_ptr(ji,jj))
-            !-- Slopes limitation
-            limitation_slop(zzslpz_ptr(ji,jj), zzslpz_ptr(ji,jj), zzwzp1_ptr(ji,jj), zzwz_ptr(ji,jj))
-            !-- vertical advective flux
-            vertical_adv_flux(zwz(ji,jj,2), 1, 0, zzslpz_ptr(ji,jj))
-         END_2D
-         
-         DO jk = 2, jpk-3    
-            DO_2D( 0, 0, 0, 0 )
-               !-- first guess of the slopes
-               initial_slop_k(zzwzp2_ptr(ji,jj), jk+2)
-               !-- Slopes of tracer
-               tracer_slop(zzslpzp1_ptr(ji,jj), zzwzp1_ptr(ji,jj), zzwzp2_ptr(ji,jj))
-               !-- Slopes limitation
-               limitation_slop(zzslpzp1_ptr(ji,jj), zzslpzp1_ptr(ji,jj), zzwzp2_ptr(ji,jj), zzwzp1_ptr(ji,jj))
-               !-- vertical advective flux
-               vertical_adv_flux(zwz(ji,jj,jk+1), jk, zzslpz_ptr(ji,jj), zzslpzp1_ptr(ji,jj))
-            END_2D
-            tmp => zzwzp1_ptr
-            zzwzp1_ptr => zzwzp2_ptr
-            zzwzp2_ptr => tmp
-
-            tmp => zzslpz_ptr
-            zzslpz_ptr => zzslpzp1_ptr
-            zzslpzp1_ptr => tmp 
-         END DO
-         DO_2D( 0, 0, 0, 0 ) 
-            !-- Slopes of tracer
-            tracer_slop(zzslpzp1_ptr(ji,jj), zzwzp1_ptr(ji,jj), 0)
-            !-- Slopes limitation
-            limitation_slop(zzslpzp1_ptr(ji,jj), zzslpzp1_ptr(ji,jj), 0, zzwzp1_ptr(ji,jj))
-            !-- vertical advective flux
-            vertical_adv_flux(zwz(ji,jj,jpk-1), jpk-2, zzslpz_ptr(ji,jj), zzslpzp1_ptr(ji,jj))
-         END_2D
-
-         IF( ln_linssh ) THEN                   ! top values, linear free surface only
-            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean)
-               DO_2D( 1, 1, 1, 1 )
-                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)
-               END_2D
-            ELSE                                      ! no cavities: only at the ocean surface
-               zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb)
-            ENDIF
-         ENDIF
-         !
-         DO_3D( 0, 0, 0, 0, 1, jpkm1 )     !-- vertical advective trend
-            pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
-               &                                      * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
-         END_3D
-         !                                ! trend horizontal diagnostics
-         IF( l_trd )  THEN
-            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kbb) )
-            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kbb) )
-         END IF
-         !                                 ! "Poleward" heat and salt transports 
-         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
-         !                                 !  heat transport
-         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
-         !
-         !                                ! send vertical trends for diagnostic
-         IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kbb) )
-         !
-      END DO                     ! end of tracer loop
-      !
-   END SUBROUTINE tra_adv_mus_lf
-
-   !!======================================================================
-END MODULE traadv_mus_lf
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck.F90	(revision 14986)
@@ -27,4 +27,7 @@
    USE lbclnk          ! ocean lateral boundary condition (or mpp link)
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_loop_fusion
+   USE traadv_qck_lf   ! QCK    scheme            (tra_adv_qck  routine - loop fusion version)
+#endif
 
    IMPLICIT NONE
@@ -92,10 +95,13 @@
       INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_qck_lf ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
@@ -118,4 +124,5 @@
       CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
       !
+#endif
    END SUBROUTINE tra_adv_qck
 
@@ -130,5 +137,5 @@
       INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
@@ -150,5 +157,5 @@
             zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer
          END_3D
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions
 
          !
@@ -168,5 +175,5 @@
          END_3D
          !--- Lateral boundary conditions
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp,  zwx(:,:,:), 'T', 1.0_wp )
 
          !--- QUICKEST scheme
@@ -177,5 +184,5 @@
             zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
          END_3D
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )      ! Lateral boundary conditions
 
          !
@@ -215,5 +222,5 @@
       INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
@@ -230,16 +237,20 @@
          zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0
          !
-         DO jk = 1, jpkm1
-            !
-            !--- Computation of the ustream and downstream value of the tracer and the mask
-            DO_2D( 0, 0, nn_hls-1, nn_hls-1 )
-               ! Upstream in the x-direction for the tracer
-               zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb)
-               ! Downstream in the x-direction for the tracer
-               zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb)
-            END_2D
-         END DO
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions
-
+         !--- Computation of the ustream and downstream value of the tracer and the mask
+         DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 )
+            ! Upstream in the x-direction for the tracer
+            zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb)
+            ! Downstream in the x-direction for the tracer
+            zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb)
+         END_3D
+
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions
+
+         ! Correct zfd on northfold after lbc_lnk; see #2640
+         IF( nn_hls == 1 .AND. l_IdoNFold .AND. ntej == Nje0 ) THEN
+            DO jk = 1, jpkm1
+               WHERE( tmask_i(ntsi:ntei,ntej:jpj) == 0._wp ) zfd(ntsi:ntei,ntej:jpj,jk) = zfc(ntsi:ntei,ntej:jpj,jk)
+            END DO
+         ENDIF
          !
          ! Horizontal advective fluxes
@@ -260,5 +271,5 @@
 
          !--- Lateral boundary conditions
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )
 
          !--- QUICKEST scheme
@@ -269,5 +280,5 @@
             zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
          END_3D
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )    !--- Lateral boundary conditions
          !
          ! Tracer flux on the x-direction
@@ -307,5 +318,5 @@
       CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
       INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
@@ -366,5 +377,5 @@
       !----------------------------------------------------------------------
       !
-      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
+      DO_3D( 1, 0, 1, 0, 1, jpkm1 )
          zc     = puc(ji,jj,jk)                         ! Courant number
          zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck_lf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck_lf.F90	(revision 14986)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_qck_lf.F90	(revision 14986)
@@ -0,0 +1,374 @@
+MODULE traadv_qck_lf
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_qck  ***
+   !! Ocean tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! History :  3.0  !  2008-07  (G. Reffray)  Original code
+   !!            3.3  !  2010-05  (C.Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_qck    : update the tracer trend with the horizontal advection
+   !!                    trends using a 3rd order finite difference scheme
+   !!   tra_adv_qck_i  : apply QUICK scheme in i-direction
+   !!   tra_adv_qck_j  : apply QUICK scheme in j-direction
+   !!   tra_adv_cen2_k : 2nd centered scheme for the vertical advection
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers
+   USE diaptr          ! poleward transport diagnostics
+   USE iom
+   !
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_qck_lf   ! routine called by step.F90
+
+   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio
+
+   LOGICAL  ::   l_trd   ! flag to compute trends
+   LOGICAL  ::   l_ptr   ! flag to compute poleward transport
+
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: traadv_qck.F90 14776 2021-04-30 12:33:41Z mocavero $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_qck_lf ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_qck  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method :   The advection is evaluated by a third order scheme
+      !!             For a positive velocity u :              u(i)>0
+      !!                                          |--FU--|--FC--|--FD--|------|
+      !!                                             i-1    i      i+1   i+2
+      !!
+      !!             For a negative velocity u :              u(i)<0
+      !!                                          |------|--FD--|--FC--|--FU--|
+      !!                                             i-1    i      i+1   i+2
+      !!             where  FU is the second upwind point
+      !!                    FD is the first douwning point
+      !!                    FC is the central point (or the first upwind point)
+      !!
+      !!      Flux(i) = u(i) * { 0.5(FC+FD)  -0.5C(i)(FD-FC)  -((1-C(i))/6)(FU+FD-2FC) }
+      !!                with C(i)=|u(i)|dx(i)/dt (=Courant number)
+      !!
+      !!         dt = 2*rdtra and the scalar values are tb and sb
+      !!
+      !!       On the vertical, the simple centered scheme used pt(:,:,:,:,Kmm)
+      !!
+      !!               The fluxes are bounded by the ULTIMATE limiter to
+      !!             guarantee the monotonicity of the solution and to
+      !!            prevent the appearance of spurious numerical oscillations
+      !!
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
+      !!
+      !! ** Reference : Leonard (1979, 1991)
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
+      !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == kit000 )  THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+         !
+         l_trd = .FALSE.
+         l_ptr = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE.
+      ENDIF
+      !
+      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme
+      CALL tra_adv_qck_i_lf( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
+      CALL tra_adv_qck_j_lf( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
+
+      !        ! vertical fluxes are computed with the 2nd order centered scheme
+      CALL tra_adv_cen2_k_lf( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
+      !
+   END SUBROUTINE tra_adv_qck_lf
+
+
+   SUBROUTINE tra_adv_qck_i_lf( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
+      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU        ! i-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zdir, zdx, zmsk  ! local scalars
+      REAL(wp) ::   zzfc, zzfd, zzfu, zzfu_ip1   !   -     -
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwx, zfu, zfc, zfd
+      !----------------------------------------------------------------------
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0._wp     ;   zfc(:,:,:) = 0._wp
+         zfd(:,:,:) = 0._wp     ;   zwx(:,:,:) = 0._wp
+         !
+!!gm why not using a SHIFT instruction...
+         DO_3D( 1, 0, 0, 0, 1, jpkm1 )     !--- Computation of the ustream and downstream value of the tracer and the mask
+            zzfc = pt(ji-1,jj,jk,jn,Kbb)        ! Upstream   in the x-direction for the tracer
+            zzfd = pt(ji+2,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer
+            !
+            ! Horizontal advective fluxes
+            ! ---------------------------
+            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0
+            zfu(ji,jj,jk) = zdir * zzfc + ( 1. - zdir ) * zzfd  ! FU in the x-direction for T
+            !
+            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0
+            zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+            zwx(ji,jj,jk)  = ABS( pU(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+            zfc(ji,jj,jk)  = zdir * pt(ji  ,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji+1,jj,jk,jn,Kbb)  ! FC in the x-direction for T
+            zfd(ji,jj,jk)  = zdir * pt(ji+1,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji  ,jj,jk,jn,Kbb)  ! FD in the x-direction for T
+         END_3D
+         !--- Lateral boundary conditions
+
+         !--- QUICKEST scheme
+         CALL quickest( zfu, zfd, zfc, zwx )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO_3D( 1, 0, 0, 0, 1, jpkm1 )
+            zzfu = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
+            zzfu_ip1 = tmask(ji,jj,jk) + tmask(ji+1,jj,jk) + tmask(ji+2,jj,jk) - 2.
+            !
+            ! Tracer flux on the x-direction
+            zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0
+            !--- If the second ustream point is a land point
+            !--- the flux is computed by the 1st order UPWIND scheme
+            zmsk = zdir * zzfu + ( 1. - zdir ) * zzfu_ip1
+            zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+            zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk)
+         END_3D
+         !
+         ! Computation of the trend
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            ! horizontal advective trends
+            ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
+            !--- add it to the general tracer trends
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra
+         END_3D
+         !                                 ! trend diagnostics
+         IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) )
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_qck_i_lf
+
+
+   SUBROUTINE tra_adv_qck_j_lf( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt         ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt       ! tracer time-step
+      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pV        ! j-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
+      !!
+      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices
+      REAL(wp) :: ztra, zbtr, zdir, zdx, zmsk   ! local scalars
+      REAL(wp) :: zzfc, zzfd, zzfu, zzfu_jp1    !   -     -
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwy, zfu, zfc, zfd   ! 3D workspace
+      !----------------------------------------------------------------------
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0
+         zfd(:,:,:) = 0.0     ;   zwy(:,:,:) = 0.0
+         !
+         !--- Computation of the ustream and downstream value of the tracer and the mask
+         DO_3D( 0, 0, 1, 0, 1, jpkm1 )
+            ! Upstream in the x-direction for the tracer
+            zzfc = pt(ji,jj-1,jk,jn,Kbb)
+            ! Downstream in the x-direction for the tracer
+            zzfd = pt(ji,jj+2,jk,jn,Kbb)
+            !
+            ! Horizontal advective fluxes
+            ! ---------------------------
+            !
+            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0
+            zfu(ji,jj,jk) = zdir * zzfc + ( 1. - zdir ) * zzfd  ! FU in the x-direction for T
+            !
+            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0
+            zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm)
+            zwy(ji,jj,jk)  = ABS( pV(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+            zfc(ji,jj,jk)  = zdir * pt(ji,jj  ,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj+1,jk,jn,Kbb)  ! FC in the x-direction for T
+            zfd(ji,jj,jk)  = zdir * pt(ji,jj+1,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj  ,jk,jn,Kbb)  ! FD in the x-direction for T
+         END_3D
+
+         !--- QUICKEST scheme
+         CALL quickest( zfu, zfd, zfc, zwy )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO_3D( 0, 0, 1, 0, 1, jpkm1 )
+            zzfu = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2.
+            zzfu_jp1 = tmask(ji,jj,jk) + tmask(ji,jj+1,jk) + tmask(ji,jj+2,jk) - 2.
+            !
+            ! Tracer flux on the x-direction
+            zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) )   ! if pU > 0 : zdir = 1 otherwise zdir = 0
+            !--- If the second ustream point is a land point
+            !--- the flux is computed by the 1st order UPWIND scheme
+            zmsk = zdir * zzfu + ( 1. - zdir ) * zzfu_jp1
+            zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk)
+            zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk)
+         END_3D
+         !
+         ! Computation of the trend
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            ! horizontal advective trends
+            ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
+            !--- add it to the general tracer trends
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra
+         END_3D
+         !                                 ! trend diagnostics
+         IF( l_trd )   CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) )
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_qck_j_lf
+
+
+   SUBROUTINE tra_adv_cen2_k_lf( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kmm, Krhs  ! ocean time level indices
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt     ! number of tracers
+      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pW      ! vertical velocity
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zwz   ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      zwz(:,:, 1 ) = 0._wp       ! surface & bottom values set to zero for all tracers
+      zwz(:,:,jpk) = 0._wp
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !
+         DO_3D( 0, 0, 0, 0, 2, jpkm1 )       !* Interior point   (w-masked 2nd order centered flux)
+            zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk)
+         END_3D
+         IF( ln_linssh ) THEN                !* top value   (only in linear free surf. as zwz is multiplied by wmask)
+            IF( ln_isfcav ) THEN                  ! ice-shelf cavities (top of the ocean)
+               DO_2D( 0, 0, 0, 0 )
+                  zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm)   ! linear free surface
+               END_2D
+            ELSE                                   ! no ocean cavities (only ocean surface)
+               DO_2D( 0, 0, 0, 0 )
+                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)
+               END_2D
+            ENDIF
+         ENDIF
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !==  Tracer flux divergence added to the general trend  ==!
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   &
+               &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
+         !                                 ! Send trends for diagnostic
+         IF( l_trd )  CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) )
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_cen2_k_lf
+
+
+   SUBROUTINE quickest( pfu, pfd, pfc, puc )
+      !!----------------------------------------------------------------------
+      !!
+      !! ** Purpose :  Computation of advective flux with Quickest scheme
+      !!
+      !! ** Method :
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pfu   ! second upwind point
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pfd   ! first douwning point
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(in   ) ::   pfc   ! the central point (or the first upwind point)
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   puc   ! input as Courant number ; output as flux
+      !!
+      INTEGER  ::  ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! local scalars
+      REAL(wp) ::  zc, zcurv, zfho          !   -      -
+      !----------------------------------------------------------------------
+      !
+      DO_3D( 2, 2, 2, 2, 1, jpkm1 )
+         zc     = puc(ji,jj,jk)                         ! Courant number
+         zcurv  = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk)
+         zcoef1 = 0.5 *      ( pfc(ji,jj,jk) + pfd(ji,jj,jk) )
+         zcoef2 = 0.5 * zc * ( pfd(ji,jj,jk) - pfc(ji,jj,jk) )
+         zcoef3 = ( 1. - ( zc * zc ) ) * r1_6 * zcurv
+         zfho   = zcoef1 - zcoef2 - zcoef3              !  phi_f QUICKEST
+         !
+         zcoef1 = pfd(ji,jj,jk) - pfu(ji,jj,jk)
+         zcoef2 = ABS( zcoef1 )
+         zcoef3 = ABS( zcurv )
+         IF( zcoef3 >= zcoef2 ) THEN
+            zfho = pfc(ji,jj,jk)
+         ELSE
+            zcoef3 = pfu(ji,jj,jk) + ( ( pfc(ji,jj,jk) - pfu(ji,jj,jk) ) / MAX( zc, 1.e-9 ) )    ! phi_REF
+            IF( zcoef1 >= 0. ) THEN
+               zfho = MAX( pfc(ji,jj,jk), zfho )
+               zfho = MIN( zfho, MIN( zcoef3, pfd(ji,jj,jk) ) )
+            ELSE
+               zfho = MIN( pfc(ji,jj,jk), zfho )
+               zfho = MAX( zfho, MAX( zcoef3, pfd(ji,jj,jk) ) )
+            ENDIF
+         ENDIF
+         puc(ji,jj,jk) = zfho
+      END_3D
+      !
+   END SUBROUTINE quickest
+
+   !!======================================================================
+END MODULE traadv_qck_lf
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs.F90	(revision 14986)
@@ -26,4 +26,7 @@
    USE lbclnk         ! ocean lateral boundary condition (or mpp link)
    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+#if defined key_loop_fusion
+   USE traadv_ubs_lf  ! UBS      scheme            (tra_adv_ubs  routine - loop fusion version)
+#endif
 
    IMPLICIT NONE
@@ -93,5 +96,5 @@
       INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
       REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
-      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      ! TEMP: [tiling] This can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
       REAL(dp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
@@ -104,5 +107,8 @@
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+#if defined key_loop_fusion
+      CALL tra_adv_ubs_lf    ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v )
+#else
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
@@ -141,5 +147,5 @@
             !
          END DO
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp )   ! Lateral boundary cond. (unchanged sgn)
+         IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary cond. (unchanged sgn)
          !
          DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS)
@@ -156,5 +162,5 @@
          END_3D
          !
-         DO_3D( 1, 1, 1, 1, 1, jpk )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
             zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)      ! store the initial trends before its update
          END_3D
@@ -170,5 +176,5 @@
          END DO
          !
-         DO_3D( 1, 1, 1, 1, 1, jpk )
+         DO_3D( 0, 0, 0, 0, 1, jpk )
             zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk)  ! Horizontal advective trend used in vertical 2nd order FCT case
          END_3D                                                     ! and/or in trend diagnostic (l_trd=T)
@@ -198,5 +204,5 @@
             !
             !                               !*  upstream advection with initial mass fluxes & intermediate update  ==!
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
                zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
@@ -205,9 +211,9 @@
             IF( ln_linssh ) THEN                ! top ocean value (only in linear free surface as ztw has been w-masked)
                IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface
-                  DO_2D( 1, 1, 1, 1 )
+                  DO_2D( 0, 0, 0, 0 )
                      ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface
                   END_2D
                ELSE                                   ! no cavities: only at the ocean surface
-                  DO_2D( 1, 1, 1, 1 )
+                  DO_2D( 0, 0, 0, 0 )
                      ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
                   END_2D
@@ -223,5 +229,5 @@
             !
             !                          !*  anti-diffusive flux : high order minus low order
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
                   &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
@@ -238,5 +244,5 @@
             END_3D
             IF( ln_linssh ) THEN
-               DO_2D( 1, 1, 1, 1 )
+               DO_2D( 0, 0, 0, 0 )
                   ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work
                END_2D
@@ -261,4 +267,5 @@
       END DO
       !
+#endif
    END SUBROUTINE tra_adv_ubs
 
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs_lf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs_lf.F90	(revision 14986)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traadv_ubs_lf.F90	(revision 14986)
@@ -0,0 +1,366 @@
+MODULE traadv_ubs_lf
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_ubs  ***
+   !! Ocean active tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! History :  1.0  !  2006-08  (L. Debreu, R. Benshila)  Original code
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_ubs : update the tracer trend with the horizontal
+   !!                 advection trends using a third order biaised scheme
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trc_oce        ! share passive tracers/Ocean variables
+   USE trd_oce        ! trends: ocean variables
+   USE traadv_fct      ! acces to routine interp_4th_cpt
+   USE trdtra         ! trends manager: tracers
+   USE diaptr         ! poleward transport diagnostics
+   USE diaar5         ! AR5 diagnostics
+   !
+   USE iom            ! I/O library
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! massively parallel library
+   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
+   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_ubs_lf   ! routine called by traadv module
+
+   LOGICAL :: l_trd   ! flag to compute trends
+   LOGICAL :: l_ptr   ! flag to compute poleward transport
+   LOGICAL :: l_hst   ! flag to compute heat transport
+
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
+   !! $Id: traadv_ubs.F90 14776 2021-04-30 12:33:41Z mocavero $
+   !! Software governed by the CeCILL license (see ./LICENSE)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_ubs_lf( kt, kit000, cdtype, p2dt, pU, pV, pW,          &
+      &                    Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_ubs  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The 3rd order Upstream Biased Scheme (UBS) is based on an
+      !!      upstream-biased parabolic interpolation (Shchepetkin and McWilliams 2005)
+      !!      It is only used in the horizontal direction.
+      !!      For example the i-component of the advective fluxes are given by :
+      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0
+      !!          ztu = !  or
+      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0
+      !!      where zltu is the second derivative of the before temperature field:
+      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ]
+      !!        This results in a dissipatively dominant (i.e. hyper-diffusive)
+      !!      truncation error. The overall performance of the advection scheme
+      !!      is similar to that reported in (Farrow and Stevens, 1995).
+      !!        For stability reasons, the first term of the fluxes which corresponds
+      !!      to a second order centered scheme is evaluated using the now velocity
+      !!      (centered in time) while the second term which is the diffusive part
+      !!      of the scheme, is evaluated using the before velocity (forward in time).
+      !!      Note that UBS is not positive. Do not use it on passive tracers.
+      !!                On the vertical, the advection is evaluated using a FCT scheme,
+      !!      as the UBS have been found to be too diffusive.
+      !!                kn_ubs_v argument controles whether the FCT is based on
+      !!      a 2nd order centrered scheme (kn_ubs_v=2) or on a 4th order compact
+      !!      scheme (kn_ubs_v=4).
+      !!
+      !! ** Action : - update pt(:,:,:,:,Krhs)  with the now advective tracer trends
+      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T)
+      !!             - poleward advective heat and salt transport (ln_diaptr=T)
+      !!
+      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404.
+      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731�1741.
+      !!----------------------------------------------------------------------
+      INTEGER                                  , INTENT(in   ) ::   kt              ! ocean time-step index
+      INTEGER                                  , INTENT(in   ) ::   Kbb, Kmm, Krhs  ! ocean time level indices
+      INTEGER                                  , INTENT(in   ) ::   kit000          ! first time step index
+      CHARACTER(len=3)                         , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator)
+      INTEGER                                  , INTENT(in   ) ::   kjpt            ! number of tracers
+      INTEGER                                  , INTENT(in   ) ::   kn_ubs_v        ! number of tracers
+      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step
+      ! TEMP: [tiling] This can be A2D(nn_hls) if using XIOS (subdomain support)
+      REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zcoef, zcoef_ip1, zcoef_jp1        ! local scalars
+      REAL(wp) ::   zfp_ui, zfm_ui, zcenut, ztak, zfp_wk, zfm_wk   !   -      -
+      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt, zeeu, zeev, z_hdivn    !   -      -
+      REAL(wp) ::   zeeu_im1, zeeu_ip1, zeev_jm1, zeev_jp1
+      REAL(wp) ::   zztu, zztu_im1, zztu_ip1
+      REAL(wp) ::   zztv, zztv_jm1, zztv_jp1
+      REAL(wp) ::   zzltu, zzltu_ip1, zzltv, zzltv_jp1
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   ztu, ztv, zltu, zltv, zti, ztw     ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( kt == kit000 )  THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+         !
+         l_trd = .FALSE.
+         l_hst = .FALSE.
+         l_ptr = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )      l_trd = .TRUE.
+         IF(   cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) )  )   l_ptr = .TRUE.
+         IF(   cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
+            &                          iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) ) l_hst = .TRUE.
+      ENDIF
+      !
+      ztw (:,:, 1 ) = 0._wp      ! surface & bottom value : set to zero for all tracers
+      zltu(:,:,jpk) = 0._wp   ;   zltv(:,:,jpk) = 0._wp
+      ztw (:,:,jpk) = 0._wp   ;   zti (:,:,jpk) = 0._wp
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                        !==  horizontal laplacian of before tracer ==!
+         DO_3D( 1, 1, 1, 1, 1, jpkm1 )                   ! Second derivative (divergence)
+            ! First derivative (masked gradient)
+            zeeu_im1 = e2_e1u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * umask(ji-1,jj,jk)
+            zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk)
+            zeeu_ip1 = e2_e1u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm) * umask(ji+1,jj,jk)
+            zeev_jm1 = e1_e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vmask(ji,jj-1,jk)
+            zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk)
+            zeev_jp1 = e1_e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm) * vmask(ji,jj+1,jk)
+            !
+            zztu_im1 = zeeu_im1 * ( pt(ji,jj,jk,jn,Kbb) - pt(ji-1,jj,jk,jn,Kbb) )
+            zztu = zeeu * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
+            zztu_ip1 = zeeu_ip1 * ( pt(ji+2,jj,jk,jn,Kbb) - pt(ji+1,jj,jk,jn,Kbb) )
+            !
+            zztv_jm1 = zeev_jm1 * ( pt(ji,jj,jk,jn,Kbb) - pt(ji,jj-1,jk,jn,Kbb) )
+            zztv = zeev * ( pt(ji  ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) )
+            zztv_jp1 = zeev_jp1 * ( pt(ji,jj+2,jk,jn,Kbb) - pt(ji,jj+1,jk,jn,Kbb) )
+            ! Second derivative (divergence)
+            zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) )
+            zcoef_ip1 = 1._wp / ( 6._wp * e3t(ji+1,jj,jk,Kmm) )
+            zcoef_jp1 = 1._wp / ( 6._wp * e3t(ji,jj+1,jk,Kmm) )
+            !
+            zzltu = (  zztu - zztu_im1  ) * zcoef
+            zzltu_ip1 = (  zztu_ip1 - zztu  ) * zcoef_ip1
+            zzltv = (  zztv - zztv_jm1  ) * zcoef
+            zzltv_jp1 = (  zztv_jp1 - zztv  ) * zcoef_jp1
+            !
+            !                     !==  Horizontal advective fluxes  ==!     (UBS)
+            zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) )        ! upstream transport (x2)
+            zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) )
+            zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) )
+            zfm_vj = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) )
+            !                                                  ! 2nd order centered advective fluxes (x2)
+            zcenut = pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj  ,jk,jn,Kmm) )
+            zcenvt = pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji  ,jj+1,jk,jn,Kmm) )
+            !                                                  ! UBS advective fluxes
+            ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zzltu - zfm_ui * zzltu_ip1 )
+            ztv(ji,jj,jk) = 0.5 * ( zcenvt - zfp_vj * zzltv - zfm_vj * zzltv_jp1 )
+         END_3D
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpk )
+            zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)      ! store the initial trends before its update
+         END_3D
+         !
+         !                           !==  add the horizontal advective trend  ==!
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs)                &
+               &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    &
+               &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) &
+               &                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpk )
+            zltu(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltu(ji,jj,jk)  ! Horizontal advective trend used in vertical 2nd order FCT case
+         END_3D                                                     ! and/or in trend diagnostic (l_trd=T)
+         !
+         IF( l_trd ) THEN                  ! trend diagnostics
+             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) )
+             CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) )
+         END IF
+         !
+         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) )
+         !                                !  heati/salt transport
+         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) )
+         !
+         !
+         !                       !== vertical advective trend  ==!
+         !
+         SELECT CASE( kn_ubs_v )       ! select the vertical advection scheme
+         !
+         CASE(  2  )                   ! 2nd order FCT
+            !
+            IF( l_trd ) THEN
+               DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+                  zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs)          ! store pt(:,:,:,:,Krhs) if trend diag.
+               END_3D
+            ENDIF
+            !
+            !                               !*  upstream advection with initial mass fluxes & intermediate update  ==!
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+               zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) )
+               zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) )
+               ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb)  ) * wmask(ji,jj,jk)
+            END_3D
+            IF( ln_linssh ) THEN                ! top ocean value (only in linear free surface as ztw has been w-masked)
+               IF( ln_isfcav ) THEN                   ! top of the ice-shelf cavities and at the ocean surface
+                  DO_2D( 1, 1, 1, 1 )
+                     ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb)   ! linear free surface
+                  END_2D
+               ELSE                                   ! no cavities: only at the ocean surface
+                  DO_2D( 1, 1, 1, 1 )
+                     ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb)
+                  END_2D
+               ENDIF
+            ENDIF
+            !
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !* trend and after field with monotonic scheme
+               ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    &
+                  &     * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+               pt(ji,jj,jk,jn,Krhs) =   pt(ji,jj,jk,jn,Krhs) +  ztak
+               zti(ji,jj,jk)    = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+            END_3D
+            !
+            !                          !*  anti-diffusive flux : high order minus low order
+            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+               ztw(ji,jj,jk) = (   0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) )   &
+                  &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk)
+            END_3D
+            !                                            ! top ocean value: high order == upstream  ==>>  zwz=0
+            IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked
+            !
+            CALL nonosc_z( Kmm, pt(:,:,:,jn,Kbb), ztw, zti, p2dt )      !  monotonicity algorithm
+            !
+         CASE(  4  )                               ! 4th order COMPACT
+            CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw )         ! 4th order compact interpolation of T at w-point
+            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)
+            END_3D
+            IF( ln_linssh ) THEN
+               DO_2D( 1, 1, 1, 1 )
+                  ztw(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm)     !!gm ISF & 4th COMPACT doesn't work
+               END_2D
+            ENDIF
+            !
+         END SELECT
+         !
+         DO_3D( 0, 0, 0, 0, 1, jpkm1 )   !  final trend with corrected fluxes
+            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )    &
+               &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+         END_3D
+         !
+         IF( l_trd )  THEN               ! vertical advective trend diagnostics
+            DO_3D( 0, 0, 0, 0, 1, jpkm1 )                 ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
+               zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk)                          &
+                  &           + pt(ji,jj,jk,jn,Kmm) * (  pW(ji,jj,jk) - pW(ji,jj,jk+1)  )   &
+                  &                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            END_3D
+            CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zltv )
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE tra_adv_ubs_lf
+
+
+   SUBROUTINE nonosc_z( Kmm, pbef, pcc, paft, p2dt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc_z  ***
+      !!
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream
+      !!       scheme and the before field by a nonoscillatory algorithm
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                         ::   Kmm    ! time level index
+      REAL(wp), INTENT(in   )                         ::   p2dt   ! tracer time-step
+      REAL(wp),                DIMENSION(jpi,jpj,jpk) ::   pbef   ! before field
+      REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls)    ,jpk) ::   paft   ! after field
+      REAL(wp), INTENT(inout), DIMENSION(A2D(nn_hls)    ,jpk) ::   pcc    ! monotonic flux in the k direction
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn   ! local scalars
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zbetup, zbetdo         ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      zbig  = 1.e+38_wp
+      zrtrn = 1.e-15_wp
+      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
+      !
+      ! Search local extrema
+      ! --------------------
+      !                    ! large negative value (-zbig) inside land
+      DO_3D( 0, 0, 0, 0, 1, jpk )
+         pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) )
+         paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1.e0 - tmask(ji,jj,jk) )
+      END_3D
+      !
+      DO jk = 1, jpkm1     ! search maximum in neighbourhood
+         ikm1 = MAX(jk-1,1)
+         DO_2D( 0, 0, 0, 0 )
+            zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+               &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+         END_2D
+      END DO
+      !                    ! large positive value (+zbig) inside land
+      DO_3D( 0, 0, 0, 0, 1, jpk )
+         pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) )
+         paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1.e0 - tmask(ji,jj,jk) )
+      END_3D
+      !
+      DO jk = 1, jpkm1     ! search minimum in neighbourhood
+         ikm1 = MAX(jk-1,1)
+         DO_2D( 0, 0, 0, 0 )
+            zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+               &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+               &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+         END_2D
+      END DO
+      !                    ! restore masked values to zero
+      DO_3D( 0, 0, 0, 0, 1, jpk )
+         pbef(ji,jj,jk) = pbef(ji,jj,jk) * tmask(ji,jj,jk)
+         paft(ji,jj,jk) = paft(ji,jj,jk) * tmask(ji,jj,jk)
+      END_3D
+      !
+      ! Positive and negative part of fluxes and beta terms
+      ! ---------------------------------------------------
+      DO_3D( 0, 0, 0, 0, 1, jpkm1 )
+         ! positive & negative part of the flux
+         zpos = MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+         zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+         ! up & down beta terms
+         zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt
+         zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
+         zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
+      END_3D
+      !
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+      DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
+         zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
+         zc = 0.5 * ( 1.e0 + SIGN( 1.0_wp, pcc(ji,jj,jk) ) )
+         pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb )
+      END_3D
+      !
+   END SUBROUTINE nonosc_z
+
+   !!======================================================================
+END MODULE traadv_ubs_lf
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbc.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbc.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbc.F90	(revision 14986)
@@ -103,7 +103,6 @@
       ENDIF
       !
-      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
-         CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
-      ENDIF
+      CALL iom_put ( "hfgeou" , rho0_rcp * qgh_trd0(:,:) )
+
       IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
       !
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbl.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbl.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trabbl.F90	(revision 14986)
@@ -127,8 +127,6 @@
          CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, &
             &          tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
-            CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
-            CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
-         ENDIF
+         CALL iom_put( "ahu_bbl", ahu_bbl )   ! bbl diffusive flux i-coef
+         CALL iom_put( "ahv_bbl", ahv_bbl )   ! bbl diffusive flux j-coef
          !
       ENDIF
@@ -140,10 +138,6 @@
          CALL prt_ctl( tab3d_1=CASTWP(pts(:,:,:,jp_tem,Krhs)), clinfo1=' bbl_adv  - Ta: ', mask1=tmask, &
             &          tab3d_2=CASTWP(pts(:,:,:,jp_sal,Krhs)), clinfo2=           ' Sa: ', mask2=tmask, clinfo3='tra' )
-         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
-            ! lateral boundary conditions ; just need for outputs
-            CALL lbc_lnk( 'trabbl', utr_bbl, 'U', 1.0_wp , vtr_bbl, 'V', 1.0_wp )
-            CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
-            CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
-         ENDIF
+         CALL iom_put( "uoce_bbl", utr_bbl )  ! bbl i-transport
+         CALL iom_put( "voce_bbl", vtr_bbl )  ! bbl j-transport
          !
       ENDIF
@@ -216,4 +210,5 @@
 
 
+   ! NOTE: [tiling] tiling changes the results, but only the order of floating point operations is different
    SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm )
       !!----------------------------------------------------------------------
@@ -239,15 +234,11 @@
       INTEGER  ::   iis , iid , ijs , ijd    ! local integers
       INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       -
-      INTEGER  ::   isi, isj                 !   -       -
       REAL(wp) ::   zbtr, ztra               ! local scalars
       REAL(wp) ::   zu_bbl, zv_bbl           !   -      -
       !!----------------------------------------------------------------------
-      !
-      IF( ntsi == Nis0 ) THEN ; isi = 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = 1 ; ELSE ; isj = 0 ; ENDIF
       !                                                          ! ===========
       DO jn = 1, kjpt                                            ! tracer loop
          !                                                       ! ===========
-         DO_2D( isi, 0, isj, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+         DO_2D_OVR( 1, 0, 1, 0 )            ! CAUTION start from i=1 to update i=2 when cyclic east-west
             IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
                ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
@@ -341,5 +332,5 @@
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 )  THEN
             IF(lwp)  WRITE(numout,*)
@@ -364,5 +355,5 @@
       IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
          !                                !-------------------!
-         DO_2D( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+         DO_2D_OVR( 1, 0, 1, 0 )                   ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
             !                                                   ! i-direction
             za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)              ! 2*(alpha,beta) at u-point
@@ -394,5 +385,5 @@
          !
          CASE( 1 )                                   != use of upper velocity
-            DO_2D( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
+            DO_2D_OVR( 1, 0, 1, 0 )                              ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0
                !                                                  ! i-direction
                za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem)               ! 2*(alpha,beta) at u-point
@@ -423,5 +414,5 @@
          CASE( 2 )                                 != bbl velocity = F( delta rho )
             zgbbl = grav * rn_gambbl
-            DO_2D( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down
+            DO_2D_OVR( 1, 0, 1, 0 )                         ! criteria: rho_up > rho_down
                !                                                  ! i-direction
                ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tradmp.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tradmp.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tradmp.F90	(revision 14986)
@@ -54,4 +54,5 @@
 #  include "do_loop_substitute.h90"
 #  include "single_precision_substitute.h90"
+#  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
@@ -97,4 +98,5 @@
       INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
       REAL(dp), DIMENSION(A2D(nn_hls),jpk,jpts)     ::  zts_dta
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE ::  zwrk
       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdts
       !!----------------------------------------------------------------------
@@ -102,7 +104,11 @@
       IF( ln_timing )   CALL timing_start('tra_dmp')
       !
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )
-         ztrdts(:,:,:,:) = pts(:,:,:,:,Krhs)
+      IF( l_trdtra .OR. iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN   !* Save ta and sa trends
+         ALLOCATE( ztrdts(A2D(nn_hls),jpk,jpts) )
+         DO jn = 1, jpts
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
+               ztrdts(ji,jj,jk,jn) = pts(ji,jj,jk,jn,Krhs)
+            END_3D
+         END DO
       ENDIF
       !                           !==  input T-S data at kt  ==!
@@ -140,4 +146,25 @@
          !
       END SELECT
+      !
+      ! outputs (clem trunk)
+      IF( iom_use('hflx_dmp_cea') .OR. iom_use('sflx_dmp_cea') ) THEN
+         ALLOCATE( zwrk(A2D(nn_hls),jpk) )          ! Needed to handle expressions containing e3t when using key_qco or key_linssh
+         zwrk(:,:,:) = 0._wp
+
+         IF( iom_use('hflx_dmp_cea') ) THEN
+            DO_3D( 0, 0, 0, 0, 1, jpk )
+               zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_tem,Krhs) - ztrdts(ji,jj,jk,jp_tem) ) * e3t(ji,jj,jk,Kmm)
+            END_3D
+            CALL iom_put('hflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rcp * rho0 ) ! W/m2
+         ENDIF
+         IF( iom_use('sflx_dmp_cea') ) THEN
+            DO_3D( 0, 0, 0, 0, 1, jpk )
+               zwrk(ji,jj,jk) = ( pts(ji,jj,jk,jp_sal,Krhs) - ztrdts(ji,jj,jk,jp_sal) ) * e3t(ji,jj,jk,Kmm)
+            END_3D
+            CALL iom_put('sflx_dmp_cea', SUM( zwrk(:,:,:), dim=3 ) * rho0 )       ! g/m2/s
+         ENDIF
+
+         DEALLOCATE( zwrk )
+      ENDIF
       !
       IF( l_trdtra )   THEN       ! trend diagnostic
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traisf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traisf.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traisf.F90	(revision 14986)
@@ -48,5 +48,5 @@
       IF( ln_timing )   CALL timing_start('tra_isf')
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
@@ -80,5 +80,5 @@
       !
       IF ( ln_isfdebug ) THEN
-         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only for the full domain
+         IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN                       ! Do only for the full domain
             CALL debug('tra_isf: pts(:,:,:,:,Krhs) T', CASTWP(pts(:,:,:,1,Krhs)))
             CALL debug('tra_isf: pts(:,:,:,:,Krhs) S', CASTWP(pts(:,:,:,2,Krhs)))
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf.F90	(revision 14986)
@@ -17,6 +17,4 @@
    USE oce            ! ocean dynamics and tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
-   USE domtile
    USE phycst         ! physical constants
    USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
@@ -59,12 +57,8 @@
       !!
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds
-      ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
-      LOGICAL :: lskip
       !!----------------------------------------------------------------------
       !
       IF( ln_timing )   CALL timing_start('tra_ldf')
       !
-      lskip = .FALSE.
-
       IF( l_trdtra )   THEN                    !* Save ta and sa trends
          ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )
@@ -72,39 +66,22 @@
          ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
       ENDIF
-
-      ! TEMP: [tiling] These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
-      IF( nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it )  THEN
-         IF( ln_tile ) THEN
-            IF( ntile == 1 ) THEN
-               CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
-            ELSE
-               lskip = .TRUE.
-            ENDIF
-         ENDIF
-      ENDIF
-      IF( .NOT. lskip ) THEN
-         !
-         SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend
-         CASE ( np_lap   )                                  ! laplacian: iso-level operator
-            CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs),                   jpts,  1 )
-         CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
-            CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts,  1 )
-         CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
-            CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts,  1 )
-         CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
-            IF(nn_hls.EQ.2) CALL lbc_lnk( 'tra_ldf', pts(:,:,:,:,Kbb), 'T',1._wp)
-            CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs),             jpts, nldf_tra )
-         END SELECT
-         !
-         IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
-            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
-            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
-            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt )
-            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds )
-            DEALLOCATE( ztrdt, ztrds )
-         ENDIF
-
-         ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*)
-         IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )
+      !
+      SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend
+      CASE ( np_lap   )                                  ! laplacian: iso-level operator
+         CALL tra_ldf_lap  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs),                   jpts,  1 )
+      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec)
+         CALL tra_ldf_iso  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts,  1 )
+      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies)
+         CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs), jpts,  1 )
+      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators
+         CALL tra_ldf_blp  ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, CASTWP(pts(:,:,:,:,Kbb)), pts(:,:,:,:,Krhs),             jpts, nldf_tra )
+      END SELECT
+      !
+      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)
+         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt )
+         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds )
+         DEALLOCATE( ztrdt, ztrds )
       ENDIF
       !                                        !* print mean trends (used for debugging)
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_iso.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_iso.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_iso.F90	(revision 14986)
@@ -132,5 +132,5 @@
       INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
       INTEGER  ::  ikt
-      INTEGER  ::  ierr             ! local integer
+      INTEGER  ::  ierr, iij        ! local integer
       REAL(wp) ::  zmsku, zahu_w, zabe1, zcof1, zcoef3   ! local scalars
       REAL(wp) ::  zmskv, zahv_w, zabe2, zcof2, zcoef4   !   -      -
@@ -141,5 +141,5 @@
       !
       IF( kpass == 1 .AND. kt == kit000 )  THEN
-         IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
             IF(lwp) WRITE(numout,*)
             IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype
@@ -147,5 +147,5 @@
          ENDIF
          !
-         DO_3D( 0, 0, 0, 0, 1, jpk )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
             akz     (ji,jj,jk) = 0._wp
             ah_wslp2(ji,jj,jk) = 0._wp
@@ -153,5 +153,5 @@
       ENDIF
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                           ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                           ! Do only on the first tile
          l_hst = .FALSE.
          l_ptr = .FALSE.
@@ -161,4 +161,9 @@
       ENDIF
       !
+      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_tra == np_blp_i .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                             ; iij = 1
+      ENDIF
+
       !
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
@@ -172,5 +177,5 @@
       IF( kpass == 1 ) THEN                  !==  first pass only  ==!
          !
-         DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
             !
             zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
@@ -179,8 +184,16 @@
                &                           + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk) , 1._wp  )
                !
-            zahu_w = (   pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)    &
-               &       + pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)  ) * zmsku
-            zahv_w = (   pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)    &
-               &       + pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)  ) * zmskv
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            zahu_w = ( (  pahu(ji  ,jj,jk-1) + pahu(ji-1,jj,jk)                    &
+               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility
+               &       + ( pahu(ji-1,jj,jk-1) + pahu(ji  ,jj,jk)                   &
+               &         )                                                         & ! bracket for halo 1 - halo 2 compatibility
+               &     ) * zmsku
+            zahv_w = ( (  pahv(ji,jj  ,jk-1) + pahv(ji,jj-1,jk)                    &
+               &       )                                                           & ! bracket for halo 1 - halo 2 compatibility
+               &       + ( pahv(ji,jj-1,jk-1) + pahv(ji,jj  ,jk)                   &
+               &         )                                                         & ! bracket for halo 1 - halo 2 compatibility
+               &     ) * zmskv
                !
             ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
@@ -189,14 +202,19 @@
          !
          IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient
-            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
                akz(ji,jj,jk) = 0.25_wp * (                                                                     &
-                  &              ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
+                  &            ( ( pahu(ji  ,jj,jk) + pahu(ji  ,jj,jk-1) ) / ( e1u(ji  ,jj) * e1u(ji  ,jj) )   &
                   &            + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) )   &
-                  &            + ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) )   &
-                  &            + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) )   )
+                  &            )                                                                               & ! bracket for halo 1 - halo 2 compatibility
+                  &            + ( ( pahv(ji,jj  ,jk) + pahv(ji,jj  ,jk-1) ) / ( e2v(ji,jj  ) * e2v(ji,jj  ) ) &
+                  &              + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) &
+                  &              )                                                                             & ! bracket for halo 1 - halo 2 compatibility
+                  &                      )
             END_3D
             !
             IF( ln_traldf_blp ) THEN                ! bilaplacian operator
-               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   akz(ji,jj,jk) = 16._wp   &
                      &   * ah_wslp2   (ji,jj,jk)   &
@@ -206,5 +224,5 @@
                END_3D
             ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
-               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
                   zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
@@ -214,5 +232,5 @@
            !
          ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
-            DO_3D( 0, 0, 0, 0, 1, jpk )
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
                akz(ji,jj,jk) = ah_wslp2(ji,jj,jk)
             END_3D
@@ -227,21 +245,19 @@
          !!   I - masked horizontal derivative
          !!----------------------------------------------------------------------
-!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient....
-         zdit (ntsi-nn_hls,:,:) = 0._wp     ;     zdit (ntei+nn_hls,:,:) = 0._wp
-         zdjt (ntsi-nn_hls,:,:) = 0._wp     ;     zdjt (ntei+nn_hls,:,:) = 0._wp
-         !!end
+         zdit(:,:,:) = 0._wp
+         zdjt(:,:,:) = 0._wp
 
          ! Horizontal tracer gradient
-         DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )
             zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
             zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
          END_3D
          IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient
-            DO_2D( 1, 0, 1, 0 )           ! bottom correction (partial bottom cell)
+            DO_2D( iij, iij-1, iij, iij-1 )            ! bottom correction (partial bottom cell)
                zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
                zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
             END_2D
             IF( ln_isfcav ) THEN      ! first wet level beneath a cavity
-               DO_2D( 1, 0, 1, 0 )
+               DO_2D( iij, iij-1, iij, iij-1 )
                   IF( miku(ji,jj) > 1 )   zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn)
                   IF( mikv(ji,jj) > 1 )   zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn)
@@ -256,5 +272,5 @@
          DO jk = 1, jpkm1                                 ! Horizontal slab
             !
-            DO_2D( 1, 1, 1, 1 )
+            DO_2D( iij, iij, iij, iij )
                !                             !== Vertical tracer gradient
                zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1
@@ -265,5 +281,5 @@
             END_2D
             !
-            DO_2D( 1, 0, 1, 0 )           !==  Horizontal fluxes
+            DO_2D( iij, iij-1, iij, iij-1 )           !==  Horizontal fluxes
                zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)
                zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
@@ -278,16 +294,29 @@
                zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
                !
-               zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
-                  &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
-                  &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
-               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
-                  &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
-                  &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)                       &
+                  &               + zcof1 * ( ( zdkt (ji+1,jj) + zdk1t(ji,jj)    &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         + ( zdk1t(ji+1,jj) + zdkt (ji,jj)    &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         ) ) * umask(ji,jj,jk)
+               zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)                        &
+                  &              + zcof2 * ( ( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         + ( zdk1t(ji,jj+1) + zdkt (ji,jj)    &
+                  &                           )                                  & ! bracket for halo 1 - halo 2 compatibility
+                  &                         ) ) * vmask(ji,jj,jk)
             END_2D
             !
-            DO_2D( 0, 0, 0, 0 )           !== horizontal divergence and add to pta
-               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    &
-                  &       + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   &
-                  &                                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
+            DO_2D( iij-1, iij-1, iij-1, iij-1 )           !== horizontal divergence and add to pta
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                         &
+                  &       + zsign * ( ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk)        &
+                  &                   )                                          & ! bracket for halo 1 - halo 2 compatibility
+                  &                 + ( zftv(ji,jj,jk) - zftv(ji,jj-1,jk)        &
+                  &                   )                                          & ! bracket for halo 1 - halo 2 compatibility
+                  &                 ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm)
             END_2D
          END DO                                        !   End of slab
@@ -302,5 +331,5 @@
          ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp
 
-         DO_3D( 0, 0, 0, 0, 2, jpkm1 )    ! interior (2=<jk=<jpk-1)
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )    ! interior (2=<jk=<jpk-1)
             !
             zmsku = wmask(ji,jj,jk) / MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)          &
@@ -317,12 +346,20 @@
             zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
             !
-            ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
-               &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
-               &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
-               &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            ztfw(ji,jj,jk) = zcoef3 * ( ( zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   + ( zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   )                                                &
+                  &        + zcoef4 * ( ( zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   + ( zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)    &
+                  &                     )                                              & ! bracket for halo 1 - halo 2 compatibility
+                  &                   )
          END_3D
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
-            DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * wmask(ji,jj,jk)   &
                   &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )               &
@@ -333,5 +370,5 @@
             SELECT CASE( kpass )
             CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
-               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                   ztfw(ji,jj,jk) =   &
                      &  ztfw(ji,jj,jk) + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   &
@@ -347,5 +384,5 @@
          ENDIF
          !
-         DO_3D( 0, 0, 0, 0, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )    !==  Divergence of vertical fluxes added to pta  ==!
             pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * r1_e1e2t(ji,jj)   &
                &                                             / e3t(ji,jj,jk,Kmm)
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_lap_blp.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_lap_blp.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_lap_blp.F90	(revision 14986)
@@ -104,10 +104,10 @@
       !
       INTEGER  ::   ji, jj, jk, jn      ! dummy loop indices
-      INTEGER  ::   isi, iei, isj, iej  ! local integers
+      INTEGER  ::   iij
       REAL(wp) ::   zsign               ! local scalars
       REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   ztu, ztv, zaheeu, zaheev
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 .AND. lwp )  THEN
             WRITE(numout,*)
@@ -123,10 +123,9 @@
       ENDIF
       !
-      l_hst = .FALSE.
-      l_ptr = .FALSE.
-      IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) )     l_ptr = .TRUE.
-      IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &
-         &                        iom_use("uadv_salttr") .OR. iom_use("vadv_salttr")  ) )  l_hst = .TRUE.
-      !
+      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_tra == np_blp .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                           ; iij = 1
+      ENDIF
+
       !                                !==  Initialization of metric arrays used for all tracers  ==!
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
@@ -134,10 +133,5 @@
       ENDIF
 
-      IF( ntsi == Nis0 ) THEN ; isi = nn_hls - 1 ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = nn_hls - 1 ; ELSE ; isj = 0 ; ENDIF
-      IF( ntei == Nie0 ) THEN ; iei = nn_hls - 1 ; ELSE ; iei = 0 ; ENDIF
-      IF( ntej == Nje0 ) THEN ; iej = nn_hls - 1 ; ELSE ; iej = 0 ; ENDIF
-
-      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
+      DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
          zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm)   !!gm   * umask(ji,jj,jk) pah masked!
          zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm)   !!gm   * vmask(ji,jj,jk)
@@ -148,15 +142,15 @@
          !                          ! =========== !
          !
-         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
+         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )            !== First derivative (gradient)  ==!
             ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) )
             ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) )
          END_3D
          IF( ln_zps ) THEN                             ! set gradient at bottom/top ocean level
-            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                              ! bottom
+            DO_2D( iij, iij-1, iij, iij-1 )                              ! bottom
                ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
                ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
             END_2D
             IF( ln_isfcav ) THEN                             ! top in ocean cavities only
-               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
+               DO_2D( iij, iij-1, iij, iij-1 )
                   IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn)
                   IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn)
@@ -165,8 +159,12 @@
          ENDIF
          !
-         DO_3D( isi, iei, isj, iej, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==!
-            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
-               &                                      +    ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
-               &                                      / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )            !== Second derivative (divergence) added to the general tracer trends  ==!
+            ! round brackets added to fix the order of floating point operations
+            ! needed to ensure halo 1 - halo 2 compatibility
+            pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk)    &
+               &                                          )                                    & ! bracket for halo 1 - halo 2 compatibility
+               &                                      +   ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk)    &
+               &                                          )                                    & ! bracket for halo 1 - halo 2 compatibility
+               &                                        ) / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) )
          END_3D
          !
@@ -218,5 +216,5 @@
       !!---------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == kit000 .AND. lwp )  THEN
             WRITE(numout,*)
@@ -242,5 +240,5 @@
       END SELECT
       !
-      CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign)
+      IF (nn_hls==1) CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp )     ! Lateral boundary conditions (unchanged sign)
       !                                               ! Partial top/bottom cell: GRADh( zlap )
       IF( ln_isfcav .AND. ln_zps ) THEN   ;   CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi )  ! both top & bottom
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_triad.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_triad.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traldf_triad.F90	(revision 14986)
@@ -13,6 +13,4 @@
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary if XIOS has subdomain support
-   USE domtile
    USE domutl, ONLY : is_tile
    USE phycst         ! physical constants
@@ -109,22 +107,16 @@
       REAL(dp), DIMENSION(A2D_T(ktt_rhs),JPK,KJPT), INTENT(inout) ::   pt_rhs     ! tracer trend
       !
-      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
-      INTEGER  ::  ip,jp,kp         ! dummy loop indices
-      INTEGER  ::  ierr            ! local integer
-      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3    ! local scalars
-      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4    !   -      -
+      INTEGER  ::  ji, jj, jk, jn, kp, iij   ! dummy loop indices
       REAL(wp) ::  zcoef0, ze3w_2, zsign          !   -      -
       !
-      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
-      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt
-      REAL(wp) ::   zah, zah_slp, zaei_slp
-      REAL(wp), DIMENSION(A2D(nn_hls),0:1)     ::   zdkt3d                         ! vertical tracer gradient at 2 levels
-      REAL(wp), DIMENSION(A2D(nn_hls)        ) ::   z2d                            ! 2D workspace
-      REAL(wp), DIMENSION(A2D(nn_hls)    ,jpk) ::   zdit, zdjt, zftu, zftv, ztfw   ! 3D     -
-      ! TEMP: [tiling] This can be A2D(nn_hls) if XIOS has subdomain support
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpsi_uw, zpsi_vw
+      REAL(wp) ::   zslope2, zbu, zbv, zbu1, zbv1, zslope21, zah, zah1, zah_ip1, zah_jp1, zbu_ip1, zbv_jp1
+      REAL(wp) ::   ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt, zdyt_jp1, ze3wr_jp1, zdzt_jp1, zah_slp1, zah_slp_jp1, zaei_slp_jp1
+      REAL(wp) ::   zah_slp, zaei_slp, zdxt_ip1, ze3wr_ip1, zdzt_ip1, zah_slp_ip1, zaei_slp_ip1, zaei_slp1
+      REAL(wp), DIMENSION(A2D(nn_hls),0:1) ::   zdkt3d                                           ! vertical tracer gradient at 2 levels
+      REAL(wp), DIMENSION(A2D(nn_hls)    ) ::   z2d                                              ! 2D workspace
+      REAL(wp), DIMENSION(A2D(nn_hls),jpk) ::   zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw   ! 3D     -
       !!----------------------------------------------------------------------
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kpass == 1 .AND. kt == kit000 )  THEN
             IF(lwp) WRITE(numout,*)
@@ -142,4 +134,10 @@
       ENDIF
       !
+      ! Define pt_rhs halo points for multi-point haloes in bilaplacian case
+      IF( nldf_tra == np_blp_it .AND. kpass == 1 ) THEN ; iij = nn_hls
+      ELSE                                              ; iij = 1
+      ENDIF
+
+      !
       IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
       ELSE                    ;   zsign = -1._wp
@@ -152,44 +150,54 @@
       IF( kpass == 1 ) THEN         !==  first pass only  and whatever the tracer is  ==!
          !
-         DO_3D( 0, 0, 0, 0, 1, jpk )
+         DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
             akz     (ji,jj,jk) = 0._wp
             ah_wslp2(ji,jj,jk) = 0._wp
          END_3D
          !
-         DO ip = 0, 1                            ! i-k triads
-            DO kp = 0, 1
-               DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-                  ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
-                  zbu   = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm)
-                  zah   = 0.25_wp * pahu(ji-ip,jj,jk)
-                  zslope_skew = triadi_g(ji,jj,jk,1-ip,kp)
-                  ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
-                  zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp)
-                  zslope2 = zslope2 *zslope2
-                  ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2
-                  akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e1u(ji-ip,jj)       &
-                     &                                                      * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp)
-                     !
-               END_3D
-            END DO
+         DO kp = 0, 1                            ! i-k triads
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+               ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+               zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+               zbu1  = e1e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm)
+               zah   = 0.25_wp * pahu(ji,jj,jk)
+               zah1  = 0.25_wp * pahu(ji-1,jj,jk)
+               ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth)
+               zslope2 = triadi_g(ji,jj,jk,1,kp) + ( gdept(ji+1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)
+               zslope2 = zslope2 *zslope2
+               zslope21 = triadi_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji-1,jj,jk,Kmm) ) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp)
+               zslope21 = zslope21 *zslope21
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               ah_wslp2(ji,jj,jk+kp) =  ah_wslp2(ji,jj,jk+kp) + ( zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2                    &
+                        &                                       + zah1 * zbu1 * ze3wr * r1_e1e2t(ji,jj) * zslope21                 &
+                        &                                       )                                                                  ! bracket for halo 1 - halo 2 compatibility
+               akz     (ji,jj,jk+kp) =  akz     (ji,jj,jk+kp) + ( zah * r1_e1u(ji,jj) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)         &
+                                                                + zah1 * r1_e1u(ji-1,jj) * r1_e1u(ji-1,jj) * umask(ji-1,jj,jk+kp)  &
+                        &                                       )                                                                  ! bracket for halo 1 - halo 2 compatibility
+            END_3D
          END DO
          !
-         DO jp = 0, 1                            ! j-k triads
-            DO kp = 0, 1
-               DO_3D( 0, 0, 0, 0, 1, jpkm1 )
-                  ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm)
-                  zbv   = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm)
-                  zah   = 0.25_wp * pahv(ji,jj-jp,jk)
-                  zslope_skew = triadj_g(ji,jj,jk,1-jp,kp)
-                  ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
-                  !    (do this by *adding* gradient of depth)
-                  zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp)
-                  zslope2 = zslope2 * zslope2
-                  ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2
-                  akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + zah * r1_e2v(ji,jj-jp)     &
-                     &                                                      * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp)
-                  !
-               END_3D
-            END DO
+         DO kp = 0, 1                            ! j-k triads
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 )
+               ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm)
+               zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+               zbv1   = e1e2v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm)
+               zah   = 0.25_wp * pahv(ji,jj,jk)
+               zah1   = 0.25_wp * pahv(ji,jj-1,jk)
+               ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+               !    (do this by *adding* gradient of depth)
+               zslope2 = triadj_g(ji,jj,jk,1,kp) + ( gdept(ji,jj+1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)
+               zslope2 = zslope2 * zslope2
+               zslope21 = triadj_g(ji,jj,jk,0,kp) + ( gdept(ji,jj,jk,Kmm) - gdept(ji,jj-1,jk,Kmm) ) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp)
+               zslope21 = zslope21 * zslope21
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + ( zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2                     &
+                        &                                      + zah1 * zbv1 * ze3wr * r1_e1e2t(ji,jj) * zslope21                  &
+                        &                                      )                                                                   ! bracket for halo 1 - halo 2 compatibility
+               akz     (ji,jj,jk+kp) = akz     (ji,jj,jk+kp) + ( zah * r1_e2v(ji,jj) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)          &
+                        &                                      + zah1 * r1_e2v(ji,jj-1) * r1_e2v(ji,jj-1) * vmask(ji,jj-1,jk+kp)   &
+                        &                                      )                                                                   ! bracket for halo 1 - halo 2 compatibility
+            END_3D
          END DO
          !
@@ -197,5 +205,5 @@
             !
             IF( ln_traldf_blp ) THEN                ! bilaplacian operator
-               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   akz(ji,jj,jk) = 16._wp           &
                      &   * ah_wslp2   (ji,jj,jk)   &
@@ -205,5 +213,5 @@
                END_3D
             ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator
-               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
+               DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 )
                   ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm)
                   zcoef0 = rDt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  )
@@ -213,31 +221,28 @@
            !
          ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit
-            DO_3D( 0, 0, 0, 0, 1, jpk )
+            DO_3D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk )
                akz(ji,jj,jk) = ah_wslp2(ji,jj,jk)
             END_3D
          ENDIF
          !
-         ! TEMP: [tiling] These changes not necessary if XIOS has subdomain support
-         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
-            IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN
-               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )
-
-               zpsi_uw(:,:,:) = 0._wp
-               zpsi_vw(:,:,:) = 0._wp
-
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO_3D( 1, 0, 1, 0, 1, jpkm1 )
-                        zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) &
-                           & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp)
-                        zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) &
-                           & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp)
-                     END_3D
-                  END DO
-               END DO
-               CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
-
-               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )
-            ENDIF
+         IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN
+            zpsi_uw(:,:,:) = 0._wp
+            zpsi_vw(:,:,:) = 0._wp
+
+            DO kp = 0, 1
+               DO_3D( 1, 0, 1, 0, 1, jpkm1 )
+                  ! round brackets added to fix the order of floating point operations
+                  ! needed to ensure halo 1 - halo 2 compatibility
+                  zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp)                                     &
+                     & + ( 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji,jj,jk,1,kp)        &
+                     &   + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+1,jj,jk,0,kp)      &
+                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility
+                  zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp)                                     &
+                     & + ( 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj,jk,1,kp)        &
+                     &   + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+1,jk,0,kp)      &
+                     &   )                                                                        ! bracket for halo 1 - halo 2 compatibility
+               END_3D
+            END DO
+            CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm )
          ENDIF
          !
@@ -252,16 +257,18 @@
          zftu(:,:,:) = 0._wp
          zftv(:,:,:) = 0._wp
-         !
-         DO_3D( 1, 0, 1, 0, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==!
+         zdit(:,:,:) = 0._wp
+         zdjt(:,:,:) = 0._wp
+         !
+         DO_3D( iij, iij-1, iij, iij-1, 1, jpkm1 )    !==  before lateral T & S gradients at T-level jk  ==!
             zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk)
             zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
          END_3D
          IF( ln_zps .AND. l_grad_zps ) THEN    ! partial steps: correction at top/bottom ocean level
-            DO_2D( 1, 0, 1, 0 )                    ! bottom level
+            DO_2D( iij, iij-1, iij, iij-1 )                    ! bottom level
                zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
                zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
             END_2D
             IF( ln_isfcav ) THEN                   ! top level (ocean cavities only)
-               DO_2D( 1, 0, 1, 0 )
+               DO_2D( iij, iij-1, iij, iij-1 )
                   IF( miku(ji,jj)  > 1 )   zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn)
                   IF( mikv(ji,jj)  > 1 )   zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn)
@@ -276,5 +283,5 @@
          DO jk = 1, jpkm1
             !                    !==  Vertical tracer gradient at level jk and jk+1
-            DO_2D( 1, 1, 1, 1 )
+            DO_2D( iij, iij, iij, iij )
                zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1)
             END_2D
@@ -283,5 +290,5 @@
             IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1)
             ELSE
-               DO_2D( 1, 1, 1, 1 )
+               DO_2D( iij, iij, iij, iij )
                   zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
                END_2D
@@ -289,96 +296,163 @@
             !
             zaei_slp = 0._wp
+            zaei_slp_ip1 = 0._wp
+            zaei_slp_jp1 = 0._wp
+            zaei_slp1 = 0._wp
             !
             IF( ln_botmix_triad ) THEN
-               DO ip = 0, 1              !==  Horizontal & vertical fluxes
-                  DO kp = 0, 1
-                     DO_2D( 1, 0, 1, 0 )
-                        ze1ur = r1_e1u(ji,jj)
-                        zdxt  = zdit(ji,jj,jk) * ze1ur
-                        ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
-                        zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                        zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp)
-                        !
-                        zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
-                        ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
-                        zah = pahu(ji,jj,jk)
-                        zah_slp  = zah * zslope_iso
-                        IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew
-                        zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt                 * zbu * ze3wr
-                     END_2D
-                  END DO
+               DO kp = 0, 1              !==  Horizontal & vertical fluxes
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze1ur = r1_e1u(ji,jj)
+                     zdxt  = zdit(ji,jj,jk) * ze1ur
+                     zdxt_ip1  = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_ip1  = zdkt3d(ji+1,jj,kp) * ze3wr_ip1
+                     !
+                     zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm)
+                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                     zah = pahu(ji,jj,jk)
+                     zah_ip1 = pahu(ji+1,jj,jk)
+                     zah_slp  = zah * triadi(ji,jj,jk,1,kp)
+                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp)
+                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp)
+                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp)
+                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftu(ji   ,jj,jk  ) =  zftu(ji   ,jj,jk )                                                               &
+                                         &    - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur               &
+                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              &
+                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
                !
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO_2D( 1, 0, 1, 0 )
-                        ze2vr = r1_e2v(ji,jj)
-                        zdyt  = zdjt(ji,jj,jk) * ze2vr
-                        ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm)
-                        zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                        zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
-                        ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked...
-                        zah = pahv(ji,jj,jk)
-                        zah_slp = zah * zslope_iso
-                        IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew
-                        zftv(ji,jj   ,jk   ) = zftv(ji,jj   ,jk   ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt                * zbv * ze3wr
-                     END_2D
-                  END DO
+               DO kp = 0, 1
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze2vr = r1_e2v(ji,jj)
+                     zdyt  = zdjt(ji,jj,jk) * ze2vr
+                     zdyt_jp1  = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_jp1  = zdkt3d(ji,jj+1,kp) * ze3wr_jp1
+                     zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                     zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm)
+                     ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked....
+                     zah = pahv(ji,jj,jk)          ! pahv(ji,jj+jp,jk)  ????
+                     zah_jp1 = pahv(ji,jj+1,jk)
+                     zah_slp = zah * triadj(ji,jj,jk,1,kp)
+                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp)
+                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp)
+                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp)
+                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftv(ji,jj  ,jk   ) =  zftv(ji,jj  ,jk   )                                                              &
+                                         &    - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr               &
+                                         &      + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji,jj+1,jk+kp) =  ztfw(ji,jj+1,jk+kp)                                                              &
+                                         &    - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1             &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
                !
             ELSE
                !
-               DO ip = 0, 1               !==  Horizontal & vertical fluxes
-                  DO kp = 0, 1
-                     DO_2D( 1, 0, 1, 0 )
-                        ze1ur = r1_e1u(ji,jj)
-                        zdxt  = zdit(ji,jj,jk) * ze1ur
-                        ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,Kmm)
-                        zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr
-                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
-                        zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp)
-                        !
-                        zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
-                        ! ln_botmix_triad is .F. mask zah for bottom half cells
-                        zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
-                        zah_slp  = zah * zslope_iso
-                        IF( ln_ldfeiv )   zaei_slp = aeiu(ji,jj,jk) * zslope_skew        ! aeit(ji+ip,jj,jk)*zslope_skew
-                        zftu(ji   ,jj,jk   ) = zftu(ji   ,jj,jk   ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
-                        ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
-                     END_2D
-                  END DO
+               DO kp = 0, 1               !==  Horizontal & vertical fluxes
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze1ur = r1_e1u(ji,jj)
+                     zdxt  = zdit(ji,jj,jk) * ze1ur
+                     zdxt_ip1  = zdit(ji+1,jj,jk) * r1_e1u(ji+1,jj)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_ip1 = 1._wp / e3w(ji+1,jj,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_ip1  = zdkt3d(ji+1,jj,kp) * ze3wr_ip1
+                     !
+                     zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm)
+                     zbu_ip1 = 0.25_wp * e1e2u(ji+1,jj) * e3u(ji+1,jj,jk,Kmm)
+                     ! ln_botmix_triad is .F. mask zah for bottom half cells
+                     zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ????
+                     zah_ip1 = pahu(ji+1,jj,jk) * umask(ji+1,jj,jk+kp)
+                     zah_slp  = zah * triadi(ji,jj,jk,1,kp)
+                     zah_slp_ip1  = zah_ip1 * triadi(ji+1,jj,jk,1,kp)
+                     zah_slp1  = zah * triadi(ji+1,jj,jk,0,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiu(ji,jj,jk) * triadi_g(ji,jj,jk,1,kp)
+                        zaei_slp_ip1 = aeiu(ji+1,jj,jk) * triadi_g(ji+1,jj,jk,1,kp)
+                        zaei_slp1 = aeiu(ji,jj,jk) * triadi_g(ji+1,jj,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftu(ji   ,jj,jk  ) =  zftu(ji   ,jj,jk )                                                               &
+                                         &    - ( ( zah * zdxt + ( zah_slp - zaei_slp ) * zdzt ) * zbu * ze1ur               &
+                                         &      + ( zah * zdxt + zah_slp1 * zdzt_ip1 - zaei_slp1 * zdzt_ip1 ) * zbu * ze1ur  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji+1,jj,jk+kp) =  ztfw(ji+1,jj,jk+kp)                                                              &
+                                         &    - ( (zah_slp_ip1 + zaei_slp_ip1) * zdxt_ip1 * zbu_ip1 * ze3wr_ip1              &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdxt * zbu * ze3wr_ip1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
                !
-               DO jp = 0, 1
-                  DO kp = 0, 1
-                     DO_2D( 1, 0, 1, 0 )
-                        ze2vr = r1_e2v(ji,jj)
-                        zdyt  = zdjt(ji,jj,jk) * ze2vr
-                        ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,Kmm)
-                        zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr
-                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp)
-                        zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp)
-                        zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
-                        ! ln_botmix_triad is .F. mask zah for bottom half cells
-                        zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
-                        zah_slp = zah * zslope_iso
-                        IF( ln_ldfeiv )   zaei_slp = aeiv(ji,jj,jk) * zslope_skew        ! aeit(ji,jj+jp,jk)*zslope_skew
-                        zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
-                        ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
-                     END_2D
-                  END DO
+               DO kp = 0, 1
+                  DO_2D( iij, iij-1, iij, iij-1 )
+                     ze2vr = r1_e2v(ji,jj)
+                     zdyt  = zdjt(ji,jj,jk) * ze2vr
+                     zdyt_jp1  = zdjt(ji,jj+1,jk) * r1_e2v(ji,jj+1)
+                     ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm)
+                     ze3wr_jp1 = 1._wp / e3w(ji,jj+1,jk+kp,Kmm)
+                     zdzt  = zdkt3d(ji,jj,kp) * ze3wr
+                     zdzt_jp1  = zdkt3d(ji,jj+1,kp) * ze3wr_jp1
+                     zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm)
+                     zbv_jp1 = 0.25_wp * e1e2v(ji,jj+1) * e3v(ji,jj+1,jk,Kmm)
+                     ! ln_botmix_triad is .F. mask zah for bottom half cells
+                     zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ????
+                     zah_jp1 = pahv(ji,jj+1,jk) * vmask(ji,jj+1,jk+kp)
+                     zah_slp = zah * triadj(ji,jj,jk,1,kp)
+                     zah_slp1 = zah * triadj(ji,jj+1,jk,0,kp)
+                     zah_slp_jp1 = zah_jp1 * triadj(ji,jj+1,jk,1,kp)
+                     IF( ln_ldfeiv )   THEN
+                        zaei_slp = aeiv(ji,jj,jk) * triadj_g(ji,jj,jk,1,kp)
+                        zaei_slp_jp1 = aeiv(ji,jj+1,jk) * triadj_g(ji,jj+1,jk,1,kp)
+                        zaei_slp1 = aeiv(ji,jj,jk) * triadj_g(ji,jj+1,jk,0,kp)
+                     ENDIF
+                     ! round brackets added to fix the order of floating point operations
+                     ! needed to ensure halo 1 - halo 2 compatibility
+                     zftv(ji,jj  ,jk   ) =  zftv(ji,jj  ,jk   )                                                              &
+                                         &    - ( ( zah * zdyt + ( zah_slp - zaei_slp ) * zdzt ) * zbv * ze2vr               &
+                                         &      + ( zah * zdyt + zah_slp1 * zdzt_jp1 - zaei_slp1 * zdzt_jp1 ) * zbv * ze2vr  &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                     ztfw(ji,jj+1,jk+kp) =  ztfw(ji,jj+1,jk+kp)                                                              &
+                                         &    - ( ( zah_slp_jp1 + zaei_slp_jp1) * zdyt_jp1 * zbv_jp1 * ze3wr_jp1             &
+                                         &      + ( zah_slp1 + zaei_slp1) * zdyt * zbv * ze3wr_jp1                           &
+                                         &      )                                                                            ! bracket for halo 1 - halo 2 compatibility
+                  END_2D
                END DO
             ENDIF
             !                             !==  horizontal divergence and add to the general trend  ==!
-            DO_2D( 0, 0, 0, 0 )
-               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    &
-                  &                       + zsign * (  zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)       &
-                  &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   &
-                  &                                        / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  )
+            DO_2D( iij-1, iij-1, iij-1, iij-1 )
+               ! round brackets added to fix the order of floating point operations
+               ! needed to ensure halo 1 - halo 2 compatibility
+               pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                                                &
+                  &                       + zsign * ( ( zftu(ji-1,jj  ,jk) - zftu(ji,jj,jk)             &
+                  &                                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+                  &                                 + ( zftv(ji,jj-1,jk) - zftv(ji,jj,jk)               &
+                  &                                   )                                                 & ! bracket for halo 1 - halo 2 compatibility
+                  &                                 ) / (  e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm)  )
             END_2D
             !
@@ -387,5 +461,5 @@
          !                                !==  add the vertical 33 flux  ==!
          IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz
-            DO_3D( 0, 0, 1, 0, 2, jpkm1 )
+            DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)   &
                   &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             &
@@ -395,10 +469,10 @@
             SELECT CASE( kpass )
             CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2
-               DO_3D( 0, 0, 1, 0, 2, jpkm1 )
+               DO_3D( iij-1, iij-1, iij-1, iij-1, 2, jpkm1 )
                   ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)             &
                      &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) )
                END_3D
             CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt2 gradients, resp.
-               DO_3D( 0, 0, 1, 0, 2, jpkm1 )
+               DO_3D( 0, 0, 0, 0, 2, jpkm1 )
                   ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,Kmm) * tmask(ji,jj,jk)                      &
                      &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   &
@@ -408,5 +482,5 @@
          ENDIF
          !
-         DO_3D( 0, 0, 0, 0, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==!
+         DO_3D( iij-1, iij-1, iij-1, iij-1, 1, jpkm1 )      !==  Divergence of vertical fluxes added to pta  ==!
             pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    &
             &                                  + zsign * (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tramle.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tramle.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tramle.F90	(revision 14986)
@@ -87,7 +87,8 @@
       INTEGER                     , INTENT(in   ) ::   Kmm        ! ocean time level index
       CHARACTER(len=3)            , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
-      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
-      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
-      REAL(wp), DIMENSION(A2D(nn_hls),jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
+      ! TEMP: [tiling] Can be A2D(nn_hls) after all lbc_lnks removed in the nn_hls = 2 case in tra_adv_fct
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu         ! in : 3 ocean transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pv         ! out: same 3  transport components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pw         !   increased by the MLE induced transport
       !
       INTEGER  ::   ji, jj, jk          ! dummy loop indices
@@ -96,9 +97,6 @@
       REAL(wp) ::   zcvw, zmvw          !   -      -
       INTEGER , DIMENSION(A2D(nn_hls))     :: inml_mle
-      REAL(wp), DIMENSION(A2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_MH
+      REAL(wp), DIMENSION(A2D(nn_hls))     :: zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH
       REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw
-      ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
-      REAL(wp), DIMENSION(:,:),   ALLOCATABLE, SAVE :: zLf_NH
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zpsiu_mle, zpsiv_mle
       !!----------------------------------------------------------------------
       !
@@ -110,15 +108,15 @@
          SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
          CASE ( 0 )                                               != min of the 2 neighbour MLDs
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MIN( hmle(ji+1,jj), hmle(ji,jj) )
                zhv(ji,jj) = MIN( hmle(ji,jj+1), hmle(ji,jj) )
             END_2D
          CASE ( 1 )                                               != average of the 2 neighbour MLDs
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
                zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
             END_2D
          CASE ( 2 )                                               != max of the 2 neighbour MLDs
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MAX( hmle(ji+1,jj), hmle(ji,jj) )
                zhv(ji,jj) = MAX( hmle(ji,jj+1), hmle(ji,jj) )
@@ -126,5 +124,5 @@
          END SELECT
          IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2u(ji,jj)                                            &
                     &           * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )   &
@@ -137,5 +135,5 @@
             !
          ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj)               &
                     &                  * dbdx_mle(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) )
@@ -149,9 +147,9 @@
          !                                      !==  MLD used for MLE  ==!
          !                                                ! compute from the 10m density to deal with the diurnal cycle
-         DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             inml_mle(ji,jj) = mbkt(ji,jj) + 1                    ! init. to number of ocean w-level (T-level + 1)
          END_2D
          IF ( nla10 > 0 ) THEN                            ! avoid case where first level is thicker than 10m
-           DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m)
+           DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 )        ! from the bottom to nlb10 (10m)
               IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + rn_rho_c_mle )   inml_mle(ji,jj) = jk      ! Mixed layer
            END_3D
@@ -163,5 +161,5 @@
          zbm (:,:) = 0._wp
          zn2 (:,:) = 0._wp
-         DO_3D( 1, 1, 1, 1, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax )                    ! MLD and mean buoyancy and N2 over the mixed layer
             zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, inml_mle(ji,jj)-jk ) , 1  )  )    ! zc being 0 outside the ML t-points
             zmld(ji,jj) = zmld(ji,jj) + zc
@@ -172,15 +170,15 @@
          SELECT CASE( nn_mld_uv )                         ! MLD at u- & v-pts
          CASE ( 0 )                                               != min of the 2 neighbour MLDs
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MIN( zmld(ji+1,jj), zmld(ji,jj) )
                zhv(ji,jj) = MIN( zmld(ji,jj+1), zmld(ji,jj) )
             END_2D
          CASE ( 1 )                                               != average of the 2 neighbour MLDs
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = ( zmld(ji+1,jj) + zmld(ji,jj) ) * 0.5_wp
                zhv(ji,jj) = ( zmld(ji,jj+1) + zmld(ji,jj) ) * 0.5_wp
             END_2D
          CASE ( 2 )                                               != max of the 2 neighbour MLDs
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zhu(ji,jj) = MAX( zmld(ji+1,jj), zmld(ji,jj) )
                zhv(ji,jj) = MAX( zmld(ji,jj+1), zmld(ji,jj) )
@@ -188,5 +186,5 @@
          END SELECT
          !                                                ! convert density into buoyancy
-         DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             zbm(ji,jj) = + grav * zbm(ji,jj) / MAX( e3t(ji,jj,1,Kmm), zmld(ji,jj) )
          END_2D
@@ -201,5 +199,5 @@
          !
          IF( nn_mle == 0 ) THEN           ! Fox-Kemper et al. 2010 formulation
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj)  * e2_e1u(ji,jj)                                            &
                     &           * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )   &
@@ -212,5 +210,5 @@
             !
          ELSEIF( nn_mle == 1 ) THEN       ! New formulation (Lf = 5km fo/ff with fo=Coriolis parameter at latitude rn_lat)
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               &
                     &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) )
@@ -222,5 +220,5 @@
          !
          IF( nn_conv == 1 ) THEN              ! No MLE in case of convection
-            DO_2D( 1, 0, 1, 0 )
+            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
                IF( MIN( zn2(ji,jj) , zn2(ji+1,jj) ) < 0._wp )   zpsim_u(ji,jj) = 0._wp
                IF( MIN( zn2(ji,jj) , zn2(ji,jj+1) ) < 0._wp )   zpsim_v(ji,jj) = 0._wp
@@ -230,5 +228,5 @@
       ENDIF  ! end of ln_osm_mle conditional
     !                                      !==  structure function value at uw- and vw-points  ==!
-    DO_2D( 1, 0, 1, 0 )
+    DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
        zhu(ji,jj) = 1._wp / MAX(zhu(ji,jj), rsmall)                   ! hu --> 1/hu
        zhv(ji,jj) = 1._wp / MAX(zhv(ji,jj), rsmall) 
@@ -238,5 +236,6 @@
     zpsi_vw(:,:,:) = 0._wp
     !
-      DO_3D( 1, 0, 1, 0, 2, ikmax )                ! start from 2 : surface value = 0
+      DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, ikmax )                ! start from 2 : surface value = 0
+      
          zcuw = 1._wp - ( gdepw(ji+1,jj,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhu(ji,jj)
          zcvw = 1._wp - ( gdepw(ji,jj+1,jk,Kmm) + gdepw(ji,jj,jk,Kmm) ) * zhv(ji,jj)
@@ -252,9 +251,9 @@
       !                                      !==  transport increased by the MLE induced transport ==!
       DO jk = 1, ikmax
-         DO_2D( 1, 0, 1, 0 )                      ! CAUTION pu,pv must be defined at row/column i=1 / j=1
+         DO_2D_OVR( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             pu(ji,jj,jk) = pu(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) )
             pv(ji,jj,jk) = pv(ji,jj,jk) + ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) )
          END_2D
-         DO_2D( 0, 0, 0, 0 )
+         DO_2D_OVR( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
             pw(ji,jj,jk) = pw(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj,jk)   &
                &                          + zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj-1,jk) ) * wmask(ji,jj,1)
@@ -262,10 +261,5 @@
       END DO
 
-      ! TEMP: [tiling] These changes not necessary if using XIOS (subdomain support)
       IF( cdtype == 'TRA') THEN              !==  outputs  ==!
-         IF( ntile == 0 .OR. ntile == 1 ) THEN                             ! Do only on the first tile
-            ALLOCATE( zLf_NH(jpi,jpj), zpsiu_mle(jpi,jpj,jpk), zpsiv_mle(jpi,jpj,jpk) )
-            zpsiu_mle(:,:,:) = 0._wp ; zpsiv_mle(:,:,:) = 0._wp
-         ENDIF
          !
          IF (ln_osm_mle.and.ln_zdfosm) THEN
@@ -279,16 +273,13 @@
          ENDIF
          !
+         CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f
+         !
          ! divide by cross distance to give streamfunction with dimensions m^2/s
          DO_3D( 0, 0, 0, 0, 1, ikmax+1 )
-            zpsiu_mle(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj)
-            zpsiv_mle(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj)
+            zpsi_uw(ji,jj,jk) = zpsi_uw(ji,jj,jk) * r1_e2u(ji,jj)
+            zpsi_vw(ji,jj,jk) = zpsi_vw(ji,jj,jk) * r1_e1v(ji,jj)
          END_3D
-
-         IF( ntile == 0 .OR. ntile == nijtile ) THEN                       ! Do only on the last tile
-            CALL iom_put( "Lf_NHpf" , zLf_NH  )    ! Lf = N H / f
-            CALL iom_put( "psiu_mle", zpsiu_mle )    ! i-mle streamfunction
-            CALL iom_put( "psiv_mle", zpsiv_mle )    ! j-mle streamfunction
-            DEALLOCATE( zLf_NH, zpsiu_mle, zpsiv_mle )
-         ENDIF
+         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction
+         CALL iom_put( "psiv_mle", zpsi_vw )    ! j-mle streamfunction
       ENDIF
       !
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tranpc.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tranpc.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/tranpc.F90	(revision 14986)
@@ -17,6 +17,4 @@
    USE oce            ! ocean dynamics and active tracers
    USE dom_oce        ! ocean space and time domain
-   ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed)
-   USE domtile
    USE phycst         ! physical constants
    USE zdf_oce        ! ocean vertical physics
@@ -82,5 +80,4 @@
       LOGICAL, PARAMETER :: l_LB_debug = .FALSE. ! set to true if you want to follow what is
       INTEGER :: ilc1, jlc1, klc1, nncpu         ! actually happening in a water column at point "ilc1, jlc1"
-      INTEGER :: isi, isj, iei, iej
       LOGICAL :: lp_monitor_point = .FALSE.      ! in CPU domain "nncpu"
       !!----------------------------------------------------------------------
@@ -106,12 +103,7 @@
          CALL bn2    ( CASTWP(pts(:,:,:,:,Kaa)), zab, zn2, Kmm )    ! after Brunt-Vaisala  (given on W-points)
          !
-         IF( ntile == 0 .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile
-         !
-         IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-         IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
-         IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
-         IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
-         !
-         DO_2D( isi, iei, isj, iej )                        ! interior column only
+         IF( .NOT. l_istiled .OR. ntile == 1 ) nnpcc = 0         ! Do only on the first tile
+         !
+         DO_2D_OVR( 0, 0, 0, 0 )                        ! interior column only
             !
             IF( tmask(ji,jj,2) == 1 ) THEN      ! At least 2 ocean points
@@ -320,5 +312,5 @@
          ENDIF
          !
-         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
+         IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only for the full domain
             IF( lwp .AND. l_LB_debug ) THEN
                WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', nnpcc
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traqsr.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traqsr.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/traqsr.F90	(revision 14986)
@@ -109,5 +109,5 @@
       !
       INTEGER  ::   ji, jj, jk               ! dummy loop indices
-      INTEGER  ::   irgb, isi, iei, isj, iej ! local integers
+      INTEGER  ::   irgb                     ! local integers
       REAL(wp) ::   zchl, zcoef, z1_2        ! local scalars
       REAL(wp) ::   zc0 , zc1 , zc2 , zc3    !    -         -
@@ -122,5 +122,5 @@
       IF( ln_timing )   CALL timing_start('tra_qsr')
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
@@ -138,13 +138,8 @@
       !                         !  before qsr induced heat content  !
       !                         !-----------------------------------!
-      IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
-      IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
-      IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
-
       IF( kt == nit000 ) THEN          !==  1st time step  ==!
          IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN    ! read in restart
             z1_2 = 0.5_wp
-            IF( ntile == 0 .OR. ntile == 1 )  THEN                        ! Do only on the first tile
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                        ! Do only on the first tile
                IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file'
                CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
@@ -152,5 +147,5 @@
          ELSE                                           ! No restart or Euler forward at 1st time step
             z1_2 = 1._wp
-            DO_3D( isi, iei, isj, iej, 1, jpk )
+            DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
                qsr_hc_b(ji,jj,jk) = 0._wp
             END_3D
@@ -158,5 +153,5 @@
       ELSE                             !==  Swap of qsr heat content  ==!
          z1_2 = 0.5_wp
-         DO_3D( isi, iei, isj, iej, 1, jpk )
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
             qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk)
          END_3D
@@ -169,5 +164,5 @@
       CASE( np_BIO )                   !==  bio-model fluxes  ==!
          !
-         DO_3D( isi, iei, isj, iej, 1, nksr )
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )
             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) )
          END_3D
@@ -180,8 +175,8 @@
          !
          IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll
-            IF( ntile == 0 .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
-               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                                         ! Do only for the full domain
+               IF( ln_tile ) CALL dom_tile_stop( ldhold=.TRUE. )             ! Use full domain
                CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step
-               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 )            ! Revert to tile domain
+               IF( ln_tile ) CALL dom_tile_start( ldhold=.TRUE. )            ! Revert to tile domain
             ENDIF
             !
@@ -191,5 +186,5 @@
             ! most expensive calculations)
             !
-            DO_2D( isi, iei, isj, iej )
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
                        ! zlogc = log(zchl)
                zlogc = LOG ( MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) )
@@ -210,5 +205,5 @@
 
 !
-            DO_3D( isi, iei, isj, iej, 1, nksr + 1 )
+            DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr + 1 )
                ! zchl    = ALOG( ze0(ji,jj) )
                zlogc = ze0(ji,jj)
@@ -240,5 +235,5 @@
          !
          zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B
-         DO_2D( isi, iei, isj, iej )
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
             ze0(ji,jj) = rn_abs * qsr(ji,jj)
             ze1(ji,jj) = zcoef  * qsr(ji,jj)
@@ -251,5 +246,5 @@
          !
          !                                    !* interior equi-partition in R-G-B depending on vertical profile of Chl
-         DO_3D( isi, iei, isj, iej, 2, nksr + 1 )
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1 )
             ze3t = e3t(ji,jj,jk-1,Kmm)
             irgb = NINT( ztmp3d(ji,jj,jk) )
@@ -265,5 +260,5 @@
          END_3D
          !
-         DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )          !* now qsr induced heat content
             qsr_hc(ji,jj,jk) = r1_rho0_rcp * ( ztmp3d(ji,jj,jk) - ztmp3d(ji,jj,jk+1) )
          END_3D
@@ -275,5 +270,5 @@
          zz0 =        rn_abs   * r1_rho0_rcp      ! surface equi-partition in 2-bands
          zz1 = ( 1. - rn_abs ) * r1_rho0_rcp
-         DO_3D( isi, iei, isj, iej, 1, nksr )          !* now qsr induced heat content
+         DO_3D_OVR( nn_hls, nn_hls, nn_hls, nn_hls, 1, nksr )          !* now qsr induced heat content
             zc0 = zz0 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk  ,Kmm)*xsi1r )
             zc1 = zz0 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi0r ) + zz1 * EXP( -gdepw(ji,jj,jk+1,Kmm)*xsi1r )
@@ -293,5 +288,5 @@
       !
       ! sea-ice: store the 1st ocean level attenuation coefficient
-      DO_2D( isi, iei, isj, iej )
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
          IF( qsr(ji,jj) /= 0._wp ) THEN   ;   fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rho0_rcp * qsr(ji,jj) )
          ELSE                             ;   fraqsr_1lev(ji,jj) = 1._wp
@@ -299,18 +294,15 @@
       END_2D
       !
-      ! TEMP: [tiling] This change not necessary and working array can use A2D(nn_hls) if using XIOS (subdomain support)
-      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain
-         IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
-            ALLOCATE( zetot(jpi,jpj,jpk) )
-            zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
-            DO jk = nksr, 1, -1
-               zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) * rho0_rcp
-            END DO
-            CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
-            DEALLOCATE( zetot )
-         ENDIF
-      ENDIF
-      !
-      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+      IF( iom_use('qsr3d') ) THEN      ! output the shortwave Radiation distribution
+         ALLOCATE( zetot(A2D(nn_hls),jpk) )
+         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero
+         DO_3DS(0, 0, 0, 0, nksr, 1, -1)
+            zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) * rho0_rcp
+         END_3D
+         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation
+         DEALLOCATE( zetot )
+      ENDIF
+      !
+      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
          IF( lrst_oce ) THEN     ! write in the ocean restart file
             CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      )
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trasbc.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trasbc.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trasbc.F90	(revision 14986)
@@ -78,5 +78,5 @@
       !
       INTEGER  ::   ji, jj, jk, jn               ! dummy loop indices
-      INTEGER  ::   ikt, ikb, isi, iei, isj, iej ! local integers
+      INTEGER  ::   ikt, ikb                     ! local integers
       REAL(wp) ::   zfact, z1_e3t, zdep, ztim    ! local scalar
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdt, ztrds
@@ -85,5 +85,5 @@
       IF( ln_timing )   CALL timing_start('tra_sbc')
       !
-      IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+      IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
          IF( kt == nit000 ) THEN
             IF(lwp) WRITE(numout,*)
@@ -99,12 +99,7 @@
       ENDIF
       !
-      IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF    ! Avoid double-counting when using tiling
-      IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF
-      IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF
-      IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF
-
 !!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist)
       IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
-         DO_2D( isi, iei, isj, iej )
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
             qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns
             qsr(ji,jj) = 0._wp                        ! qsr set to zero
@@ -119,5 +114,5 @@
          IF( ln_rstart .AND. .NOT.l_1st_euler ) THEN      ! Restart: read in restart file
             zfact = 0.5_wp
-            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile
+            IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                       ! Do only on the first tile
                IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file'
                sbc_tsc(:,:,:) = 0._wp
@@ -127,5 +122,5 @@
          ELSE                                             ! No restart or restart not found: Euler forward time stepping
             zfact = 1._wp
-            DO_2D( isi, iei, isj, iej )
+            DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
                sbc_tsc(ji,jj,:) = 0._wp
                sbc_tsc_b(ji,jj,:) = 0._wp
@@ -134,22 +129,20 @@
       ELSE                                !* other time-steps: swap of forcing fields
          zfact = 0.5_wp
-         DO_2D( isi, iei, isj, iej )
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
             sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:)
          END_2D
       ENDIF
       !                             !==  Now sbc tracer content fields  ==!
-      DO_2D( isi, iei, isj, iej )
+      DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )
          sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj)   ! non solar heat flux
          sbc_tsc(ji,jj,jp_sal) = r1_rho0     * sfx(ji,jj)   ! salt flux due to freezing/melting
       END_2D
       IF( ln_linssh ) THEN                !* linear free surface
-         DO_2D( isi, iei, isj, iej )                    !==>> add concentration/dilution effect due to constant volume cell
+         DO_2D_OVR( nn_hls, nn_hls, nn_hls, nn_hls )                    !==>> add concentration/dilution effect due to constant volume cell
             sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm)
             sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm)
          END_2D                                 !==>> output c./d. term
-         IF( ntile == 0 .OR. ntile == nijtile )  THEN             ! Do only on the last tile
-            IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
-            IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
-         ENDIF
+         IF( iom_use('emp_x_sst') )   CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) )
+         IF( iom_use('emp_x_sss') )   CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) )
       ENDIF
       !
@@ -161,5 +154,5 @@
       END DO
       !
-      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
+      IF( .NOT. l_istiled .OR. ntile == nijtile )  THEN                ! Do only on the last tile
          IF( lrst_oce ) THEN           !==  write sbc_tsc in the ocean restart file  ==!
             CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
@@ -187,8 +180,6 @@
       ENDIF
 
-      IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile
-         IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
-         IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
-      ENDIF
+      IF( iom_use('rnf_x_sst') )   CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) )   ! runoff term on sst
+      IF( iom_use('rnf_x_sss') )   CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) )   ! runoff term on sss
 
 #if defined key_asminc
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trazdf.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trazdf.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/trazdf.F90	(revision 14986)
@@ -65,5 +65,5 @@
       !
       IF( kt == nit000 )  THEN
-         IF( ntile == 0 .OR. ntile == 1 )  THEN                   ! Do only on the first tile
+         IF( .NOT. l_istiled .OR. ntile == 1 )  THEN                   ! Do only on the first tile
             IF(lwp)WRITE(numout,*)
             IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S'
Index: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/zpshde.F90
===================================================================
--- NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/zpshde.F90	(revision 14930)
+++ NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/TRA/zpshde.F90	(revision 14986)
@@ -47,7 +47,7 @@
       INTEGER                     , INTENT(in   )           ::  Kmm         ! ocean time level index
       INTEGER                     , INTENT(in   )           ::  kjpt        ! number of tracers
-      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta         ! 4D tracers fields
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta         ! 4D tracers fields
       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts
-      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
       REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
       !
@@ -111,7 +111,7 @@
       INTEGER                                , INTENT(in   )           ::  kjpt        ! number of tracers
       INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktrd, ktgr
-      REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta         ! 4D tracers fields
+      REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta         ! 4D tracers fields
       REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts
-      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd         ! 3D density anomaly fields
+      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields
       REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad of prd at u- & v-pts (bottom)
       !
@@ -124,8 +124,4 @@
       !
       IF( ln_timing )   CALL timing_start( 'zps_hde')
-      IF (nn_hls.EQ.2) THEN
-         CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp)
-         IF(PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp)
-      END IF
       !
       pgtu(:,:,:) = 0._wp   ;   zti (:,:,:) = 0._wp   ;   zhi (:,:) = 0._wp
@@ -134,5 +130,5 @@
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
          !
-         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )              ! Gradient of density at the last level
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )              ! Gradient of density at the last level
             iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
             ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
@@ -173,5 +169,5 @@
       END DO
       !
-      IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
       !
       IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
@@ -206,5 +202,5 @@
             ENDIF
          END_2D
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
          !
       END IF
@@ -221,8 +217,8 @@
       INTEGER                     , INTENT(in   )           ::  Kmm          ! ocean time level index
       INTEGER                     , INTENT(in   )           ::  kjpt         ! number of tracers
-      REAL(dp), DIMENSION(:,:,:,:), INTENT(inout)           ::  pta          ! 4D tracers fields
+      REAL(dp), DIMENSION(:,:,:,:), INTENT(in   )           ::  pta          ! 4D tracers fields
       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts
       REAL(wp), DIMENSION(:,:,:)  , INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
-      REAL(wp), DIMENSION(:,:,:)  , INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
       REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
       REAL(wp), DIMENSION(:,:)    , INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
@@ -291,8 +287,8 @@
       INTEGER                                , INTENT(in   )           ::  kjpt         ! number of tracers
       INTEGER                                , INTENT(in   )           ::  ktta, ktgt, ktgti, ktrd, ktgr, ktgri
-      REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(inout)           ::  pta          ! 4D tracers fields
+      REAL(dp), DIMENSION(A2D_T(ktta),JPK,KJPT), INTENT(in   )           ::  pta          ! 4D tracers fields
       REAL(wp), DIMENSION(A2D_T(ktgt)    ,KJPT), INTENT(  out)           ::  pgtu, pgtv   ! hor. grad. of ptra at u- & v-pts
       REAL(wp), DIMENSION(A2D_T(ktgti)   ,KJPT), INTENT(  out)           ::  pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF)
-      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(inout), OPTIONAL ::  prd          ! 3D density anomaly fields
+      REAL(wp), DIMENSION(A2D_T(ktrd),JPK     ), INTENT(in   ), OPTIONAL ::  prd          ! 3D density anomaly fields
       REAL(wp), DIMENSION(A2D_T(ktgr)         ), INTENT(  out), OPTIONAL ::  pgru, pgrv   ! hor. grad of prd at u- & v-pts (bottom)
       REAL(wp), DIMENSION(A2D_T(ktgri)        ), INTENT(  out), OPTIONAL ::  pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top)
@@ -307,9 +303,4 @@
       IF( ln_timing )   CALL timing_start( 'zps_hde_isf')
       !
-      IF (nn_hls.EQ.2) THEN
-         CALL lbc_lnk( 'zpshde', pta, 'T', 1.0_wp)
-         IF (PRESENT(prd)) CALL lbc_lnk( 'zpshde', prd, 'T', 1.0_wp)
-      END IF
-
       pgtu (:,:,:) = 0._wp   ;   pgtv (:,:,:) =0._wp
       pgtui(:,:,:) = 0._wp   ;   pgtvi(:,:,:) =0._wp
@@ -319,5 +310,5 @@
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
          !
-         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
 
             iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
@@ -359,5 +350,5 @@
       END DO
       !
-      IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
 
       ! horizontal derivative of density anomalies (rd)
@@ -401,5 +392,5 @@
          END_2D
 
-         IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
+         IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions
          !
       END IF
@@ -408,5 +399,5 @@
       !
       DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            !
-         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )
+         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )
             iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1
             ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1
@@ -452,5 +443,5 @@
          !
       END DO
-      IF (nn_hls.EQ.1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
+      IF (nn_hls==1) CALL lbc_lnk( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond.
 
       IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part)
@@ -491,6 +482,6 @@
 
          END_2D
-         IF (nn_hls.EQ.1) THEN
-           CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp)
+         IF (nn_hls==1) THEN
+           CALL lbc_lnk( 'zpshde', pgrui, 'U', -1.0_wp )   ! Lateral boundary conditions
            CALL lbc_lnk( 'zpshde', pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions
          ENDIF
