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 11240 – NEMO

Changeset 11240


Ignore:
Timestamp:
2019-07-10T11:08:58+02:00 (5 years ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : remove a communication in dyn_spg_ts, see #2285

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynspg_ts.F90

    r11234 r11240  
    149149      LOGICAL  ::   ll_fw_start           ! =T : forward integration  
    150150      LOGICAL  ::   ll_init               ! =T : special startup of 2d equations 
    151       LOGICAL  ::   ll_tmp1, ll_tmp2      ! local logical variables used in W/D 
    152       INTEGER  ::   ikbu, iktu, noffset   ! local integers 
    153       INTEGER  ::   ikbv, iktv            !   -      - 
    154       REAL(wp) ::   r1_2dt_b, z2dt_bf               ! local scalars 
    155       REAL(wp) ::   zx1, zx2, zhura        , z1_hu  !   -      - 
    156       REAL(wp) ::   zy1, zy2, zhvra        , z1_hv  !   -      - 
     151      INTEGER  ::   noffset               ! local integers  : time offset for bdy update 
     152      REAL(wp) ::   r1_2dt_b, z1_hu, z1_hv          ! local scalars 
    157153      REAL(wp) ::   za0, za1, za2, za3              !   -      - 
    158       REAL(wp) ::   zmdi, zztmp, zldg      , z1_ht  !   -      - 
    159       REAL(wp) ::   zhu_bck, zhv_bck                !   -      - 
     154      REAL(wp) ::   zmdi, zztmp, zldg               !   -      - 
     155      REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      - 
    160156      REAL(wp) ::   zun_save, zvn_save              !   -      - 
    161       REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e 
    162       REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zu_spg, zssh_frc 
    163       REAL(wp), DIMENSION(jpi,jpj) :: zwy, zv_trd, zv_frc, zv_spg, zhdiv 
    164       REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhust_e, zhtp2_e 
    165       REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zhvst_e 
     157      REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc 
     158      REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg 
     159      REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e 
     160      REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e 
    166161      REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points 
    167162      REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV         ! fluxes 
     
    462457            IF( ln_wd_dl )   CALL wad_tmsk( zsshp2_e, ztwdmask ) 
    463458            ! 
    464             DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    465                DO ji = 2, fs_jpim1   ! Vector opt. 
    466                   zwx(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj)     & 
    467                      &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    468                      &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 
    469                   zwy(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj)     & 
    470                      &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    471                      &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 
    472                END DO 
    473             END DO 
    474             CALL lbc_lnk_multi( 'dynspg_ts', zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 
     459            !                          ! ocean t-depth at mid-step 
     460            zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 
    475461            ! 
    476             zhup2_e(:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points 
    477             zhvp2_e(:,:) = hv_0(:,:) + zwy(:,:) 
    478             zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 
     462            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
     463            DO jj = 1, jpj 
     464               DO ji = 1, jpim1   ! not jpi-column 
     465                  zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
     466                       &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
     467                       &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
     468               END DO 
     469            END DO 
     470            DO jj = 1, jpj        ! not jpj-row 
     471               DO ji = 1, jpim1 
     472                  zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
     473                       &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     474                       &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
     475               END DO 
     476            END DO 
    479477            ! 
    480478         ENDIF 
     
    486484         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 
    487485         ! 
    488          zhU(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5 
    489          zhV(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
     486         !                             ! resulting flux at mid-step (not over the full domain) 
     487         zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column 
     488         zhV(1:jpi  ,1:jpjm1) = e1v(1:jpi  ,1:jpjm1) * va_e(1:jpi  ,1:jpjm1) * zhvp2_e(1:jpi  ,1:jpjm1)   ! not jpj-row 
    490489         ! 
    491490#if defined key_agrif 
     
    518517         ENDIF 
    519518#endif 
    520          IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt) 
     519         IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt)    !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV 
    521520 
    522521         IF( ln_wd_dl ) THEN           ! un_e and vn_e are set to zero at faces where  
    523522            !                          ! the direction of the flow is from dry cells 
    524             CALL wad_Umsk( ztwdmask, zhU, zhV, un_e, vn_e, zuwdmask, zvwdmask ) 
     523            CALL wad_Umsk( ztwdmask, zhU, zhV, un_e, vn_e, zuwdmask, zvwdmask )   ! not jpi colomn for U, not jpj row for V 
    525524            ! 
    526525         ENDIF     
    527526         ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc=True)  
    528527         IF ( ln_wd_dl_bc ) THEN 
    529             zuwdav2(:,:) = zuwdav2(:,:) + za2 * zuwdmask(:,:) 
    530             zvwdav2(:,:) = zvwdav2(:,:) + za2 * zvwdmask(:,:) 
    531          END IF  
    532           
    533          ! Sum over sub-time-steps to compute advective velocities 
    534          !  
    535          za2 = wgtbtp2(jn) 
    536          un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:) 
    537          vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:) 
    538  
    539          ! Set next sea level: 
    540          DO jj = 2, jpjm1                                  
    541             DO ji = fs_2, fs_jpim1   ! vector opt. 
    542                zhdiv(ji,jj) = (   zhU(ji,jj) - zhU(ji-1,jj)   & 
    543                   &             + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    544             END DO 
    545          END DO 
     528            zuwdav2(1:jpim1,1:jpj  ) = zuwdav2(1:jpim1,1:jpj  ) + za2 * zuwdmask(1:jpim1,1:jpj  )   ! not jpi-column 
     529            zvwdav2(1:jpi  ,1:jpjm1) = zvwdav2(1:jpi  ,1:jpjm1) + za2 * zvwdmask(1:jpi  ,1:jpjm1)   ! not jpj-row 
     530         END IF 
     531         ! 
     532         ! 
    546533         !     Compute Sea Level at step jit+1 
    547534         !--           m+1        m                               m+1/2          --! 
    548535         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
    549536         !-------------------------------------------------------------------------! 
    550          ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
    551           
    552          CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T',  1._wp ) 
    553  
     537         DO jj = 2, jpjm1        ! INNER domain                              
     538            DO ji = 2, jpim1 
     539               zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
     540               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
     541            END DO 
     542         END DO 
     543         ! 
     544         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', 1._wp,  zhV, 'V', 1._wp ) 
     545         ! 
     546         !                             ! Sum over sub-time-steps to compute advective velocities 
     547         za2 = wgtbtp2(jn)             ! zhU, zhV hold fluxes extrapolated at jn+0.5 
     548         un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:) 
     549         vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:) 
     550         ! 
    554551         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
    555552         IF( ln_bdy )   CALL bdy_ssh( ssha_e ) 
     
    652649         ELSE                           !* Flux form 
    653650            DO jj = 2, jpjm1 
    654                DO ji = fs_2, fs_jpim1   ! vector opt. 
     651               DO ji = 2, jpim1 
    655652                  !                    ! backward extrapolated depth used in spg terms at jn+1/2 
    656653                  zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    & 
     
    11331130      REAL(wp), DIMENSION(jpi,jpj) :: zhf 
    11341131      !!---------------------------------------------------------------------- 
    1135       ! 
    11361132      ! 
    11371133      SELECT CASE( nvor_scheme ) 
Note: See TracChangeset for help on using the changeset viewer.