Changeset 14856 for NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/TRA/traadv_qck.F90

Timestamp:

2021-05-12T17:58:07+02:00 (3 years ago)

Author:

smueller

Message:

Synchronizing with ^{/NEMO/trunk@14854 (ticket #2353)}

File:

• NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/TRA/traadv_qck.F90 (modified) (13 diffs)

NEMO/branches/2021/dev_r14122_HPC-08_Mueller_OSMOSIS_streamlining/src/OCE/TRA/traadv_qck.F90

@@ -27 +27 @@
    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
@@ -91 +94 @@
       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(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 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,*)
@@ -117 +123 @@
       CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs )
       !
+#endif
    END SUBROUTINE tra_adv_qck
 
@@ -129 +136 @@
       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(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
@@ -149 +156 @@
             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
 
          !
@@ -167 +174 @@
          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
@@ -176 +183 @@
             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
 
          !
@@ -214 +221 @@
       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(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
@@ -229 +236 @@
          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
 
          !
@@ -259 +264 @@
 
          !--- 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
@@ -268 +273 @@
             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
@@ -306 +311 @@
       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(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! active tracers and RHS of tracer equation
@@ -365 +370 @@
       !----------------------------------------------------------------------
       !
-      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)