New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14730 – NEMO

Changeset 14730


Ignore:
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

Location:
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DOM/domqco.F90

    r14667 r14730  
    9696#endif 
    9797      ! 
     98      IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, & 
     99                                                 &                r3u(:,:,Kmm), 'U', 1.0_wp, r3v(:,:,Kmm), 'V', 1.0_wp, r3t(:,:,Kmm), 'T', 1.0_wp, r3f(:,:), 'F', 1.0_wp ) 
    98100   END SUBROUTINE dom_qco_init 
    99101 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DOM/istate.F90

    r14139 r14730  
    152152      ! 
    153153!!gm  the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 
    154       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     154      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    155155         uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
    156156         vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynatf_qco.F90

    r14511 r14730  
    139139         IF( ln_linssh ) THEN             ! Fixed volume ! 
    140140            !                             ! =============! 
    141             DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     141            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    142142               puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    143143               pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    149149            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
    150150               ! Before filtered scale factor at (u/v)-points 
    151                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     151               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    152152                  puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 
    153153                  pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) 
    … …  
    156156            ELSE                          ! Asselin filter applied on thickness weighted velocity 
    157157               ! 
    158                DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     158               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 
    159159                  zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 
    160160                  zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynspg_ts.F90

    r14511 r14730  
    730730      IF (ln_bt_fw) THEN 
    731731         IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 
    732             DO_2D( 1, 1, 1, 1 ) 
     732            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    733733               zun_save = un_adv(ji,jj) 
    734734               zvn_save = vn_adv(ji,jj) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/IOM/restart.F90

    r14239 r14730  
    410410               ssh(:,:,Kbb) = -ssh_ref 
    411411               ! 
    412                DO_2D( 1, 1, 1, 1 ) 
     412               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    413413                  IF( ht_0(ji,jj)-ssh_ref <  rn_wdmin1 ) THEN   ! if total depth is less than min depth 
    414414                     ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv.F90

    r14538 r14730  
    178178         ! 
    179179         CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    180             ! [comm_cleanup] 
    181             ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 
    182180            CALL tra_adv_cen    ( kt, nit000, 'TRA',         zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 
    183181         CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    184182            IF (nn_hls.EQ.2) THEN 
    185                ! [comm_cleanup] - lbc_lnk shifted into step 
    186                ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 
    187                ! CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    188183#if defined key_loop_fusion 
    189184               CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    196191         CASE ( np_MUS )                                 ! MUSCL 
    197192            IF (nn_hls.EQ.2) THEN 
    198                ! [comm_cleanup] - lbc_lnk shifted into step 
    199                ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    200193#if defined key_loop_fusion 
    201194                CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 
    … …  
    207200            END IF 
    208201         CASE ( np_UBS )                                 ! UBS 
    209             ! [comm_cleanup] - lbc_lnk shifted into step 
    210             ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    211202            CALL tra_adv_ubs    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v   ) 
    212203         CASE ( np_QCK )                                 ! QUICKEST 
    213             ! [comm_cleanup] - lbc_lnk shifted into step 
    214             ! IF (nn_hls.EQ.2) THEN 
    215             !   CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    216             !   CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 
    217             ! END IF 
    218204            CALL tra_adv_qck    ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 
    219205         ! 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/USR/usrdef_istate.F90

    r14053 r14730  
    6161      pv  (:,:,:) = 0._wp 
    6262      ! 
    63       DO_3D( 1, 1, 1, 1, 1, jpk )   ! horizontally uniform T & S profiles 
     63      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )   ! horizontally uniform T & S profiles 
    6464         pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   & 
    6565              &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             & 

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

    r14682 r14730  
    170170      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    171171      !  THERMODYNAMICS 
    172       ! [ comm_cleanup ] ! lbc_lnk for AMM12 with blp / triad & for atf_qco with ln_iceberg .true. 
    173       IF( nn_hls.eq.2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1._wp) 
    174172                         CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn )       ! before local thermal/haline expension ratio at T-points 
    175173                         CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn )       ! now    local thermal/haline expension ratio at T-points 
    … …  
    178176 
    179177      !  VERTICAL PHYSICS 
    180       ! [comm_cleanup] ! lbc_lnk from ZDF 
    181       IF (nn_hls.eq.2) THEN 
    182          IF( l_zdfsh2 ) THEN 
    183             CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
    184                &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    185          ELSE 
    186             CALL lbc_lnk( 'stp_MLF', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
    187          ENDIF 
    188       ENDIF 
    189178                         CALL zdf_phy( kstp, Nbb, Nnn, Nrhs )   ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 
    190179 
    … …  
    240229               &         CALL Agrif_Sponge_dyn        ! momentum sponge 
    241230#endif 
    242       ! [comm_cleanup] ! lbc_lnk from DYN 
    243       IF (nn_hls.eq.2) THEN 
    244          CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.,       &  
    245                  &                uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.) 
    246          IF(.NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Nnn), 'U', 1.0_wp, r3v(:,:,Nnn), 'V', 1.0_wp,    & 
    247                  &                                   r3u(:,:,Nbb), 'U', 1.0_wp, r3v(:,:,Nbb), 'V', 1.0_wp,    & 
    248                  &                                   r3t(:,:,Nbb), 'T', 1.0_wp ) 
    249       ENDIF 
    250231                         CALL dyn_adv( kstp, Nbb, Nnn      , uu, vv, Nrhs )  ! advection (VF or FF)   ==> RHS 
    251232                         CALL dyn_vor( kstp,      Nnn      , uu, vv, Nrhs )  ! vorticity              ==> RHS 
    … …  
    267248      ENDIF 
    268249 
     250      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) 
    269251 
    270252      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    292274                         CALL ssh_atf    ( kstp, Nbb, Nnn, Naa, ssh )            ! time filtering of "now" sea surface height 
    293275      IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )   ! "now" ssh/h_0 ratio from filtrered ssh 
    294          ! [comm_cleanup] this should not be needed 
    295          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 ) 
     276      ! 
     277      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 ) 
    296278#if defined key_top 
    297279      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    329311      ENDIF 
    330312#endif 
    331  
    332       ! [comm_cleanup] ! lbc_lnk from tra_adv 
    333       IF (nn_hls.EQ.2) THEN 
    334          SELECT CASE ( nadv ) 
    335          CASE ( np_FCT )                                 ! FCT scheme : 2nd / 4th order 
    336                CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.) 
    337                CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.) 
    338          CASE ( np_MUS )                                 ! MUSCL 
    339                 CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) 
    340          CASE ( np_UBS )                                 ! UBS 
    341                 CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) 
    342          CASE ( np_QCK )                                 ! QUICKEST 
    343                CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.) 
    344                CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.) 
    345          END SELECT 
    346       ENDIF 
    347313 
    348314      ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) 
    … …  
    383349                         CALL tra_atf_qco   ( kstp, Nbb, Nnn, Naa        , ts )   ! time filtering of "now" tracer arrays 
    384350                         CALL dyn_atf_qco   ( kstp, Nbb, Nnn, Naa, uu, vv     )   ! time filtering of "now" velocities 
     351 
     352      IF( nn_hls.eq.2)   CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp) 
     353 
    385354      IF(.NOT.lk_linssh) THEN 
    386355                         r3t(:,:,Nnn) = r3t_f(:,:)                                ! update now ssh/h_0 with time filtered values 
    … …  
    548517                       &          , pts(:,:,:,jp_tem,Kaa), 'T',  1., pts(:,:,:,jp_sal,Kaa), 'T',  1. ) 
    549518      ! 
     519      IF (nn_hls.eq.2) THEN 
     520         IF( l_zdfsh2 ) THEN 
     521            CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp,   & 
     522                &                    avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     523         ELSE 
     524            CALL lbc_lnk( 'stp_MLF', avm  , 'W', 1.0_wp , avt  , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 
     525         ENDIF 
     526      ENDIF 
    550527      !                                        !* BDY open boundaries 
    551528      IF( ln_bdy )   THEN 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/SWE/stprk3.F90

    r14511 r14730  
    172172      ! 
    173173      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     174      ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 
     175      IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    174176      ! 
    175177      !                                 !==  Swap time levels  ==! 
    … …  
    237239      ! 
    238240      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     241      ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 
     242      IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    239243      ! 
    240244      !                                 !==  Swap time levels  ==! 
    … …  
    300304      ! 
    301305      CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 
     306      ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 
     307      IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 
    302308      ! 
    303309      !                                 !==  Swap time levels  ==! 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcadv.F90

    r14511 r14730  
    127127      ! 
    128128      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
    129          IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 
    130129         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    131130      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    132131         IF (nn_hls.EQ.2) THEN 
    133             CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 
    134             CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.) 
    135132#if defined key_loop_fusion 
    136133            CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    … …  
    143140      CASE ( np_MUS )                                 ! MUSCL 
    144141         IF (nn_hls.EQ.2) THEN 
    145             IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    146142#if defined key_loop_fusion 
    147143            CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups )  
    … …  
    153149         END IF 
    154150      CASE ( np_UBS )                                 ! UBS 
    155          IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    156151         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v           ) 
    157152      CASE ( np_QCK )                                 ! QUICKEST 
    158          IF (nn_hls.EQ.2) THEN 
    159             CALL lbc_lnk( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 
    160             CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) 
    161          END IF 
    162153         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    163154      ! 

  • NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/trcdta.F90

    r14086 r14730  
    195195               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    196196            ENDIF 
    197             DO_2D( 1, 1, 1, 1 )                 ! vertical interpolation of T & S 
     197            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                 ! vertical interpolation of T & S 
    198198               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    199199                  zl = gdept_0(ji,jj,jk) 
    … …  
    220220            ! zps-coordinate (partial steps) interpolation at the last ocean level 
    221221            IF( ln_zps ) THEN 
    222                 DO_2D( 1, 1, 1, 1 ) 
     222                DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )  
    223223                   ik = mbkt(ji,jj) 
    224224                   IF( ik > 1 ) THEN 
Note: See TracChangeset for help on using the changeset viewer.