Changeset 13882 for NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_mus_lf.F90

Timestamp:

2020-11-26T10:52:00+01:00 (3 years ago)

Author:

francesca

Message:

loop fusion v2 - mus and fct advection schemes - ticket #2367

File:

• NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_mus_lf.F90 (modified) (3 diffs)

NEMO/branches/2020/dev_r13508_HPC-09_loop_fusion/src/OCE/TRA/traadv_mus_lf.F90

@@ -129 +129 @@
       REAL(wp) ::   zv, z0v, z0w           !   -      -
       REAL(wp) ::   zzwx, zzwxm1, zzwxp1, zzwy, zzwym1, zzwyp1
-      REAL(wp) ::   zzwz, zzwzp1, zzwzp2, zzslpz, zzslpzp1
-      REAL(wp) ::   zzslpx, zzslpx_ip1, zzslpy, zzslpy_jp1
-      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz 
+      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
       !!----------------------------------------------------------------------
       !
@@ -167 +170 @@
          &                          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  ==!
          !
-         !                          !* Horizontal advective fluxes
-         !
-         !!----------------------------------------------------------------------
          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(zzwxm1, ji-1)
             initial_slop_i(zzwxp1, ji+1)
 
+            initial_slop_j(zzwym1, jj-1)
             initial_slop_j(zzwy, jj)
-            initial_slop_j(zzwym1, jj-1)
             initial_slop_j(zzwyp1, jj+1)
             !-- Slopes of tracer
             tracer_slop(zzslpx, zzwx, zzwxm1) 
-            tracer_slop(zzslpx_ip1, zzwxp1, zzwx) 
+            tracer_slop(zzslpxp1, zzwxp1, zzwx) 
             tracer_slop(zzslpy, zzwy, zzwym1) 
-            tracer_slop(zzslpy_jp1, zzwyp1, zzwy) 
+            tracer_slop(zzslpyp1, zzwyp1, zzwy) 
             !-- Slopes limitation
             limitation_slop(zzslpx, zzslpx, zzwxm1, zzwx)
-            limitation_slop(zzslpx_ip1, zzslpx_ip1, zzwx, zzwxp1)
+            limitation_slop(zzslpxp1, zzslpxp1, zzwx, zzwxp1)
             limitation_slop(zzslpy, zzslpy, zzwym1, zzwy)
-            limitation_slop(zzslpy_jp1, zzslpy_jp1, zzwy, zzwyp1)
+            limitation_slop(zzslpyp1, zzslpyp1, zzwy, zzwyp1)
             !-- MUSCL horizontal advective fluxes
-            vertical_adv_flux_i(zwx(ji,jj,jk), jk, zzslpx, zzslpx_ip1) 
-            vertical_adv_flux_j(zwy(ji,jj,jk), jk, zzslpy, zzslpy_jp1) 
+            vertical_adv_flux_i(zwx(ji,jj,jk), jk, zzslpx, zzslpxp1) 
+            vertical_adv_flux_j(zwy(ji,jj,jk), jk, zzslpy, zzslpyp1) 
          END_3D
          !
@@ -207 +215 @@
          END_3D
          !                          !* Vertical advective fluxes
-         !
          DO_2D( 0, 0, 0, 0 ) 
             !-- first guess of the slopes
-            initial_slop_k(zzwzp1, 2)
-            initial_slop_k(zzwzp2, 3)
+            initial_slop_k(zzwz_ptr(ji,jj), 2)
+            initial_slop_k(zzwzp1_ptr(ji,jj), 3)
             !-- Slopes of tracer
-            tracer_slop(zzslpzp1, zzwzp1, zzwzp2)
+            tracer_slop(zzslpz_ptr(ji,jj), zzwz_ptr(ji,jj), zzwzp1_ptr(ji,jj))
             !-- Slopes limitation
-            limitation_slop(zzslpzp1, zzslpzp1, zzwzp2, zzwzp1)
+            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, zzslpzp1)
+            vertical_adv_flux(zwz(ji,jj,2), 1, 0, zzslpz_ptr(ji,jj))
          END_2D
-         DO_3D( 0, 0, 0, 0, 2, jpk-3 )    
-            !-- first guess of the slopes
-            initial_slop_k(zzwz, jk)
-            initial_slop_k(zzwzp1, jk+1)
-            initial_slop_k(zzwzp2, jk+2)
+         
+         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(zzslpz, zzwz, zzwzp1)
-            tracer_slop(zzslpzp1, zzwzp1, zzwzp2)
+            tracer_slop(zzslpzp1_ptr(ji,jj), zzwzp1_ptr(ji,jj), 0)
             !-- Slopes limitation
-            limitation_slop(zzslpz, zzslpz, zzwzp1, zzwz)
-            limitation_slop(zzslpzp1, zzslpzp1, zzwzp2, zzwzp1)
+            limitation_slop(zzslpzp1_ptr(ji,jj), zzslpzp1_ptr(ji,jj), 0, zzwzp1_ptr(ji,jj))
             !-- vertical advective flux
-            vertical_adv_flux(zwz(ji,jj,jk+1), jk, zzslpz, zzslpzp1)
-         END_3D
-         DO_2D( 0, 0, 0, 0 ) 
-            !-- first guess of the slopes
-            initial_slop_k(zzwz, jpk-2)
-            initial_slop_k(zzwzp1, jpk-1)
-            zzwzp2 = 0
-            !-- Slopes of tracer
-            tracer_slop(zzslpz, zzwz, zzwzp1)
-            tracer_slop(zzslpzp1, zzwzp1, zzwzp2)
-            !-- Slopes limitation
-            limitation_slop(zzslpz, zzslpz, zzwzp1, zzwz)
-            limitation_slop(zzslpzp1, zzslpzp1, zzwzp2, zzwzp1)
-            !-- vertical advective flux
-            vertical_adv_flux(zwz(ji,jj,jpk-1), jpk-2, zzslpz, zzslpzp1)
+            vertical_adv_flux(zwz(ji,jj,jpk-1), jpk-2, zzslpz_ptr(ji,jj), zzslpzp1_ptr(ji,jj))
          END_2D