- Timestamp:
- 2020-03-29T12:55:27+02:00 (4 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatfQCO.F90
r12623 r12624 1 MODULE dynatf LF1 MODULE dynatfqco 2 2 !!========================================================================= 3 !! *** MODULE dynatf LF***3 !! *** MODULE dynatfqco *** 4 4 !! Ocean dynamics: time filtering 5 5 !!========================================================================= … … 24 24 25 25 !!---------------------------------------------------------------------------------------------- 26 !! dyn_atf LF: apply Asselin time filtering to "now" velocities and vertical scale factors26 !! dyn_atf_qco : apply Asselin time filtering to "now" velocities and vertical scale factors 27 27 !!---------------------------------------------------------------------------------------------- 28 28 USE oce ! ocean dynamics and tracers … … 57 57 PRIVATE 58 58 59 PUBLIC dyn_atf_ lf! routine called by step.F9059 PUBLIC dyn_atf_qco ! routine called by step.F90 60 60 61 61 !! * Substitutions 62 62 # include "do_loop_substitute.h90" 63 # include "domzgr_substitute.h90" 63 64 !!---------------------------------------------------------------------- 64 65 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 68 69 CONTAINS 69 70 70 SUBROUTINE dyn_atf_ lf( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v )71 SUBROUTINE dyn_atf_qco ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 71 72 !!---------------------------------------------------------------------- 72 !! *** ROUTINE dyn_atf_ lf***73 !! *** ROUTINE dyn_atf_qco *** 73 74 !! 74 75 !! ** Purpose : Finalize after horizontal velocity. Apply the boundary … … 106 107 !!---------------------------------------------------------------------- 107 108 ! 108 IF( ln_timing ) CALL timing_start('dyn_atf_ lf')109 IF( ln_timing ) CALL timing_start('dyn_atf_qco') 109 110 IF( ln_dynspg_ts ) ALLOCATE( zue(jpi,jpj) , zve(jpi,jpj) ) 110 111 IF( l_trddyn ) ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) ) … … 112 113 IF( kt == nit000 ) THEN 113 114 IF(lwp) WRITE(numout,*) 114 IF(lwp) WRITE(numout,*) 'dyn_atf_ lf: Asselin time filtering'115 IF(lwp) WRITE(numout,*) 'dyn_atf_qco : Asselin time filtering' 115 116 IF(lwp) WRITE(numout,*) '~~~~~~~' 116 117 ENDIF 117 118 ! IF ( ln_dynspg_ts ) THEN119 ! ! Ensure below that barotropic velocities match time splitting estimate120 ! ! Compute actual transport and replace it with ts estimate at "after" time step121 ! zue(:,:) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)122 ! zve(:,:) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)123 ! DO jk = 2, jpkm1124 ! zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)125 ! zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)126 ! END DO127 ! DO jk = 1, jpkm1128 ! puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - zue(:,:) * r1_hu(:,:,Kaa) + uu_b(:,:,Kaa) ) * umask(:,:,jk)129 ! pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - zve(:,:) * r1_hv(:,:,Kaa) + vv_b(:,:,Kaa) ) * vmask(:,:,jk)130 ! END DO131 ! !132 ! IF( .NOT.ln_bt_fw ) THEN133 ! ! Remove advective velocity from "now velocities"134 ! ! prior to asselin filtering135 ! ! In the forward case, this is done below after asselin filtering136 ! ! so that asselin contribution is removed at the same time137 ! DO jk = 1, jpkm1138 ! puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm) + uu_b(:,:,Kmm) )*umask(:,:,jk)139 ! pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm) + vv_b(:,:,Kmm) )*vmask(:,:,jk)140 ! END DO141 ! ENDIF142 ! ENDIF143 !144 ! ! Update after velocity on domain lateral boundaries145 ! ! --------------------------------------------------146 ! # if defined key_agrif147 ! CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries148 ! # endif149 ! !150 ! CALL lbc_lnk_multi( 'dynatfLF', puu(:,:,:,Kaa), 'U', -1., pvv(:,:,:,Kaa), 'V', -1. ) !* local domain boundaries151 ! !152 ! ! !* BDY open boundaries153 ! IF( ln_bdy .AND. ln_dynspg_exp ) CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa )154 ! IF( ln_bdy .AND. ln_dynspg_ts ) CALL bdy_dyn( kt, Kbb, puu, pvv, Kaa, dyn3d_only=.true. )155 156 !!$ Do we need a call to bdy_vol here??157 118 ! 158 119 IF( l_trddyn ) THEN ! prepare the atf trend computation + some diagnostics … … 191 152 ! Time-filtered scale factor at t-points 192 153 ! ---------------------------------------------------- 193 DO jk = 1, jpk ! filtered scale factor at T-points194 pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) )195 END DO154 ! DO jk = 1, jpk ! filtered scale factor at T-points 155 ! pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) ) 156 ! END DO 196 157 ! 197 158 ! 198 159 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 199 160 ! Before filtered scale factor at (u/v)-points 200 DO jk = 1, jpk201 pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )202 pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )203 END DO161 ! DO jk = 1, jpk 162 ! pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) ) 163 ! pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) ) 164 ! END DO 204 165 ! 205 166 DO_3D_11_11( 1, jpkm1 ) … … 211 172 ! 212 173 DO_3D_11_11( 1, jpkm1 ) 213 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 214 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 215 zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 216 zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 217 zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 218 zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 174 ! zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 175 ! zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) 176 ! zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 177 ! zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 178 ! zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 179 ! zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 180 ! 181 zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 182 zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) 183 zue3n = ( 1._wp + r3u(ji,jj,Kmm) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kmm) 184 zve3n = ( 1._wp + r3v(ji,jj,Kmm) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kmm) 185 zue3b = ( 1._wp + r3u(ji,jj,Kbb) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kbb) 186 zve3b = ( 1._wp + r3v(ji,jj,Kbb) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kbb) 219 187 ! ! filtered scale factor at U-,V-points 220 pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) )221 pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) )188 ! pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) ) 189 ! pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) ) 222 190 ! 223 puu(ji,jj,jk,Kmm) = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / pe3u(ji,jj,jk,Kmm) !!st ze3u_f(ji,jj,jk)224 pvv(ji,jj,jk,Kmm) = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / pe3v(ji,jj,jk,Kmm) !!st ze3v_f(ji,jj,jk)191 puu(ji,jj,jk,Kmm) = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ( 1._wp + r3u_f(ji,jj)*umask(ji,jj,jk) ) !!st ze3u_f(ji,jj,jk) 192 pvv(ji,jj,jk,Kmm) = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ( 1._wp + r3v_f(ji,jj)*vmask(ji,jj,jk) ) !!st ze3v_f(ji,jj,jk) 225 193 END_3D 226 194 ! … … 232 200 ! Revert filtered "now" velocities to time split estimate 233 201 ! Doing it here also means that asselin filter contribution is removed 234 zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 235 zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 202 ! zue(:,:) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 203 ! zve(:,:) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 204 ! DO jk = 2, jpkm1 205 ! zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 206 ! zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 207 ! END DO 208 zue(:,:) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 209 zve(:,:) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 236 210 DO jk = 2, jpkm1 237 zue(:,:) = zue(:,:) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)238 zve(:,:) = zve(:,:) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)211 zue(:,:) = zue(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 212 zve(:,:) = zve(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 239 213 END DO 240 214 DO jk = 1, jpkm1 … … 251 225 ! 252 226 IF(.NOT.ln_linssh ) THEN 253 hu(:,:,Kmm) = pe3u(:,:,1,Kmm ) * umask(:,:,1)254 hv(:,:,Kmm) = pe3v(:,:,1,Kmm ) * vmask(:,:,1)227 hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 228 hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 255 229 DO jk = 2, jpkm1 256 hu(:,:,Kmm) = hu(:,:,Kmm) + pe3u(:,:,jk,Kmm ) * umask(:,:,jk)257 hv(:,:,Kmm) = hv(:,:,Kmm) + pe3v(:,:,jk,Kmm ) * vmask(:,:,jk)230 hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 231 hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 258 232 END DO 259 233 r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) … … 261 235 ENDIF 262 236 ! 263 uu_b(:,:,Kaa) = pe3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1)264 uu_b(:,:,Kmm) = pe3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1)265 vv_b(:,:,Kaa) = pe3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1)266 vv_b(:,:,Kmm) = pe3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1)237 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 238 uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 239 vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 240 vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 267 241 DO jk = 2, jpkm1 268 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + pe3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk)269 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + pe3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)270 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + pe3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk)271 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + pe3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)242 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 243 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 244 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 245 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 272 246 END DO 273 247 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) … … 291 265 IF( ln_dynspg_ts ) DEALLOCATE( zue, zve ) 292 266 IF( l_trddyn ) DEALLOCATE( zua, zva ) 293 IF( ln_timing ) CALL timing_stop('dyn_atf_ lf')294 ! 295 END SUBROUTINE dyn_atf_ lf267 IF( ln_timing ) CALL timing_stop('dyn_atf_qco') 268 ! 269 END SUBROUTINE dyn_atf_qco 296 270 297 271 !!========================================================================= 298 END MODULE dynatf LF272 END MODULE dynatfqco
Note: See TracChangeset
for help on using the changeset viewer.
