Index: NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/traadv.F90
===================================================================
--- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/traadv.F90	(revision 13360)
+++ NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/traadv.F90	(revision 14037)
@@ -18,4 +18,6 @@
    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
+   USE domain, ONLY : dom_tile
    USE domvvl         ! variable vertical scale factors
    USE sbcwave        ! wave module
@@ -23,5 +25,7 @@
    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)
@@ -65,5 +69,7 @@
    INTEGER, PARAMETER ::   np_UBS     = 4   ! 3rd order Upstream Biased Scheme
    INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme
-   
+
+   !! * Substitutions
+#  include "do_loop_substitute.h90"
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
@@ -86,88 +92,151 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation
       !
-      INTEGER ::   jk   ! dummy loop index
-      REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zuu, zvv, zww   ! 3D workspace
-      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds
+      INTEGER ::   ji, jj, jk   ! dummy loop index
+      ! TEMP: [tiling] This change not necessary and can be A2D(nn_hls) if using XIOS (subdomain support)
+      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
+      LOGICAL :: lskip
       !!----------------------------------------------------------------------
       !
       IF( ln_timing )   CALL timing_start('tra_adv')
       !
-      !                                         !==  effective transport  ==!
-      zuu(:,:,jpk) = 0._wp
-      zvv(:,:,jpk) = 0._wp
-      zww(:,:,jpk) = 0._wp
-      IF( ln_wave .AND. ln_sdw )  THEN
-         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift
-            zuu(:,:,jk) =   &
-               &  e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) )
-            zvv(:,:,jk) =   & 
-               &  e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) )
-            zww(:,:,jk) =   & 
-               &  e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) )
-         END DO
-      ELSE
-         DO jk = 1, jpkm1
-            zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)               ! eulerian transport only
-            zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm)
-            zww(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk)
-         END DO
-      ENDIF
-      !
-      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections
-         zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:)
-         zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:)
-      ENDIF
-      !
-      zuu(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom
-      zvv(:,:,jpk) = 0._wp
-      zww(:,:,jpk) = 0._wp
-      !
-      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &
-         &              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)
-      !
-      CALL iom_put( "uocetr_eff", zuu )                                        ! output effective transport      
-      CALL iom_put( "vocetr_eff", zvv )
-      CALL iom_put( "wocetr_eff", zww )
-      !
-!!gm ???
-      CALL dia_ptr( kt, Kmm, zvv )                                    ! diagnose the effective MSF 
-!!gm ???
-      !
-
-      IF( l_trdtra )   THEN                    !* Save ta and sa trends
-         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
-         ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
-         ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
-      ENDIF
-      !
-      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
-      !
-      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
-         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
-         CALL tra_adv_fct    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v )
-      CASE ( np_MUS )                                 ! MUSCL
-         CALL tra_adv_mus    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
-      CASE ( np_UBS )                                 ! UBS
-         CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   )
-      CASE ( np_QCK )                                 ! QUICKEST
-         CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
-      !
-      END SELECT
-      !
-      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
-         DO jk = 1, jpkm1
-            ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk)
-            ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk)
-         END DO
-         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt )
-         CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds )
-         DEALLOCATE( ztrdt, ztrds )
+      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
+         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
+         ENDIF
+      ENDIF
+      IF( .NOT. lskip ) THEN
+         !                                         !==  effective transport  ==!
+         IF( ln_wave .AND. ln_sdw )  THEN
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 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) )
+               zww(ji,jj,jk) = e1e2t(ji,jj)                     * ( ww(ji,jj,jk)     + wsd(ji,jj,jk) )
+            END_3D
+         ELSE
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 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)
+               zww(ji,jj,jk) = e1e2t(ji,jj)                     * ww(ji,jj,jk)
+            END_3D
+         ENDIF
+         !
+         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 )
+               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)
+            END_3D
+         ENDIF
+         !
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
+            zuu(ji,jj,jpk) = 0._wp                                                      ! no transport trough the bottom
+            zvv(ji,jj,jpk) = 0._wp
+            zww(ji,jj,jpk) = 0._wp
+         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 iom_put( "uocetr_eff", zuu )                                        ! output effective transport
+            CALL iom_put( "vocetr_eff", zvv )
+            CALL iom_put( "wocetr_eff", zww )
+         ENDIF
+         !
+   !!gm ???
+         ! TEMP: [tiling] This change not necessary if using XIOS (subdomain support)
+         CALL dia_ptr( kt, Kmm, zvv(A2D(nn_hls),:) )                                    ! diagnose the effective MSF
+   !!gm ???
+         !
+
+         IF( l_trdtra )   THEN                    !* Save ta and sa trends
+            ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) )
+            ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs)
+            ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs)
+         ENDIF
+         !
+         ! NOTE: [tiling-comms-merge] These lbc_lnk calls are still needed (pts in the zco case because zps_hde is not called in step, zuu/zvv/zww in all cases, I think because DO loop bounds need to be updated in DYN as done in TRA)
+         SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==!
+         !
+         CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order
+            IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. )
+            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_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.)
+               CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.)
+#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
+            ! NOTE: [tiling-comms-merge] I added this lbc_lnk as it did not validate against the trunk when using ln_zco
+            IF (nn_hls.EQ.2) THEN 
+                CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)
+#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.)
+            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_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)
+               CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)
+            END IF
+            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs )
+         !
+         END SELECT
+         !
+         IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics
+            DO jk = 1, jpkm1
+               ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk)
+               ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk)
+            END DO
+            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt )
+            CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds )
+            DEALLOCATE( ztrdt, ztrds )
+         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 )
+
       ENDIF
       !                                              ! print mean trends (used for debugging)
-      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask,               &
+      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv  - Ta: ', mask1=tmask, &
          &                                  tab3d_2=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
+         DEALLOCATE( zuu, zvv, zww )
+      ENDIF
       !
       IF( ln_timing )   CALL timing_stop( 'tra_adv' )
