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 13151 for NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/DYN/dynspg_ts.F90 – NEMO

Ignore:
Timestamp:
2020-06-24T14:38:26+02:00 (4 years ago)
Author:
gm
Message:

result from merge with qco r12983

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/OCE/DYN/dynspg_ts.F90

    r12489 r13151  
    8787   !! * Substitutions 
    8888#  include "do_loop_substitute.h90" 
     89#  include "domzgr_substitute.h90" 
    8990   !!---------------------------------------------------------------------- 
    9091   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    161162      REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points 
    162163      REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV         ! fluxes 
     164      REAL(wp), DIMENSION(jpi, jpj, jpk) :: ze3u, ze3v 
    163165      ! 
    164166      REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_wd_dl = .True.  
     
    227229      !                                   !=  zu_frc =  1/H e3*d/dt(Ua)  =!  (Vertical mean of Ua, the 3D trends) 
    228230      !                                   !  ---------------------------  ! 
    229       zu_frc(:,:) = SUM( e3u(:,:,:,Kmm) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 
    230       zv_frc(:,:) = SUM( e3v(:,:,:,Kmm) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 
     231      DO jk = 1 , jpk 
     232         ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 
     233         ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 
     234      END DO 
     235      ! 
     236      zu_frc(:,:) = SUM( ze3u(:,:,:) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 
     237      zv_frc(:,:) = SUM( ze3v(:,:,:) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 
    231238      ! 
    232239      ! 
     
    250257      zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
    251258      ! 
    252       CALL dyn_cor_2d( hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
     259      CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
    253260         &                                                                     zu_trd, zv_trd   )   ! ==>> out 
    254261      ! 
     
    567574         ! at each time step. We however keep them constant here for optimization. 
    568575         ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 
    569          CALL dyn_cor_2d( zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
     576         CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
    570577         ! 
    571578         ! Add tidal astronomical forcing if defined 
     
    10881095      ! 
    10891096      SELECT CASE( nvor_scheme ) 
    1090       CASE( np_EEN )                != EEN scheme using e3f (energy & enstrophy scheme) 
     1097      CASE( np_EEN )                != EEN scheme using e3f energy & enstrophy scheme 
    10911098         SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    10921099         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     
    11151122         END_2D 
    11161123         ! 
    1117       CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme) 
     1124      CASE( np_EET )                  != EEN scheme using e3t energy conserving scheme 
    11181125         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    11191126         DO_2D_01_01 
     
    11791186 
    11801187 
    1181    SUBROUTINE dyn_cor_2d( phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   ) 
     1188   SUBROUTINE dyn_cor_2d( pht, phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   ) 
    11821189      !!--------------------------------------------------------------------- 
    11831190      !!                   ***  ROUTINE dyn_cor_2d  *** 
     
    11871194      INTEGER  ::   ji ,jj                             ! dummy loop indices 
    11881195      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      - 
    1189       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phu, phv, punb, pvnb, zhU, zhV 
     1196      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pht, phu, phv, punb, pvnb, zhU, zhV 
    11901197      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd 
    11911198      !!---------------------------------------------------------------------- 
     
    11961203            z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    11971204            zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    & 
    1198                &               * (  e1e2t(ji+1,jj)*ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   & 
    1199                &                  + e1e2t(ji  ,jj)*ht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   ) 
     1205               &               * (  e1e2t(ji+1,jj)*pht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   & 
     1206               &                  + e1e2t(ji  ,jj)*pht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   ) 
    12001207               ! 
    12011208            zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    & 
    1202                &               * (  e1e2t(ji,jj+1)*ht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   &  
    1203                &                  + e1e2t(ji,jj  )*ht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   )  
     1209               &               * (  e1e2t(ji,jj+1)*pht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   &  
     1210               &                  + e1e2t(ji,jj  )*pht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   )  
    12041211         END_2D 
    12051212         !          
Note: See TracChangeset for help on using the changeset viewer.