Changeset 717 for trunk/NEMO/OPA_SRC/lbclnk.F90
- Timestamp:
- 2007-10-16T13:03:55+02:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lbclnk.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lbclnk.F90
r699 r717 329 329 330 330 331 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp )331 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 332 332 !!--------------------------------------------------------------------- 333 333 !! *** ROUTINE lbc_lnk_3d *** … … 355 355 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 356 356 cd_mpp ! fill the overlap area only (here do nothing) 357 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 357 358 358 359 !! * Local declarations 359 360 INTEGER :: ji, jk 360 361 INTEGER :: ijt, iju 362 REAL(wp) :: zland 361 363 !!---------------------------------------------------------------------- 362 364 !! OPA 9.0 , LOCEAN-IPSL (2005) … … 365 367 !!---------------------------------------------------------------------- 366 368 367 IF (PRESENT(cd_mpp)) THEN 369 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 370 zland = pval 371 ELSE 372 zland = 0.e0 373 ENDIF 374 375 376 IF( PRESENT( cd_mpp ) ) THEN 368 377 ! only fill the overlap area and extra allows 369 378 ! this is in mpp case. In this module, just do nothing … … 385 394 SELECT CASE ( cd_type ) 386 395 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 387 pt3d( 1 ,:,jk) = 0.e0388 pt3d(jpi,:,jk) = 0.e0389 CASE ( 'F' ) ! F-point 390 pt3d(jpi,:,jk) = 0.e0396 pt3d( 1 ,:,jk) = zland 397 pt3d(jpi,:,jk) = zland 398 CASE ( 'F' ) ! F-point 399 pt3d(jpi,:,jk) = zland 391 400 END SELECT 392 401 … … 402 411 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 403 412 pt3d(:, 1 ,jk) = pt3d(:,3,jk) 404 pt3d(:,jpj,jk) = 0.e0413 pt3d(:,jpj,jk) = zland 405 414 CASE ( 'V' , 'F' ) ! V-, F-points 406 415 pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk) 407 pt3d(:,jpj,jk) = 0.e0416 pt3d(:,jpj,jk) = zland 408 417 END SELECT 409 418 410 419 CASE ( 3 , 4 ) ! * North fold T-point pivot 411 420 412 pt3d( 1 ,jpj,jk) = 0.e0413 pt3d(jpi,jpj,jk) = 0.e0421 pt3d( 1 ,jpj,jk) = zland 422 pt3d(jpi,jpj,jk) = zland 414 423 415 424 SELECT CASE ( cd_type ) … … 417 426 DO ji = 2, jpi 418 427 ijt = jpi-ji+2 419 pt3d(ji, 1 ,jk) = 0.e0428 pt3d(ji, 1 ,jk) = zland 420 429 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 421 430 END DO … … 427 436 DO ji = 1, jpi-1 428 437 iju = jpi-ji+1 429 pt3d(ji, 1 ,jk) = 0.e0438 pt3d(ji, 1 ,jk) = zland 430 439 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk) 431 440 END DO … … 437 446 DO ji = 2, jpi 438 447 ijt = jpi-ji+2 439 pt3d(ji, 1 ,jk) = 0.e0448 pt3d(ji, 1 ,jk) = zland 440 449 pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk) 441 450 pt3d(ji,jpj ,jk) = psgn * pt3d(ijt,jpj-3,jk) … … 451 460 CASE ( 5 , 6 ) ! * North fold F-point pivot 452 461 453 pt3d( 1 ,jpj,jk) = 0.e0454 pt3d(jpi,jpj,jk) = 0.e0462 pt3d( 1 ,jpj,jk) = zland 463 pt3d(jpi,jpj,jk) = zland 455 464 456 465 SELECT CASE ( cd_type ) … … 458 467 DO ji = 1, jpi 459 468 ijt = jpi-ji+1 460 pt3d(ji, 1 ,jk) = 0.e0469 pt3d(ji, 1 ,jk) = zland 461 470 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk) 462 471 END DO … … 464 473 DO ji = 1, jpi-1 465 474 iju = jpi-ji 466 pt3d(ji, 1 ,jk) = 0.e0475 pt3d(ji, 1 ,jk) = zland 467 476 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk) 468 477 END DO … … 470 479 DO ji = 1, jpi 471 480 ijt = jpi-ji+1 472 pt3d(ji, 1 ,jk) = 0.e0481 pt3d(ji, 1 ,jk) = zland 473 482 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 474 483 END DO … … 492 501 SELECT CASE ( cd_type ) 493 502 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 494 pt3d(:, 1 ,jk) = 0.e0495 pt3d(:,jpj,jk) = 0.e0496 CASE ( 'F' ) ! F-point 497 pt3d(:,jpj,jk) = 0.e0503 pt3d(:, 1 ,jk) = zland 504 pt3d(:,jpj,jk) = zland 505 CASE ( 'F' ) ! F-point 506 pt3d(:,jpj,jk) = zland 498 507 END SELECT 499 508 … … 506 515 507 516 508 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp )517 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 509 518 !!--------------------------------------------------------------------- 510 519 !! *** ROUTINE lbc_lnk_2d *** … … 532 541 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 533 542 cd_mpp ! fill the overlap area only (here do nothing) 543 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries) 534 544 535 545 !! * Local declarations 536 546 INTEGER :: ji 537 547 INTEGER :: ijt, iju 548 REAL(wp) :: zland 538 549 !!---------------------------------------------------------------------- 539 !! OPA 8.5, LODYC-IPSL (2002) 540 !!---------------------------------------------------------------------- 550 551 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 552 zland = pval 553 ELSE 554 zland = 0.e0 555 ENDIF 541 556 542 557 IF (PRESENT(cd_mpp)) THEN … … 556 571 SELECT CASE ( cd_type ) 557 572 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 558 pt2d( 1 ,:) = 0.e0559 pt2d(jpi,:) = 0.e0573 pt2d( 1 ,:) = zland 574 pt2d(jpi,:) = zland 560 575 CASE ( 'F' ) ! F-point, ice U-V point 561 pt2d(jpi,:) = 0.e0576 pt2d(jpi,:) = zland 562 577 CASE ( 'I' ) ! F-point, ice U-V point 563 pt2d( 1 ,:) = 0.e0564 pt2d(jpi,:) = 0.e0578 pt2d( 1 ,:) = zland 579 pt2d(jpi,:) = zland 565 580 END SELECT 566 581 … … 576 591 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 577 592 pt2d(:, 1 ) = pt2d(:,3) 578 pt2d(:,jpj) = 0.e0593 pt2d(:,jpj) = zland 579 594 CASE ( 'V' , 'F' , 'I' ) ! V-, F-points, ice U-V point 580 595 pt2d(:, 1 ) = psgn * pt2d(:,2) 581 pt2d(:,jpj) = 0.e0596 pt2d(:,jpj) = zland 582 597 END SELECT 583 598 584 599 CASE ( 3 , 4 ) ! * North fold T-point pivot 585 600 586 pt2d( 1 , 1 ) = 0.e0!!!!! bug gm ??? !Edmee587 pt2d( 1 ,jpj) = 0.e0588 pt2d(jpi,jpj) = 0.e0601 pt2d( 1 , 1 ) = zland !!!!! bug gm ??? !Edmee 602 pt2d( 1 ,jpj) = zland 603 pt2d(jpi,jpj) = zland 589 604 590 605 SELECT CASE ( cd_type ) … … 593 608 DO ji = 2, jpi 594 609 ijt = jpi-ji+2 595 pt2d(ji, 1 ) = 0.e0610 pt2d(ji, 1 ) = zland 596 611 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 597 612 END DO … … 604 619 DO ji = 1, jpi-1 605 620 iju = jpi-ji+1 606 pt2d(ji, 1 ) = 0.e0621 pt2d(ji, 1 ) = zland 607 622 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2) 608 623 END DO … … 615 630 DO ji = 2, jpi 616 631 ijt = jpi-ji+2 617 pt2d(ji, 1 ) = 0.e0632 pt2d(ji, 1 ) = zland 618 633 pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2) 619 634 pt2d(ji,jpj ) = psgn * pt2d(ijt,jpj-3) … … 628 643 629 644 CASE ( 'I' ) ! ice U-V point 630 pt2d(:, 1 ) = 0.e0645 pt2d(:, 1 ) = zland 631 646 pt2d(2,jpj) = psgn * pt2d(3,jpj-1) 632 647 DO ji = 3, jpi … … 639 654 CASE ( 5 , 6 ) ! * North fold F-point pivot 640 655 641 pt2d( 1 , 1 ) = 0.e0!!bug ???642 pt2d( 1 ,jpj) = 0.e0643 pt2d(jpi,jpj) = 0.e0656 pt2d( 1 , 1 ) = zland !!bug ??? 657 pt2d( 1 ,jpj) = zland 658 pt2d(jpi,jpj) = zland 644 659 645 660 SELECT CASE ( cd_type ) … … 648 663 DO ji = 1, jpi 649 664 ijt = jpi-ji+1 650 pt2d(ji, 1 ) = 0.e0665 pt2d(ji, 1 ) = zland 651 666 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1) 652 667 END DO … … 655 670 DO ji = 1, jpi-1 656 671 iju = jpi-ji 657 pt2d(ji, 1 ) = 0.e0672 pt2d(ji, 1 ) = zland 658 673 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1) 659 674 END DO … … 662 677 DO ji = 1, jpi 663 678 ijt = jpi-ji+1 664 pt2d(ji, 1 ) = 0.e0679 pt2d(ji, 1 ) = zland 665 680 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 666 681 END DO … … 681 696 682 697 CASE ( 'I' ) ! ice U-V point 683 pt2d( : , 1 ) = 0.e0684 pt2d( 2 ,jpj) = 0.e0698 pt2d( : , 1 ) = zland 699 pt2d( 2 ,jpj) = zland 685 700 DO ji = 2 , jpim1 686 701 ijt = jpi - ji + 2 … … 694 709 SELECT CASE ( cd_type ) 695 710 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 696 pt2d(:, 1 ) = 0.e0697 pt2d(:,jpj) = 0.e0711 pt2d(:, 1 ) = zland 712 pt2d(:,jpj) = zland 698 713 CASE ( 'F' ) ! F-point 699 pt2d(:,jpj) = 0.e0714 pt2d(:,jpj) = zland 700 715 CASE ( 'I' ) ! ice U-V point 701 pt2d(:, 1 ) = 0.e0702 pt2d(:,jpj) = 0.e0716 pt2d(:, 1 ) = zland 717 pt2d(:,jpj) = zland 703 718 END SELECT 704 719
Note: See TracChangeset
for help on using the changeset viewer.
