Changeset 2068 for branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/dynnxt.F90
- Timestamp:
- 2010-09-06T17:56:51+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1837_MLF/NEMO/OPA_SRC/DYN/dynnxt.F90
r2005 r2068 22 22 USE oce ! ocean dynamics and tracers 23 23 USE dom_oce ! ocean space and time domain 24 USE sbc_oce ! Surface boundary condition: ocean fields 25 USE phycst ! physical constants 24 26 USE dynspg_oce ! type of surface pressure gradient 25 27 USE dynadv ! dynamics: vector invariant versus flux form … … 218 220 END DO 219 221 ELSE !* Leap-Frog : Asselin filter and swap 220 IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN ! applied on velocity 222 ! ! =============! 223 IF( .NOT. lk_vvl ) THEN ! Fixed volume ! 224 ! ! =============! 221 225 DO jk = 1, jpkm1 222 226 DO jj = 1, jpj … … 232 236 END DO 233 237 END DO 234 ELSE ! applied on thickness weighted velocity 235 ! Before scale factors at (t/u/v)-points (actually "now filtered" and futur "before") 236 ! ====================================== 237 ! Scale factor at t-points 238 ! ------------------------ 239 fse3t_b(:,:,:) = fse3t_n(:,:,:) + atfp * fse3t_m(:,:,:) 238 ! ! ================! 239 ELSE ! Variable volume ! 240 ! ! ================! 241 ! Before scale factor at t-points 242 ! ------------------------------- 243 DO jk = 1, jpkm1 244 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) + atfp * fse3t_d(:,:,jk) 245 ENDDO 240 246 ! Add volume filter correction only at the first level of t-point scale factors 241 247 zec = atfp * rdt / rau0 242 248 fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 243 ! Scale factor at (u/v)-points244 ! ------------------------245 249 ! surface at t-points and inverse surface at (u/v)-points used in surface averaging computations 246 250 zs_t (:,:) = e1t(:,:) * e2t(:,:) 247 251 zs_u_1(:,:) = 0.5 / e1u(:,:) * e2u(:,:) 248 252 zs_v_1(:,:) = 0.5 / e1v(:,:) * e2v(:,:) 249 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 250 DO jk = 1, jpkm1 251 DO jj = 1, jpjm1 252 DO ji = 1, jpim1 253 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 254 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 255 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 256 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) ) 257 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) ) 258 END DO 259 END DO 260 END DO 261 CALL lbc_lnk( ze3u_f, 'U', 1. ) ! lateral boundary conditions 262 CALL lbc_lnk( ze3v_f, 'U', 1. ) 263 ! Add initial scale factor to scale factor anomaly 264 ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 265 ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 266 267 DO jk = 1, jpkm1 268 DO jj = 1, jpj 269 DO ji = 1, jpim 270 zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 271 zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 272 zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk) 273 zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk) 274 zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk) 275 zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 276 ! 277 zuf = ( zue3n + atfp * ( zue3b - 2.e0 * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) 278 zvf = ( zve3n + atfp * ( zve3b - 2.e0 * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 279 ! 280 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity 281 vb(ji,jj,jk) = zvf 282 fse3u_b(ji,jj,jk) = ze3u_f(ji,jj,jk) ! e3u_b <-- filtered scale factor 283 fse3v_b(ji,jj,jk) = ze3v_f(ji,jj,jk) 284 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 285 vn(ji,jj,jk) = va(ji,jj,jk) 286 END DO 287 END DO 288 END DO 289 CALL lbc_lnk( ub, 'U', -1. ) ! local domain boundaries 290 CALL lbc_lnk( vb, 'V', -1. ) 253 ! 254 IF( ln_dynadv_vec ) THEN 255 ! Before scale factor at (u/v)-points 256 ! ----------------------------------- 257 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 258 DO jk = 1, jpkm1 259 DO jj = 1, jpjm1 260 DO ji = 1, jpim1 261 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 262 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 263 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 264 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) ) 265 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) ) 266 END DO 267 END DO 268 END DO 269 ! lateral boundary conditions 270 CALL lbc_lnk( fse3u_b(:,:,:), 'U', 1. ) 271 CALL lbc_lnk( fse3v_b(:,:,:), 'V', 1. ) 272 ! Add initial scale factor to scale factor anomaly 273 fse3u_b(:,:,:) = fse3u_b(:,:,:) + fse3u_0(:,:,:) 274 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 275 ! Leap-Frog - Asselin filter and swap: applied on velocity 276 ! ----------------------------------- 277 DO jk = 1, jpkm1 278 DO jj = 1, jpj 279 DO ji = 1, jpi 280 zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) ) 281 zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) ) 282 ! 283 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity 284 vb(ji,jj,jk) = zvf 285 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 286 vn(ji,jj,jk) = va(ji,jj,jk) 287 END DO 288 END DO 289 END DO 290 ! 291 ELSE 292 ! Temporary filered scale factor at (u/v)-points (will become before scale factor) 293 !----------------------------------------------- 294 ! Scale factor anomaly at (u/v)-points: surface averaging of scale factor at t-points 295 DO jk = 1, jpkm1 296 DO jj = 1, jpjm1 297 DO ji = 1, jpim1 298 zv_t_ij = zs_t(ji ,jj ) * fse3t_b(ji ,jj ,jk) 299 zv_t_ip1j = zs_t(ji+1,jj ) * fse3t_b(ji+1,jj ,jk) 300 zv_t_ijp1 = zs_t(ji ,jj+1) * fse3t_b(ji ,jj+1,jk) 301 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) ) 302 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) ) 303 END DO 304 END DO 305 END DO 306 ! lateral boundary conditions 307 CALL lbc_lnk( ze3u_f, 'U', 1. ) 308 CALL lbc_lnk( ze3v_f, 'V', 1. ) 309 ! Add initial scale factor to scale factor anomaly 310 ze3u_f(:,:,:) = ze3u_f(:,:,:) + fse3u_0(:,:,:) 311 ze3v_f(:,:,:) = ze3v_f(:,:,:) + fse3v_0(:,:,:) 312 ! Leap-Frog - Asselin filter and swap: applied on thickness weighted velocity 313 ! ----------------------------------- =========================== 314 DO jk = 1, jpkm1 315 DO jj = 1, jpj 316 DO ji = 1, jpim1 317 zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk) 318 zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk) 319 zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk) 320 zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk) 321 zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk) 322 zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk) 323 ! 324 zuf = ( zue3n + atfp * ( zue3b - 2.e0 * zue3n + zue3a ) ) / ze3u_f(ji,jj,jk) 325 zvf = ( zve3n + atfp * ( zve3b - 2.e0 * zve3n + zve3a ) ) / ze3v_f(ji,jj,jk) 326 ! 327 ub(ji,jj,jk) = zuf ! ub <-- filtered velocity 328 vb(ji,jj,jk) = zvf 329 un(ji,jj,jk) = ua(ji,jj,jk) ! un <-- ua 330 vn(ji,jj,jk) = va(ji,jj,jk) 331 END DO 332 END DO 333 END DO 334 fse3u_b(:,:,:) = ze3u_f(:,:,:) ! e3u_b <-- filtered scale factor 335 fse3v_b(:,:,:) = ze3v_f(:,:,:) 336 CALL lbc_lnk( ub, 'U', -1. ) ! lateral boundary conditions 337 CALL lbc_lnk( vb, 'V', -1. ) 338 ENDIF 339 ! 291 340 ENDIF 341 ! 292 342 ENDIF 293 343
Note: See TracChangeset
for help on using the changeset viewer.
