Changeset 719 for trunk/NEMO/OPA_SRC/lbclnk.F90
- Timestamp:
- 2007-10-16T16:59:56+02:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lbclnk.F90 (modified) (27 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lbclnk.F90
- Property svn:keywords changed from Id to Author Date Id Revision
r717 r719 93 93 !!---------------------------------------------------------------------- 94 94 !! OPA 9.0 , LOCEAN-IPSL (2005) 95 !! $ Id$95 !! $Header$ 96 96 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 97 97 !!---------------------------------------------------------------------- … … 329 329 330 330 331 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp , pval)331 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp ) 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)358 357 359 358 !! * Local declarations 360 359 INTEGER :: ji, jk 361 360 INTEGER :: ijt, iju 362 REAL(wp) :: zland363 361 !!---------------------------------------------------------------------- 364 362 !! OPA 9.0 , LOCEAN-IPSL (2005) 365 !! $ Id$363 !! $Header$ 366 364 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 367 365 !!---------------------------------------------------------------------- 368 366 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 367 IF (PRESENT(cd_mpp)) THEN 377 368 ! only fill the overlap area and extra allows 378 369 ! this is in mpp case. In this module, just do nothing … … 394 385 SELECT CASE ( cd_type ) 395 386 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 396 pt3d( 1 ,:,jk) = zland397 pt3d(jpi,:,jk) = zland398 CASE ( 'F' ) ! F-point 399 pt3d(jpi,:,jk) = zland387 pt3d( 1 ,:,jk) = 0.e0 388 pt3d(jpi,:,jk) = 0.e0 389 CASE ( 'F' ) ! F-point 390 pt3d(jpi,:,jk) = 0.e0 400 391 END SELECT 401 392 … … 411 402 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 412 403 pt3d(:, 1 ,jk) = pt3d(:,3,jk) 413 pt3d(:,jpj,jk) = zland404 pt3d(:,jpj,jk) = 0.e0 414 405 CASE ( 'V' , 'F' ) ! V-, F-points 415 406 pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk) 416 pt3d(:,jpj,jk) = zland407 pt3d(:,jpj,jk) = 0.e0 417 408 END SELECT 418 409 419 410 CASE ( 3 , 4 ) ! * North fold T-point pivot 420 411 421 pt3d( 1 ,jpj,jk) = zland422 pt3d(jpi,jpj,jk) = zland412 pt3d( 1 ,jpj,jk) = 0.e0 413 pt3d(jpi,jpj,jk) = 0.e0 423 414 424 415 SELECT CASE ( cd_type ) … … 426 417 DO ji = 2, jpi 427 418 ijt = jpi-ji+2 428 pt3d(ji, 1 ,jk) = zland419 pt3d(ji, 1 ,jk) = 0.e0 429 420 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 430 421 END DO … … 436 427 DO ji = 1, jpi-1 437 428 iju = jpi-ji+1 438 pt3d(ji, 1 ,jk) = zland429 pt3d(ji, 1 ,jk) = 0.e0 439 430 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk) 440 431 END DO … … 446 437 DO ji = 2, jpi 447 438 ijt = jpi-ji+2 448 pt3d(ji, 1 ,jk) = zland439 pt3d(ji, 1 ,jk) = 0.e0 449 440 pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk) 450 441 pt3d(ji,jpj ,jk) = psgn * pt3d(ijt,jpj-3,jk) … … 460 451 CASE ( 5 , 6 ) ! * North fold F-point pivot 461 452 462 pt3d( 1 ,jpj,jk) = zland463 pt3d(jpi,jpj,jk) = zland453 pt3d( 1 ,jpj,jk) = 0.e0 454 pt3d(jpi,jpj,jk) = 0.e0 464 455 465 456 SELECT CASE ( cd_type ) … … 467 458 DO ji = 1, jpi 468 459 ijt = jpi-ji+1 469 pt3d(ji, 1 ,jk) = zland460 pt3d(ji, 1 ,jk) = 0.e0 470 461 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk) 471 462 END DO … … 473 464 DO ji = 1, jpi-1 474 465 iju = jpi-ji 475 pt3d(ji, 1 ,jk) = zland466 pt3d(ji, 1 ,jk) = 0.e0 476 467 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk) 477 468 END DO … … 479 470 DO ji = 1, jpi 480 471 ijt = jpi-ji+1 481 pt3d(ji, 1 ,jk) = zland472 pt3d(ji, 1 ,jk) = 0.e0 482 473 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 483 474 END DO … … 501 492 SELECT CASE ( cd_type ) 502 493 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 503 pt3d(:, 1 ,jk) = zland504 pt3d(:,jpj,jk) = zland505 CASE ( 'F' ) ! F-point 506 pt3d(:,jpj,jk) = zland494 pt3d(:, 1 ,jk) = 0.e0 495 pt3d(:,jpj,jk) = 0.e0 496 CASE ( 'F' ) ! F-point 497 pt3d(:,jpj,jk) = 0.e0 507 498 END SELECT 508 499 … … 515 506 516 507 517 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp , pval)508 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp ) 518 509 !!--------------------------------------------------------------------- 519 510 !! *** ROUTINE lbc_lnk_2d *** … … 541 532 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 542 533 cd_mpp ! fill the overlap area only (here do nothing) 543 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (used at closed boundaries)544 534 545 535 !! * Local declarations 546 536 INTEGER :: ji 547 537 INTEGER :: ijt, iju 548 REAL(wp) :: zland 549 !!---------------------------------------------------------------------- 550 551 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) 552 zland = pval 553 ELSE 554 zland = 0.e0 555 ENDIF 538 !!---------------------------------------------------------------------- 539 !! OPA 8.5, LODYC-IPSL (2002) 540 !!---------------------------------------------------------------------- 556 541 557 542 IF (PRESENT(cd_mpp)) THEN … … 571 556 SELECT CASE ( cd_type ) 572 557 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 573 pt2d( 1 ,:) = zland574 pt2d(jpi,:) = zland558 pt2d( 1 ,:) = 0.e0 559 pt2d(jpi,:) = 0.e0 575 560 CASE ( 'F' ) ! F-point, ice U-V point 576 pt2d(jpi,:) = zland561 pt2d(jpi,:) = 0.e0 577 562 CASE ( 'I' ) ! F-point, ice U-V point 578 pt2d( 1 ,:) = zland579 pt2d(jpi,:) = zland563 pt2d( 1 ,:) = 0.e0 564 pt2d(jpi,:) = 0.e0 580 565 END SELECT 581 566 … … 591 576 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 592 577 pt2d(:, 1 ) = pt2d(:,3) 593 pt2d(:,jpj) = zland578 pt2d(:,jpj) = 0.e0 594 579 CASE ( 'V' , 'F' , 'I' ) ! V-, F-points, ice U-V point 595 580 pt2d(:, 1 ) = psgn * pt2d(:,2) 596 pt2d(:,jpj) = zland581 pt2d(:,jpj) = 0.e0 597 582 END SELECT 598 583 599 584 CASE ( 3 , 4 ) ! * North fold T-point pivot 600 585 601 pt2d( 1 , 1 ) = zland!!!!! bug gm ??? !Edmee602 pt2d( 1 ,jpj) = zland603 pt2d(jpi,jpj) = zland586 pt2d( 1 , 1 ) = 0.e0 !!!!! bug gm ??? !Edmee 587 pt2d( 1 ,jpj) = 0.e0 588 pt2d(jpi,jpj) = 0.e0 604 589 605 590 SELECT CASE ( cd_type ) … … 608 593 DO ji = 2, jpi 609 594 ijt = jpi-ji+2 610 pt2d(ji, 1 ) = zland595 pt2d(ji, 1 ) = 0.e0 611 596 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 612 597 END DO … … 619 604 DO ji = 1, jpi-1 620 605 iju = jpi-ji+1 621 pt2d(ji, 1 ) = zland606 pt2d(ji, 1 ) = 0.e0 622 607 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2) 623 608 END DO … … 630 615 DO ji = 2, jpi 631 616 ijt = jpi-ji+2 632 pt2d(ji, 1 ) = zland617 pt2d(ji, 1 ) = 0.e0 633 618 pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2) 634 619 pt2d(ji,jpj ) = psgn * pt2d(ijt,jpj-3) … … 643 628 644 629 CASE ( 'I' ) ! ice U-V point 645 pt2d(:, 1 ) = zland630 pt2d(:, 1 ) = 0.e0 646 631 pt2d(2,jpj) = psgn * pt2d(3,jpj-1) 647 632 DO ji = 3, jpi … … 654 639 CASE ( 5 , 6 ) ! * North fold F-point pivot 655 640 656 pt2d( 1 , 1 ) = zland!!bug ???657 pt2d( 1 ,jpj) = zland658 pt2d(jpi,jpj) = zland641 pt2d( 1 , 1 ) = 0.e0 !!bug ??? 642 pt2d( 1 ,jpj) = 0.e0 643 pt2d(jpi,jpj) = 0.e0 659 644 660 645 SELECT CASE ( cd_type ) … … 663 648 DO ji = 1, jpi 664 649 ijt = jpi-ji+1 665 pt2d(ji, 1 ) = zland650 pt2d(ji, 1 ) = 0.e0 666 651 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1) 667 652 END DO … … 670 655 DO ji = 1, jpi-1 671 656 iju = jpi-ji 672 pt2d(ji, 1 ) = zland657 pt2d(ji, 1 ) = 0.e0 673 658 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1) 674 659 END DO … … 677 662 DO ji = 1, jpi 678 663 ijt = jpi-ji+1 679 pt2d(ji, 1 ) = zland664 pt2d(ji, 1 ) = 0.e0 680 665 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2) 681 666 END DO … … 696 681 697 682 CASE ( 'I' ) ! ice U-V point 698 pt2d( : , 1 ) = zland699 pt2d( 2 ,jpj) = zland683 pt2d( : , 1 ) = 0.e0 684 pt2d( 2 ,jpj) = 0.e0 700 685 DO ji = 2 , jpim1 701 686 ijt = jpi - ji + 2 … … 709 694 SELECT CASE ( cd_type ) 710 695 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 711 pt2d(:, 1 ) = zland712 pt2d(:,jpj) = zland696 pt2d(:, 1 ) = 0.e0 697 pt2d(:,jpj) = 0.e0 713 698 CASE ( 'F' ) ! F-point 714 pt2d(:,jpj) = zland699 pt2d(:,jpj) = 0.e0 715 700 CASE ( 'I' ) ! ice U-V point 716 pt2d(:, 1 ) = zland717 pt2d(:,jpj) = zland701 pt2d(:, 1 ) = 0.e0 702 pt2d(:,jpj) = 0.e0 718 703 END SELECT 719 704
Note: See TracChangeset
for help on using the changeset viewer.
