Changeset 15563 for NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM

Timestamp:

2021-12-01T16:50:19+01:00 (3 years ago)

Author:

jchanut

Message:

#1791, correct bottom scale factors interpolation at U/V/F points with non-linear free surface

File:

• NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM/domvvl.F90 (modified) (4 diffs)

NEMO/releases/r4.0/r4.0-HEAD/src/OCE/DOM/domvvl.F90

@@ -719 +719 @@
       !
       INTEGER ::   ji, jj, jk                                       ! dummy loop indices
+      INTEGER ::   iku, ikum1, ikv, ikvm1, ikf, ikfm1               ! 
       REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd_il = T/F
       !!----------------------------------------------------------------------
@@ -740 +741 @@
             END DO
          END DO
+         !
+         ! Bottom correction:
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               iku    = mbku(ji  ,jj)
+               ikum1  = iku - 1
+               pe3_out(ji,jj,iku) = ( umask(ji,jj,iku) * (1.0_wp - zlnwd) + zlnwd )                              & 
+                  &      *(  0.5_wp * r1_e1e2u(ji,jj)                                                            &
+                  &      *(  e1e2t(ji  ,jj) * ( SUM(tmask(ji  ,jj,:)*(pe3_in(ji  ,jj,:) - e3t_0(ji  ,jj,:))) )   &
+                  &        + e1e2t(ji+1,jj) * ( SUM(tmask(ji+1,jj,:)*(pe3_in(ji+1,jj,:) - e3t_0(ji+1,jj,:))) ) ) &
+                  &     - SUM(pe3_out(ji,jj,1:ikum1)))
+            END DO
+         END DO
+         !
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:)
@@ -753 +768 @@
             END DO
          END DO
+         !
+         ! Bottom correction:
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ikv    = mbkv(ji  ,jj)
+               ikvm1  = ikv - 1
+               pe3_out(ji,jj,ikv) = ( vmask(ji,jj,ikv) * (1.0_wp - zlnwd) + zlnwd )                              & 
+                  &      *(  0.5_wp * r1_e1e2v(ji,jj)                                                            &
+                  &      *(  e1e2t(ji,jj  ) * ( SUM(tmask(ji,jj  ,:)*(pe3_in(ji,jj  ,:) - e3t_0(ji,jj  ,:))) )   &
+                  &        + e1e2t(ji,jj+1) * ( SUM(tmask(ji,jj+1,:)*(pe3_in(ji,jj+1,:) - e3t_0(ji,jj+1,:))) ) ) &
+                  &     - SUM(pe3_out(ji,jj,1:ikvm1)))
+            END DO
+         END DO
+         !
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:)
@@ -767 +796 @@
             END DO
          END DO
+         !
+         ! Bottom correction:
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ikf    = MIN(mbku(ji  ,jj),mbku(ji,jj+1))
+               ikfm1  = ikf - 1
+               pe3_out(ji,jj,ikf) = ( umask(ji,jj,ikf) * umask(ji,jj+1,ikf) * (1.0_wp - zlnwd) + zlnwd )         &
+                  &     * ( 0.5_wp *  r1_e1e2f(ji,jj)                                                            &
+                  &     * (  e1e2u(ji,jj  ) * ( SUM(umask(ji,jj  ,:)*(pe3_in(ji,jj  ,:) - e3u_0(ji,jj  ,:))) )   &
+                  &        + e1e2u(ji,jj+1) * ( SUM(umask(ji,jj+1,:)*(pe3_in(ji,jj+1,:) - e3u_0(ji,jj+1,:))) ) ) &
+                  &     - SUM(pe3_out(ji,jj,1:ikfm1)))
+            END DO
+         END DO
+         !
          CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp )
          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:)