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 2338 for branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90 – NEMO

Ignore:
Timestamp:
2010-10-29T10:45:18+02:00 (13 years ago)
Author:
rblod
Message:

Fix pb with vvl and time splitting, see ticket #748

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r2305 r2338  
    5151   REAL(wp), DIMENSION(jpi,jpj) ::  ftsw, ftse   ! (only used with een vorticity scheme) 
    5252 
    53    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   un_b, vn_b   ! averaged velocity 
     53   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   un_b, vn_b   ! now    averaged velocity 
     54   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ub_b, vb_b   ! before averaged velocity 
     55 
    5456 
    5557   !! * Substitutions 
     
    8284      !!          momentum and continuity integration. Barotropic former  
    8385      !!          variables are time averaging over the full barotropic cycle 
    84       !!          (= 2 * baroclinic time step) and saved in zuX_b  
    85       !!          and zvX_b (X specifying after, now or before). 
     86      !!          (= 2 * baroclinic time step) and saved in uX_b  
     87      !!          and vX_b (X specifying after, now or before). 
    8688      !!      -3- The new general trend becomes : 
    87       !!          ua = ua - sum_k(ua)/H + ( ua_e - sum_k(ub) ) 
     89      !!          ua = ua - sum_k(ua)/H + ( un_b - ub_b ) 
    8890      !! 
    8991      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 
     
    109111      REAL(wp), DIMENSION(jpi,jpj) ::   zsshun_e, zsshvn_e   ! 2D workspace 
    110112      !! 
    111       REAL(wp), DIMENSION(jpi,jpj) ::   zcu, zwx, zua, zun, zub   ! 2D workspace 
    112       REAL(wp), DIMENSION(jpi,jpj) ::   zcv, zwy, zva, zvn, zvb   !  -      - 
     113      REAL(wp), DIMENSION(jpi,jpj) ::   zcu, zwx, zua, zun   ! 2D workspace 
     114      REAL(wp), DIMENSION(jpi,jpj) ::   zcv, zwy, zva, zvn   !  -      - 
    113115      REAL(wp), DIMENSION(jpi,jpj) ::   zun_e, zub_e, zu_sum      ! 2D workspace 
    114116      REAL(wp), DIMENSION(jpi,jpj) ::   zvn_e, zvb_e, zv_sum      !  -      - 
     
    161163      !                                   !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 
    162164      !                                   ! -------------------------- 
    163       zua(:,:) = 0.e0   ;   zun(:,:) = 0.e0   ;   zub(:,:) = 0.e0 
    164       zva(:,:) = 0.e0   ;   zvn(:,:) = 0.e0   ;   zvb(:,:) = 0.e0 
     165      zua(:,:) = 0.e0   ;   zun(:,:) = 0.e0  
     166      zva(:,:) = 0.e0   ;   zvn(:,:) = 0.e0  
    165167      ! 
    166168      DO jk = 1, jpkm1 
     
    178180               zun(ji,jj) = zun(ji,jj) + fse3u  (ji,jj,jk) * un(ji,jj,jk) 
    179181               zvn(ji,jj) = zvn(ji,jj) + fse3v  (ji,jj,jk) * vn(ji,jj,jk)                
    180                !                                                                              ! before velocity 
    181                zub(ji,jj) = zub(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)  
    182                zvb(ji,jj) = zvb(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 
    183182            END DO 
    184183         END DO 
     
    280279         DO jj = 2, jpjm1 
    281280            DO ji = fs_2, fs_jpim1   ! vector opt. 
    282                zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj)   & 
     281               zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj)   & 
    283282                  &       / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1.e0 - umask(ji,jj,1) ) 
    284                zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj)   & 
     283               zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj)   & 
    285284                  &       / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1.e0 - vmask(ji,jj,1) ) 
    286285            END DO 
     
    289288         DO jj = 2, jpjm1 
    290289            DO ji = fs_2, fs_jpim1   ! vector opt. 
    291                zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj) * hur(ji,jj) 
    292                zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj) * hvr(ji,jj) 
     290               zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 
     291               zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 
    293292            END DO 
    294293         END DO 
     
    300299      zva(:,:) = zva(:,:) * hvr(:,:) 
    301300      ! 
    302       IF( lk_vvl ) THEN 
    303          zub(:,:) = zub(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) ) 
    304          zvb(:,:) = zvb(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) ) 
    305       ELSE 
    306          zub(:,:) = zub(:,:) * hur(:,:) 
    307          zvb(:,:) = zvb(:,:) * hvr(:,:) 
    308       ENDIF 
    309301 
    310302      ! ----------------------------------------------------------------------- 
     
    352344         !                                                !* Update the forcing (OBC, BDY and tides) 
    353345         !                                                !  ------------------ 
    354          IF( lk_obc )   CALL obc_dta_bt( kt, jn   ) 
     346         IF( lk_obc )   CALL obc_dta_bt ( kt, jn   ) 
    355347         IF( lk_bdy )   CALL bdy_dta_fla( kt, jn+1, icycle ) 
    356348 
     
    476468         !                                                      !         - Correct the velocity 
    477469 
    478          IF( lk_obc                   )   CALL obc_fla_ts 
    479          IF( lk_bdy .OR. ln_bdy_tides )   CALL bdy_dyn_fla( sshn_e )  
     470         IF( lk_obc               )   CALL obc_fla_ts 
     471         IF( lk_bdy .OR. ln_tides )   CALL bdy_dyn_fla( sshn_e )  
    480472         ! 
    481473         CALL lbc_lnk( ua_e  , 'U', -1. )                      ! local domain boundaries  
     
    543535      !                                   !* Time average ==> after barotropic u, v, ssh 
    544536      zcoef =  1.e0 / ( 2 * nn_baro  + 1 )  
    545       un_b  (:,:) = zcoef * zu_sum  (:,:)  
    546       vn_b  (:,:) = zcoef * zv_sum  (:,:)  
    547       sshn_b(:,:) = zcoef * zssh_sum(:,:)  
     537      zu_sum(:,:) = zcoef * zu_sum  (:,:)  
     538      zv_sum(:,:) = zcoef * zv_sum  (:,:)  
    548539      !  
    549540      !                                   !* update the general momentum trend 
    550541      DO jk=1,jpkm1 
    551          ua(:,:,jk) = ua(:,:,jk) + ( un_b(:,:) - zub(:,:) ) / z2dt_b 
    552          va(:,:,jk) = va(:,:,jk) + ( vn_b(:,:) - zvb(:,:) ) / z2dt_b 
     542         ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) / z2dt_b 
     543         va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) / z2dt_b 
    553544      END DO 
     545      ub_b (:,:) = un_b(:,:) 
     546      vb_b (:,:) = vn_b(:,:) 
     547      un_b  (:,:) =  zu_sum(:,:)  
     548      vn_b  (:,:) =  zv_sum(:,:)  
     549      sshn_b(:,:) = zcoef * zssh_sum(:,:)  
    554550      ! 
    555551      !                                   !* write time-spliting arrays in the restart 
     
    596592            vn_b (:,:) = vn_b(:,:) * hvr(:,:) 
    597593         ENDIF 
     594 
     595         ! Vertically integrated velocity (before) 
     596         IF (neuler/=0) THEN 
     597            ub_b (:,:) = 0.e0 
     598            vb_b (:,:) = 0.e0 
     599 
     600            ! vertical sum 
     601            IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll 
     602               DO jk = 1, jpkm1 
     603                  DO ji = 1, jpij 
     604                     ub_b(ji,1) = ub_b(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk) 
     605                     vb_b(ji,1) = vb_b(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk) 
     606                  END DO 
     607               END DO 
     608            ELSE                             ! No  vector opt. 
     609               DO jk = 1, jpkm1 
     610                  ub_b(:,:) = ub_b(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) 
     611                  vb_b(:,:) = vb_b(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) 
     612               END DO 
     613            ENDIF 
     614 
     615            IF( lk_vvl ) THEN 
     616               ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) ) 
     617               vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) ) 
     618            ELSE 
     619               ub_b(:,:) = ub_b(:,:) * hur(:,:) 
     620               vb_b(:,:) = vb_b(:,:) * hvr(:,:) 
     621            ENDIF 
     622         ELSE                                 ! neuler==0 
     623            ub_b (:,:) = un_b (:,:) 
     624            vb_b (:,:) = vn_b (:,:) 
     625         ENDIF 
     626 
    598627         IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN 
    599628            CALL iom_get( numror, jpdom_autoglo, 'sshn_b' , sshn_b (:,:) )   ! filtered extrenal ssh 
Note: See TracChangeset for help on using the changeset viewer.