Changeset 4671 for trunk/NEMOGCM/NEMO/OPA_SRC/LBC
- Timestamp:
- 2014-06-17T17:00:51+02:00 (10 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/LBC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4230 r4671 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 … … 435 435 DO jk = 1, jpk 436 436 DO ji = startloop, nlci 437 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4437 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 438 438 jia = ji + nimpp - 1 439 439 ijta = jpiglo - jia + 2 … … 448 448 449 449 450 451 450 CASE ( 'U' ) ! U-point 452 IF ( narea .ne. (jpnij)) THEN451 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 453 452 endloop = nlci 454 453 ELSE … … 457 456 DO jk = 1, jpk 458 457 DO ji = 1, endloop 459 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3458 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 460 459 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 461 460 END DO 462 461 END DO 463 462 464 IF ( narea .ne. (jpnij)) THEN463 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 465 464 endloop = nlci 466 465 ELSE … … 477 476 DO jk = 1, jpk 478 477 DO ji = startloop, endloop 479 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3478 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 480 479 jia = ji + nimpp - 1 481 480 ijua = jpiglo - jia + 1 … … 490 489 491 490 CASE ( 'V' ) ! V-point 492 IF (n area .ne. (jpnij - jpni + 1)) THEN491 IF (nimpp .ne. 1) THEN 493 492 startloop = 1 494 493 ELSE … … 497 496 DO jk = 1, jpk 498 497 DO ji = startloop, nlci 499 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4498 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 500 499 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 501 500 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) … … 503 502 END DO 504 503 CASE ( 'F' ) ! F-point 505 IF ( narea .ne. (jpnij)) THEN504 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 506 505 endloop = nlci 507 506 ELSE … … 510 509 DO jk = 1, jpk 511 510 DO ji = 1, endloop 512 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3511 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 513 512 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 514 513 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-3,jk) … … 524 523 DO jk = 1, jpk 525 524 DO ji = 1, nlci 526 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3525 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 527 526 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 528 527 END DO … … 530 529 531 530 CASE ( 'U' ) ! U-point 532 IF ( narea .ne. (jpnij)) THEN531 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 533 532 endloop = nlci 534 533 ELSE … … 537 536 DO jk = 1, jpk 538 537 DO ji = 1, endloop 539 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2538 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 540 539 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 541 540 END DO … … 545 544 DO jk = 1, jpk 546 545 DO ji = 1, nlci 547 ijt = jpiglo - ji- nimpp - n imppt(isendto(1)) + 3546 ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 548 547 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 549 548 END DO … … 560 559 DO jk = 1, jpk 561 560 DO ji = startloop, nlci 562 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3561 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 563 562 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 564 563 END DO … … 567 566 568 567 CASE ( 'F' ) ! F-point 569 IF ( narea .ne. (jpnij)) THEN568 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 570 569 endloop = nlci 571 570 ELSE … … 574 573 DO jk = 1, jpk 575 574 DO ji = 1, endloop 576 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2575 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 577 576 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 578 577 END DO 579 578 END DO 580 579 581 IF ( narea .ne. (jpnij)) THEN580 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 582 581 endloop = nlci 583 582 ELSE … … 594 593 DO jk = 1, jpk 595 594 DO ji = startloop, endloop 596 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2595 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 597 596 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 598 597 END DO … … 656 655 ! 657 656 CASE ( 'T' , 'W' ) ! T- , W-points 658 IF (n area .ne. (jpnij - jpni + 1)) THEN657 IF (nimpp .ne. 1) THEN 659 658 startloop = 1 660 659 ELSE … … 662 661 ENDIF 663 662 DO ji = startloop, nlci 664 ijt=jpiglo - ji - nimpp - n imppt(isendto(1)) + 4663 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 665 664 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 666 665 END DO … … 674 673 ENDIF 675 674 DO ji = startloop, nlci 676 ijt=jpiglo - ji - nimpp - n imppt(isendto(1)) + 4675 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 677 676 jia = ji + nimpp - 1 678 677 ijta = jpiglo - jia + 2 … … 685 684 686 685 CASE ( 'U' ) ! U-point 687 IF ( narea .ne. (jpnij)) THEN686 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 688 687 endloop = nlci 689 688 ELSE … … 691 690 ENDIF 692 691 DO ji = 1, endloop 693 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3692 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 694 693 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 695 694 END DO 696 695 697 IF ( narea .ne. (jpnij)) THEN696 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 698 697 endloop = nlci 699 698 ELSE … … 708 707 ENDIF 709 708 DO ji = startloop, endloop 710 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3709 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 711 710 jia = ji + nimpp - 1 712 711 ijua = jpiglo - jia + 1 … … 719 718 720 719 CASE ( 'V' ) ! V-point 721 IF (n area .ne. (jpnij - jpni + 1)) THEN720 IF (nimpp .ne. 1) THEN 722 721 startloop = 1 723 722 ELSE … … 725 724 ENDIF 726 725 DO ji = startloop, nlci 727 ijt=jpiglo - ji - nimpp - n imppt(isendto(1)) + 4726 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 728 727 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 729 728 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) … … 731 730 732 731 CASE ( 'F' ) ! F-point 733 IF ( narea .ne. (jpnij)) THEN732 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 734 733 endloop = nlci 735 734 ELSE … … 737 736 ENDIF 738 737 DO ji = 1, endloop 739 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3738 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 740 739 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 741 740 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) … … 743 742 744 743 CASE ( 'I' ) ! ice U-V point (I-point) 745 IF (n area .ne. (jpnij - jpni + 1)) THEN744 IF (nimpp .ne. 1) THEN 746 745 startloop = 1 747 746 ELSE … … 750 749 ENDIF 751 750 DO ji = startloop, nlci 752 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 5751 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 753 752 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 754 753 END DO 755 754 756 755 CASE ( 'J' ) ! first ice U-V point 757 IF (n area .ne. (jpnij - jpni + 1)) THEN756 IF (nimpp .ne. 1) THEN 758 757 startloop = 1 759 758 ELSE … … 762 761 ENDIF 763 762 DO ji = startloop, nlci 764 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 5763 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 765 764 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 766 765 END DO 767 766 768 767 CASE ( 'K' ) ! second ice U-V point 769 IF (n area .ne. (jpnij - jpni + 1)) THEN768 IF (nimpp .ne. 1) THEN 770 769 startloop = 1 771 770 ELSE … … 774 773 ENDIF 775 774 DO ji = startloop, nlci 776 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 5775 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 777 776 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 778 777 END DO … … 785 784 CASE ( 'T' , 'W' ) ! T-, W-point 786 785 DO ji = 1, nlci 787 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3786 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 788 787 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 789 788 END DO 790 789 791 790 CASE ( 'U' ) ! U-point 792 IF ( narea .ne. (jpnij)) THEN791 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 793 792 endloop = nlci 794 793 ELSE … … 796 795 ENDIF 797 796 DO ji = 1, endloop 798 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2797 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 799 798 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 800 799 END DO … … 802 801 CASE ( 'V' ) ! V-point 803 802 DO ji = 1, nlci 804 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3803 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 805 804 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 806 805 END DO … … 813 812 ENDIF 814 813 DO ji = startloop, nlci 815 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 3814 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 816 815 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 817 816 END DO 818 817 819 818 CASE ( 'F' ) ! F-point 820 IF ( narea .ne. (jpnij)) THEN819 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 821 820 endloop = nlci 822 821 ELSE … … 824 823 ENDIF 825 824 DO ji = 1, endloop 826 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2825 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 827 826 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 828 827 END DO 829 828 830 IF ( narea .ne. (jpnij)) THEN829 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 831 830 endloop = nlci 832 831 ELSE … … 842 841 843 842 DO ji = startloop, endloop 844 iju = jpiglo - ji - nimpp - n imppt(isendto(1)) + 2843 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 845 844 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 846 845 END DO 847 846 848 847 CASE ( 'I' ) ! ice U-V point (I-point) 849 IF (n area .ne. (jpnij - jpni + 1)) THEN848 IF (nimpp .ne. 1) THEN 850 849 startloop = 1 851 850 ELSE 852 851 startloop = 2 853 852 ENDIF 854 IF ( narea .ne. jpnij) THEN853 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 855 854 endloop = nlci 856 855 ELSE … … 858 857 ENDIF 859 858 DO ji = startloop , endloop 860 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4859 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 861 860 pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 862 861 END DO 863 862 864 863 CASE ( 'J' ) ! first ice U-V point 865 IF (n area .ne. (jpnij - jpni + 1)) THEN864 IF (nimpp .ne. 1) THEN 866 865 startloop = 1 867 866 ELSE 868 867 startloop = 2 869 868 ENDIF 870 IF ( narea .ne. jpnij) THEN869 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 871 870 endloop = nlci 872 871 ELSE … … 874 873 ENDIF 875 874 DO ji = startloop , endloop 876 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4875 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 877 876 pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 878 877 END DO 879 878 880 879 CASE ( 'K' ) ! second ice U-V point 881 IF (n area .ne. (jpnij - jpni + 1)) THEN880 IF (nimpp .ne. 1) THEN 882 881 startloop = 1 883 882 ELSE 884 883 startloop = 2 885 884 ENDIF 886 IF ( narea .ne. jpnij) THEN885 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 887 886 endloop = nlci 888 887 ELSE … … 890 889 ENDIF 891 890 DO ji = startloop, endloop 892 ijt = jpiglo - ji - nimpp - n imppt(isendto(1)) + 4891 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 893 892 pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 894 893 END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4645 r4671 2026 2026 ijpjm1 = 3 2027 2027 ! 2028 znorthloc(:,:,:) = 0 2028 2029 DO jk = 1, jpk 2029 2030 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d … … 2036 2037 itaille = jpi * jpk * ijpj 2037 2038 2038 2039 2039 IF ( l_north_nogather ) THEN 2040 2040 ! 2041 2041 ztabr(:,:,:) = 0 2042 ztabl(:,:,:) = 0 2043 2042 2044 DO jk = 1, jpk 2043 2045 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2044 2046 ij = jj - nlcj + ijpj 2045 DO ji = 1, nlci2047 DO ji = nfsloop, nfeloop 2046 2048 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 2047 2049 END DO … … 2050 2052 2051 2053 DO jr = 1,nsndto 2052 IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 2054 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2055 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 2056 ENDIF 2053 2057 END DO 2054 2058 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) 2059 iproc = nfipproc(isendto(jr),jpnj) 2060 IF(iproc .ne. -1) THEN 2061 ilei = nleit (iproc+1) 2062 ildi = nldit (iproc+1) 2063 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2064 ENDIF 2065 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2066 CALL mpprecv(5, zfoldwk, itaille, iproc) 2061 2067 DO jk = 1, jpk 2062 2068 DO jj = 1, ijpj 2063 DO ji = 1, ilei2069 DO ji = ildi, ilei 2064 2070 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 2065 2071 END DO 2066 2072 END DO 2067 2073 END DO 2068 ELSE 2074 ELSE IF (iproc .eq. (narea-1)) THEN 2069 2075 DO jk = 1, jpk 2070 2076 DO jj = 1, ijpj 2071 DO ji = 1, ilei2077 DO ji = ildi, ilei 2072 2078 ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 2073 2079 END DO … … 2078 2084 IF (l_isend) THEN 2079 2085 DO jr = 1,nsndto 2080 IF ( isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)2086 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2081 2087 END DO 2082 2088 ENDIF 2083 2089 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition 2084 !2085 2090 DO jk = 1, jpk 2086 2091 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d … … 2190 2195 ! 2191 2196 ztabr(:,:) = 0 2197 ztabl(:,:) = 0 2198 2192 2199 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2193 2200 ij = jj - nlcj + ijpj 2194 DO ji = 1, nlci2201 DO ji = nfsloop, nfeloop 2195 2202 ztabl(ji,ij) = pt2d(ji,jj) 2196 2203 END DO … … 2198 2205 2199 2206 DO jr = 1,nsndto 2200 IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 2207 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2208 CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 2209 ENDIF 2201 2210 END DO 2202 2211 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) 2212 iproc = nfipproc(isendto(jr),jpnj) 2213 IF(iproc .ne. -1) THEN 2214 ilei = nleit (iproc+1) 2215 ildi = nldit (iproc+1) 2216 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2217 ENDIF 2218 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2219 CALL mpprecv(5, zfoldwk, itaille, iproc) 2209 2220 DO jj = 1, ijpj 2210 DO ji = 1, ilei2221 DO ji = ildi, ilei 2211 2222 ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 2212 2223 END DO 2213 2224 END DO 2214 ELSE 2225 ELSE IF (iproc .eq. (narea-1)) THEN 2215 2226 DO jj = 1, ijpj 2216 DO ji = 1, ilei2227 DO ji = ildi, ilei 2217 2228 ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 2218 2229 END DO … … 2222 2233 IF (l_isend) THEN 2223 2234 DO jr = 1,nsndto 2224 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2235 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2236 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2237 ENDIF 2225 2238 END DO 2226 2239 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r3294 r4671 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 -
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r4647 r4671 144 144 #endif 145 145 146 nfilcit(:,:) = ilci(:,:) 147 146 148 IF(lwp) WRITE(numout,*) 147 149 IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' … … 175 177 END DO 176 178 ENDIF 179 nfiimpp(:,:) = iimppt(:,:) 177 180 178 181 IF( jpnj > 1 )THEN … … 195 198 ili = ilci(ii,ij) 196 199 ilj = ilcj(ii,ij) 197 198 200 ibondj(ii,ij) = -1 199 201 IF( jarea > jpni ) ibondj(ii,ij) = 0 200 202 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 201 203 IF( jpnj == 1 ) ibondj(ii,ij) = 2 202 203 204 ibondi(ii,ij) = 0 204 205 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 … … 308 309 END DO 309 310 311 nfipproc(:,:) = ipproc(:,:) 312 313 310 314 ! Control 311 315 IF(icont+1 /= jpnij) THEN
Note: See TracChangeset
for help on using the changeset viewer.