Changeset 11261

Timestamp:

2019-07-12T10:28:39+02:00 (5 years ago)

Author:

girrmann

Message:

dev_r10984_HPC-13 : bugfix, see #2285

File:

• NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynspg_ts.F90 (modified) (7 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynspg_ts.F90

@@ -542 +542 @@
          END DO
          !
-         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', 1._wp,  zhV, 'V', 1._wp )
+         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp )
          !
          !                             ! Sum over sub-time-steps to compute advective velocities
@@ -567 +567 @@
                END DO
             END DO
-            !                    !* Update ocean depth (variable volume case only)
-            hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1)         
-            hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1)
-            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) )
-            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) )
          ENDIF   
          !         
@@ -626 +621 @@
          !     Compute barotropic speeds at step jit+1    (h : total height of the water colomn)
          !--                              VECTOR FORM
-         !--     m+1                    m               /                                     m+1/2           \     --!
-         !--    u     =                u   + delta_t' * \ grad_x( ssh') -         f * k vect u      +     frc /     --!
-         !--                                                                                                        --!
-         !--                             FLUX FORM                                                                  --!
-         !--   m+1    ___1___   /  m    m               /                  m+1/2              m+1/2    n      \  \  --!
-         !--  u    =     m+1   |  h  * u   + delta_t' * \ grad_x( ssh') - h     * f * k vect u      + h * frc /   | --!
-         !--            h       \                                                                                /  --!
-         !------------------------------------------------------------------------------------------------------------!
+         !--   m+1                 m               /                                                       m+1/2           \    --!
+         !--  u     =             u   + delta_t' * \         (1-r)*g * grad_x( ssh') -         f * k vect u      +     frc /    --!
+         !--                                                                                                                    --!
+         !--                             FLUX FORM                                                                              --!
+         !--  m+1   __1__  /  m    m               /  m+1/2                             m+1/2              m+1/2    n      \ \  --!
+         !-- u    =   m+1 |  h  * u   + delta_t' * \ h     * (1-r)*g * grad_x( ssh') - h     * f * k vect u      + h * frc /  | --!
+         !--         h     \                                                                                                 /  --!
+         !------------------------------------------------------------------------------------------------------------------------!
          IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form
             DO jj = 2, jpjm1
@@ -654 +649 @@
             DO jj = 2, jpjm1
                DO ji = 2, jpim1
-                  !                    ! backward extrapolated depth used in spg terms at jn+1/2
+                  !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2
+                  !                    ! backward interpolated depth used in spg terms at jn+1/2
                   zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    &
                        &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj)
@@ -661 +657 @@
                   !                    ! inverse depth at jn+1
                   z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) )
-                  z1_hv = ssvmask(ji,jj) / ( hu_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
+                  z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) )
                   !
                   ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      & 
@@ -671 +667 @@
                        &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   !
                        &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   !
-                       &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hu
+                       &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv
                END DO
             END DO
@@ -685 +681 @@
          ENDIF
        
-         IF( .NOT. ln_linssh ) THEN                      !* domain lateral boundary
+         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only)
+            hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1)
+            hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) )
+            hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1)
+            hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) )
             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  &
-                 &                         , hu_e , 'U',  1._wp, hv_e , 'V',  1._wp  &
-                 &                         , hur_e, 'U',  1._wp, hvr_e, 'V',  1._wp  )
-            !
+                 &                         , hu_e , 'U', -1._wp, hv_e , 'V', -1._wp  &
+                 &                         , hur_e, 'U', -1._wp, hvr_e, 'V', -1._wp  )
+         ELSE
+            CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  )
          ELSE                                            !* domain lateral boundary
             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  )
             !
          ENDIF
+         !
          !
          !                                                 ! open boundaries