Changeset 11027 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynnxt.F90
- Timestamp:
- 2019-05-21T17:33:54+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynnxt.F90
r10957 r11027 64 64 CONTAINS 65 65 66 SUBROUTINE dyn_nxt ( kt, Kbb, Kmm, K aa )66 SUBROUTINE dyn_nxt ( kt, Kbb, Kmm, Krhs, puu, pvv, Kaa ) 67 67 !!---------------------------------------------------------------------- 68 68 !! *** ROUTINE dyn_nxt *** … … 83 83 !! * Apply the time filter applied and swap of the dynamics 84 84 !! arrays to start the next time step: 85 !! ( ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]86 !! ( un,vn) = (ua,va).85 !! (puu(Kbb),pvv(Kbb)) = (puu(Kmm),pvv(Kmm)) + atfp [ (puu(Kbb),pvv(Kbb)) + (puu(Krhs),pvv(Krhs)) - 2 (puu(Kmm),pvv(Kmm)) ] 86 !! (puu(Kmm),pvv(Kmm)) = (puu(Krhs),pvv(Krhs)). 87 87 !! Note that with flux form advection and non linear free surface, 88 88 !! the time filter is applied on thickness weighted velocity. 89 89 !! As a result, dyn_nxt MUST be called after tra_nxt. 90 90 !! 91 !! ** Action : ub,vbfiltered before horizontal velocity of next time-step92 !! un,vnnow horizontal velocity of next time-step91 !! ** Action : puu(Kbb),pvv(Kbb) filtered before horizontal velocity of next time-step 92 !! puu(Kmm),pvv(Kmm) now horizontal velocity of next time-step 93 93 !!---------------------------------------------------------------------- 94 INTEGER, INTENT( in ) :: kt ! ocean time-step index 95 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 94 INTEGER, INTENT( in ) :: kt ! ocean time-step index 95 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices 96 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocity arrays 96 97 ! 97 98 INTEGER :: ji, jj, jk ! dummy loop indices … … 116 117 ! Ensure below that barotropic velocities match time splitting estimate 117 118 ! Compute actual transport and replace it with ts estimate at "after" time step 118 zue(:,:) = e3u _a(:,:,1) * ua(:,:,1) * umask(:,:,1)119 zve(:,:) = e3v _a(:,:,1) * va(:,:,1) * vmask(:,:,1)119 zue(:,:) = e3u(:,:,1,Krhs) * puu(:,:,1,Krhs) * umask(:,:,1) 120 zve(:,:) = e3v(:,:,1,Krhs) * pvv(:,:,1,Krhs) * vmask(:,:,1) 120 121 DO jk = 2, jpkm1 121 zue(:,:) = zue(:,:) + e3u _a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)122 zve(:,:) = zve(:,:) + e3v _a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)122 zue(:,:) = zue(:,:) + e3u(:,:,jk,Krhs) * puu(:,:,jk,Krhs) * umask(:,:,jk) 123 zve(:,:) = zve(:,:) + e3v(:,:,jk,Krhs) * pvv(:,:,jk,Krhs) * vmask(:,:,jk) 123 124 END DO 124 125 DO jk = 1, jpkm1 125 ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)126 va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)126 puu(:,:,jk,Krhs) = ( puu(:,:,jk,Krhs) - zue(:,:) * r1_hu_a(:,:) + uu_b(:,:,Krhs) ) * umask(:,:,jk) 127 pvv(:,:,jk,Krhs) = ( pvv(:,:,jk,Krhs) - zve(:,:) * r1_hv_a(:,:) + vv_b(:,:,Krhs) ) * vmask(:,:,jk) 127 128 END DO 128 129 ! … … 133 134 ! so that asselin contribution is removed at the same time 134 135 DO jk = 1, jpkm1 135 un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) )*umask(:,:,jk)136 vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) )*vmask(:,:,jk)136 puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu_n(:,:) + uu_b(:,:,Kmm) )*umask(:,:,jk) 137 pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv_n(:,:) + vv_b(:,:,Kmm) )*vmask(:,:,jk) 137 138 END DO 138 139 ENDIF … … 142 143 ! -------------------------------------------------- 143 144 # if defined key_agrif 144 CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries145 Krhs_a = Krhs ; CALL Agrif_dyn( kt ) !* AGRIF zoom boundaries 145 146 # endif 146 147 ! 147 CALL lbc_lnk_multi( 'dynnxt', ua, 'U', -1., va, 'V', -1. ) !* local domain boundaries148 CALL lbc_lnk_multi( 'dynnxt', puu(:,:,:,Krhs), 'U', -1., pvv(:,:,:,Krhs), 'V', -1. ) !* local domain boundaries 148 149 ! 149 150 ! !* BDY open boundaries … … 162 163 ! 163 164 ! ! Kinetic energy and Conversion 164 IF( ln_KE_trd ) CALL trd_dyn( ua, va, jpdyn_ken, kt, Kmm )165 IF( ln_KE_trd ) CALL trd_dyn( puu(:,:,:,Krhs), pvv(:,:,:,Krhs), jpdyn_ken, kt, Kmm ) 165 166 ! 166 167 IF( ln_dyn_trd ) THEN ! 3D output: total momentum trends 167 zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt168 zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt168 zua(:,:,:) = ( puu(:,:,:,Krhs) - puu(:,:,:,Kbb) ) * z1_2dt 169 zva(:,:,:) = ( pvv(:,:,:,Krhs) - pvv(:,:,:,Kbb) ) * z1_2dt 169 170 CALL iom_put( "utrd_tot", zua ) ! total momentum trends, except the asselin time filter 170 171 CALL iom_put( "vtrd_tot", zva ) 171 172 ENDIF 172 173 ! 173 zua(:,:,:) = un(:,:,:) ! save the now velocity before the asselin filter174 zva(:,:,:) = vn(:,:,:) ! (caution: there will be a shift by 1 timestep in the174 zua(:,:,:) = puu(:,:,:,Kmm) ! save the now velocity before the asselin filter 175 zva(:,:,:) = pvv(:,:,:,Kmm) ! (caution: there will be a shift by 1 timestep in the 175 176 ! ! computation of the asselin filter trends) 176 177 ENDIF … … 180 181 IF( neuler == 0 .AND. kt == nit000 ) THEN !* Euler at first time-step: only swap 181 182 DO jk = 1, jpkm1 182 un(:,:,jk) = ua(:,:,jk) ! un <-- ua183 vn(:,:,jk) = va(:,:,jk)183 puu(:,:,jk,Kmm) = puu(:,:,jk,Krhs) ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 184 pvv(:,:,jk,Kmm) = pvv(:,:,jk,Krhs) 184 185 END DO 185 186 IF( .NOT.ln_linssh ) THEN ! e3._b <-- e3._n 186 187 !!gm BUG ???? I don't understand why it is not : e3._n <-- e3._a 187 188 DO jk = 1, jpkm1 188 ! e3t _b(:,:,jk) = e3t_n(:,:,jk)189 ! e3u _b(:,:,jk) = e3u_n(:,:,jk)190 ! e3v _b(:,:,jk) = e3v_n(:,:,jk)189 ! e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 190 ! e3u(:,:,jk,Kbb) = e3u(:,:,jk,Kmm) 191 ! e3v(:,:,jk,Kbb) = e3v(:,:,jk,Kmm) 191 192 ! 192 e3t _n(:,:,jk) = e3t_a(:,:,jk)193 e3u _n(:,:,jk) = e3u_a(:,:,jk)194 e3v _n(:,:,jk) = e3v_a(:,:,jk)193 e3t(:,:,jk,Kmm) = e3t(:,:,jk,Krhs) 194 e3u(:,:,jk,Kmm) = e3u(:,:,jk,Krhs) 195 e3v(:,:,jk,Kmm) = e3v(:,:,jk,Krhs) 195 196 END DO 196 197 !!gm BUG end … … 205 206 DO jj = 1, jpj 206 207 DO ji = 1, jpi 207 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )208 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )208 zuf = puu(ji,jj,jk,Kmm) + atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Krhs) ) 209 zvf = pvv(ji,jj,jk,Kmm) + atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Krhs) ) 209 210 ! 210 ub(ji,jj,jk) = zuf ! ub<-- filtered velocity211 vb(ji,jj,jk) = zvf212 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua213 vn(ji,jj,jk) = va(ji,jj,jk)211 puu(ji,jj,jk,Kbb) = zuf ! puu(:,:,:,Kbb) <-- filtered velocity 212 pvv(ji,jj,jk,Kbb) = zvf 213 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Krhs) ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 214 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Krhs) 214 215 END DO 215 216 END DO … … 222 223 ! ---------------------------------------------------- 223 224 DO jk = 1, jpkm1 224 e3t _b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )225 e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) + atfp * ( e3t(:,:,jk,Kbb) - 2._wp * e3t(:,:,jk,Kmm) + e3t(:,:,jk,Krhs) ) 225 226 END DO 226 227 ! Add volume filter correction: compatibility with tracer advection scheme … … 228 229 zcoef = atfp * rdt * r1_rau0 229 230 230 e3t _b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)231 e3t(:,:,1,Kbb) = e3t(:,:,1,Kbb) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 231 232 232 233 IF ( ln_rnf ) THEN … … 236 237 DO ji = 1, jpi 237 238 IF( jk <= nk_rnf(ji,jj) ) THEN 238 e3t _b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( - rnf_b(ji,jj) + rnf(ji,jj) ) &239 & * ( e3t _n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk)239 e3t(ji,jj,jk,Kbb) = e3t(ji,jj,jk,Kbb) - zcoef * ( - rnf_b(ji,jj) + rnf(ji,jj) ) & 240 & * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) ) * tmask(ji,jj,jk) 240 241 ENDIF 241 242 ENDDO … … 243 244 ENDDO 244 245 ELSE 245 e3t _b(:,:,1) = e3t_b(:,:,1) - zcoef * ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1)246 e3t(:,:,1,Kbb) = e3t(:,:,1,Kbb) - zcoef * ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1) 246 247 ENDIF 247 248 END IF … … 252 253 DO ji = 1, jpi 253 254 IF( misfkt(ji,jj) <=jk .and. jk < misfkb(ji,jj) ) THEN 254 e3t _b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &255 & * ( e3t _n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk)255 e3t(ji,jj,jk,Kbb) = e3t(ji,jj,jk,Kbb) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) & 256 & * ( e3t(ji,jj,jk,Kmm) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk) 256 257 ELSEIF ( jk==misfkb(ji,jj) ) THEN 257 e3t _b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &258 & * ( e3t _n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * ralpha(ji,jj) * tmask(ji,jj,jk)258 e3t(ji,jj,jk,Kbb) = e3t(ji,jj,jk,Kbb) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) & 259 & * ( e3t(ji,jj,jk,Kmm) * r1_hisf_tbl(ji,jj) ) * ralpha(ji,jj) * tmask(ji,jj,jk) 259 260 ENDIF 260 261 END DO … … 265 266 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 266 267 ! Before filtered scale factor at (u/v)-points 267 CALL dom_vvl_interpol( e3t _b(:,:,:), e3u_b(:,:,:), 'U' )268 CALL dom_vvl_interpol( e3t _b(:,:,:), e3v_b(:,:,:), 'V' )268 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 269 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 269 270 DO jk = 1, jpkm1 270 271 DO jj = 1, jpj 271 272 DO ji = 1, jpi 272 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )273 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )273 zuf = puu(ji,jj,jk,Kmm) + atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Krhs) ) 274 zvf = pvv(ji,jj,jk,Kmm) + atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Krhs) ) 274 275 ! 275 ub(ji,jj,jk) = zuf ! ub<-- filtered velocity276 vb(ji,jj,jk) = zvf277 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua278 vn(ji,jj,jk) = va(ji,jj,jk)276 puu(ji,jj,jk,Kbb) = zuf ! puu(:,:,:,Kbb) <-- filtered velocity 277 pvv(ji,jj,jk,Kbb) = zvf 278 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Krhs) ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 279 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Krhs) 279 280 END DO 280 281 END DO … … 285 286 ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) ) 286 287 ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 287 CALL dom_vvl_interpol( e3t _b(:,:,:), ze3u_f, 'U' )288 CALL dom_vvl_interpol( e3t _b(:,:,:), ze3v_f, 'V' )288 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), ze3u_f, 'U' ) 289 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), ze3v_f, 'V' ) 289 290 DO jk = 1, jpkm1 290 291 DO jj = 1, jpj 291 292 DO ji = 1, jpi 292 zue3a = e3u _a(ji,jj,jk) * ua(ji,jj,jk)293 zve3a = e3v _a(ji,jj,jk) * va(ji,jj,jk)294 zue3n = e3u _n(ji,jj,jk) * un(ji,jj,jk)295 zve3n = e3v _n(ji,jj,jk) * vn(ji,jj,jk)296 zue3b = e3u _b(ji,jj,jk) * ub(ji,jj,jk)297 zve3b = e3v _b(ji,jj,jk) * vb(ji,jj,jk)293 zue3a = e3u(ji,jj,jk,Krhs) * puu(ji,jj,jk,Krhs) 294 zve3a = e3v(ji,jj,jk,Krhs) * pvv(ji,jj,jk,Krhs) 295 zue3n = e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 296 zve3n = e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 297 zue3b = e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 298 zve3b = e3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 298 299 ! 299 300 zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) 300 301 zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 301 302 ! 302 ub(ji,jj,jk) = zuf ! ub<-- filtered velocity303 vb(ji,jj,jk) = zvf304 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua305 vn(ji,jj,jk) = va(ji,jj,jk)303 puu(ji,jj,jk,Kbb) = zuf ! puu(:,:,:,Kbb) <-- filtered velocity 304 pvv(ji,jj,jk,Kbb) = zvf 305 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Krhs) ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 306 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Krhs) 306 307 END DO 307 308 END DO 308 309 END DO 309 e3u _b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b<-- filtered scale factor310 e3v _b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)310 e3u(:,:,1:jpkm1,Kbb) = ze3u_f(:,:,1:jpkm1) ! e3u(:,:,:,Kbb) <-- filtered scale factor 311 e3v(:,:,1:jpkm1,Kbb) = ze3v_f(:,:,1:jpkm1) 311 312 ! 312 313 DEALLOCATE( ze3u_f , ze3v_f ) … … 318 319 ! Revert "before" velocities to time split estimate 319 320 ! Doing it here also means that asselin filter contribution is removed 320 zue(:,:) = e3u _b(:,:,1) * ub(:,:,1) * umask(:,:,1)321 zve(:,:) = e3v _b(:,:,1) * vb(:,:,1) * vmask(:,:,1)321 zue(:,:) = e3u(:,:,1,Kbb) * puu(:,:,1,Kbb) * umask(:,:,1) 322 zve(:,:) = e3v(:,:,1,Kbb) * pvv(:,:,1,Kbb) * vmask(:,:,1) 322 323 DO jk = 2, jpkm1 323 zue(:,:) = zue(:,:) + e3u _b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)324 zve(:,:) = zve(:,:) + e3v _b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)324 zue(:,:) = zue(:,:) + e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) * umask(:,:,jk) 325 zve(:,:) = zve(:,:) + e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) * vmask(:,:,jk) 325 326 END DO 326 327 DO jk = 1, jpkm1 327 ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk)328 vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk)328 puu(:,:,jk,Kbb) = puu(:,:,jk,Kbb) - (zue(:,:) * r1_hu_n(:,:) - uu_b(:,:,Kmm)) * umask(:,:,jk) 329 pvv(:,:,jk,Kbb) = pvv(:,:,jk,Kbb) - (zve(:,:) * r1_hv_n(:,:) - vv_b(:,:,Kmm)) * vmask(:,:,jk) 329 330 END DO 330 331 ENDIF … … 338 339 ! 339 340 IF(.NOT.ln_linssh ) THEN 340 hu_b(:,:) = e3u _b(:,:,1) * umask(:,:,1)341 hv_b(:,:) = e3v _b(:,:,1) * vmask(:,:,1)341 hu_b(:,:) = e3u(:,:,1,Kbb) * umask(:,:,1) 342 hv_b(:,:) = e3v(:,:,1,Kbb) * vmask(:,:,1) 342 343 DO jk = 2, jpkm1 343 hu_b(:,:) = hu_b(:,:) + e3u _b(:,:,jk) * umask(:,:,jk)344 hv_b(:,:) = hv_b(:,:) + e3v _b(:,:,jk) * vmask(:,:,jk)344 hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 345 hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 345 346 END DO 346 347 r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) … … 348 349 ENDIF 349 350 ! 350 u n_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1)351 u b_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)352 v n_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1)353 v b_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)351 uu_b(:,:,Kmm) = e3u(:,:,1,Krhs) * puu(:,:,1,Kmm) * umask(:,:,1) 352 uu_b(:,:,Kbb) = e3u(:,:,1,Kbb) * puu(:,:,1,Kbb) * umask(:,:,1) 353 vv_b(:,:,Kmm) = e3v(:,:,1,Krhs) * pvv(:,:,1,Kmm) * vmask(:,:,1) 354 vv_b(:,:,Kbb) = e3v(:,:,1,Kbb) * pvv(:,:,1,Kbb) * vmask(:,:,1) 354 355 DO jk = 2, jpkm1 355 u n_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk)356 u b_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)357 v n_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)358 v b_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)356 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Krhs) * puu(:,:,jk,Kmm) * umask(:,:,jk) 357 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) + e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) * umask(:,:,jk) 358 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Krhs) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 359 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) + e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) * vmask(:,:,jk) 359 360 END DO 360 u n_b(:,:) = un_b(:,:) * r1_hu_a(:,:)361 v n_b(:,:) = vn_b(:,:) * r1_hv_a(:,:)362 u b_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)363 v b_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)361 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu_a(:,:) 362 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv_a(:,:) 363 uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu_b(:,:) 364 vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv_b(:,:) 364 365 ! 365 366 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents 366 CALL iom_put( "ubar", u n_b(:,:) )367 CALL iom_put( "vbar", v n_b(:,:) )367 CALL iom_put( "ubar", uu_b(:,:,Kmm) ) 368 CALL iom_put( "vbar", vv_b(:,:,Kmm) ) 368 369 ENDIF 369 370 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 370 zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt371 zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt371 zua(:,:,:) = ( puu(:,:,:,Kbb) - zua(:,:,:) ) * z1_2dt 372 zva(:,:,:) = ( pvv(:,:,:,Kbb) - zva(:,:,:) ) * z1_2dt 372 373 CALL trd_dyn( zua, zva, jpdyn_atf, kt, Kmm ) 373 374 ENDIF 374 375 ! 375 IF(ln_ctl) CALL prt_ctl( tab3d_1= un, clinfo1=' nxt - Un: ', mask1=umask, &376 & tab3d_2= vn, clinfo2=' Vn: ' , mask2=vmask )376 IF(ln_ctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Kmm), clinfo1=' nxt - Un: ', mask1=umask, & 377 & tab3d_2=pvv(:,:,:,Kmm), clinfo2=' Vn: ' , mask2=vmask ) 377 378 ! 378 379 IF( ln_dynspg_ts ) DEALLOCATE( zue, zve )
Note: See TracChangeset
for help on using the changeset viewer.
