- Timestamp:
- 2011-07-19T18:35:40+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2802_NOCS_vvlfix/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r2779 r2807 92 92 !! un,vn now horizontal velocity of next time-step 93 93 !!---------------------------------------------------------------------- 94 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released95 94 USE oce , ONLY: ze3u_f => ta , ze3v_f => sa ! (ta,sa) used as 3D workspace 96 USE wrk_nemo, ONLY: zs_t => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_397 95 ! 98 96 INTEGER, INTENT( in ) :: kt ! ocean time-step index 99 97 ! 100 98 INTEGER :: ji, jj, jk ! dummy loop indices 99 INTEGER :: iku, ikv ! local integers 101 100 #if ! defined key_dynspg_flt 102 101 REAL(wp) :: z2dt ! temporary scalar 103 102 #endif 104 REAL(wp) :: zue3a, zue3n, zue3b, zuf ! local scalars 105 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 106 REAL(wp) :: zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 103 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 104 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 107 105 !!---------------------------------------------------------------------- 108 109 IF( wrk_in_use(2, 1,2,3) ) THEN110 CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable') ; RETURN111 ENDIF112 106 113 107 IF( kt == nit000 ) THEN … … 238 232 ELSE ! Variable volume ! 239 233 ! ! ================! 240 ! Before scale factor at t-points 241 ! ------------------------------- 242 DO jk = 1, jpkm1 234 ! 235 DO jk = 1, jpkm1 ! Before scale factor at t-points 243 236 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) & 244 237 & + atfp * ( fse3t_b(:,:,jk) + fse3t_a(:,:,jk) & 245 & - 2.e0 * fse3t_n(:,:,jk) ) 246 ENDDO 247 ! Add volume filter correction only at the first level of t-point scale factors 248 zec = atfp * rdt / rau0 238 & - 2._wp * fse3t_n(:,:,jk) ) 239 END DO 240 zec = atfp * rdt / rau0 ! Add filter correction only at the 1st level of t-point scale factors 249 241 fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 250 ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations251 zs_t (:,:) = e1t(:,:) * e2t(:,:)252 zs_u_1(:,:) = 0.5 / ( e1u(:,:) * e2u(:,:) )253 zs_v_1(:,:) = 0.5 / ( e1v(:,:) * e2v(:,:) )254 242 ! 255 IF( ln_dynadv_vec ) THEN 256 ! Before scale factor at (u/v)-points 257 ! ----------------------------------- 258 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 259 DO jk = 1, jpkm1 260 DO jj = 1, jpjm1 261 DO ji = 1, jpim1 262 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 263 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 264 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 265 fse3u_b(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 266 fse3v_b(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 267 END DO 268 END DO 269 END DO 270 ! lateral boundary conditions 271 CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) 272 CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 273 ! Add initial scale factor to scale factor anomaly 274 fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 275 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 276 ! Leap-Frog - Asselin filter and swap: applied on velocity 277 ! ----------------------------------- 278 DO jk = 1, jpkm1 279 DO jj = 1, jpj 243 IF( ln_dynadv_vec ) THEN ! vector invariant form (no thickness weighted calulation) 244 ! 245 ! ! before scale factors at u- & v-pts (computed from fse3t_b) 246 CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 247 ! 248 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: applied on velocity 249 DO jj = 1, jpj ! -------- 280 250 DO ji = 1, jpi 281 251 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) … … 290 260 END DO 291 261 ! 292 ELSE 293 ! Temporary filered scale factor at (u/v)-points (will become before scale factor) 294 !----------------------------------------------- 295 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 296 DO jk = 1, jpkm1 297 DO jj = 1, jpjm1 298 DO ji = 1, jpim1 299 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 300 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 301 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 302 ze3u_f(ji,jj,jk) = umask(ji,jj,jk) * ( zs_u_1(ji,jj) * ( zv_t_ij + zv_t_ip1j ) - fse3u_0(ji,jj,jk) ) 303 ze3v_f(ji,jj,jk) = vmask(ji,jj,jk) * ( zs_v_1(ji,jj) * ( zv_t_ij + zv_t_ijp1 ) - fse3v_0(ji,jj,jk) ) 304 END DO 305 END DO 306 END DO 307 ! lateral boundary conditions 308 CALL lbc_lnk( ze3u_f, 'U', 1. ) 309 CALL lbc_lnk( ze3v_f, 'V', 1. ) 310 ! Add initial scale factor to scale factor anomaly 311 ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 312 ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 313 ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 314 ! ----------------------------------- =========================== 315 DO jk = 1, jpkm1 316 DO jj = 1, jpj 317 DO ji = 1, jpim1 262 ELSE ! flux form (thickness weighted calulation) 263 ! 264 CALL dom_vvl_2( kt, ze3u_f, ze3v_f ) ! before scale factors at u- & v-pts (computed from fse3t_b) 265 ! 266 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: 267 DO jj = 1, jpj ! applied on thickness weighted velocity 268 DO ji = 1, jpim1 ! --------------------------- 318 269 zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 319 270 zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) … … 323 274 zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 324 275 ! 325 zuf = ( zue3n + atfp * ( zue3b - 2.e0* zue3n + zue3a ) ) / ze3u_f(ji,jj,jk)326 zvf = ( zve3n + atfp * ( zve3b - 2.e0* zve3n + zve3a ) ) / ze3v_f(ji,jj,jk)276 zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) 277 zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 327 278 ! 328 ub(ji,jj,jk) = zuf 279 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity 329 280 vb(ji,jj,jk) = zvf 330 un(ji,jj,jk) = ua(ji,jj,jk) 281 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 331 282 vn(ji,jj,jk) = va(ji,jj,jk) 332 283 END DO 333 284 END DO 334 285 END DO 335 fse3u_b(:,:, :) = ze3u_f(:,:,:)! e3u_b <-- filtered scale factor336 fse3v_b(:,:, :) = ze3v_f(:,:,:)337 CALL lbc_lnk( ub, 'U', -1. ) 286 fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 287 fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 288 CALL lbc_lnk( ub, 'U', -1. ) ! lateral boundary conditions 338 289 CALL lbc_lnk( vb, 'V', -1. ) 339 290 ENDIF … … 346 297 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 347 298 ! 348 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dyn_nxt: failed to release workspace arrays')349 !350 299 END SUBROUTINE dyn_nxt 351 300
Note: See TracChangeset
for help on using the changeset viewer.
