Changeset 14072 for NEMO/trunk/src/OCE/DYN/dynatf.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DYN/dynatf.F90
r13472 r14072 13 13 !! - ! 2002-10 (C. Talandier, A-M. Treguier) Open boundary cond. 14 14 !! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 15 !! 2.3 ! 2007-07 (D. Storkey) Calls to BDY routines. 15 !! 2.3 ! 2007-07 (D. Storkey) Calls to BDY routines. 16 16 !! 3.2 ! 2009-06 (G. Madec, R.Benshila) re-introduce the vvl option 17 17 !! 3.3 ! 2010-09 (D. Storkey, E.O'Dea) Bug fix for BDY module … … 22 22 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) Rename dynnxt.F90 -> dynatf.F90. Now just does time filtering. 23 23 !!------------------------------------------------------------------------- 24 24 25 25 !!---------------------------------------------------------------------------------------------- 26 26 !! dyn_atf : apply Asselin time filtering to "now" velocities and vertical scale factors … … 42 42 USE trdken ! trend manager: kinetic energy 43 43 USE isf_oce , ONLY: ln_isf ! ice shelf 44 USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine 44 USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine 45 45 ! 46 46 USE in_out_manager ! I/O manager … … 81 81 !!---------------------------------------------------------------------- 82 82 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 83 !! $Id$ 83 !! $Id$ 84 84 !! Software governed by the CeCILL license (see ./LICENSE) 85 85 !!---------------------------------------------------------------------- … … 89 89 !!---------------------------------------------------------------------- 90 90 !! *** ROUTINE dyn_atf *** 91 !! 92 !! ** Purpose : Finalize after horizontal velocity. Apply the boundary 91 !! 92 !! ** Purpose : Finalize after horizontal velocity. Apply the boundary 93 93 !! condition on the after velocity and apply the Asselin time 94 94 !! filter to the now fields. … … 97 97 !! estimate (ln_dynspg_ts=T) 98 98 !! 99 !! * Apply lateral boundary conditions on after velocity 99 !! * Apply lateral boundary conditions on after velocity 100 100 !! at the local domain boundaries through lbc_lnk call, 101 101 !! at the one-way open boundaries (ln_bdy=T), … … 104 104 !! * Apply the Asselin time filter to the now fields 105 105 !! arrays to start the next time step: 106 !! (puu(Kmm),pvv(Kmm)) = (puu(Kmm),pvv(Kmm)) 106 !! (puu(Kmm),pvv(Kmm)) = (puu(Kmm),pvv(Kmm)) 107 107 !! + rn_atfp [ (puu(Kbb),pvv(Kbb)) + (puu(Kaa),pvv(Kaa)) - 2 (puu(Kmm),pvv(Kmm)) ] 108 108 !! Note that with flux form advection and non linear free surface, … … 110 110 !! As a result, dyn_atf MUST be called after tra_atf. 111 111 !! 112 !! ** Action : puu(Kmm),pvv(Kmm) filtered now horizontal velocity 112 !! ** Action : puu(Kmm),pvv(Kmm) filtered now horizontal velocity 113 113 !!---------------------------------------------------------------------- 114 114 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 122 122 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve, zwfld 123 123 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zutau, zvtau 124 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3t_f, ze3u_f, ze3v_f, zua, zva 124 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3t_f, ze3u_f, ze3v_f, zua, zva 125 125 !!---------------------------------------------------------------------- 126 126 ! … … 150 150 ! 151 151 IF( .NOT.ln_bt_fw ) THEN 152 ! Remove advective velocity from "now velocities" 153 ! prior to asselin filtering 154 ! In the forward case, this is done below after asselin filtering 155 ! so that asselin contribution is removed at the same time 152 ! Remove advective velocity from "now velocities" 153 ! prior to asselin filtering 154 ! In the forward case, this is done below after asselin filtering 155 ! so that asselin contribution is removed at the same time 156 156 DO jk = 1, jpkm1 157 157 puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk) 158 158 pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk) 159 END DO 159 END DO 160 160 ENDIF 161 161 ENDIF 162 162 163 163 ! Update after velocity on domain lateral boundaries 164 ! -------------------------------------------------- 164 ! -------------------------------------------------- 165 165 # if defined key_agrif 166 166 CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries … … 194 194 ! Time filter and swap of dynamics arrays 195 195 ! ------------------------------------------ 196 197 IF( .NOT. l_1st_euler ) THEN !* Leap-Frog : Asselin time filter 196 197 IF( .NOT. l_1st_euler ) THEN !* Leap-Frog : Asselin time filter 198 198 ! ! =============! 199 199 IF( ln_linssh ) THEN ! Fixed volume ! … … 220 220 DO jk = 1, jpkm1 221 221 ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 222 & * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) ) 222 & * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) ) 223 223 END DO 224 224 ! … … 257 257 pvv(ji,jj,jk,Kmm) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 258 258 END_3D 259 pe3u(:,:,1:jpkm1,Kmm) = ze3u_f(:,:,1:jpkm1) 259 pe3u(:,:,1:jpkm1,Kmm) = ze3u_f(:,:,1:jpkm1) 260 260 pe3v(:,:,1:jpkm1,Kmm) = ze3v_f(:,:,1:jpkm1) 261 261 ! … … 268 268 IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN 269 269 ! Revert filtered "now" velocities to time split estimate 270 ! Doing it here also means that asselin filter contribution is removed 270 ! Doing it here also means that asselin filter contribution is removed 271 271 zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 272 zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 272 zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 273 273 DO jk = 2, jpkm1 274 274 zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 275 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 275 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 276 276 END DO 277 277 DO jk = 1, jpkm1 … … 325 325 IF ( iom_use("utau") ) THEN 326 326 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 327 ALLOCATE(zutau(jpi,jpj)) 327 ALLOCATE(zutau(jpi,jpj)) 328 328 DO_2D( 0, 0, 0, 0 ) 329 jk = miku(ji,jj) 329 jk = miku(ji,jj) 330 330 zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 331 331 END_2D … … 353 353 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt - puu(:,:,:,Kaa): ', mask1=umask, & 354 354 & tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): ' , mask2=vmask ) 355 ! 355 ! 356 356 IF( ln_dynspg_ts ) DEALLOCATE( zue, zve ) 357 357 IF( l_trddyn ) DEALLOCATE( zua, zva )
Note: See TracChangeset
for help on using the changeset viewer.