Changeset 9286 for branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

Timestamp:

2018-01-29T10:40:42+01:00 (7 years ago)

Author:

cetlod

Message:

bugfix on ocean kinetic energy dissipation due to vertical friction diag., see ticket #2005

File:

• branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90 (modified) (3 diffs)

branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

@@ -74 +74 @@
       REAL(wp), POINTER, DIMENSION(:,:)   ::  z2d
       REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d
       !!----------------------------------------------------------------------
       !
@@ -354 +355 @@
          !                                ! Note that formally, in a Leap-Frog environment, the shear**2 should be the product of 
          !                                ! now by before shears, i.e. the source term of TKE (local positivity is not ensured).
-         CALL wrk_alloc(jpi,jpj,   z2d )
+         CALL wrk_alloc(jpi, jpj,      z2d )
+         CALL wrk_alloc(jpi, jpj, jpk, z3d )
          z2d(:,:) = 0._wp
-         DO jk = 1, jpkm1
+         z3d(:,:,:) = ua(:,:,:)     ;      CALL lbc_lnk( z3d,'U', -1. )
+         DO jk = 2, jpkm1
             DO jj = 2, jpjm1
-               DO ji = 2, jpim1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
                   z2d(ji,jj) = z2d(ji,jj)  +  (                                                                                  &
-                     &   avmu(ji  ,jj,jk) * ( ua(ji  ,jj,jk-1) - ua(ji  ,jj,jk) )**2 / fse3uw(ji  ,jj,jk) * wumask(ji  ,jj,jk)   &
-                     & + avmu(ji-1,jj,jk) * ( ua(ji-1,jj,jk-1) - ua(ji-1,jj,jk) )**2 / fse3uw(ji-1,jj,jk) * wumask(ji-1,jj,jk)   &
-                     & + avmv(ji,jj  ,jk) * ( va(ji,jj  ,jk-1) - va(ji,jj  ,jk) )**2 / fse3vw(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   &
-                     & + avmv(ji,jj-1,jk) * ( va(ji,jj-1,jk-1) - va(ji,jj-1,jk) )**2 / fse3vw(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   &
+                     &   avmu(ji  ,jj,jk) * ( z3d(ji  ,jj,jk-1) - z3d(ji  ,jj,jk) )**2 / fse3uw(ji  ,jj,jk) * wumask(ji  ,jj,jk)   &
+                     & + avmu(ji-1,jj,jk) * ( z3d(ji-1,jj,jk-1) - z3d(ji-1,jj,jk) )**2 / fse3uw(ji-1,jj,jk) * wumask(ji-1,jj,jk)   &
+                     &                        )
+               END DO
+            END DO
+         END DO
+         z3d(:,:,:) = va(:,:,:)     ;      CALL lbc_lnk( z3d,'V', -1. )
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z2d(ji,jj) = z2d(ji,jj)  +  (                                                                                  &
+                     &   avmv(ji,jj  ,jk) * ( z3d(ji,jj  ,jk-1) - z3d(ji,jj  ,jk) )**2 / fse3vw(ji,jj  ,jk) * wvmask(ji,jj  ,jk)   &
+                     & + avmv(ji,jj-1,jk) * ( z3d(ji,jj-1,jk-1) - z3d(ji,jj-1,jk) )**2 / fse3vw(ji,jj-1,jk) * wvmask(ji,jj-1,jk)   &
                      &                        )
                END DO
@@ -372 +384 @@
          CALL lbc_lnk( z2d,'T', 1. )
          CALL iom_put( 'dispkevfo', z2d )
-         CALL wrk_dealloc(jpi,jpj,   z2d )
+         !
+         CALL wrk_dealloc(jpi, jpj,     z2d  )
+         CALL wrk_dealloc(jpi, jpj, jpk, z3d )
       ENDIF