Changeset 14730 for NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90

Timestamp:

2021-04-19T17:31:10+02:00 (3 years ago)

Author:

francesca

Message:

lbc_lnk reordering in stp_MLF and other adjustments - ticket #2607

File:

• NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90 (modified) (8 diffs)

NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90

@@ -170 +170 @@
       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       !  THERMODYNAMICS
-      ! [ comm_cleanup ] ! lbc_lnk for AMM12 with blp / triad & for atf_qco with ln_iceberg .true.
-      IF( nn_hls.eq.2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1._wp)
                          CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points
                          CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points
@@ -178 +176 @@
 
       !  VERTICAL PHYSICS
-      ! [comm_cleanup] ! lbc_lnk from ZDF
-      IF (nn_hls.eq.2) THEN
-         IF( l_zdfsh2 ) THEN
-            CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   &
-               &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
-         ELSE
-            CALL lbc_lnk( 'stp_MLF', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
-         ENDIF
-      ENDIF
                          CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD)
 
@@ -240 +229 @@
                &         CALL Agrif_Sponge_dyn        ! momentum sponge
 #endif
-      ! [comm_cleanup] ! lbc_lnk from DYN
-      IF (nn_hls.eq.2) THEN
-         CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.,       & 
-                 &                uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.)
-         IF(.NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Nnn), 'U', 1.0_wp, r3v(:,:,Nnn), 'V', 1.0_wp,    &
-                 &                                   r3u(:,:,Nbb), 'U', 1.0_wp, r3v(:,:,Nbb), 'V', 1.0_wp,    &
-                 &                                   r3t(:,:,Nbb), 'T', 1.0_wp )
-      ENDIF
                          CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS
                          CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS
@@ -267 +248 @@
       ENDIF
 
+      IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp)
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -292 +274 @@
                          CALL ssh_atf    ( kstp, Nbb, Nnn, Naa, ssh )            ! time filtering of "now" sea surface height
       IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh
-         ! [comm_cleanup] this should not be needed
-         IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp )
+      !
+      IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp, r3t_f, 'T', 1.0_wp )
 #if defined key_top
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -329 +311 @@
       ENDIF
 #endif
-
-      ! [comm_cleanup] ! lbc_lnk from tra_adv
-      IF (nn_hls.EQ.2) THEN
-         SELECT CASE ( nadv )
-         CASE ( np_FCT )                                 ! FCT scheme : 2nd / 4th order
-               CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.)
-               CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.)
-         CASE ( np_MUS )                                 ! MUSCL
-                CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.)
-         CASE ( np_UBS )                                 ! UBS
-                CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.)
-         CASE ( np_QCK )                                 ! QUICKEST
-               CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.)
-               CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.)
-         END SELECT
-      ENDIF
 
       ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling)
@@ -383 +349 @@
                          CALL tra_atf_qco   ( kstp, Nbb, Nnn, Naa        , ts )   ! time filtering of "now" tracer arrays
                          CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv     )   ! time filtering of "now" velocities
+
+      IF( nn_hls.eq.2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp)
+
       IF(.NOT.lk_linssh) THEN
                          r3t(:,:,Nnn) = r3t_f(:,:)                                ! update now ssh/h_0 with time filtered values
@@ -548 +517 @@
                        &          , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. )
       !
+      IF (nn_hls.eq.2) THEN
+         IF( l_zdfsh2 ) THEN
+            CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   &
+                &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
+         ELSE
+            CALL lbc_lnk( 'stp_MLF', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp )
+         ENDIF
+      ENDIF
       !                                        !* BDY open boundaries
       IF( ln_bdy )   THEN