- Timestamp:
- 2021-10-23T12:18:24+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/OCE/BDY/bdyini.F90
r15349 r15440 146 146 INTEGER :: ib_bdy, ii, ij, igrd, ib, ir, iseg ! dummy loop indices 147 147 INTEGER :: icount, icountr, icountr0, ibr_max ! local integers 148 INTEGER :: ilen1 ! - - 148 INTEGER :: ilen1 ! - - 149 INTEGER :: iiRst, iiRnd, iiSst, iiSnd, iiSstdiag, iiSnddiag, iiSstsono, iiSndsono 150 INTEGER :: ijRst, ijRnd, ijSst, ijSnd, ijSstdiag, ijSnddiag, ijSstsono, ijSndsono 151 INTEGER :: iiout, ijout, iioutdir, ijoutdir, icnt 152 INTEGER :: iRnei, iRdiag, iRsono 153 INTEGER :: iSnei, iSdiag, iSsono ! - - 149 154 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 150 155 INTEGER :: jpbdta ! - - … … 163 168 REAL(wp) , DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 164 169 REAL(wp) , DIMENSION(jpi,jpj) :: ztmask, zumask, zvmask ! temporary u/v mask array 170 REAL(wp) , DIMENSION(jpi,jpj) :: zzbdy 165 171 !!---------------------------------------------------------------------- 166 172 ! … … 562 568 ! Initialize array indicating communications in bdy 563 569 ! ------------------------------------------------- 564 ALLOCATE( lsend_bdy (nb_bdy,jpbgrd,4,0:1), lrecv_bdy(nb_bdy,jpbgrd,4,0:1) )565 lsend_bdy (:,:,:,:) = .false.566 lrecv_bdy (:,:,:,:) = .false.570 ALLOCATE( lsend_bdyolr(nb_bdy,jpbgrd,8,0:1), lrecv_bdyolr(nb_bdy,jpbgrd,8,0:1) ) 571 lsend_bdyolr(:,:,:,:) = .false. 572 lrecv_bdyolr(:,:,:,:) = .false. 567 573 568 574 DO ib_bdy = 1, nb_bdy … … 576 582 ! 577 583 ! check if point has to be sent to a neighbour 578 ! W neighbour and on the inner left side 579 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. mpiSnei(nn_hls,jpwe) > -1 ) lsend_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE. 580 ! E neighbour and on the inner right side 581 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. mpiSnei(nn_hls,jpea) > -1 ) lsend_bdy(ib_bdy,igrd,jpea,ir) = .TRUE. 582 ! S neighbour and on the inner down side 583 IF( ij >= Njs0 .AND. ij < Njs0 + nn_hls .AND. mpiSnei(nn_hls,jpso) > -1 ) lsend_bdy(ib_bdy,igrd,jpso,ir) = .TRUE. 584 ! N neighbour and on the inner up side 585 IF( ij <= Nje0 .AND. ij > Nje0 - nn_hls .AND. mpiSnei(nn_hls,jpno) > -1 ) lsend_bdy(ib_bdy,igrd,jpno,ir) = .TRUE. 584 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! we inner side 585 IF( mpiSnei(nn_hls,jpwe) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpwe,ir) = .TRUE. 586 ENDIF 587 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! ea inner side 588 IF( mpiSnei(nn_hls,jpea) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpea,ir) = .TRUE. 589 ENDIF 590 IF( ii >= Nis0 .AND. ii <= Nie0 .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! so inner side 591 IF( mpiSnei(nn_hls,jpso) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 592 ENDIF 593 IF( ii < Nis0 .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! so side we-halo 594 IF( mpiSnei(nn_hls,jpso) > -1 .AND. nn_comm == 1 ) lsend_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 595 ENDIF 596 IF( ii > Nie0 .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! so side ea-halo 597 IF( mpiSnei(nn_hls,jpso) > -1 .AND. nn_comm == 1 ) lsend_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 598 ENDIF 599 IF( ii >= Nis0 .AND. ii <= Nie0 .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! no inner side 600 IF( mpiSnei(nn_hls,jpno) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 601 ENDIF 602 IF( ii < Nis0 .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! no side we-halo 603 IF( mpiSnei(nn_hls,jpno) > -1 .AND. nn_comm == 1 ) lsend_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 604 ENDIF 605 IF( ii > Nie0 .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! no side ea-halo 606 IF( mpiSnei(nn_hls,jpno) > -1 .AND. nn_comm == 1 ) lsend_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 607 ENDIF 608 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! sw inner corner 609 IF( mpiSnei(nn_hls,jpsw) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpsw,ir) = .TRUE. 610 ENDIF 611 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! se inner corner 612 IF( mpiSnei(nn_hls,jpse) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpse,ir) = .TRUE. 613 ENDIF 614 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! nw inner corner 615 IF( mpiSnei(nn_hls,jpnw) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpnw,ir) = .TRUE. 616 ENDIF 617 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! ne inner corner 618 IF( mpiSnei(nn_hls,jpne) > -1 ) lsend_bdyolr(ib_bdy,igrd,jpne,ir) = .TRUE. 619 ENDIF 586 620 ! 587 621 ! check if point has to be received from a neighbour 588 ! W neighbour and on the outter left side 589 IF( ii < Nis0 .AND. mpiRnei(nn_hls,jpwe) > -1 ) lrecv_bdy(ib_bdy,igrd,jpwe,ir) = .TRUE. 590 ! E neighbour and on the outter right side 591 IF( ii > Nie0 .AND. mpiRnei(nn_hls,jpea) > -1 ) lrecv_bdy(ib_bdy,igrd,jpea,ir) = .TRUE. 592 ! S neighbour and on the outter down side 593 IF( ij < Njs0 .AND. mpiRnei(nn_hls,jpso) > -1 ) lrecv_bdy(ib_bdy,igrd,jpso,ir) = .TRUE. 594 ! N neighbour and on the outter up side 595 IF( ij > Nje0 .AND. mpiRnei(nn_hls,jpno) > -1 ) lrecv_bdy(ib_bdy,igrd,jpno,ir) = .TRUE. 622 IF( ii < Nis0 .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! we side 623 IF( mpiRnei(nn_hls,jpwe) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpwe,ir) = .TRUE. 624 ENDIF 625 IF( ii > Nie0 .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! ea side 626 IF( mpiRnei(nn_hls,jpea) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpea,ir) = .TRUE. 627 ENDIF 628 IF( ii >= Nis0 .AND. ii <= Nie0 .AND. ij < Njs0 ) THEN ! so side 629 IF( mpiRnei(nn_hls,jpso) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 630 ENDIF 631 IF( ii >= Nis0 .AND. ii <= Nie0 .AND. ij > Nje0 ) THEN ! no side 632 IF( mpiRnei(nn_hls,jpno) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 633 ENDIF 634 IF( ii < Nis0 .AND. ij < Njs0 ) THEN ! sw corner 635 IF( mpiRnei(nn_hls,jpsw) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpsw,ir) = .TRUE. 636 IF( mpiRnei(nn_hls,jpso) > -1 .AND. nn_comm == 1 ) lrecv_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 637 ENDIF 638 IF( ii > Nie0 .AND. ij < Njs0 ) THEN ! se corner 639 IF( mpiRnei(nn_hls,jpse) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpse,ir) = .TRUE. 640 IF( mpiRnei(nn_hls,jpso) > -1 .AND. nn_comm == 1 ) lrecv_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 641 ENDIF 642 IF( ii < Nis0 .AND. ij > Nje0 ) THEN ! nw corner 643 IF( mpiRnei(nn_hls,jpnw) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpnw,ir) = .TRUE. 644 IF( mpiRnei(nn_hls,jpno) > -1 .AND. nn_comm == 1 ) lrecv_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 645 ENDIF 646 IF( ii > Nie0 .AND. ij > Nje0 ) THEN ! ne corner 647 IF( mpiRnei(nn_hls,jpne) > -1 ) lrecv_bdyolr(ib_bdy,igrd,jpne,ir) = .TRUE. 648 IF( mpiRnei(nn_hls,jpno) > -1 .AND. nn_comm == 1 ) lrecv_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 649 ENDIF 596 650 ! 597 651 END DO 598 END DO ! igrd 599 652 END DO ! igrd 653 654 ! Comment out for debug 655 !!$ DO ir = 0,1 656 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'T', 1._wp, kfillmode = jpfillnothing, & 657 !!$ & lsend = lsend_bdyolr(ib_bdy,1,:,ir), lrecv = lrecv_bdyolr(ib_bdy,1,:,ir) ) 658 !!$ IF(lwp) WRITE(numout,*) ' seb bdy debug olr T', ir ; CALL FLUSH(numout) 659 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'U', 1._wp, kfillmode = jpfillnothing, & 660 !!$ & lsend = lsend_bdyolr(ib_bdy,2,:,ir), lrecv = lrecv_bdyolr(ib_bdy,2,:,ir) ) 661 !!$ IF(lwp) WRITE(numout,*) ' seb bdy debug olr U', ir ; CALL FLUSH(numout) 662 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'V', 1._wp, kfillmode = jpfillnothing, & 663 !!$ & lsend = lsend_bdyolr(ib_bdy,3,:,ir), lrecv = lrecv_bdyolr(ib_bdy,3,:,ir) ) 664 !!$ IF(lwp) WRITE(numout,*) ' seb bdy debug olr V', ir ; CALL FLUSH(numout) 665 !!$ END DO 666 600 667 ! Compute rim weights for FRS scheme 601 668 ! ---------------------------------- … … 709 776 ! 710 777 ! Check which boundaries might need communication 711 ALLOCATE( lsend_bdyint(nb_bdy,jpbgrd, 4,0:1), lrecv_bdyint(nb_bdy,jpbgrd,4,0:1) )778 ALLOCATE( lsend_bdyint(nb_bdy,jpbgrd,8,0:1), lrecv_bdyint(nb_bdy,jpbgrd,8,0:1) ) 712 779 lsend_bdyint(:,:,:,:) = .false. 713 780 lrecv_bdyint(:,:,:,:) = .false. 714 ALLOCATE( lsend_bdyext(nb_bdy,jpbgrd, 4,0:1), lrecv_bdyext(nb_bdy,jpbgrd,4,0:1) )781 ALLOCATE( lsend_bdyext(nb_bdy,jpbgrd,8,0:1), lrecv_bdyext(nb_bdy,jpbgrd,8,0:1) ) 715 782 lsend_bdyext(:,:,:,:) = .false. 716 783 lrecv_bdyext(:,:,:,:) = .false. 717 784 ! 718 DO i grd = 1, jpbgrd719 DO i b_bdy = 1, nb_bdy785 DO ib_bdy = 1, nb_bdy 786 DO igrd = 1, jpbgrd 720 787 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 721 788 IF( idx_bdy(ib_bdy)%ntreat(ib,igrd) == -1 ) CYCLE … … 731 798 CALL find_neib( ii, ij, idx_bdy(ib_bdy)%ntreat(ib,igrd), ii1, ij1, ii2, ij2, ii3, ij3 ) ! free ocean neighbours 732 799 ! 733 ! search neighbour in the west/east direction800 ! take care of the 4 sides 734 801 ! 735 ! Rim is on the halo and computed ocean is towards exterior of mpi domain : 736 ! <-- (o exterior) --> 737 ! (1) o|x OR (2) x|o 738 ! |___ ___| 739 ! ==> cannot compute the point x -> need to receive it 740 IF( iibi==0 .OR. ii1==0 .OR. ii2==0 .OR. ii3==0 ) lrecv_bdyint(ib_bdy,igrd,jpwe,ir) = .TRUE. 741 IF( iibe==0 ) lrecv_bdyext(ib_bdy,igrd,jpwe,ir) = .TRUE. 742 IF( iibi==jpi+1 .OR. ii1==jpi+1 .OR. ii2==jpi+1 .OR. ii3==jpi+1 ) lrecv_bdyint(ib_bdy,igrd,jpea,ir) = .TRUE. 743 IF( iibe==jpi+1 ) lrecv_bdyext(ib_bdy,igrd,jpea,ir) = .TRUE. 744 ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo. 745 ! :¨¨¨¨¨|¨¨--> | | <--¨¨|¨¨¨¨¨: 746 ! : | x:o | neighbour limited by ... would need o | o:x | : 747 ! :.....|_._:_____| (1) W neighbour E neighbour (2) |_____:_._|.....: 748 ! ==> the neighbour cannot compute the point x -> need to send it 749 IF( ii == 2*nn_hls .AND. mpiSnei(nn_hls,jpwe) > -1 ) THEN ! 2*nn_hls -> ji=jpi of western neighbour 750 IF( iibi==ii+1 .OR. ii1==ii+1 .OR. ii2==ii+1 .OR. ii3==ii+1 ) lsend_bdyint(ib_bdy,igrd,jpwe,ir) = .TRUE. 751 IF( iibe==ii+1 ) lsend_bdyext(ib_bdy,igrd,jpwe,ir) = .TRUE. 752 ENDIF 753 IF( ii == jpi-2*nn_hls+1 .AND. mpiSnei(nn_hls,jpea) > -1 ) THEN ! jpi-2*nn_hls+1-> ji=1 of eastern neighbour 754 IF( iibi==ii-1 .OR. ii1==ii-1 .OR. ii2==ii-1 .OR. ii3==ii-1 ) lsend_bdyint(ib_bdy,igrd,jpea,ir) = .TRUE. 755 IF( iibe==ii-1 ) lsend_bdyext(ib_bdy,igrd,jpea,ir) = .TRUE. 756 ENDIF 802 DO icnt = 1, 4 803 SELECT CASE( icnt ) 804 ! ... _____ 805 CASE( 1 ) ! x: rim on rcvwe/sndea-side o| : 806 ! o: potential neighbour(s) o|x : 807 ! outside of the MPI domain ..o|__:__ 808 iRnei = jpwe ; iSnei = jpea 809 iiRst = 1 ; ijRst = Njs0 ! Rcv we-side starting point, excluding sw-corner 810 iiRnd = nn_hls ; ijRnd = Nje0 ! Rcv we-side ending point, excluding nw-corner 811 iiSst = Nie0-nn_hls+1 ; ijSst = Njs0 ! Snd ea-side starting point, excluding se-corner 812 iiSnd = Nie0 ; ijSnd = Nje0 ! Snd ea-side ending point, excluding ne-corner 813 iioutdir = -1 ; ijoutdir = -999 ! outside MPI domain: westward 814 ! ______.... 815 CASE( 2 ) ! x: rim on rcvea/sndwe-side : |o 816 ! o: potential neighbour(s) : x|o 817 ! outside of the MPI domain ___:__|o.. 818 iRnei = jpea ; iSnei = jpwe 819 iiRst = Nie0+1 ; ijRst = Njs0 ! Rcv ea-side starting point, excluding se-corner 820 iiRnd = jpi ; ijRnd = Nje0 ! Rcv ea-side ending point, excluding ne-corner 821 iiSst = Nis0 ; ijSst = Njs0 ! Snd we-side starting point, excluding sw-corner 822 iiSnd = Nis0+nn_hls-1 ; ijSnd = Nje0 ! Snd we-side ending point, excluding nw-corner 823 iioutdir = 1 ; ijoutdir = -999 ! outside MPI domain: eastward 824 ! 825 CASE( 3 ) ! x: rim on rcvso/sndno-side | | 826 ! o: potential neighbour(s) |¨¨¨¨¨¨¨| 827 ! outside of the MPI domain |___x___| 828 ! : o o o : 829 ! : : 830 iRnei = jpso ; iSnei = jpno 831 iiRst = Nis0 ; ijRst = 1 ! Rcv so-side starting point, excluding sw-corner 832 iiRnd = Nie0 ; ijRnd = nn_hls ! Rcv so-side ending point, excluding se-corner 833 iiSst = Nis0 ; ijSst = Nje0-nn_hls+1 ! Snd no-side starting point, excluding nw-corner 834 iiSnd = Nie0 ; ijSnd = Nje0 ! Snd no-side ending point, excluding ne-corner 835 iioutdir = -999 ; ijoutdir = -1 ! outside MPI domain: southward 836 ! : : 837 CASE( 4 ) ! x: rim on rcvno/sndso-side :_o_o_o_: 838 ! o: potential neighbour(s) | x | 839 ! outside of the MPI domain | | 840 ! |¨¨¨¨¨¨¨| 841 iRnei = jpno ; iSnei = jpso 842 iiRst = Nis0 ; ijRst = Nje0+1 ! Rcv no-side starting point, excluding nw-corner 843 iiRnd = Nie0 ; ijRnd = jpj ! Rcv no-side ending point, excluding ne-corner 844 iiSst = Nis0 ; ijSst = Njs0 ! Snd so-side starting point, excluding sw-corner 845 iiSnd = Nie0 ; ijSnd = Njs0+nn_hls-1 ! Snd so-side ending point, excluding se-corner 846 iioutdir = -999 ; ijoutdir = 1 ! outside MPI domain: northward 847 END SELECT 848 ! 849 IF( ii >= iiRst .AND. ii <= iiRnd .AND. ij >= ijRst .AND. ij <= ijRnd ) THEN ! rim point in recv side 850 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the MPI domain? 851 ! take care of neighbourg(s) in the interior of the computational domain 852 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of the MPI domain 853 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) THEN ! -> I cannot compute it -> recv it 854 IF( mpiRnei(nn_hls,iRnei) > -1 ) lrecv_bdyint(ib_bdy,igrd,iRnei,ir) = .TRUE. 855 ENDIF 856 ! take care of neighbourg in the exterior of the computational domain 857 IF( iibe==iiout .OR. ijbe==ijout ) THEN ! Neib outside of the MPI domain -> I cannot compute it -> recv it 858 IF( mpiRnei(nn_hls,iRnei) > -1 ) lrecv_bdyext(ib_bdy,igrd,iRnei,ir) = .TRUE. 859 ENDIF 860 ENDIF 861 862 IF( ii >= iiSst .AND. ii <= iiSnd .AND. ij >= ijSst .AND. ij <= ijSnd ) THEN ! rim point in send side 863 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the nei MPI domain? 864 ! take care of neighbourg(s) in the interior of the computational domain 865 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of nei MPI domain 866 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) THEN ! -> nei cannot compute it 867 IF( mpiSnei(nn_hls,iSnei) > -1 ) lsend_bdyint(ib_bdy,igrd,iSnei,ir) = .TRUE. ! -> send to nei 868 ENDIF 869 ! take care of neighbourg in the exterior of the computational domain 870 IF( iibe == iiout .OR. ijbe == ijout ) THEN ! Neib outside of the nei MPI domain -> nei cannot compute it 871 IF( mpiSnei(nn_hls,iSnei) > -1 ) lsend_bdyext(ib_bdy,igrd,iSnei,ir) = .TRUE. ! -> send to nei 872 ENDIF 873 END IF 874 875 END DO ! 4 sides 757 876 ! 758 ! s earch neighbour in the north/south direction877 ! specific treatment for the corners 759 878 ! 760 ! Rim is on the halo and computed ocean is towards exterior of mpi domain 761 ! ==> cannot compute the point x -> need to receive it 762 !(3) | | ^ ___o___ 763 ! | |___x___| OR | | x | 764 ! v o (4) | | 765 IF( ijbi==0 .OR. ij1==0 .OR. ij2==0 .OR. ij3==0 ) lrecv_bdyint(ib_bdy,igrd,jpso,ir) = .TRUE. 766 IF( ijbe==0 ) lrecv_bdyext(ib_bdy,igrd,jpso,ir) = .TRUE. 767 IF( ijbi==jpj+1 .OR. ij1==jpj+1 .OR. ij2==jpj+1 .OR. ij3==jpj+1 ) lrecv_bdyint(ib_bdy,igrd,jpno,ir) = .TRUE. 768 IF( ijbe==jpj+1 ) lrecv_bdyext(ib_bdy,igrd,jpno,ir) = .TRUE. 769 ! Check if neighbour has its rim parallel to its mpi subdomain _________ border and next to its halo 770 ! ^ | o | : : 771 ! | |¨¨¨¨x¨¨¨¨| neighbour limited by ... would need o | |....x....| 772 ! :_________: (3) S neighbour N neighbour (4) v | o | 773 ! ==> the neighbour cannot compute the point x -> need to send it 774 IF( ij == 2*nn_hls .AND. mpiSnei(nn_hls,jpso) > -1 ) THEN ! 2*nn_hls -> jj=jpj of southern neighbour 775 IF( ijbi==ij+1 .OR. ij1==ij+1 .OR. ij2==ij+1 .OR. ij3==ij+1 ) lsend_bdyint(ib_bdy,igrd,jpso,ir) = .TRUE. 776 IF( ijbe==ij+1 ) lsend_bdyext(ib_bdy,igrd,jpso,ir) = .TRUE. 777 ENDIF 778 IF( ij == jpj-2*nn_hls+1 .AND. mpiSnei(nn_hls,jpno) > -1 ) THEN ! jpj-2*nn_hls+1-> jj=1 of northern neighbour 779 IF( ijbi==ij-1 .OR. ij1==ij-1 .OR. ij2==ij-1 .OR. ij3==ij-1 ) lsend_bdyint(ib_bdy,igrd,jpno,ir) = .TRUE. 780 IF( ijbe==ij-1 ) lsend_bdyext(ib_bdy,igrd,jpno,ir) = .TRUE. 781 ENDIF 782 END DO 783 END DO 784 END DO 879 DO icnt = 1, 4 880 SELECT CASE( icnt ) 881 ! ...|.... 882 CASE( 1 ) ! x: rim on sw-corner o| : 883 ! o: potential neighbour(s) o|x__:__ 884 ! outside of the MPI domain o o o: 885 ! : 886 iRdiag = jpsw ; iRsono = jpso ! Recv: for sw or so 887 iSdiag = jpne ; iSsono = jpno ! Send: to ne or no 888 iiRst = 1 ; ijRst = 1 ! Rcv sw-corner starting point 889 iiRnd = nn_hls ; ijRnd = nn_hls ! Rcv sw-corner ending point 890 iiSstdiag = Nie0-nn_hls+1 ; ijSstdiag = Nje0-nn_hls+1 ! send to sw-corner of ne neighbourg 891 iiSnddiag = Nie0 ; ijSnddiag = Nje0 ! send to sw-corner of ne neighbourg 892 iiSstsono = 1 ; ijSstsono = Nje0-nn_hls+1 ! send to sw-corner of no neighbourg 893 iiSndsono = nn_hls ; ijSndsono = Nje0 ! send to sw-corner of no neighbourg 894 iioutdir = -1 ; ijoutdir = -1 ! outside MPI domain: westward or southward 895 ! ....|... 896 CASE( 2 ) ! x: rim on se-corner : |o 897 ! o: potential neighbour(s) __:__x|o 898 ! outside of the MPI domain :o o o 899 ! : 900 iRdiag = jpse ; iRsono = jpso ! Recv: for se or so 901 iSdiag = jpnw ; iSsono = jpno ! Send: to nw or no 902 iiRst = Nie0+1 ; ijRst = 1 ! Rcv se-corner starting point 903 iiRnd = jpi ; ijRnd = nn_hls ! Rcv se-corner ending point 904 iiSstdiag = Nis0 ; ijSstdiag = Nje0-nn_hls+1 ! send to se-corner of nw neighbourg 905 iiSnddiag = Nis0+nn_hls-1 ; ijSnddiag = Nje0 ! send to se-corner of nw neighbourg 906 iiSstsono = Nie0+1 ; ijSstsono = Nje0-nn_hls+1 ! send to se-corner of no neighbourg 907 iiSndsono = jpi ; ijSndsono = Nje0 ! send to se-corner of no neighbourg 908 iioutdir = 1 ; ijoutdir = -1 ! outside MPI domain: eastward or southward 909 ! : 910 ! o o_o:___ 911 CASE( 3 ) ! x: rim on nw-corner o|x : 912 ! o: potential neighbour(s) ..o|...: 913 ! outside of the MPI domain | 914 iRdiag = jpnw ; iRsono = jpno ! Recv: for nw or no 915 iSdiag = jpse ; iSsono = jpso ! Send: to se or so 916 iiRst = 1 ; ijRst = Nje0+1 ! Rcv nw-corner starting point 917 iiRnd = nn_hls ; ijRnd = jpj ! Rcv nw-corner ending point 918 iiSstdiag = Nie0-nn_hls+1 ; ijSstdiag = Njs0 ! send to nw-corner of se neighbourg 919 iiSnddiag = Nie0 ; ijSnddiag = Njs0+nn_hls-1 ! send to nw-corner of se neighbourg 920 iiSstsono = 1 ; ijSstsono = Njs0 ! send to nw-corner of so neighbourg 921 iiSndsono = nn_hls ; ijSndsono = Njs0+nn_hls-1 ! send to nw-corner of so neighbourg 922 iioutdir = -1 ; ijoutdir = 1 ! outside MPI domain: westward or northward 923 ! : 924 ! ___:o_o o 925 CASE( 4 ) ! x: rim on ne-corner : x|o 926 ! o: potential neighbour(s) :...|o... 927 ! outside of the MPI domain | 928 iRdiag = jpne ; iRsono = jpno ! Recv: for ne or no 929 iSdiag = jpsw ; iSsono = jpso ! Send: to sw or so 930 iiRst = Nie0+1 ; ijRst = Nje0+1 ! Rcv ne-corner starting point 931 iiRnd = jpi ; ijRnd = jpj ! Rcv ne-corner ending point 932 iiSstdiag = Nis0 ; ijSstdiag = Njs0 ! send to ne-corner of sw neighbourg 933 iiSnddiag = Nis0+nn_hls-1 ; ijSnddiag = Njs0+nn_hls-1 ! send to ne-corner of sw neighbourg 934 iiSstsono = Nie0+1 ; ijSstsono = Njs0 ! send to ne-corner of so neighbourg 935 iiSndsono = jpi ; ijSndsono = Njs0+nn_hls-1 ! send to ne-corner of so neighbourg 936 iioutdir = 1 ; ijoutdir = 1 ! outside MPI domain: eastward or southward 937 END SELECT 938 ! 939 ! Check if we need to receive data for this rim point 940 IF( ii >= iiRst .AND. ii <= iiRnd .AND. ij >= ijRst .AND. ij <= ijRnd ) THEN ! rim point on the corner 941 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the MPI domain? 942 ! take care of neighbourg(s) in the interior of the computational domain 943 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of the MPI domain 944 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) THEN ! -> I cannot compute it -> recv it 945 IF( mpiRnei(nn_hls,iRdiag) > -1 ) lrecv_bdyint(ib_bdy,igrd,iRdiag,ir) = .TRUE. ! Receive directly from diagonal neighbourg 946 IF( mpiRnei(nn_hls,iRsono) > -1 .AND. nn_comm == 1 ) lrecv_bdyint(ib_bdy,igrd,iRsono,ir) = .TRUE. ! Receive through the South/North neighbourg 947 ENDIF 948 ! take care of neighbourg in the exterior of the computational domain 949 IF( iibe==iiout .OR. ijbe==ijout ) THEN ! Neib outside of the MPI domain -> I cannot compute it -> recv it 950 IF( mpiRnei(nn_hls,iRdiag) > -1 ) lrecv_bdyext(ib_bdy,igrd,iRdiag,ir) = .TRUE. ! Receive directly from diagonal neighbourg 951 IF( mpiRnei(nn_hls,iRsono) > -1 .AND. nn_comm == 1 ) lrecv_bdyext(ib_bdy,igrd,iRsono,ir) = .TRUE. ! Receive through the South/North neighbourg 952 ENDIF 953 ENDIF 954 ! 955 ! Check if this rim point corresponds to the corner of one neighbourg. if yes, do we need to send data? 956 ! Direct send to diag: Is this rim point the corner point of a diag neighbour with which we communicate? 957 IF( ii >= iiSstdiag .AND. ii <= iiSnddiag .AND. ij >= ijSstdiag .AND. ij <= ijSnddiag & 958 & .AND. mpiSnei(nn_hls,iSdiag) > -1 ) THEN 959 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the nei MPI domain? 960 ! take care of neighbourg(s) in the interior of the computational domain 961 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of diag nei MPI 962 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) & ! domain -> nei cannot compute it 963 & lsend_bdyint(ib_bdy,igrd,iSdiag,ir) = .TRUE. ! send rim point data to diag nei 964 ! take care of neighbourg in the exterior of the computational domain 965 IF( iibe==iiout .OR. ijbe==ijout ) & 966 & lsend_bdyext(ib_bdy,igrd,iSdiag,ir) = .TRUE. 967 ENDIF 968 ! Indirect send to diag (through so/no): rim point is the corner point of a so/no nei with which we communicate 969 IF( ii >= iiSstsono .AND. ii <= iiSndsono .AND. ij >= ijSstsono .AND. ij <= ijSndsono & 970 & .AND. mpiSnei(nn_hls,iSsono) > -1 .AND. nn_comm == 1 ) THEN 971 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the nei MPI domain? 972 ! take care of neighbourg(s) in the interior of the computational domain 973 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of so/no nei MPI 974 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) & ! domain -> nei cannot compute it 975 & lsend_bdyint(ib_bdy,igrd,iSsono,ir) = .TRUE. ! send rim point data to so/no nei 976 ! take care of neighbourg in the exterior of the computational domain 977 IF( iibe==iiout .OR. ijbe==ijout ) & 978 & lsend_bdyext(ib_bdy,igrd,iSsono,ir) = .TRUE. 979 ENDIF 980 ! 981 END DO ! 4 corners 982 END DO ! ib 983 END DO ! igrd 984 985 ! Comment out for debug 986 !!$ DO ir = 0,1 987 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'T', 1._wp, kfillmode = jpfillnothing, & 988 !!$ & lsend = lsend_bdyint(ib_bdy,1,:,ir), lrecv = lrecv_bdyint(ib_bdy,1,:,ir) ) 989 !!$ IF(lwp) WRITE(numout,*) ' bdy debug int T', ir ; CALL FLUSH(numout) 990 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'U', 1._wp, kfillmode = jpfillnothing, & 991 !!$ & lsend = lsend_bdyint(ib_bdy,2,:,ir), lrecv = lrecv_bdyint(ib_bdy,2,:,ir) ) 992 !!$ IF(lwp) WRITE(numout,*) ' bdy debug int U', ir ; CALL FLUSH(numout) 993 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'V', 1._wp, kfillmode = jpfillnothing, & 994 !!$ & lsend = lsend_bdyint(ib_bdy,3,:,ir), lrecv = lrecv_bdyint(ib_bdy,3,:,ir) ) 995 !!$ IF(lwp) WRITE(numout,*) ' bdy debug int V', ir ; CALL FLUSH(numout) 996 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'T', 1._wp, kfillmode = jpfillnothing, & 997 !!$ & lsend = lsend_bdyext(ib_bdy,1,:,ir), lrecv = lrecv_bdyext(ib_bdy,1,:,ir) ) 998 !!$ IF(lwp) WRITE(numout,*) ' bdy debug ext T', ir ; CALL FLUSH(numout) 999 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'U', 1._wp, kfillmode = jpfillnothing, & 1000 !!$ & lsend = lsend_bdyext(ib_bdy,2,:,ir), lrecv = lrecv_bdyext(ib_bdy,2,:,ir) ) 1001 !!$ IF(lwp) WRITE(numout,*) ' bdy debug ext U', ir ; CALL FLUSH(numout) 1002 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'V', 1._wp, kfillmode = jpfillnothing, & 1003 !!$ & lsend = lsend_bdyext(ib_bdy,3,:,ir), lrecv = lrecv_bdyext(ib_bdy,3,:,ir) ) 1004 !!$ IF(lwp) WRITE(numout,*) ' bdy debug ext V', ir ; CALL FLUSH(numout) 1005 !!$ END DO 1006 1007 END DO ! ib_bdy 785 1008 786 1009 DO ib_bdy = 1,nb_bdy
Note: See TracChangeset
for help on using the changeset viewer.
