- Timestamp:
- 2014-11-28T18:24:01+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LBC
- Files:
-
- 4 edited
-
lbcnfd.F90 (modified) (38 diffs)
-
lib_mpp.F90 (modified) (7 diffs)
-
mppini.F90 (modified) (3 diffs)
-
mppini_2.h90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4230 r4924 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_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4645 r4924 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)) THEN 2087 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2088 ENDIF 2081 2089 END DO 2082 2090 ENDIF 2083 2091 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition 2084 !2085 2092 DO jk = 1, jpk 2086 2093 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d … … 2190 2197 ! 2191 2198 ztabr(:,:) = 0 2199 ztabl(:,:) = 0 2200 2192 2201 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2193 2202 ij = jj - nlcj + ijpj 2194 DO ji = 1, nlci2203 DO ji = nfsloop, nfeloop 2195 2204 ztabl(ji,ij) = pt2d(ji,jj) 2196 2205 END DO … … 2198 2207 2199 2208 DO jr = 1,nsndto 2200 IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 2209 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2210 CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 2211 ENDIF 2201 2212 END DO 2202 2213 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) 2214 iproc = nfipproc(isendto(jr),jpnj) 2215 IF(iproc .ne. -1) THEN 2216 ilei = nleit (iproc+1) 2217 ildi = nldit (iproc+1) 2218 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2219 ENDIF 2220 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2221 CALL mpprecv(5, zfoldwk, itaille, iproc) 2209 2222 DO jj = 1, ijpj 2210 DO ji = 1, ilei2223 DO ji = ildi, ilei 2211 2224 ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 2212 2225 END DO 2213 2226 END DO 2214 ELSE 2227 ELSE IF (iproc .eq. (narea-1)) THEN 2215 2228 DO jj = 1, ijpj 2216 DO ji = 1, ilei2229 DO ji = ildi, ilei 2217 2230 ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 2218 2231 END DO … … 2222 2235 IF (l_isend) THEN 2223 2236 DO jr = 1,nsndto 2224 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2237 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2238 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2239 ENDIF 2225 2240 END DO 2226 2241 ENDIF -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r3294 r4924 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_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r4747 r4924 152 152 #endif 153 153 154 nfilcit(:,:) = ilci(:,:) 155 154 156 IF(lwp) WRITE(numout,*) 155 157 IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' … … 183 185 END DO 184 186 ENDIF 187 nfiimpp(:,:) = iimppt(:,:) 185 188 186 189 IF( jpnj > 1 )THEN … … 203 206 ili = ilci(ii,ij) 204 207 ilj = ilcj(ii,ij) 205 206 208 ibondj(ii,ij) = -1 207 209 IF( jarea > jpni ) ibondj(ii,ij) = 0 208 210 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 209 211 IF( jpnj == 1 ) ibondj(ii,ij) = 2 210 211 212 ibondi(ii,ij) = 0 212 213 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 … … 316 317 END DO 317 318 319 nfipproc(:,:) = ipproc(:,:) 320 321 318 322 ! Control 319 323 IF(icont+1 /= jpnij) THEN
Note: See TracChangeset
for help on using the changeset viewer.
