- Timestamp:
- 2015-01-15T14:48:42+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC
- Files:
-
- 5 edited
-
lbclnk.F90 (modified) (2 diffs)
-
lbcnfd.F90 (modified) (38 diffs)
-
lib_mpp.F90 (modified) (11 diffs)
-
mppini.F90 (modified) (3 diffs)
-
mppini_2.h90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r4328 r5034 34 34 END INTERFACE 35 35 36 INTERFACE lbc_lnk_icb 37 MODULE PROCEDURE mpp_lnk_2d_icb 38 END INTERFACE 39 36 40 PUBLIC lbc_lnk ! ocean lateral boundary conditions 37 41 PUBLIC lbc_lnk_e 38 42 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 43 PUBLIC lbc_lnk_icb 39 44 40 45 !!---------------------------------------------------------------------- … … 73 78 END INTERFACE 74 79 80 INTERFACE lbc_lnk_icb 81 MODULE PROCEDURE lbc_lnk_2d_e 82 END INTERFACE 83 75 84 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 76 85 PUBLIC lbc_lnk_e 77 86 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 87 PUBLIC lbc_lnk_icb 78 88 79 89 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4230 r5034 33 33 34 34 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 3 35 INTEGER, PUBLIC :: nsndto 35 INTEGER, PUBLIC :: nsndto, nfsloop, nfeloop 36 36 INTEGER, PUBLIC, DIMENSION (jpmaxngh) :: isendto ! processes to which communicate 37 37 … … 412 412 SELECT CASE ( cd_type ) 413 413 CASE ( 'T' , 'W' ) ! T-, W-point 414 IF (n area .ne. (jpnij - jpni + 1)) THEN414 IF (nimpp .ne. 1) THEN 415 415 startloop = 1 416 416 ELSE … … 420 420 DO jk = 1, jpk 421 421 DO ji = startloop, nlci 422 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4422 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 423 423 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 424 424 END DO 425 IF(nimpp .eq. 1) THEN 426 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 427 ENDIF 425 428 END DO 426 429 … … 435 438 DO jk = 1, jpk 436 439 DO ji = startloop, nlci 437 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4440 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 438 441 jia = ji + nimpp - 1 439 442 ijta = jpiglo - jia + 2 … … 448 451 449 452 450 451 453 CASE ( 'U' ) ! U-point 452 IF ( narea .ne. (jpnij)) THEN454 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 453 455 endloop = nlci 454 456 ELSE … … 457 459 DO jk = 1, jpk 458 460 DO ji = 1, endloop 459 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3461 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 460 462 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 461 463 END DO 462 END DO 463 464 IF (narea .ne. (jpnij)) THEN 464 IF(nimpp .eq. 1) THEN 465 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-2,jk) 466 ENDIF 467 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 468 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 469 ENDIF 470 END DO 471 472 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 465 473 endloop = nlci 466 474 ELSE … … 477 485 DO jk = 1, jpk 478 486 DO ji = startloop, endloop 479 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3487 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 480 488 jia = ji + nimpp - 1 481 489 ijua = jpiglo - jia + 1 … … 490 498 491 499 CASE ( 'V' ) ! V-point 492 IF (n area .ne. (jpnij - jpni + 1)) THEN500 IF (nimpp .ne. 1) THEN 493 501 startloop = 1 494 502 ELSE … … 497 505 DO jk = 1, jpk 498 506 DO ji = startloop, nlci 499 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4507 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 500 508 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 501 509 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 502 510 END DO 511 IF(nimpp .eq. 1) THEN 512 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 513 ENDIF 503 514 END DO 504 515 CASE ( 'F' ) ! F-point 505 IF ( narea .ne. (jpnij)) THEN516 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 506 517 endloop = nlci 507 518 ELSE … … 510 521 DO jk = 1, jpk 511 522 DO ji = 1, endloop 512 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3523 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 513 524 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 514 525 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 515 526 END DO 527 IF(nimpp .eq. 1) THEN 528 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-3,jk) 529 ENDIF 530 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 531 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 532 ENDIF 516 533 END DO 517 534 END SELECT … … 524 541 DO jk = 1, jpk 525 542 DO ji = 1, nlci 526 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3543 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 527 544 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 528 545 END DO … … 530 547 531 548 CASE ( 'U' ) ! U-point 532 IF ( narea .ne. (jpnij)) THEN549 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 533 550 endloop = nlci 534 551 ELSE … … 537 554 DO jk = 1, jpk 538 555 DO ji = 1, endloop 539 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2556 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 540 557 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 541 558 END DO 559 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 560 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 561 ENDIF 542 562 END DO 543 563 … … 545 565 DO jk = 1, jpk 546 566 DO ji = 1, nlci 547 ijt = jpiglo - ji- nimpp - n imppt(isendto(1)) + 3567 ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 548 568 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 549 569 END DO … … 560 580 DO jk = 1, jpk 561 581 DO ji = startloop, nlci 562 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3582 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 563 583 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 564 584 END DO … … 567 587 568 588 CASE ( 'F' ) ! F-point 569 IF ( narea .ne. (jpnij)) THEN589 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 570 590 endloop = nlci 571 591 ELSE … … 574 594 DO jk = 1, jpk 575 595 DO ji = 1, endloop 576 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2596 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 577 597 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 578 598 END DO 579 END DO 580 581 IF (narea .ne. (jpnij)) THEN 599 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 600 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 601 ENDIF 602 END DO 603 604 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 582 605 endloop = nlci 583 606 ELSE … … 594 617 DO jk = 1, jpk 595 618 DO ji = startloop, endloop 596 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2619 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 597 620 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 598 621 END DO … … 656 679 ! 657 680 CASE ( 'T' , 'W' ) ! T- , W-points 658 IF (n area .ne. (jpnij - jpni + 1)) THEN681 IF (nimpp .ne. 1) THEN 659 682 startloop = 1 660 683 ELSE … … 662 685 ENDIF 663 686 DO ji = startloop, nlci 664 ijt=jpiglo - ji - nimpp - n imppt(isendto(1)) + 4687 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 665 688 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 666 689 END DO 690 IF (nimpp .eq. 1) THEN 691 pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2) 692 ENDIF 667 693 668 694 IF(nimpp .ge. (jpiglo/2+1)) THEN … … 674 700 ENDIF 675 701 DO ji = startloop, nlci 676 ijt=jpiglo - ji - nimpp - n imppt(isendto(1)) + 4702 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 677 703 jia = ji + nimpp - 1 678 704 ijta = jpiglo - jia + 2 … … 685 711 686 712 CASE ( 'U' ) ! U-point 687 IF ( narea .ne. (jpnij)) THEN713 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 688 714 endloop = nlci 689 715 ELSE … … 691 717 ENDIF 692 718 DO ji = 1, endloop 693 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3719 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 694 720 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 695 721 END DO 696 722 697 IF (narea .ne. (jpnij)) THEN 723 IF (nimpp .eq. 1) THEN 724 pt2dl( 1 ,ijpj ) = psgn * pt2dl( 2 ,ijpj-2) 725 pt2dl(1 ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 726 ENDIF 727 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 728 pt2dl(nlci,ijpj ) = psgn * pt2dl(nlci-1,ijpj-2) 729 ENDIF 730 731 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 698 732 endloop = nlci 699 733 ELSE … … 708 742 ENDIF 709 743 DO ji = startloop, endloop 710 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3744 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 711 745 jia = ji + nimpp - 1 712 746 ijua = jpiglo - jia + 1 … … 719 753 720 754 CASE ( 'V' ) ! V-point 721 IF (n area .ne. (jpnij - jpni + 1)) THEN755 IF (nimpp .ne. 1) THEN 722 756 startloop = 1 723 757 ELSE … … 725 759 ENDIF 726 760 DO ji = startloop, nlci 727 ijt=jpiglo - ji - nimpp - n imppt(isendto(1)) + 4761 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 728 762 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 729 763 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 730 764 END DO 765 IF (nimpp .eq. 1) THEN 766 pt2dl( 1 ,ijpj) = psgn * pt2dl( 3 ,ijpj-3) 767 ENDIF 731 768 732 769 CASE ( 'F' ) ! F-point 733 IF ( narea .ne. (jpnij)) THEN770 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 734 771 endloop = nlci 735 772 ELSE … … 737 774 ENDIF 738 775 DO ji = 1, endloop 739 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3776 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 740 777 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 741 778 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 742 779 END DO 780 IF (nimpp .eq. 1) THEN 781 pt2dl( 1 ,ijpj) = psgn * pt2dl( 2 ,ijpj-3) 782 pt2dl( 1 ,ijpj-1) = psgn * pt2dl( 2 ,ijpj-2) 783 ENDIF 784 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 785 pt2dl(nlci,ijpj) = psgn * pt2dl(nlci-1,ijpj-3) 786 pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 787 ENDIF 743 788 744 789 CASE ( 'I' ) ! ice U-V point (I-point) 745 IF (n area .ne. (jpnij - jpni + 1)) THEN790 IF (nimpp .ne. 1) THEN 746 791 startloop = 1 747 792 ELSE … … 750 795 ENDIF 751 796 DO ji = startloop, nlci 752 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 5797 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 753 798 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 754 799 END DO 755 800 756 801 CASE ( 'J' ) ! first ice U-V point 757 IF (n area .ne. (jpnij - jpni + 1)) THEN802 IF (nimpp .ne. 1) THEN 758 803 startloop = 1 759 804 ELSE … … 762 807 ENDIF 763 808 DO ji = startloop, nlci 764 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 5809 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 765 810 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 766 811 END DO 767 812 768 813 CASE ( 'K' ) ! second ice U-V point 769 IF (n area .ne. (jpnij - jpni + 1)) THEN814 IF (nimpp .ne. 1) THEN 770 815 startloop = 1 771 816 ELSE … … 774 819 ENDIF 775 820 DO ji = startloop, nlci 776 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 5821 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 777 822 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 778 823 END DO … … 785 830 CASE ( 'T' , 'W' ) ! T-, W-point 786 831 DO ji = 1, nlci 787 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3832 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 788 833 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 789 834 END DO 790 835 791 836 CASE ( 'U' ) ! U-point 792 IF ( narea .ne. (jpnij)) THEN837 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 793 838 endloop = nlci 794 839 ELSE … … 796 841 ENDIF 797 842 DO ji = 1, endloop 798 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2843 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 799 844 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 800 845 END DO 846 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 847 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 848 ENDIF 801 849 802 850 CASE ( 'V' ) ! V-point 803 851 DO ji = 1, nlci 804 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3852 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 805 853 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 806 854 END DO … … 813 861 ENDIF 814 862 DO ji = startloop, nlci 815 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3863 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 816 864 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 817 865 END DO 818 866 819 867 CASE ( 'F' ) ! F-point 820 IF ( narea .ne. (jpnij)) THEN868 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 821 869 endloop = nlci 822 870 ELSE … … 824 872 ENDIF 825 873 DO ji = 1, endloop 826 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2874 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 827 875 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 828 876 END DO 829 830 IF (narea .ne. (jpnij)) THEN 877 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 878 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 879 ENDIF 880 881 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 831 882 endloop = nlci 832 883 ELSE … … 842 893 843 894 DO ji = startloop, endloop 844 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2895 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 845 896 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 846 897 END DO 847 898 848 899 CASE ( 'I' ) ! ice U-V point (I-point) 849 IF (n area .ne. (jpnij - jpni + 1)) THEN900 IF (nimpp .ne. 1) THEN 850 901 startloop = 1 851 902 ELSE 852 903 startloop = 2 853 904 ENDIF 854 IF ( narea .ne. jpnij) THEN905 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 855 906 endloop = nlci 856 907 ELSE … … 858 909 ENDIF 859 910 DO ji = startloop , endloop 860 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4911 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 861 912 pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 862 913 END DO 863 914 864 915 CASE ( 'J' ) ! first ice U-V point 865 IF (n area .ne. (jpnij - jpni + 1)) THEN916 IF (nimpp .ne. 1) THEN 866 917 startloop = 1 867 918 ELSE 868 919 startloop = 2 869 920 ENDIF 870 IF ( narea .ne. jpnij) THEN921 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 871 922 endloop = nlci 872 923 ELSE … … 874 925 ENDIF 875 926 DO ji = startloop , endloop 876 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4927 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 877 928 pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 878 929 END DO 879 930 880 931 CASE ( 'K' ) ! second ice U-V point 881 IF (n area .ne. (jpnij - jpni + 1)) THEN932 IF (nimpp .ne. 1) THEN 882 933 startloop = 1 883 934 ELSE 884 935 startloop = 2 885 936 ENDIF 886 IF ( narea .ne. jpnij) THEN937 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 887 938 endloop = nlci 888 939 ELSE … … 890 941 ENDIF 891 942 DO ji = startloop, endloop 892 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4943 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 893 944 pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 894 945 END DO -
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4645 r5034 42 42 !! mpp_lnk_3d_gather : Message passing manadgement for two 3D arrays 43 43 !! mpp_lnk_e : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 44 !! mpp_lnk_icb : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 44 45 !! mpprecv : 45 46 !! mppsend : SUBROUTINE mpp_ini_znl … … 56 57 !! mpp_lbc_north : north fold processors gathering 57 58 !! mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 59 !! mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs 58 60 !!---------------------------------------------------------------------- 59 61 USE dom_oce ! ocean space and time domain … … 74 76 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 75 77 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 78 PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb 76 79 77 80 !! * Interfaces … … 2026 2029 ijpjm1 = 3 2027 2030 ! 2031 znorthloc(:,:,:) = 0 2028 2032 DO jk = 1, jpk 2029 2033 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d … … 2036 2040 itaille = jpi * jpk * ijpj 2037 2041 2038 2039 2042 IF ( l_north_nogather ) THEN 2040 2043 ! 2041 2044 ztabr(:,:,:) = 0 2045 ztabl(:,:,:) = 0 2046 2042 2047 DO jk = 1, jpk 2043 2048 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2044 2049 ij = jj - nlcj + ijpj 2045 DO ji = 1, nlci2050 DO ji = nfsloop, nfeloop 2046 2051 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 2047 2052 END DO … … 2050 2055 2051 2056 DO jr = 1,nsndto 2052 IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 2057 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2058 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 2059 ENDIF 2053 2060 END DO 2054 2061 DO jr = 1,nsndto 2055 iproc = isendto(jr) 2056 ildi = nldit (iproc) 2057 ilei = nleit (iproc) 2058 iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 2059 IF(isendto(jr) .ne. narea) THEN 2060 CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 2062 iproc = nfipproc(isendto(jr),jpnj) 2063 IF(iproc .ne. -1) THEN 2064 ilei = nleit (iproc+1) 2065 ildi = nldit (iproc+1) 2066 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2067 ENDIF 2068 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2069 CALL mpprecv(5, zfoldwk, itaille, iproc) 2061 2070 DO jk = 1, jpk 2062 2071 DO jj = 1, ijpj 2063 DO ji = 1, ilei2072 DO ji = ildi, ilei 2064 2073 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 2065 2074 END DO 2066 2075 END DO 2067 2076 END DO 2068 ELSE 2077 ELSE IF (iproc .eq. (narea-1)) THEN 2069 2078 DO jk = 1, jpk 2070 2079 DO jj = 1, ijpj 2071 DO ji = 1, ilei2080 DO ji = ildi, ilei 2072 2081 ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 2073 2082 END DO … … 2078 2087 IF (l_isend) THEN 2079 2088 DO jr = 1,nsndto 2080 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2089 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2090 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2091 ENDIF 2081 2092 END DO 2082 2093 ENDIF 2083 2094 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition 2084 !2085 2095 DO jk = 1, jpk 2086 2096 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d … … 2190 2200 ! 2191 2201 ztabr(:,:) = 0 2202 ztabl(:,:) = 0 2203 2192 2204 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2193 2205 ij = jj - nlcj + ijpj 2194 DO ji = 1, nlci2206 DO ji = nfsloop, nfeloop 2195 2207 ztabl(ji,ij) = pt2d(ji,jj) 2196 2208 END DO … … 2198 2210 2199 2211 DO jr = 1,nsndto 2200 IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 2212 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2213 CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 2214 ENDIF 2201 2215 END DO 2202 2216 DO jr = 1,nsndto 2203 iproc = isendto(jr) 2204 ildi = nldit (iproc) 2205 ilei = nleit (iproc) 2206 iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 2207 IF(isendto(jr) .ne. narea) THEN 2208 CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 2217 iproc = nfipproc(isendto(jr),jpnj) 2218 IF(iproc .ne. -1) THEN 2219 ilei = nleit (iproc+1) 2220 ildi = nldit (iproc+1) 2221 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2222 ENDIF 2223 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2224 CALL mpprecv(5, zfoldwk, itaille, iproc) 2209 2225 DO jj = 1, ijpj 2210 DO ji = 1, ilei2226 DO ji = ildi, ilei 2211 2227 ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 2212 2228 END DO 2213 2229 END DO 2214 ELSE 2230 ELSE IF (iproc .eq. (narea-1)) THEN 2215 2231 DO jj = 1, ijpj 2216 DO ji = 1, ilei2232 DO ji = ildi, ilei 2217 2233 ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 2218 2234 END DO … … 2222 2238 IF (l_isend) THEN 2223 2239 DO jr = 1,nsndto 2224 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2240 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2241 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2242 ENDIF 2225 2243 END DO 2226 2244 ENDIF … … 2878 2896 END SUBROUTINE DDPDD_MPI 2879 2897 2898 SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj) 2899 !!--------------------------------------------------------------------- 2900 !! *** routine mpp_lbc_north_icb *** 2901 !! 2902 !! ** Purpose : Ensure proper north fold horizontal bondary condition 2903 !! in mpp configuration in case of jpn1 > 1 and for 2d 2904 !! array with outer extra halo 2905 !! 2906 !! ** Method : North fold condition and mpp with more than one proc 2907 !! in i-direction require a specific treatment. We gather 2908 !! the 4+2*jpr2dj northern lines of the global domain on 1 2909 !! processor and apply lbc north-fold on this sub array. 2910 !! Then we scatter the north fold array back to the processors. 2911 !! This version accounts for an extra halo with icebergs. 2912 !! 2913 !!---------------------------------------------------------------------- 2914 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array with extra halo 2915 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 2916 ! ! = T , U , V , F or W -points 2917 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the 2918 !! ! north fold, = 1. otherwise 2919 INTEGER, OPTIONAL , INTENT(in ) :: pr2dj 2920 INTEGER :: ji, jj, jr 2921 INTEGER :: ierr, itaille, ildi, ilei, iilb 2922 INTEGER :: ijpj, ij, iproc, ipr2dj 2923 ! 2924 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 2925 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 2926 2927 !!---------------------------------------------------------------------- 2928 ! 2929 ijpj=4 2930 IF( PRESENT(pr2dj) ) THEN ! use of additional halos 2931 ipr2dj = pr2dj 2932 ELSE 2933 ipr2dj = 0 2934 ENDIF 2935 ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) ) 2936 2937 ! 2938 ztab_e(:,:) = 0.e0 2939 2940 ij=0 2941 ! put in znorthloc_e the last 4 jlines of pt2d 2942 DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj 2943 ij = ij + 1 2944 DO ji = 1, jpi 2945 znorthloc_e(ji,ij)=pt2d(ji,jj) 2946 END DO 2947 END DO 2948 ! 2949 itaille = jpi * ( ijpj + 2 * ipr2dj ) 2950 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2951 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2952 ! 2953 DO jr = 1, ndim_rank_north ! recover the global north array 2954 iproc = nrank_north(jr) + 1 2955 ildi = nldit (iproc) 2956 ilei = nleit (iproc) 2957 iilb = nimppt(iproc) 2958 DO jj = 1, ijpj+2*ipr2dj 2959 DO ji = ildi, ilei 2960 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 2961 END DO 2962 END DO 2963 END DO 2964 2965 2966 ! 2. North-Fold boundary conditions 2967 ! ---------------------------------- 2968 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 2969 2970 ij = ipr2dj 2971 !! Scatter back to pt2d 2972 DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj 2973 ij = ij +1 2974 DO ji= 1, nlci 2975 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 2976 END DO 2977 END DO 2978 ! 2979 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 2980 ! 2981 END SUBROUTINE mpp_lbc_north_icb 2982 2983 SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj ) 2984 !!---------------------------------------------------------------------- 2985 !! *** routine mpp_lnk_2d_icb *** 2986 !! 2987 !! ** Purpose : Message passing manadgement for 2d array (with extra halo and icebergs) 2988 !! 2989 !! ** Method : Use mppsend and mpprecv function for passing mask 2990 !! between processors following neighboring subdomains. 2991 !! domain parameters 2992 !! nlci : first dimension of the local subdomain 2993 !! nlcj : second dimension of the local subdomain 2994 !! jpri : number of rows for extra outer halo 2995 !! jprj : number of columns for extra outer halo 2996 !! nbondi : mark for "east-west local boundary" 2997 !! nbondj : mark for "north-south local boundary" 2998 !! noea : number for local neighboring processors 2999 !! nowe : number for local neighboring processors 3000 !! noso : number for local neighboring processors 3001 !! nono : number for local neighboring processors 3002 !! 3003 !!---------------------------------------------------------------------- 3004 INTEGER , INTENT(in ) :: jpri 3005 INTEGER , INTENT(in ) :: jprj 3006 REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) :: pt2d ! 2D array with extra halo 3007 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 3008 ! ! = T , U , V , F , W and I points 3009 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 3010 !! ! north boundary, = 1. otherwise 3011 INTEGER :: jl ! dummy loop indices 3012 INTEGER :: imigr, iihom, ijhom ! temporary integers 3013 INTEGER :: ipreci, iprecj ! temporary integers 3014 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 3015 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 3016 !! 3017 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 3018 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 3019 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 3020 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 3021 !!---------------------------------------------------------------------- 3022 3023 ipreci = jpreci + jpri ! take into account outer extra 2D overlap area 3024 iprecj = jprecj + jprj 3025 3026 3027 ! 1. standard boundary treatment 3028 ! ------------------------------ 3029 ! Order matters Here !!!! 3030 ! 3031 ! ! East-West boundaries 3032 ! !* Cyclic east-west 3033 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 3034 pt2d(1-jpri: 1 ,:) = pt2d(jpim1-jpri: jpim1 ,:) ! east 3035 pt2d( jpi :jpi+jpri,:) = pt2d( 2 :2+jpri,:) ! west 3036 ! 3037 ELSE !* closed 3038 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0.e0 ! south except at F-point 3039 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0 ! north 3040 ENDIF 3041 ! 3042 3043 ! north fold treatment 3044 ! ----------------------- 3045 IF( npolj /= 0 ) THEN 3046 ! 3047 SELECT CASE ( jpni ) 3048 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 3049 CASE DEFAULT ; CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj) , cd_type, psgn , pr2dj=jprj ) 3050 END SELECT 3051 ! 3052 ENDIF 3053 3054 ! 2. East and west directions exchange 3055 ! ------------------------------------ 3056 ! we play with the neigbours AND the row number because of the periodicity 3057 ! 3058 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 3059 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 3060 iihom = nlci-nreci-jpri 3061 DO jl = 1, ipreci 3062 r2dew(:,jl,1) = pt2d(jpreci+jl,:) 3063 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 3064 END DO 3065 END SELECT 3066 ! 3067 ! ! Migrations 3068 imigr = ipreci * ( jpj + 2*jprj) 3069 ! 3070 SELECT CASE ( nbondi ) 3071 CASE ( -1 ) 3072 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 3073 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 3074 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3075 CASE ( 0 ) 3076 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 3077 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 3078 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 3079 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 3080 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3081 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 3082 CASE ( 1 ) 3083 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 3084 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 3085 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3086 END SELECT 3087 ! 3088 ! ! Write Dirichlet lateral conditions 3089 iihom = nlci - jpreci 3090 ! 3091 SELECT CASE ( nbondi ) 3092 CASE ( -1 ) 3093 DO jl = 1, ipreci 3094 pt2d(iihom+jl,:) = r2dew(:,jl,2) 3095 END DO 3096 CASE ( 0 ) 3097 DO jl = 1, ipreci 3098 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 3099 pt2d( iihom+jl,:) = r2dew(:,jl,2) 3100 END DO 3101 CASE ( 1 ) 3102 DO jl = 1, ipreci 3103 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 3104 END DO 3105 END SELECT 3106 3107 3108 ! 3. North and south directions 3109 ! ----------------------------- 3110 ! always closed : we play only with the neigbours 3111 ! 3112 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 3113 ijhom = nlcj-nrecj-jprj 3114 DO jl = 1, iprecj 3115 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 3116 r2dns(:,jl,1) = pt2d(:,jprecj+jl) 3117 END DO 3118 ENDIF 3119 ! 3120 ! ! Migrations 3121 imigr = iprecj * ( jpi + 2*jpri ) 3122 ! 3123 SELECT CASE ( nbondj ) 3124 CASE ( -1 ) 3125 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 3126 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 3127 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3128 CASE ( 0 ) 3129 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 3130 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 3131 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 3132 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 3133 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3134 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 3135 CASE ( 1 ) 3136 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 3137 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 3138 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3139 END SELECT 3140 ! 3141 ! ! Write Dirichlet lateral conditions 3142 ijhom = nlcj - jprecj 3143 ! 3144 SELECT CASE ( nbondj ) 3145 CASE ( -1 ) 3146 DO jl = 1, iprecj 3147 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 3148 END DO 3149 CASE ( 0 ) 3150 DO jl = 1, iprecj 3151 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 3152 pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 3153 END DO 3154 CASE ( 1 ) 3155 DO jl = 1, iprecj 3156 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 3157 END DO 3158 END SELECT 3159 3160 END SUBROUTINE mpp_lnk_2d_icb 2880 3161 #else 2881 3162 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r3294 r5034 177 177 178 178 #endif 179 nfilcit(:,:) = ilcit(:,:) 179 180 IF( irestj == 0 ) irestj = jpnj 180 181 … … 255 256 END DO 256 257 ENDIF 258 nfiimpp(:,:)=iimppt(:,:) 257 259 258 260 IF( jpnj > 1 ) THEN … … 270 272 ii = 1 + MOD( jn-1, jpni ) 271 273 ij = 1 + (jn-1) / jpni 274 nfipproc(ii,ij) = jn - 1 272 275 nimppt(jn) = iimppt(ii,ij) 273 276 njmppt(jn) = ijmppt(ii,ij) -
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r4647 r5034 67 67 imask ! temporary global workspace 68 68 REAL(wp), DIMENSION(jpiglo,jpjglo) :: & 69 zdta ! temporary data workspace69 zdta, zdtaisf ! temporary data workspace 70 70 REAL(wp) :: zidom , zjdom ! temporary scalars 71 71 72 72 ! read namelist for ln_zco 73 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 73 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 74 74 75 75 !!---------------------------------------------------------------------- … … 109 109 ENDIF 110 110 CALL iom_close (inum) 111 112 ! used to compute the land processor in case of not masked bathy file. 113 zdtaisf(:,:) = 0.0_wp 114 IF ( ln_isfcav ) THEN 115 CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps 116 CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 117 END IF 118 CALL iom_close (inum) 111 119 112 120 ! land/sea mask over the global/zoom domain 113 121 114 122 imask(:,:)=1 115 WHERE ( zdta(:,:) <= 0. ) imask = 0123 WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0 116 124 117 125 ! 1. Dimension arrays for subdomains … … 143 151 ilcj(:, irestj+1:jpnj) = jpj-1 144 152 #endif 153 154 nfilcit(:,:) = ilci(:,:) 145 155 146 156 IF(lwp) WRITE(numout,*) … … 175 185 END DO 176 186 ENDIF 187 nfiimpp(:,:) = iimppt(:,:) 177 188 178 189 IF( jpnj > 1 )THEN … … 195 206 ili = ilci(ii,ij) 196 207 ilj = ilcj(ii,ij) 197 198 208 ibondj(ii,ij) = -1 199 209 IF( jarea > jpni ) ibondj(ii,ij) = 0 200 210 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 201 211 IF( jpnj == 1 ) ibondj(ii,ij) = 2 202 203 212 ibondi(ii,ij) = 0 204 213 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 … … 308 317 END DO 309 318 319 nfipproc(:,:) = ipproc(:,:) 320 321 310 322 ! Control 311 323 IF(icont+1 /= jpnij) THEN
Note: See TracChangeset
for help on using the changeset viewer.
