- Timestamp:
- 2015-10-26T15:59:39+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/LBC
- Files:
-
- 5 edited
-
lbclnk.F90 (modified) (3 diffs)
-
lbcnfd.F90 (modified) (38 diffs)
-
lib_mpp.F90 (modified) (18 diffs)
-
mppini.F90 (modified) (3 diffs)
-
mppini_2.h90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r4328 r5837 22 22 USE lib_mpp ! distributed memory computing library 23 23 24 25 INTERFACE lbc_lnk_multi 26 MODULE PROCEDURE mpp_lnk_2d_9 27 END INTERFACE 28 24 29 INTERFACE lbc_lnk 25 30 MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d … … 34 39 END INTERFACE 35 40 41 INTERFACE lbc_lnk_icb 42 MODULE PROCEDURE mpp_lnk_2d_icb 43 END INTERFACE 44 36 45 PUBLIC lbc_lnk ! ocean lateral boundary conditions 46 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 37 47 PUBLIC lbc_lnk_e 38 48 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 49 PUBLIC lbc_lnk_icb 39 50 40 51 !!---------------------------------------------------------------------- … … 73 84 END INTERFACE 74 85 86 INTERFACE lbc_lnk_icb 87 MODULE PROCEDURE lbc_lnk_2d_e 88 END INTERFACE 89 75 90 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 76 91 PUBLIC lbc_lnk_e 77 92 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 93 PUBLIC lbc_lnk_icb 78 94 79 95 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4230 r5837 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.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4645 r5837 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 … … 69 71 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 70 72 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 73 PUBLIC mpp_lnk_2d_9 71 74 PUBLIC mppscatter, mppgather 72 75 PUBLIC mpp_ini_ice, mpp_ini_znl … … 74 77 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 75 78 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 76 79 PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb 80 81 TYPE arrayptr 82 REAL , DIMENSION (:,:), POINTER :: pt2d 83 END TYPE arrayptr 84 77 85 !! * Interfaces 78 86 !! define generic interface for these routine as they are called sometimes … … 161 169 162 170 163 FUNCTION mynode( ldtxt, kumnam_ref , kumnam_cfg , kumond , kstop, localComm )171 FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 164 172 !!---------------------------------------------------------------------- 165 173 !! *** routine mynode *** … … 168 176 !!---------------------------------------------------------------------- 169 177 CHARACTER(len=*),DIMENSION(:), INTENT( out) :: ldtxt 178 CHARACTER(len=*) , INTENT(in ) :: ldname 170 179 INTEGER , INTENT(in ) :: kumnam_ref ! logical unit for reference namelist 171 180 INTEGER , INTENT(in ) :: kumnam_cfg ! logical unit for configuration namelist … … 294 303 295 304 IF( mynode == 0 ) THEN 296 CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )297 WRITE(kumond, nammpp)305 CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 306 WRITE(kumond, nammpp) 298 307 ENDIF 299 308 ! … … 508 517 END SUBROUTINE mpp_lnk_3d 509 518 519 SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) 520 !!---------------------------------------------------------------------- 521 !! *** routine mpp_lnk_2d_multiple *** 522 !! 523 !! ** Purpose : Message passing management for multiple 2d arrays 524 !! 525 !! ** Method : Use mppsend and mpprecv function for passing mask 526 !! between processors following neighboring subdomains. 527 !! domain parameters 528 !! nlci : first dimension of the local subdomain 529 !! nlcj : second dimension of the local subdomain 530 !! nbondi : mark for "east-west local boundary" 531 !! nbondj : mark for "north-south local boundary" 532 !! noea : number for local neighboring processors 533 !! nowe : number for local neighboring processors 534 !! noso : number for local neighboring processors 535 !! nono : number for local neighboring processors 536 !! 537 !!---------------------------------------------------------------------- 538 539 INTEGER :: num_fields 540 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 541 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 542 ! ! = T , U , V , F , W and I points 543 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 544 ! ! = 1. , the sign is kept 545 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 546 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 547 !! 548 INTEGER :: ji, jj, jl ! dummy loop indices 549 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 550 INTEGER :: imigr, iihom, ijhom ! temporary integers 551 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 552 553 REAL(wp) :: zland 554 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 555 ! 556 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 557 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 558 559 !!---------------------------------------------------------------------- 560 561 ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields), & 562 & zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields) ) 563 564 ! 565 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 566 ELSE ; zland = 0.e0 ! zero by default 567 ENDIF 568 569 ! 1. standard boundary treatment 570 ! ------------------------------ 571 ! 572 !First Array 573 DO ii = 1 , num_fields 574 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values 575 ! 576 ! WARNING pt2d is defined only between nld and nle 577 DO jj = nlcj+1, jpj ! added line(s) (inner only) 578 pt2d_array(ii)%pt2d(nldi :nlei , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej) 579 pt2d_array(ii)%pt2d(1 :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi , nlej) 580 pt2d_array(ii)%pt2d(nlei+1:nlci , jj) = pt2d_array(ii)%pt2d( nlei, nlej) 581 END DO 582 DO ji = nlci+1, jpi ! added column(s) (full) 583 pt2d_array(ii)%pt2d(ji, nldj :nlej ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej) 584 pt2d_array(ii)%pt2d(ji, 1 :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj ) 585 pt2d_array(ii)%pt2d(ji, nlej+1:jpj ) = pt2d_array(ii)%pt2d(nlei, nlej) 586 END DO 587 ! 588 ELSE ! standard close or cyclic treatment 589 ! 590 ! ! East-West boundaries 591 IF( nbondi == 2 .AND. & ! Cyclic east-west 592 & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 593 pt2d_array(ii)%pt2d( 1 , : ) = pt2d_array(ii)%pt2d( jpim1, : ) ! west 594 pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d( 2 , : ) ! east 595 ELSE ! closed 596 IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d( 1 : jpreci,:) = zland ! south except F-point 597 pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi ,:) = zland ! north 598 ENDIF 599 ! ! North-South boundaries (always closed) 600 IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d(:, 1:jprecj ) = zland ! south except F-point 601 pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj ) = zland ! north 602 ! 603 ENDIF 604 END DO 605 606 ! 2. East and west directions exchange 607 ! ------------------------------------ 608 ! we play with the neigbours AND the row number because of the periodicity 609 ! 610 DO ii = 1 , num_fields 611 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 612 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 613 iihom = nlci-nreci 614 DO jl = 1, jpreci 615 zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : ) 616 zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : ) 617 END DO 618 END SELECT 619 END DO 620 ! 621 ! ! Migrations 622 imigr = jpreci * jpj 623 ! 624 SELECT CASE ( nbondi ) 625 CASE ( -1 ) 626 CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 ) 627 CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 628 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 629 CASE ( 0 ) 630 CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 631 CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 ) 632 CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 633 CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 634 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 635 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 636 CASE ( 1 ) 637 CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 638 CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 639 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 640 END SELECT 641 ! 642 ! ! Write Dirichlet lateral conditions 643 iihom = nlci - jpreci 644 ! 645 646 DO ii = 1 , num_fields 647 SELECT CASE ( nbondi ) 648 CASE ( -1 ) 649 DO jl = 1, jpreci 650 pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 651 END DO 652 CASE ( 0 ) 653 DO jl = 1, jpreci 654 pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii) 655 pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 656 END DO 657 CASE ( 1 ) 658 DO jl = 1, jpreci 659 pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii) 660 END DO 661 END SELECT 662 END DO 663 664 ! 3. North and south directions 665 ! ----------------------------- 666 ! always closed : we play only with the neigbours 667 ! 668 !First Array 669 DO ii = 1 , num_fields 670 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 671 ijhom = nlcj-nrecj 672 DO jl = 1, jprecj 673 zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl ) 674 zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl ) 675 END DO 676 ENDIF 677 END DO 678 ! 679 ! ! Migrations 680 imigr = jprecj * jpi 681 ! 682 SELECT CASE ( nbondj ) 683 CASE ( -1 ) 684 CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 ) 685 CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 686 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 687 CASE ( 0 ) 688 CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 689 CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 ) 690 CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 691 CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 692 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 693 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 694 CASE ( 1 ) 695 CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 696 CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 697 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 698 END SELECT 699 ! 700 ! ! Write Dirichlet lateral conditions 701 ijhom = nlcj - jprecj 702 ! 703 704 DO ii = 1 , num_fields 705 !First Array 706 SELECT CASE ( nbondj ) 707 CASE ( -1 ) 708 DO jl = 1, jprecj 709 pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii ) 710 END DO 711 CASE ( 0 ) 712 DO jl = 1, jprecj 713 pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii) 714 pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii ) 715 END DO 716 CASE ( 1 ) 717 DO jl = 1, jprecj 718 pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii ) 719 END DO 720 END SELECT 721 END DO 722 723 ! 4. north fold treatment 724 ! ----------------------- 725 ! 726 DO ii = 1 , num_fields 727 !First Array 728 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 729 ! 730 SELECT CASE ( jpni ) 731 CASE ( 1 ) ; CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp 732 CASE DEFAULT ; CALL mpp_lbc_north( pt2d_array(ii)%pt2d( : , : ), type_array(ii), psgn_array(ii) ) ! for all northern procs. 733 END SELECT 734 ! 735 ENDIF 736 ! 737 END DO 738 739 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 740 ! 741 END SUBROUTINE mpp_lnk_2d_multiple 742 743 744 SUBROUTINE load_array(pt2d,cd_type,psgn,pt2d_array, type_array, psgn_array,num_fields) 745 !!--------------------------------------------------------------------- 746 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2d ! Second 2D array on which the boundary condition is applied 747 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 748 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 749 TYPE(arrayptr) , DIMENSION(9) :: pt2d_array 750 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points 751 REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary 752 INTEGER , INTENT (inout):: num_fields 753 !!--------------------------------------------------------------------- 754 num_fields=num_fields+1 755 pt2d_array(num_fields)%pt2d=>pt2d 756 type_array(num_fields)=cd_type 757 psgn_array(num_fields)=psgn 758 END SUBROUTINE load_array 759 760 761 SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 762 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 763 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 764 !!--------------------------------------------------------------------- 765 ! Second 2D array on which the boundary condition is applied 766 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 767 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 768 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 769 ! define the nature of ptab array grid-points 770 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 771 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 772 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 773 ! =-1 the sign change across the north fold boundary 774 REAL(wp) , INTENT(in ) :: psgnA 775 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 776 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 777 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 778 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 779 !! 780 TYPE(arrayptr) , DIMENSION(9) :: pt2d_array 781 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points 782 ! ! = T , U , V , F , W and I points 783 REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary 784 INTEGER :: num_fields 785 !!--------------------------------------------------------------------- 786 787 num_fields = 0 788 789 !! Load the first array 790 CALL load_array(pt2dA,cd_typeA,psgnA,pt2d_array, type_array, psgn_array,num_fields) 791 792 !! Look if more arrays are added 793 IF(PRESENT (psgnB) )CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 794 IF(PRESENT (psgnC) )CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 795 IF(PRESENT (psgnD) )CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 796 IF(PRESENT (psgnE) )CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 797 IF(PRESENT (psgnF) )CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 798 IF(PRESENT (psgnG) )CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 799 IF(PRESENT (psgnH) )CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 800 IF(PRESENT (psgnI) )CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 801 802 CALL mpp_lnk_2d_multiple(pt2d_array,type_array,psgn_array,num_fields,cd_mpp,pval) 803 END SUBROUTINE mpp_lnk_2d_9 804 510 805 511 806 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) … … 2026 2321 ijpjm1 = 3 2027 2322 ! 2323 znorthloc(:,:,:) = 0 2028 2324 DO jk = 1, jpk 2029 2325 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d … … 2036 2332 itaille = jpi * jpk * ijpj 2037 2333 2038 2039 2334 IF ( l_north_nogather ) THEN 2040 2335 ! 2041 2336 ztabr(:,:,:) = 0 2337 ztabl(:,:,:) = 0 2338 2042 2339 DO jk = 1, jpk 2043 2340 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2044 2341 ij = jj - nlcj + ijpj 2045 DO ji = 1, nlci2342 DO ji = nfsloop, nfeloop 2046 2343 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 2047 2344 END DO … … 2050 2347 2051 2348 DO jr = 1,nsndto 2052 IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 2349 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2350 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 2351 ENDIF 2053 2352 END DO 2054 2353 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) 2354 iproc = nfipproc(isendto(jr),jpnj) 2355 IF(iproc .ne. -1) THEN 2356 ilei = nleit (iproc+1) 2357 ildi = nldit (iproc+1) 2358 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2359 ENDIF 2360 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2361 CALL mpprecv(5, zfoldwk, itaille, iproc) 2061 2362 DO jk = 1, jpk 2062 2363 DO jj = 1, ijpj 2063 DO ji = 1, ilei2364 DO ji = ildi, ilei 2064 2365 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 2065 2366 END DO 2066 2367 END DO 2067 2368 END DO 2068 ELSE 2369 ELSE IF (iproc .eq. (narea-1)) THEN 2069 2370 DO jk = 1, jpk 2070 2371 DO jj = 1, ijpj 2071 DO ji = 1, ilei2372 DO ji = ildi, ilei 2072 2373 ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 2073 2374 END DO … … 2078 2379 IF (l_isend) THEN 2079 2380 DO jr = 1,nsndto 2080 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2381 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2382 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2383 ENDIF 2081 2384 END DO 2082 2385 ENDIF 2083 2386 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition 2084 !2085 2387 DO jk = 1, jpk 2086 2388 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d … … 2190 2492 ! 2191 2493 ztabr(:,:) = 0 2494 ztabl(:,:) = 0 2495 2192 2496 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2193 2497 ij = jj - nlcj + ijpj 2194 DO ji = 1, nlci2498 DO ji = nfsloop, nfeloop 2195 2499 ztabl(ji,ij) = pt2d(ji,jj) 2196 2500 END DO … … 2198 2502 2199 2503 DO jr = 1,nsndto 2200 IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 2504 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2505 CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 2506 ENDIF 2201 2507 END DO 2202 2508 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) 2509 iproc = nfipproc(isendto(jr),jpnj) 2510 IF(iproc .ne. -1) THEN 2511 ilei = nleit (iproc+1) 2512 ildi = nldit (iproc+1) 2513 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2514 ENDIF 2515 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2516 CALL mpprecv(5, zfoldwk, itaille, iproc) 2209 2517 DO jj = 1, ijpj 2210 DO ji = 1, ilei2518 DO ji = ildi, ilei 2211 2519 ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 2212 2520 END DO 2213 2521 END DO 2214 ELSE 2522 ELSE IF (iproc .eq. (narea-1)) THEN 2215 2523 DO jj = 1, ijpj 2216 DO ji = 1, ilei2524 DO ji = ildi, ilei 2217 2525 ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 2218 2526 END DO … … 2222 2530 IF (l_isend) THEN 2223 2531 DO jr = 1,nsndto 2224 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2532 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2533 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2534 ENDIF 2225 2535 END DO 2226 2536 ENDIF … … 2878 3188 END SUBROUTINE DDPDD_MPI 2879 3189 3190 SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj) 3191 !!--------------------------------------------------------------------- 3192 !! *** routine mpp_lbc_north_icb *** 3193 !! 3194 !! ** Purpose : Ensure proper north fold horizontal bondary condition 3195 !! in mpp configuration in case of jpn1 > 1 and for 2d 3196 !! array with outer extra halo 3197 !! 3198 !! ** Method : North fold condition and mpp with more than one proc 3199 !! in i-direction require a specific treatment. We gather 3200 !! the 4+2*jpr2dj northern lines of the global domain on 1 3201 !! processor and apply lbc north-fold on this sub array. 3202 !! Then we scatter the north fold array back to the processors. 3203 !! This version accounts for an extra halo with icebergs. 3204 !! 3205 !!---------------------------------------------------------------------- 3206 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array with extra halo 3207 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 3208 ! ! = T , U , V , F or W -points 3209 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the 3210 !! ! north fold, = 1. otherwise 3211 INTEGER, OPTIONAL , INTENT(in ) :: pr2dj 3212 INTEGER :: ji, jj, jr 3213 INTEGER :: ierr, itaille, ildi, ilei, iilb 3214 INTEGER :: ijpj, ij, iproc, ipr2dj 3215 ! 3216 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 3217 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 3218 3219 !!---------------------------------------------------------------------- 3220 ! 3221 ijpj=4 3222 IF( PRESENT(pr2dj) ) THEN ! use of additional halos 3223 ipr2dj = pr2dj 3224 ELSE 3225 ipr2dj = 0 3226 ENDIF 3227 ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) ) 3228 3229 ! 3230 ztab_e(:,:) = 0.e0 3231 3232 ij=0 3233 ! put in znorthloc_e the last 4 jlines of pt2d 3234 DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj 3235 ij = ij + 1 3236 DO ji = 1, jpi 3237 znorthloc_e(ji,ij)=pt2d(ji,jj) 3238 END DO 3239 END DO 3240 ! 3241 itaille = jpi * ( ijpj + 2 * ipr2dj ) 3242 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 3243 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 3244 ! 3245 DO jr = 1, ndim_rank_north ! recover the global north array 3246 iproc = nrank_north(jr) + 1 3247 ildi = nldit (iproc) 3248 ilei = nleit (iproc) 3249 iilb = nimppt(iproc) 3250 DO jj = 1, ijpj+2*ipr2dj 3251 DO ji = ildi, ilei 3252 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 3253 END DO 3254 END DO 3255 END DO 3256 3257 3258 ! 2. North-Fold boundary conditions 3259 ! ---------------------------------- 3260 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 3261 3262 ij = ipr2dj 3263 !! Scatter back to pt2d 3264 DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj 3265 ij = ij +1 3266 DO ji= 1, nlci 3267 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 3268 END DO 3269 END DO 3270 ! 3271 DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 3272 ! 3273 END SUBROUTINE mpp_lbc_north_icb 3274 3275 SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj ) 3276 !!---------------------------------------------------------------------- 3277 !! *** routine mpp_lnk_2d_icb *** 3278 !! 3279 !! ** Purpose : Message passing manadgement for 2d array (with extra halo and icebergs) 3280 !! 3281 !! ** Method : Use mppsend and mpprecv function for passing mask 3282 !! between processors following neighboring subdomains. 3283 !! domain parameters 3284 !! nlci : first dimension of the local subdomain 3285 !! nlcj : second dimension of the local subdomain 3286 !! jpri : number of rows for extra outer halo 3287 !! jprj : number of columns for extra outer halo 3288 !! nbondi : mark for "east-west local boundary" 3289 !! nbondj : mark for "north-south local boundary" 3290 !! noea : number for local neighboring processors 3291 !! nowe : number for local neighboring processors 3292 !! noso : number for local neighboring processors 3293 !! nono : number for local neighboring processors 3294 !! 3295 !!---------------------------------------------------------------------- 3296 INTEGER , INTENT(in ) :: jpri 3297 INTEGER , INTENT(in ) :: jprj 3298 REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) :: pt2d ! 2D array with extra halo 3299 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 3300 ! ! = T , U , V , F , W and I points 3301 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 3302 !! ! north boundary, = 1. otherwise 3303 INTEGER :: jl ! dummy loop indices 3304 INTEGER :: imigr, iihom, ijhom ! temporary integers 3305 INTEGER :: ipreci, iprecj ! temporary integers 3306 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 3307 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 3308 !! 3309 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 3310 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 3311 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 3312 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 3313 !!---------------------------------------------------------------------- 3314 3315 ipreci = jpreci + jpri ! take into account outer extra 2D overlap area 3316 iprecj = jprecj + jprj 3317 3318 3319 ! 1. standard boundary treatment 3320 ! ------------------------------ 3321 ! Order matters Here !!!! 3322 ! 3323 ! ! East-West boundaries 3324 ! !* Cyclic east-west 3325 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 3326 pt2d(1-jpri: 1 ,:) = pt2d(jpim1-jpri: jpim1 ,:) ! east 3327 pt2d( jpi :jpi+jpri,:) = pt2d( 2 :2+jpri,:) ! west 3328 ! 3329 ELSE !* closed 3330 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0.e0 ! south except at F-point 3331 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0 ! north 3332 ENDIF 3333 ! 3334 3335 ! north fold treatment 3336 ! ----------------------- 3337 IF( npolj /= 0 ) THEN 3338 ! 3339 SELECT CASE ( jpni ) 3340 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 3341 CASE DEFAULT ; CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj) , cd_type, psgn , pr2dj=jprj ) 3342 END SELECT 3343 ! 3344 ENDIF 3345 3346 ! 2. East and west directions exchange 3347 ! ------------------------------------ 3348 ! we play with the neigbours AND the row number because of the periodicity 3349 ! 3350 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 3351 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 3352 iihom = nlci-nreci-jpri 3353 DO jl = 1, ipreci 3354 r2dew(:,jl,1) = pt2d(jpreci+jl,:) 3355 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 3356 END DO 3357 END SELECT 3358 ! 3359 ! ! Migrations 3360 imigr = ipreci * ( jpj + 2*jprj) 3361 ! 3362 SELECT CASE ( nbondi ) 3363 CASE ( -1 ) 3364 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 3365 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 3366 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3367 CASE ( 0 ) 3368 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 3369 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 3370 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 3371 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 3372 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3373 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 3374 CASE ( 1 ) 3375 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 3376 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 3377 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3378 END SELECT 3379 ! 3380 ! ! Write Dirichlet lateral conditions 3381 iihom = nlci - jpreci 3382 ! 3383 SELECT CASE ( nbondi ) 3384 CASE ( -1 ) 3385 DO jl = 1, ipreci 3386 pt2d(iihom+jl,:) = r2dew(:,jl,2) 3387 END DO 3388 CASE ( 0 ) 3389 DO jl = 1, ipreci 3390 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 3391 pt2d( iihom+jl,:) = r2dew(:,jl,2) 3392 END DO 3393 CASE ( 1 ) 3394 DO jl = 1, ipreci 3395 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 3396 END DO 3397 END SELECT 3398 3399 3400 ! 3. North and south directions 3401 ! ----------------------------- 3402 ! always closed : we play only with the neigbours 3403 ! 3404 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 3405 ijhom = nlcj-nrecj-jprj 3406 DO jl = 1, iprecj 3407 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 3408 r2dns(:,jl,1) = pt2d(:,jprecj+jl) 3409 END DO 3410 ENDIF 3411 ! 3412 ! ! Migrations 3413 imigr = iprecj * ( jpi + 2*jpri ) 3414 ! 3415 SELECT CASE ( nbondj ) 3416 CASE ( -1 ) 3417 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 3418 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 3419 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3420 CASE ( 0 ) 3421 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 3422 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 3423 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 3424 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 3425 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3426 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 3427 CASE ( 1 ) 3428 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 3429 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 3430 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3431 END SELECT 3432 ! 3433 ! ! Write Dirichlet lateral conditions 3434 ijhom = nlcj - jprecj 3435 ! 3436 SELECT CASE ( nbondj ) 3437 CASE ( -1 ) 3438 DO jl = 1, iprecj 3439 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 3440 END DO 3441 CASE ( 0 ) 3442 DO jl = 1, iprecj 3443 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 3444 pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 3445 END DO 3446 CASE ( 1 ) 3447 DO jl = 1, iprecj 3448 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 3449 END DO 3450 END SELECT 3451 3452 END SUBROUTINE mpp_lnk_2d_icb 2880 3453 #else 2881 3454 !!---------------------------------------------------------------------- … … 2903 3476 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used) 2904 3477 INTEGER :: ncomm_ice 3478 INTEGER, PUBLIC :: mpi_comm_opa ! opa local communicator 2905 3479 !!---------------------------------------------------------------------- 2906 3480 CONTAINS … … 2911 3485 END FUNCTION lib_mpp_alloc 2912 3486 2913 FUNCTION mynode( ldtxt, kumnam_ref, knumnam_cfg, kumond , kstop, localComm ) RESULT (function_value)3487 FUNCTION mynode( ldtxt, ldname, kumnam_ref, knumnam_cfg, kumond , kstop, localComm ) RESULT (function_value) 2914 3488 INTEGER, OPTIONAL , INTENT(in ) :: localComm 2915 3489 CHARACTER(len=*),DIMENSION(:) :: ldtxt 3490 CHARACTER(len=*) :: ldname 2916 3491 INTEGER :: kumnam_ref, knumnam_cfg , kumond , kstop 2917 IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) ) function_value = 0 3492 IF( PRESENT( localComm ) ) mpi_comm_opa = localComm 3493 function_value = 0 2918 3494 IF( .FALSE. ) ldtxt(:) = 'never done' 2919 CALL ctl_opn( kumond, 'output.namelist.dyn', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 )3495 CALL ctl_opn( kumond, TRIM(ldname), 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. , 1 ) 2920 3496 END FUNCTION mynode 2921 3497 -
branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r3294 r5837 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.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r4647 r5837 45 45 INTEGER :: inum ! temporary logical unit 46 46 INTEGER :: idir ! temporary integers 47 INTEGER :: jstartrow ! temporary integers 47 48 INTEGER :: ios ! Local integer output status for namelist read 48 49 INTEGER :: & … … 67 68 imask ! temporary global workspace 68 69 REAL(wp), DIMENSION(jpiglo,jpjglo) :: & 69 zdta ! temporary data workspace70 zdta, zdtaisf ! temporary data workspace 70 71 REAL(wp) :: zidom , zjdom ! temporary scalars 71 72 72 73 ! read namelist for ln_zco 73 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 74 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 74 75 75 76 !!---------------------------------------------------------------------- … … 100 101 ! open the file 101 102 ! Remember that at this level in the code, mpp is not yet initialized, so 102 ! the file must be open with jpdom_unknown, and kstart amd kcount forced 103 ! the file must be open with jpdom_unknown, and kstart and kcount forced 104 jstartrow = 1 103 105 IF ( ln_zco ) THEN 104 106 CALL iom_open ( 'bathy_level.nc', inum ) ! Level bathymetry 105 CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 107 ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 108 ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 109 CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 110 jstartrow = MAX(1,jstartrow) 111 CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) 106 112 ELSE 107 113 CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps 108 CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 114 IF ( ln_isfcav ) THEN 115 CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 116 ELSE 117 ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 118 ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 119 CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 120 jstartrow = MAX(1,jstartrow) 121 CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/) & 122 & , kcount=(/jpiglo,jpjglo/) ) 123 ENDIF 109 124 ENDIF 110 125 CALL iom_close (inum) 126 127 ! used to compute the land processor in case of not masked bathy file. 128 zdtaisf(:,:) = 0.0_wp 129 IF ( ln_isfcav ) THEN 130 CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps 131 CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) ) 132 END IF 133 CALL iom_close (inum) 111 134 112 135 ! land/sea mask over the global/zoom domain 113 136 114 137 imask(:,:)=1 115 WHERE ( zdta(:,:) <= 0. ) imask = 0138 WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0 116 139 117 140 ! 1. Dimension arrays for subdomains … … 143 166 ilcj(:, irestj+1:jpnj) = jpj-1 144 167 #endif 168 169 nfilcit(:,:) = ilci(:,:) 145 170 146 171 IF(lwp) WRITE(numout,*) … … 175 200 END DO 176 201 ENDIF 202 nfiimpp(:,:) = iimppt(:,:) 177 203 178 204 IF( jpnj > 1 )THEN … … 195 221 ili = ilci(ii,ij) 196 222 ilj = ilcj(ii,ij) 197 198 223 ibondj(ii,ij) = -1 199 224 IF( jarea > jpni ) ibondj(ii,ij) = 0 200 225 IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1 201 226 IF( jpnj == 1 ) ibondj(ii,ij) = 2 202 203 227 ibondi(ii,ij) = 0 204 228 IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1 … … 308 332 END DO 309 333 334 nfipproc(:,:) = ipproc(:,:) 335 336 310 337 ! Control 311 338 IF(icont+1 /= jpnij) THEN
Note: See TracChangeset
for help on using the changeset viewer.
