Changeset 1381 for branches/dev_004_VVL/NEMO/OPA_SRC/TRA
- Timestamp:
- 2009-04-06T15:12:22+02:00 (15 years ago)
- File:
-
- 1 edited
-
branches/dev_004_VVL/NEMO/OPA_SRC/TRA/tranxt.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_004_VVL/NEMO/OPA_SRC/TRA/tranxt.F90
r1361 r1381 277 277 INTEGER, INTENT(in) :: kt ! ocean time-step index 278 278 !! 279 280 ! Not yet ready 281 WRITE(*,*) 'tra_next_vvl : you should not be there' 282 STOP 279 INTEGER :: ji, jj, jk ! dummy loop indices 280 REAL(wp) :: ztm , ztc_f , ztf , ztca, ztcn, ztcb ! temporary scalar 281 REAL(wp) :: zsm , zsc_f , zsf , zsca, zscn, zscb ! - - 282 REAL(wp) :: ze3mr, ze3fr ! - - 283 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - - 284 !!---------------------------------------------------------------------- 285 286 IF( kt == nit000 ) THEN 287 IF(lwp) WRITE(numout,*) 288 IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping' 289 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 290 ENDIF 291 292 ! ! ----------------------- ! 293 IF( ln_dynhpg_imp ) THEN ! semi-implicite hpg case ! 294 ! ! ----------------------- ! 295 ! 296 IF( neuler == 0 .AND. kt == nit000 ) THEN 297 DO jk = 1, jpkm1 298 DO jj = 1, jpj 299 DO ji = 1, jpi 300 ze3t_b = fse3t_b(ji,jj,jk) 301 ze3t_n = fse3t_n(ji,jj,jk) 302 ze3t_a = fse3t_a(ji,jj,jk) 303 ! ! tracer content at Before, now and after 304 ztcb = tb(ji,jj,jk) * ze3t_b ; zscb = sb(ji,jj,jk) * ze3t_b 305 ztcn = tn(ji,jj,jk) * ze3t_n ; zscn = sn(ji,jj,jk) * ze3t_n 306 ztca = ta(ji,jj,jk) * ze3t_a ; zsca = sa(ji,jj,jk) * ze3t_a 307 ! 308 ! ! mean thickness and tracer 309 ze3mr= 1.e0 / ( ze3t_a + 2.* ze3t_n + ze3t_b ) 310 ztm = ze3mr * ( ztca + 2.* ztcn + ztcb ) 311 zsm = ze3mr * ( zsca + 2.* zscn + zscb ) 312 !!gm mean e3t have to be saved and used in dynhpg or it can be recomputed in dynhpg !! 313 !!gm e3t_m(ji,jj,jk) = 0.25 / ze3mr 314 ! ! swap of arrays 315 tb(ji,jj,jk) = tn(ji,jj,jk) ! tb <-- tn 316 sb(ji,jj,jk) = sn(ji,jj,jk) 317 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 318 sn(ji,jj,jk) = sa(ji,jj,jk) 319 ta(ji,jj,jk) = ztm ! ta <-- mean t 320 sa(ji,jj,jk) = zsm 321 END DO 322 END DO 323 END DO 324 ELSE 325 DO jk = 1, jpkm1 326 DO jj = 1, jpj 327 DO ji = 1, jpi 328 ze3t_b = fse3t_b(ji,jj,jk) 329 ze3t_n = fse3t_n(ji,jj,jk) 330 ze3t_a = fse3t_a(ji,jj,jk) 331 ! ! tracer content at Before, now and after 332 ztcb = tb(ji,jj,jk) * ze3t_b ; zscb = sb(ji,jj,jk) * ze3t_b 333 ztcn = tn(ji,jj,jk) * ze3t_n ; zscn = sn(ji,jj,jk) * ze3t_n 334 ztca = ta(ji,jj,jk) * ze3t_a ; zsca = sa(ji,jj,jk) * ze3t_a 335 ! 336 ! ! Asselin filter on thickness and tracer content 337 ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b ) 338 ztc_f = atfp * ( ztca - 2.* ztcn + ztcb ) 339 zsc_f = atfp * ( zsca - 2.* zscn + zscb ) 340 ! 341 ! ! filtered tracer including the correction 342 ze3fr = 1.e0 / ( ze3t_n + ze3t_f ) 343 ztf = ze3fr * ( ztcn + ztc_f ) 344 zsf = ze3fr * ( zscn + zsc_f ) 345 ! ! mean thickness and tracer 346 ze3mr = 1.e0 / ( ze3t_a + 2.* ze3t_n + ze3t_b ) 347 ztm = ze3mr * ( ztca + 2.* ztcn + ztcb ) 348 zsm = ze3mr * ( zsca + 2.* zscn + zscb ) 349 !!gm mean e3t have to be saved and used in dynhpg or it can be recomputed in dynhpg !! 350 !!gm e3t_m(ji,jj,jk) = 0.25 / ze3mr 351 ! ! swap of arrays 352 tb(ji,jj,jk) = ztf ! tb <-- tn + filter 353 sb(ji,jj,jk) = zsf 354 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 355 sn(ji,jj,jk) = sa(ji,jj,jk) 356 ta(ji,jj,jk) = ztm ! ta <-- mean t 357 sa(ji,jj,jk) = zsm 358 END DO 359 END DO 360 END DO 361 ENDIF 362 ! ! ----------------------- ! 363 ELSE ! explicit hpg case ! 364 ! ! ----------------------- ! 365 ! 366 IF( neuler == 0 .AND. kt == nit000 ) THEN ! case of Euler time-stepping at first time-step 367 DO jk = 1, jpkm1 ! No filter nor thickness weighting computation required 368 DO jj = 1, jpj ! ONLY swap 369 DO ji = 1, jpi 370 tb(ji,jj,jk) = tn(ji,jj,jk) ! tb <-- tn 371 sb(ji,jj,jk) = sn(ji,jj,jk) 372 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 373 sn(ji,jj,jk) = sa(ji,jj,jk) 374 END DO 375 END DO 376 END DO 377 ! ! general case (Leapfrog + Asselin filter) 378 ELSE ! apply filter on thickness weighted tracer and swap 379 DO jk = 1, jpkm1 380 DO jj = 1, jpj 381 DO ji = 1, jpi 382 ze3t_b = fse3t_b(ji,jj,jk) 383 ze3t_n = fse3t_n(ji,jj,jk) 384 ze3t_a = fse3t_a(ji,jj,jk) 385 ! ! tracer content at Before, now and after 386 ztcb = tb(ji,jj,jk) * ze3t_b ; zscb = sb(ji,jj,jk) * ze3t_b 387 ztcn = tn(ji,jj,jk) * ze3t_n ; zscn = sn(ji,jj,jk) * ze3t_n 388 ztca = ta(ji,jj,jk) * ze3t_a ; zsca = sa(ji,jj,jk) * ze3t_a 389 ! 390 ! ! Asselin filter on thickness and tracer content 391 ze3t_f = atfp * ( ze3t_a - 2.* ze3t_n + ze3t_b ) 392 ztc_f = atfp * ( ztca - 2.* ztcn + ztcb ) 393 zsc_f = atfp * ( zsca - 2.* zscn + zscb ) 394 ! 395 !!gm tmask useless below 396 ! ! filtered tracer including the correction 397 ze3fr = tmask(ji,jj,jk) / ( ze3t_n + ze3t_f ) 398 ztf = ( ztcn + ztc_f ) * ze3fr 399 zsf = ( zscn + zsc_f ) * ze3fr 400 ! ! swap of arrays 401 tb(ji,jj,jk) = ztf ! tb <-- tn filtered 402 sb(ji,jj,jk) = zsf 403 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 404 sn(ji,jj,jk) = sa(ji,jj,jk) 405 END DO 406 END DO 407 END DO 408 ENDIF 409 ENDIF 283 410 ! 284 411 END SUBROUTINE tra_nxt_vvl
Note: See TracChangeset
for help on using the changeset viewer.
