Changeset 237 for trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90
- Timestamp:
- 2005-03-22T11:18:01+01:00 (19 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r216 r237 401 401 ! -------------------- 402 402 ! large negative value (-zbig) inside land 403 WHERE( tmask(:,:,:) == 0. ) 404 pbef(:,:,:) = -zbig 405 paft(:,:,:) = -zbig 406 ENDWHERE 403 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 404 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) - zbig * ( 1.e0 - tmask(:,:,:) ) 407 405 ! search maximum in neighbourhood 408 406 DO jk = 1, jpkm1 … … 421 419 END DO 422 420 ! large positive value (+zbig) inside land 423 WHERE( tmask(:,:,:) == 0. ) 424 pbef(:,:,:) = +zbig 425 paft(:,:,:) = +zbig 426 ENDWHERE 421 pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 422 paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) ) 427 423 ! search minimum in neighbourhood 428 424 DO jk = 1, jpkm1 … … 473 469 474 470 475 ! 3. monotonic flux in the i direction, i.e. paa 476 ! ---------------------------------------------- 477 DO jk = 1, jpkm1 478 DO jj = 2, jpjm1 479 DO ji = fs_2, fs_jpim1 ! vector opt. 480 zc = paa(ji,jj,jk) 481 IF( zc >= 0. ) THEN 482 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 483 paa(ji,jj,jk) = za * zc 484 ELSE 485 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 486 paa(ji,jj,jk) = zb * zc 487 ENDIF 488 END DO 489 END DO 490 END DO 491 492 ! lateral boundary condition on paa (changed sign) 493 CALL lbc_lnk( paa, 'U', -1. ) 494 495 496 ! 4. monotonic flux in the j direction, i.e. pbb 497 ! ---------------------------------------------- 498 DO jk = 1, jpkm1 499 DO jj = 2, jpjm1 500 DO ji = fs_2, fs_jpim1 ! vector opt. 501 zc = pbb(ji,jj,jk) 502 IF( zc >= 0. ) THEN 503 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 504 pbb(ji,jj,jk) = za * zc 505 ELSE 506 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 507 pbb(ji,jj,jk) = zb * zc 508 ENDIF 509 END DO 510 END DO 511 END DO 512 513 ! lateral boundary condition on pbb (changed sign) 514 CALL lbc_lnk( pbb, 'V', -1. ) 471 ! 3. monotonic flux in the i & j direction (paa & pbb) 472 ! ---------------------------------------- 473 DO jk = 1, jpkm1 474 DO jj = 2, jpjm1 475 DO ji = fs_2, fs_jpim1 ! vector opt. 476 za = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 477 zb = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) 478 zc = 0.5 * ( 1.e0 + SIGN( 1.e0, paa(ji,jj,jk) ) ) 479 paa(ji,jj,jk) = paa(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 480 481 za = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) ) 482 zb = MIN( 1.e0, zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) ) 483 zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pbb(ji,jj,jk) ) ) 484 pbb(ji,jj,jk) = pbb(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 485 END DO 486 END DO 487 END DO 515 488 516 489 … … 520 493 DO jj = 2, jpjm1 521 494 DO ji = fs_2, fs_jpim1 ! vector opt. 522 zc = pcc(ji,jj,jk) 523 IF( zc >= 0. ) THEN 524 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 525 pcc(ji,jj,jk) = za * zc 526 ELSE 527 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 528 pcc(ji,jj,jk) = zb * zc 529 ENDIF 530 END DO 531 END DO 532 END DO 533 534 ! lateral boundary condition on pcc (unchanged sign) 535 CALL lbc_lnk( pcc, 'W', 1. ) 495 496 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 497 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) 498 zc = 0.5 * ( 1.e0 + SIGN( 1.e0, pcc(ji,jj,jk) ) ) 499 pcc(ji,jj,jk) = pcc(ji,jj,jk) * ( zc * za + ( 1.e0 - zc) * zb ) 500 END DO 501 END DO 502 END DO 503 504 ! lateral boundary condition on paa, pbb, pcc 505 CALL lbc_lnk( paa, 'U', -1. ) ! changed sign 506 CALL lbc_lnk( pbb, 'V', -1. ) ! changed sign 507 CALL lbc_lnk( pcc, 'W', 1. ) ! NO changed sign 536 508 537 509 END SUBROUTINE nonosc
Note: See TracChangeset
for help on using the changeset viewer.