Changeset 13419

Timestamp:

2020-08-21T13:04:45+02:00 (4 years ago)

Author:

smueller

Message:

Addition of variable allocations/deallocations and harmonisation of subroutine dyn_zdf_imp_adj with its tangent-linear counterpart (application of the patch attached to ticket #1362)

File:

• NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynzdf_imp_tam.F90 (modified) (6 diffs)

NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynzdf_imp_tam.F90

@@ -80 +80 @@
       !
       CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws )
+      CALL wrk_alloc( jpi,jpj, zavmu, zavmv)
       !
       IF( kt == nit000 ) THEN
@@ -321 +322 @@
       !
       CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)
+      CALL wrk_dealloc( jpi,jpj, zavmu, zavmv)
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp_tan')
@@ -353 +355 @@
       !! * Local declarations
       !! * Local declarations
-      INTEGER ::   ji, jj, jk                          ! dummy loop indices
+      INTEGER ::   ji, jj, jk, ikbu, ikbv                      ! dummy loop indices
       REAL(wp) ::   z1_p2dt, z2dtf, zcoef, zzws, zrhsad ! temporary scalars
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zws, zwd! temporary workspace arrays
+      REAL(wp), POINTER, DIMENSION(:,:):: zavmu, zavmv         ! temporary workspace arrays
       !!----------------------------------------------------------------------
       !
@@ -361 +364 @@
       !
       CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws )
+      CALL wrk_alloc( jpi,jpj, zavmu, zavmv )
       !
       IF( kt == nitend ) THEN
@@ -372 +376 @@
       zrhsad = 0.0_wp
       !
-      !! restore bottom layer avmu(v)
+      !
+      ! 1. Apply semi-implicit bottom friction
+      ! --------------------------------------
+      ! Only needed for semi-implicit bottom friction setup. The explicit
+      ! bottom friction has been included in "u(v)a" which act as the R.H.S
+      ! column vector of the tri-diagonal matrix equation
+      !
       IF( ln_bfrimp ) THEN
-!# if defined key_vectopt_loop
-      !DO jj = 1, 1
-         !DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-!# else
-      !DO jj = 2, jpjm1
-         !DO ji = 2, jpim1
-!# endif
-            !ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points
-            !ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
-            !avmu(ji,jj,ikbu+1) = zavmu(ji,jj)
-            !avmv(ji,jj,ikbv+1) = zavmv(ji,jj)
-         !END DO
-      !END DO
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points
+            ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+            zavmu(ji,jj) = avmu(ji,jj,ikbu+1)
+            zavmv(ji,jj) = avmv(ji,jj,ikbv+1)
+            avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)
+            avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)
+         END DO
+      END DO
       ENDIF
       !
@@ -578 +590 @@
          END DO
       END DO
-      !
-      ! 1. Apply semi-implicit bottom friction
-      ! --------------------------------------
-      ! Only needed for semi-implicit bottom friction setup. The explicit
-      ! bottom friction has been included in "u(v)a" which act as the R.H.S
-      ! column vector of the tri-diagonal matrix equation
-      !
+      !! restore bottom layer avmu(v)
       IF( ln_bfrimp ) THEN
-!# if defined key_vectopt_loop
-      !DO jj = 1, 1
-         !DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-!# else
-      !DO jj = 2, jpjm1
-         !DO ji = 2, jpim1
-!# endif
-            !ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points
-            !ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
-            !zavmu(ji,jj) = avmu(ji,jj,ikbu+1)
-            !zavmv(ji,jj) = avmv(ji,jj,ikbv+1)
-            !avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1)
-            !avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)
-         !END DO
-      !END DO
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points
+            ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+            avmu(ji,jj,ikbu+1) = zavmu(ji,jj)
+            avmv(ji,jj,ikbv+1) = zavmv(ji,jj)
+         END DO
+      END DO
       ENDIF
       !
       CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws)
+      CALL wrk_dealloc( jpi,jpj, zavmu, zavmv)
       !
       IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp_adj')