Changeset 15354
- Timestamp:
- 2021-10-12T15:44:46+02:00 (3 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 10 edited
-
OCE/BDY/bdy_oce.F90 (modified) (1 diff)
-
OCE/BDY/bdydyn2d.F90 (modified) (4 diffs)
-
OCE/BDY/bdydyn3d.F90 (modified) (3 diffs)
-
OCE/BDY/bdyice.F90 (modified) (4 diffs)
-
OCE/BDY/bdyini.F90 (modified) (6 diffs)
-
OCE/BDY/bdytra.F90 (modified) (2 diffs)
-
OCE/LBC/lbc_lnk_call_generic.h90 (modified) (1 diff)
-
OCE/LBC/lbc_lnk_neicoll_generic.h90 (modified) (2 diffs)
-
OCE/LBC/lbc_lnk_pt2pt_generic.h90 (modified) (2 diffs)
-
TOP/trcbdy.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/BDY/bdy_oce.F90
r13472 r15354 137 137 TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET :: dta_bdy !: bdy external data (local process) 138 138 !$AGRIF_END_DO_NOT_TREAT 139 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lsend_bdy 140 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lrecv_bdy !: when searching in any direction139 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lsend_bdyolr !: mark needed communication for given boundary, grid and neighbour 140 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lrecv_bdyolr !: when searching in any direction (only for orlansky) 141 141 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lsend_bdyint !: mark needed communication for given boundary, grid and neighbour 142 142 LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: lrecv_bdyint !: when searching towards the interior of the computational domain -
NEMO/trunk/src/OCE/BDY/bdydyn2d.F90
r15345 r15354 22 22 USE wet_dry ! Use wet dry to get reference ssh level 23 23 USE in_out_manager ! 24 USE lib_mpp , ONLY: ctl_stop24 USE lib_mpp 25 25 26 26 IMPLICIT NONE … … 50 50 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pssh 51 51 !! 52 INTEGER :: ib_bdy, ir ! BDY set index, rim index 53 LOGICAL :: llrim0 ! indicate if rim 0 is treated 54 LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 52 INTEGER :: ib_bdy, ir ! BDY set index, rim index 53 INTEGER, DIMENSION(3) :: idir3 54 INTEGER, DIMENSION(6) :: idir6 55 LOGICAL :: llrim0 ! indicate if rim 0 is treated 56 LOGICAL, DIMENSION(8) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 57 !!---------------------------------------------------------------------- 55 58 56 59 llsend2(:) = .false. ; llrecv2(:) = .false. … … 87 90 SELECT CASE( cn_dyn2d(ib_bdy) ) 88 91 CASE('flather') 89 llsend2(1:2) = llsend2(1:2) .OR. lsend_bdyint(ib_bdy,2,1:2,ir) ! west/east, U points 90 llsend2(1) = llsend2(1) .OR. lsend_bdyext(ib_bdy,2,1,ir) ! neighbour might search point towards its east bdy 91 llrecv2(1:2) = llrecv2(1:2) .OR. lrecv_bdyint(ib_bdy,2,1:2,ir) ! west/east, U points 92 llrecv2(2) = llrecv2(2) .OR. lrecv_bdyext(ib_bdy,2,2,ir) ! might search point towards bdy on the east 93 llsend3(3:4) = llsend3(3:4) .OR. lsend_bdyint(ib_bdy,3,3:4,ir) ! north/south, V points 94 llsend3(3) = llsend3(3) .OR. lsend_bdyext(ib_bdy,3,3,ir) ! neighbour might search point towards its north bdy 95 llrecv3(3:4) = llrecv3(3:4) .OR. lrecv_bdyint(ib_bdy,3,3:4,ir) ! north/south, V points 96 llrecv3(4) = llrecv3(4) .OR. lrecv_bdyext(ib_bdy,3,4,ir) ! might search point towards bdy on the north 92 idir6 = (/ jpwe, jpea, jpsw, jpse, jpnw, jpne /) 93 llsend2(idir6) = llsend2(idir6) .OR. lsend_bdyint(ib_bdy,2,idir6,ir) ! west/east, U points 94 idir3 = (/ jpwe, jpsw, jpnw /) 95 llsend2(idir3) = llsend2(idir3) .OR. lsend_bdyext(ib_bdy,2,idir3,ir) ! nei might search point towards its east bdy 96 llrecv2(idir6) = llrecv2(idir6) .OR. lrecv_bdyint(ib_bdy,2,idir6,ir) ! west/east, U points 97 idir3 = (/ jpea, jpse, jpne /) 98 llrecv2(idir3) = llrecv2(idir3) .OR. lrecv_bdyext(ib_bdy,2,idir3,ir) ! might search point towards bdy on the east 99 idir6 = (/ jpso, jpno, jpsw, jpse, jpnw, jpne /) 100 llsend3(idir6) = llsend3(idir6) .OR. lsend_bdyint(ib_bdy,3,idir6,ir) ! north/south, V points 101 idir3 = (/ jpso, jpsw, jpse /) 102 llsend3(idir3) = llsend3(idir3) .OR. lsend_bdyext(ib_bdy,3,idir3,ir) ! nei might search point towards its north bdy 103 llrecv3(idir6) = llrecv3(idir6) .OR. lrecv_bdyint(ib_bdy,3,idir6,ir) ! north/south, V points 104 idir3 = (/ jpno, jpnw, jpne /) 105 llrecv3(idir3) = llrecv3(idir3) .OR. lrecv_bdyext(ib_bdy,3,idir3,ir) ! might search point towards bdy on the north 97 106 CASE('orlanski', 'orlanski_npo') 98 llsend2(:) = llsend2(:) .OR. lsend_bdy (ib_bdy,2,:,ir) ! possibly every direction, U points99 llrecv2(:) = llrecv2(:) .OR. lrecv_bdy (ib_bdy,2,:,ir) ! possibly every direction, U points100 llsend3(:) = llsend3(:) .OR. lsend_bdy (ib_bdy,3,:,ir) ! possibly every direction, V points101 llrecv3(:) = llrecv3(:) .OR. lrecv_bdy (ib_bdy,3,:,ir) ! possibly every direction, V points107 llsend2(:) = llsend2(:) .OR. lsend_bdyolr(ib_bdy,2,:,ir) ! possibly every direction, U points 108 llrecv2(:) = llrecv2(:) .OR. lrecv_bdyolr(ib_bdy,2,:,ir) ! possibly every direction, U points 109 llsend3(:) = llsend3(:) .OR. lsend_bdyolr(ib_bdy,3,:,ir) ! possibly every direction, V points 110 llrecv3(:) = llrecv3(:) .OR. lrecv_bdyolr(ib_bdy,3,:,ir) ! possibly every direction, V points 102 111 END SELECT 103 112 END DO … … 310 319 INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1) 311 320 LOGICAL :: llrim0 ! indicate if rim 0 is treated 312 LOGICAL, DIMENSION( 4) :: llsend1, llrecv1 ! indicate how communications are to be carried out321 LOGICAL, DIMENSION(8) :: llsend1, llrecv1 ! indicate how communications are to be carried out 313 322 !!---------------------------------------------------------------------- 314 323 llsend1(:) = .false. ; llrecv1(:) = .false. -
NEMO/trunk/src/OCE/BDY/bdydyn3d.F90
r14834 r15354 18 18 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 19 19 USE in_out_manager ! 20 USE lib_mpp , ONLY: ctl_stop20 USE lib_mpp 21 21 Use phycst 22 22 … … 45 45 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT( inout ) :: puu, pvv ! Ocean velocities (to be updated at open boundaries) 46 46 ! 47 INTEGER :: ib_bdy, ir ! BDY set index, rim index 48 LOGICAL :: llrim0 ! indicate if rim 0 is treated 49 LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 50 51 !!---------------------------------------------------------------------- 47 INTEGER :: ib_bdy, ir ! BDY set index, rim index 48 INTEGER, DIMENSION(6) :: idir6 49 LOGICAL :: llrim0 ! indicate if rim 0 is treated 50 LOGICAL, DIMENSION(8) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 51 !!---------------------------------------------------------------------- 52 52 53 llsend2(:) = .false. ; llrecv2(:) = .false. 53 54 llsend3(:) = .false. ; llrecv3(:) = .false. … … 82 83 SELECT CASE( cn_dyn3d(ib_bdy) ) 83 84 CASE('orlanski', 'orlanski_npo') 84 llsend2(:) = llsend2(:) .OR. lsend_bdy (ib_bdy,2,:,ir) ! possibly every direction, U points85 llrecv2(:) = llrecv2(:) .OR. lrecv_bdy (ib_bdy,2,:,ir) ! possibly every direction, U points86 llsend3(:) = llsend3(:) .OR. lsend_bdy (ib_bdy,3,:,ir) ! possibly every direction, V points87 llrecv3(:) = llrecv3(:) .OR. lrecv_bdy (ib_bdy,3,:,ir) ! possibly every direction, V points85 llsend2(:) = llsend2(:) .OR. lsend_bdyolr(ib_bdy,2,:,ir) ! possibly every direction, U points 86 llrecv2(:) = llrecv2(:) .OR. lrecv_bdyolr(ib_bdy,2,:,ir) ! possibly every direction, U points 87 llsend3(:) = llsend3(:) .OR. lsend_bdyolr(ib_bdy,3,:,ir) ! possibly every direction, V points 88 llrecv3(:) = llrecv3(:) .OR. lrecv_bdyolr(ib_bdy,3,:,ir) ! possibly every direction, V points 88 89 CASE('zerograd') 89 llsend2(3:4) = llsend2(3:4) .OR. lsend_bdyint(ib_bdy,2,3:4,ir) ! north/south, U points 90 llrecv2(3:4) = llrecv2(3:4) .OR. lrecv_bdyint(ib_bdy,2,3:4,ir) ! north/south, U points 91 llsend3(1:2) = llsend3(1:2) .OR. lsend_bdyint(ib_bdy,3,1:2,ir) ! west/east, V points 92 llrecv3(1:2) = llrecv3(1:2) .OR. lrecv_bdyint(ib_bdy,3,1:2,ir) ! west/east, V points 90 idir6 = (/ jpso, jpno, jpsw, jpse, jpnw, jpne /) 91 llsend2(idir6) = llsend2(idir6) .OR. lsend_bdyint(ib_bdy,2,idir6,ir) ! north/south, U points 92 llrecv2(idir6) = llrecv2(idir6) .OR. lrecv_bdyint(ib_bdy,2,idir6,ir) ! north/south, U points 93 idir6 = (/ jpwe, jpea, jpsw, jpse, jpnw, jpne /) 94 llsend3(idir6) = llsend3(idir6) .OR. lsend_bdyint(ib_bdy,3,idir6,ir) ! west/east, V points 95 llrecv3(idir6) = llrecv3(idir6) .OR. lrecv_bdyint(ib_bdy,3,idir6,ir) ! west/east, V points 93 96 CASE('neumann') 94 97 llsend2(:) = llsend2(:) .OR. lsend_bdyint(ib_bdy,2,:,ir) ! possibly every direction, U points -
NEMO/trunk/src/OCE/BDY/bdyice.F90
r14767 r15354 58 58 INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1) 59 59 LOGICAL :: llrim0 ! indicate if rim 0 is treated 60 LOGICAL, DIMENSION( 4) :: llsend1, llrecv1 ! indicate how communications are to be carried out60 LOGICAL, DIMENSION(8) :: llsend1, llrecv1 ! indicate how communications are to be carried out 61 61 !!---------------------------------------------------------------------- 62 62 ! controls … … 327 327 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 328 328 ! 329 INTEGER :: i_bdy, jgrd ! dummy loop indices 330 INTEGER :: ji, jj ! local scalar 331 INTEGER :: jbdy, ir ! BDY set index, rim index 332 INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1) 333 REAL(wp) :: zmsk1, zmsk2, zflag 334 LOGICAL, DIMENSION(4) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 329 INTEGER :: i_bdy, jgrd ! dummy loop indices 330 INTEGER :: ji, jj ! local scalar 331 INTEGER :: jbdy, ir ! BDY set index, rim index 332 INTEGER :: ibeg, iend ! length of rim to be treated (rim 0 or rim 1) 333 INTEGER, DIMENSION(3) :: idir3 334 REAL(wp) :: zmsk1, zmsk2, zflag 335 LOGICAL, DIMENSION(8) :: llsend2, llrecv2, llsend3, llrecv3 ! indicate how communications are to be carried out 335 336 !!------------------------------------------------------------------------------ 336 337 IF( ln_timing ) CALL timing_start('bdy_ice_dyn') … … 430 431 DO jbdy = 1, nb_bdy 431 432 IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN 432 llsend2(:) = llsend2(:) .OR. lsend_bdyint(jbdy,2,:,ir) ! possibly every direction, U points 433 llsend2(1) = llsend2(1) .OR. lsend_bdyext(jbdy,2,1,ir) ! neighbour might search point towards its west bdy 434 llrecv2(:) = llrecv2(:) .OR. lrecv_bdyint(jbdy,2,:,ir) ! possibly every direction, U points 435 llrecv2(2) = llrecv2(2) .OR. lrecv_bdyext(jbdy,2,2,ir) ! might search point towards east bdy 433 llsend2( : ) = llsend2( : ) .OR. lsend_bdyint(jbdy,2, : ,ir) ! possibly every direction, U points 434 idir3 = (/ jpwe, jpsw, jpnw /) 435 llsend2(idir3) = llsend2(idir3) .OR. lsend_bdyext(jbdy,2,idir3,ir) ! nei might search point towards its ea bdy 436 llrecv2( : ) = llrecv2( : ) .OR. lrecv_bdyint(jbdy,2, : ,ir) ! possibly every direction, U points 437 idir3 = (/ jpea, jpse, jpne /) 438 llrecv2(idir3) = llrecv2(idir3) .OR. lrecv_bdyext(jbdy,2,idir3,ir) ! might search point towards east bdy 436 439 END IF 437 440 END DO … … 444 447 DO jbdy = 1, nb_bdy 445 448 IF( cn_ice(jbdy) == 'frs' .AND. nn_ice_dta(jbdy) /= 0 ) THEN 446 llsend3(:) = llsend3(:) .OR. lsend_bdyint(jbdy,3,:,ir) ! possibly every direction, V points 447 llsend3(3) = llsend3(3) .OR. lsend_bdyext(jbdy,3,3,ir) ! neighbour might search point towards its south bdy 448 llrecv3(:) = llrecv3(:) .OR. lrecv_bdyint(jbdy,3,:,ir) ! possibly every direction, V points 449 llrecv3(4) = llrecv3(4) .OR. lrecv_bdyext(jbdy,3,4,ir) ! might search point towards north bdy 449 llsend3( : ) = llsend3( : ) .OR. lsend_bdyint(jbdy,3, : ,ir) ! possibly every direction, V points 450 idir3 = (/ jpso, jpsw, jpse /) 451 llsend3(idir3) = llsend3(idir3) .OR. lsend_bdyext(jbdy,3,idir3,ir) ! nei might search point towards its no bdy 452 llrecv3( : ) = llrecv3( : ) .OR. lrecv_bdyint(jbdy,3, : ,ir) ! possibly every direction, V points 453 idir3 = (/ jpno, jpnw, jpne /) 454 llrecv3(idir3) = llrecv3(idir3) .OR. lrecv_bdyext(jbdy,3,idir3,ir) ! might search point towards north bdy 450 455 END IF 451 456 END DO -
NEMO/trunk/src/OCE/BDY/bdyini.F90
r15345 r15354 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, iiRcorn, iiSdiag, iiSsono 150 INTEGER :: ijRst, ijRnd, ijSst, ijSnd, ijRcorn, ijSdiag, ijSsono 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 ! - - … … 159 164 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: nbrdta ! Discrete distance from rim points 160 165 CHARACTER(LEN=1) , DIMENSION(jpbgrd) :: cgrid 166 CHARACTER(LEN=2) :: cRdir, cSdir 161 167 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zz_read ! work space for 2D global boundary data 162 168 REAL(wp), POINTER , DIMENSION(:,:) :: zmask ! pointer to 2D mask fields 163 169 REAL(wp) , DIMENSION(jpi,jpj) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 164 170 REAL(wp) , DIMENSION(jpi,jpj) :: ztmask, zumask, zvmask ! temporary u/v mask array 171 REAL(wp) , DIMENSION(jpi,jpj) :: zzbdy 165 172 !!---------------------------------------------------------------------- 166 173 ! … … 562 569 ! Initialize array indicating communications in bdy 563 570 ! ------------------------------------------------- 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.571 ALLOCATE( lsend_bdyolr(nb_bdy,jpbgrd,8,0:1), lrecv_bdyolr(nb_bdy,jpbgrd,8,0:1) ) 572 lsend_bdyolr(:,:,:,:) = .false. 573 lrecv_bdyolr(:,:,:,:) = .false. 567 574 568 575 DO ib_bdy = 1, nb_bdy … … 576 583 ! 577 584 ! 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. 585 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! we inner side 586 IF( mpiSnei(nn_hls,jpwe) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpwe,ir) = .TRUE. ! send to we neighbourg 587 ELSE ; CALL ctl_stop( 'bdyini send olr we-side' ) 588 ENDIF 589 ENDIF 590 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! ea inner side 591 IF( mpiSnei(nn_hls,jpea) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpea,ir) = .TRUE. ! send to ea neighbourg 592 ELSE ; CALL ctl_stop( 'bdyini send olr ea-side' ) 593 ENDIF 594 ENDIF 595 IF( ( ( ii >= Nis0 .AND. ii <= Nie0 ) .OR. nn_comm == 1 ) & 596 & .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! so inner side 597 IF( mpiSnei(nn_hls,jpso) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. ! send to so neighbourg 598 ELSE ; CALL ctl_stop( 'bdyini send olr so-side' ) 599 ENDIF 600 ENDIF 601 IF( ( ( ii >= Nis0 .AND. ii <= Nie0 ) .OR. nn_comm == 1 ) & 602 & .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! no inner side 603 IF( mpiSnei(nn_hls,jpno) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. ! send to no neighbourg 604 ELSE ; CALL ctl_stop( 'bdyini send olr no-side' ) 605 ENDIF 606 ENDIF 607 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! sw inner corner 608 IF( mpiSnei(nn_hls,jpsw) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpsw,ir) = .TRUE. ! send to sw neighbourg 609 ELSEIF( nn_comm /= 1 ) THEN ; CALL ctl_stop( 'bdyini send olr sw-corner' ) 610 ENDIF 611 ENDIF 612 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. ij >= Njs0 .AND. ij < Njs0 + nn_hls ) THEN ! se inner corner 613 IF( mpiSnei(nn_hls,jpse) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpse,ir) = .TRUE. ! send to se neighbourg 614 ELSEIF( nn_comm /= 1 ) THEN ; CALL ctl_stop( 'bdyini send olr se-corner' ) 615 ENDIF 616 ENDIF 617 IF( ii >= Nis0 .AND. ii < Nis0 + nn_hls .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! nw inner corner 618 IF( mpiSnei(nn_hls,jpnw) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpnw,ir) = .TRUE. ! send to nw neighbourg 619 ELSEIF( nn_comm /= 1 ) THEN ; CALL ctl_stop( 'bdyini send olr nw-corner' ) 620 ENDIF 621 ENDIF 622 IF( ii <= Nie0 .AND. ii > Nie0 - nn_hls .AND. ij <= Nje0 .AND. ij > Nje0 - nn_hls ) THEN ! ne inner corner 623 IF( mpiSnei(nn_hls,jpne) > -1 ) THEN ; lsend_bdyolr(ib_bdy,igrd,jpne,ir) = .TRUE. ! send to ne neighbourg 624 ELSEIF( nn_comm /= 1 ) THEN ; CALL ctl_stop( 'bdyini send olr ne-corner' ) 625 ENDIF 626 ENDIF 586 627 ! 587 628 ! 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. 629 IF( ii < Nis0 .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! we side 630 IF( mpiRnei(nn_hls,jpwe) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpwe,ir) = .TRUE. ! rcv from we nei 631 ELSE ; CALL ctl_stop( 'bdyini recv olr we-side ' ) 632 ENDIF 633 ENDIF 634 IF( ii > Nie0 .AND. ij >= Njs0 .AND. ij <= Nje0 ) THEN ! ea side 635 IF( mpiRnei(nn_hls,jpea) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpea,ir) = .TRUE. ! rcv from ea nei 636 ELSE ; CALL ctl_stop( 'bdyini recv olr ea-side ' ) 637 ENDIF 638 ENDIF 639 IF( ii >= Nis0 .AND. ii <= Nie0 .AND. ij < Njs0 ) THEN ! so side 640 IF( mpiRnei(nn_hls,jpso) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. ! rcv from so nei 641 ELSE ; CALL ctl_stop( 'bdyini recv olr so-side ' ) 642 ENDIF 643 ENDIF 644 IF( ii >= Nis0 .AND. ii <= Nie0 .AND. ij > Nje0 ) THEN ! no side 645 IF( mpiRnei(nn_hls,jpno) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. ! rcv from no nei 646 ELSE ; CALL ctl_stop( 'bdyini recv olr no-side ' ) 647 ENDIF 648 ENDIF 649 IF( ii < Nis0 .AND. ij < Njs0 ) THEN ! sw corner 650 IF( mpiRnei(nn_hls,jpsw) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpsw,ir) = .TRUE. 651 ELSEIF( mpiRnei(nn_hls,jpso) > -1 .AND. nn_comm == 1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 652 ELSE ; CALL ctl_stop( 'bdyini recv olr sw-corner' ) 653 ENDIF 654 ENDIF 655 IF( ii > Nie0 .AND. ij < Njs0 ) THEN ! se corner 656 IF( mpiRnei(nn_hls,jpse) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpse,ir) = .TRUE. 657 ELSEIF( mpiRnei(nn_hls,jpso) > -1 .AND. nn_comm == 1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpso,ir) = .TRUE. 658 ELSE ; CALL ctl_stop( 'bdyini recv olr se-corner' ) 659 ENDIF 660 ENDIF 661 IF( ii < Nis0 .AND. ij > Nje0 ) THEN ! nw corner 662 IF( mpiRnei(nn_hls,jpnw) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpnw,ir) = .TRUE. 663 ELSEIF( mpiRnei(nn_hls,jpno) > -1 .AND. nn_comm == 1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 664 ELSE ; CALL ctl_stop( 'bdyini recv olr nw-corner' ) 665 ENDIF 666 ENDIF 667 IF( ii > Nie0 .AND. ij > Nje0 ) THEN ! ne corner 668 IF( mpiRnei(nn_hls,jpne) > -1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpne,ir) = .TRUE. 669 ELSEIF( mpiRnei(nn_hls,jpno) > -1 .AND. nn_comm == 1 ) THEN ; lrecv_bdyolr(ib_bdy,igrd,jpno,ir) = .TRUE. 670 ELSE ; CALL ctl_stop( 'bdyini recv olr ne-corner' ) 671 ENDIF 672 ENDIF 596 673 ! 597 674 END DO 598 END DO ! igrd 599 675 END DO ! igrd 676 677 !!$ ! Comment out for debug 678 !!$ DO ir = 0,1 679 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'T', 1._wp, kfillmode = jpfillnothing, & 680 !!$ & lsend = lsend_bdyolr(ib_bdy,1,:,ir), lrecv = lrecv_bdyolr(ib_bdy,1,:,ir) ) 681 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'U', 1._wp, kfillmode = jpfillnothing, & 682 !!$ & lsend = lsend_bdyolr(ib_bdy,2,:,ir), lrecv = lrecv_bdyolr(ib_bdy,2,:,ir) ) 683 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'V', 1._wp, kfillmode = jpfillnothing, & 684 !!$ & lsend = lsend_bdyolr(ib_bdy,3,:,ir), lrecv = lrecv_bdyolr(ib_bdy,3,:,ir) ) 685 !!$ END DO 686 600 687 ! Compute rim weights for FRS scheme 601 688 ! ---------------------------------- … … 709 796 ! 710 797 ! Check which boundaries might need communication 711 ALLOCATE( lsend_bdyint(nb_bdy,jpbgrd, 4,0:1), lrecv_bdyint(nb_bdy,jpbgrd,4,0:1) )798 ALLOCATE( lsend_bdyint(nb_bdy,jpbgrd,8,0:1), lrecv_bdyint(nb_bdy,jpbgrd,8,0:1) ) 712 799 lsend_bdyint(:,:,:,:) = .false. 713 800 lrecv_bdyint(:,:,:,:) = .false. 714 ALLOCATE( lsend_bdyext(nb_bdy,jpbgrd, 4,0:1), lrecv_bdyext(nb_bdy,jpbgrd,4,0:1) )801 ALLOCATE( lsend_bdyext(nb_bdy,jpbgrd,8,0:1), lrecv_bdyext(nb_bdy,jpbgrd,8,0:1) ) 715 802 lsend_bdyext(:,:,:,:) = .false. 716 803 lrecv_bdyext(:,:,:,:) = .false. 717 804 ! 718 DO i grd = 1, jpbgrd719 DO i b_bdy = 1, nb_bdy805 DO ib_bdy = 1, nb_bdy 806 DO igrd = 1, jpbgrd 720 807 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 721 808 IF( idx_bdy(ib_bdy)%ntreat(ib,igrd) == -1 ) CYCLE … … 731 818 CALL find_neib( ii, ij, idx_bdy(ib_bdy)%ntreat(ib,igrd), ii1, ij1, ii2, ij2, ii3, ij3 ) ! free ocean neighbours 732 819 ! 733 ! search neighbour in the west/east direction820 ! take care of the 4 sides 734 821 ! 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 822 DO icnt = 1, 4 823 SELECT CASE( icnt ) 824 ! ... _____ 825 CASE( 1 ) ! x: rim on rcvwe/sndea-side o| : 826 ! o: potential neighbour(s) o|x : 827 ! outside of the MPI domain ..o|__:__ 828 cRdir = 'we' ; cSdir = 'ea' 829 iRnei = jpwe ; iSnei = jpea 830 iiRst = 1 ; ijRst = 2 ! Rcv we-side starting point, excluding sw-corner 831 iiRnd = 1 ; ijRnd = jpj-1 ! Rcv we-side ending point, excluding nw-corner 832 iiSst = jpi-2*nn_hls+1 ; ijSst = 2 ! Snd ea-side starting point, excluding se-corner 833 iiSnd = jpi-2*nn_hls+1 ; ijSnd = jpj-1 ! Snd ea-side ending point, excluding ne-corner 834 iioutdir = -1 ; ijoutdir = -999 ! outside MPI domain: westward 835 ! ______.... 836 CASE( 2 ) ! x: rim on rcvea/sndwe-side : |o 837 ! o: potential neighbour(s) : x|o 838 ! outside of the MPI domain ___:__|o.. 839 cRdir = 'ea' ; cSdir = 'we' 840 iRnei = jpea ; iSnei = jpwe 841 iiRst = jpi ; ijRst = 2 ! Rcv ea-side starting point, excluding se-corner 842 iiRnd = jpi ; ijRnd = jpj-1 ! Rcv ea-side ending point, excluding ne-corner 843 iiSst = 2*nn_hls ; ijSst = 2 ! Snd we-side starting point, excluding sw-corner 844 iiSnd = 2*nn_hls ; ijSnd = jpj-1 ! Snd we-side ending point, excluding nw-corner 845 iioutdir = 1 ; ijoutdir = -999 ! outside MPI domain: eastward 846 ! 847 CASE( 3 ) ! x: rim on rcvso/sndno-side | | 848 ! o: potential neighbour(s) |¨¨¨¨¨¨¨| 849 ! outside of the MPI domain |___x___| 850 ! : o o o : 851 ! : : 852 cRdir = 'so' ; cSdir = 'no' 853 iRnei = jpso ; iSnei = jpno 854 iiRst = 2 ; ijRst = 1 ! Rcv so-side starting point, excluding sw-corner 855 iiRnd = jpi-1 ; ijRnd = 1 ! Rcv so-side ending point, excluding se-corner 856 iiSst = 2 ; ijSst = jpj-2*nn_hls+1 ! Snd no-side starting point, excluding nw-corner 857 iiSnd = jpi-1 ; ijSnd = jpj-2*nn_hls+1 ! Snd no-side ending point, excluding ne-corner 858 iioutdir = -999 ; ijoutdir = -1 ! outside MPI domain: southward 859 ! : : 860 CASE( 4 ) ! x: rim on rcvno/sndso-side :_o_o_o_: 861 ! o: potential neighbour(s) | x | 862 ! outside of the MPI domain | | 863 ! |¨¨¨¨¨¨¨| 864 cRdir = 'no' ; cSdir = 'so' 865 iRnei = jpno ; iSnei = jpso 866 iiRst = 2 ; ijRst = jpj ! Rcv no-side starting point, excluding nw-corner 867 iiRnd = jpi-1 ; ijRnd = jpj ! Rcv no-side ending point, excluding ne-corner 868 iiSst = 2 ; ijSst = 2*nn_hls ! Snd so-side starting point, excluding sw-corner 869 iiSnd = jpi-1 ; ijSnd = 2*nn_hls ! Snd so-side ending point, excluding se-corner 870 iioutdir = -999 ; ijoutdir = 1 ! outside MPI domain: northward 871 END SELECT 872 ! 873 IF( ii >= iiRst .AND. ii <= iiRnd .AND. ij >= ijRst .AND. ij <= ijRnd ) THEN ! rim point in recv side 874 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the MPI domain? 875 ! take care of neighbourg(s) in the interior of the computational domain 876 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of the MPI domain 877 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) THEN ! -> I cannot compute it -> recv it 878 IF( mpiRnei(nn_hls,iRnei) > -1 ) THEN ; lrecv_bdyint(ib_bdy,igrd,iRnei,ir) = .TRUE. 879 ELSE ; CALL ctl_stop( 'bdyini recv int '//cRdir//'-side ' ) 880 ENDIF 881 ENDIF 882 ! take care of neighbourg in the exterior of the computational domain 883 IF( iibe==iiout .OR. ijbe==ijout ) THEN ! Neib outside of the MPI domain -> I cannot compute it -> recv it 884 IF( mpiRnei(nn_hls,iRnei) > -1 ) THEN ; lrecv_bdyext(ib_bdy,igrd,iRnei,ir) = .TRUE. 885 ELSE ; CALL ctl_stop( 'bdyini recv ext '//cRdir//'-side ' ) 886 ENDIF 887 ENDIF 888 ENDIF 889 890 IF( ii >= iiSst .AND. ii <= iiSnd .AND. ij >= ijSst .AND. ij <= ijSnd ) THEN ! rim point in send side 891 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the nei MPI domain? 892 ! take care of neighbourg(s) in the interior of the computational domain 893 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of nei MPI domain 894 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) THEN ! -> nei cannot compute it 895 IF( mpiSnei(nn_hls,iSnei) > -1 ) THEN ; lsend_bdyint(ib_bdy,igrd,iSnei,ir) = .TRUE. ! -> send to nei 896 ELSE ; CALL ctl_stop( 'bdyini send int '//cSdir//'-side ' ) 897 ENDIF 898 ENDIF 899 ! take care of neighbourg in the exterior of the computational domain 900 IF( iibe == iiout .OR. ijbe == ijout ) THEN ! Neib outside of the nei MPI domain -> nei cannot compute it 901 IF( mpiSnei(nn_hls,iSnei) > -1 ) THEN ; lsend_bdyext(ib_bdy,igrd,iSnei,ir) = .TRUE. ! -> send to nei 902 ELSE ; CALL ctl_stop( 'bdyini send ext '//cSdir//'-side ' ) 903 ENDIF 904 ENDIF 905 END IF 906 907 END DO ! 4 sides 757 908 ! 758 ! s earch neighbour in the north/south direction909 ! specific treatment for the corners 759 910 ! 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 911 DO icnt = 1, 4 912 SELECT CASE( icnt ) 913 ! ...|.... 914 CASE( 1 ) ! x: rim on sw-corner o| : 915 ! o: potential neighbour(s) o|x__:__ 916 ! outside of the MPI domain o o o: 917 ! : 918 cRdir = 'sw' 919 iRdiag = jpsw ; iRsono = jpso ! Recv: for sw or so 920 iSdiag = jpne ; iSsono = jpno ! Send: to ne or no 921 iiRcorn = 1 ; ijRcorn = 1 ! receiving sw-corner 922 iiSdiag = jpi-2*nn_hls+1 ; ijSdiag = jpj-2*nn_hls+1 ! send to sw-corner of ne neighbourg 923 iiSsono = 1 ; ijSsono = jpj-2*nn_hls+1 ! send to sw-corner of no neighbourg 924 iioutdir = -1 ; ijoutdir = -1 ! outside MPI domain: westward or southward 925 ! ....|... 926 CASE( 2 ) ! x: rim on se-corner : |o 927 ! o: potential neighbour(s) __:__x|o 928 ! outside of the MPI domain :o o o 929 ! : 930 cRdir = 'se' 931 iRdiag = jpse ; iRsono = jpso ! Recv: for se or so 932 iSdiag = jpnw ; iSsono = jpno ! Send: to nw or no 933 iiRcorn = jpi ; ijRcorn = 1 ! receiving se-corner 934 iiSdiag = 2*nn_hls ; ijSdiag = jpj-2*nn_hls+1 ! send to se-corner of nw neighbourg 935 iiSsono = jpi ; ijSsono = jpj-2*nn_hls+1 ! send to se-corner of no neighbourg 936 iioutdir = 1 ; ijoutdir = -1 ! outside MPI domain: eastward or southward 937 ! : 938 ! o o_o:___ 939 CASE( 3 ) ! x: rim on nw-corner o|x : 940 ! o: potential neighbour(s) ..o|...: 941 ! outside of the MPI domain | 942 cRdir = 'nw' 943 iRdiag = jpnw ; iRsono = jpno ! Recv: for nw or no 944 iSdiag = jpse ; iSsono = jpso ! Send: to se or so 945 iiRcorn = 1 ; ijRcorn = jpj ! receiving nw-corner 946 iiSdiag = jpi-2*nn_hls+1 ; ijSdiag = 2*nn_hls ! send to nw-corner of se neighbourg 947 iiSsono = 1 ; ijSsono = 2*nn_hls ! send to nw-corner of so neighbourg 948 iioutdir = -1 ; ijoutdir = 1 ! outside MPI domain: westward or northward 949 ! : 950 ! ___:o_o o 951 CASE( 4 ) ! x: rim on ne-corner : x|o 952 ! o: potential neighbour(s) :...|o... 953 ! outside of the MPI domain | 954 cRdir = 'ne' 955 iRdiag = jpne ; iRsono = jpno ! Recv: for ne or no 956 iSdiag = jpsw ; iSsono = jpso ! Send: to sw or so 957 iiRcorn = jpi ; ijRcorn = jpj ! receiving ne-corner 958 iiSdiag = 2*nn_hls ; ijSdiag = 2*nn_hls ! send to ne-corner of sw neighbourg 959 iiSsono = jpi ; ijSsono = 2*nn_hls ! send to ne-corner of so neighbourg 960 iioutdir = 1 ; ijoutdir = 1 ! outside MPI domain: eastward or southward 961 END SELECT 962 ! 963 ! Check if we need to receive data for this rim point 964 IF( ii == iiRcorn .AND. ij == ijRcorn ) THEN ! the rim point is located on the corner for the MPI domain 965 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the MPI domain? 966 ! take care of neighbourg(s) in the interior of the computational domain 967 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of the MPI domain 968 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) THEN ! -> I cannot compute it -> recv it 969 IF( mpiRnei(nn_hls,iRdiag) > -1 ) THEN 970 lrecv_bdyint(ib_bdy,igrd,iRdiag,ir) = .TRUE. ! Receive directly from diagonal neighbourg 971 ELSEIF( mpiRnei(nn_hls,iRsono) > -1 .AND. nn_comm == 1 ) THEN 972 lrecv_bdyint(ib_bdy,igrd,iRsono,ir) = .TRUE. ! Receive through the South/North neighbourg 973 ELSE 974 CALL ctl_stop( 'bdyini recv int '//cRdir//'-corner ' ) 975 ENDIF 976 ENDIF 977 ! take care of neighbourg in the exterior of the computational domain 978 IF( iibe==iiout .OR. ijbe==ijout ) THEN ! Neib outside of the MPI domain -> I cannot compute it -> recv it 979 IF( mpiRnei(nn_hls,iRdiag) > -1 ) THEN 980 lrecv_bdyext(ib_bdy,igrd,iRdiag,ir) = .TRUE. ! Receive directly from diagonal neighbourg 981 ELSEIF( mpiRnei(nn_hls,iRsono) > -1 .AND. nn_comm == 1 ) THEN 982 lrecv_bdyext(ib_bdy,igrd,iRsono,ir) = .TRUE. ! Receive through the South/North neighbourg 983 ELSE 984 CALL ctl_stop( 'bdyini recv ext '//cRdir//'-corner ' ) 985 ENDIF 986 ENDIF 987 ENDIF 988 ! 989 ! Check if this rim point corresponds to the corner of one neighbourg. if yes, do we need to send data? 990 ! Direct send to diag: Is this rim point the corner point of a diag neighbour with which we communicate? 991 IF( ii == iiSdiag .AND. ij == ijSdiag .AND. mpiSnei(nn_hls,iSdiag) > -1 ) THEN 992 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the nei MPI domain? 993 ! take care of neighbourg(s) in the interior of the computational domain 994 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of diag nei MPI 995 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) & ! domain -> nei cannot compute it 996 & lsend_bdyint(ib_bdy,igrd,iSdiag,ir) = .TRUE. ! send rim point data to diag nei 997 ! take care of neighbourg in the exterior of the computational domain 998 IF( iibe==iiout .OR. ijbe==ijout ) & 999 & lsend_bdyext(ib_bdy,igrd,iSdiag,ir) = .TRUE. 1000 ENDIF 1001 ! Indirect send to diag (through so/no): rim point is the corner point of a so/no nei with which we communicate 1002 IF( ii == iiSsono .AND. ij == ijSsono .AND. mpiSnei(nn_hls,iSsono) > -1 .AND. nn_comm == 1 ) THEN 1003 iiout = ii+iioutdir ; ijout = ij+ijoutdir ! in which direction do we go outside of the nei MPI domain? 1004 ! take care of neighbourg(s) in the interior of the computational domain 1005 IF( iibi==iiout .OR. ii1==iiout .OR. ii2==iiout .OR. ii3==iiout .OR. & ! Neib outside of so/no nei MPI 1006 & ijbi==ijout .OR. ij1==ijout .OR. ij2==ijout .OR. ij3==ijout ) & ! domain -> nei cannot compute it 1007 & lsend_bdyint(ib_bdy,igrd,iSsono,ir) = .TRUE. ! send rim point data to so/no nei 1008 ! take care of neighbourg in the exterior of the computational domain 1009 IF( iibe==iiout .OR. ijbe==ijout) & 1010 & lsend_bdyext(ib_bdy,igrd,iSsono,ir) = .TRUE. 1011 ENDIF 1012 ! 1013 END DO ! 4 corners 1014 END DO ! ib 1015 END DO ! igrd 1016 1017 !!$ ! Comment out for debug 1018 !!$ DO ir = 0,1 1019 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'T', 1._wp, kfillmode = jpfillnothing, & 1020 !!$ & lsend = lsend_bdyint(ib_bdy,1,:,ir), lrecv = lrecv_bdyint(ib_bdy,1,:,ir) ) 1021 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'U', 1._wp, kfillmode = jpfillnothing, & 1022 !!$ & lsend = lsend_bdyint(ib_bdy,2,:,ir), lrecv = lrecv_bdyint(ib_bdy,2,:,ir) ) 1023 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'V', 1._wp, kfillmode = jpfillnothing, & 1024 !!$ & lsend = lsend_bdyint(ib_bdy,3,:,ir), lrecv = lrecv_bdyint(ib_bdy,3,:,ir) ) 1025 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'T', 1._wp, kfillmode = jpfillnothing, & 1026 !!$ & lsend = lsend_bdyext(ib_bdy,1,:,ir), lrecv = lrecv_bdyext(ib_bdy,1,:,ir) ) 1027 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'U', 1._wp, kfillmode = jpfillnothing, & 1028 !!$ & lsend = lsend_bdyext(ib_bdy,2,:,ir), lrecv = lrecv_bdyext(ib_bdy,2,:,ir) ) 1029 !!$ zzbdy(:,:) = narea ; CALL lbc_lnk('bdy debug', zzbdy, 'V', 1._wp, kfillmode = jpfillnothing, & 1030 !!$ & lsend = lsend_bdyext(ib_bdy,3,:,ir), lrecv = lrecv_bdyext(ib_bdy,3,:,ir) ) 1031 !!$ END DO 1032 1033 END DO ! ib_bdy 785 1034 786 1035 DO ib_bdy = 1,nb_bdy -
NEMO/trunk/src/OCE/BDY/bdytra.F90
r14834 r15354 55 55 TYPE(ztrabdy), DIMENSION(jpts) :: zdta ! Temporary data structure 56 56 LOGICAL :: llrim0 ! indicate if rim 0 is treated 57 LOGICAL, DIMENSION( 4) :: llsend1, llrecv1 ! indicate how communications are to be carried out57 LOGICAL, DIMENSION(8) :: llsend1, llrecv1 ! indicate how communications are to be carried out 58 58 !!---------------------------------------------------------------------- 59 59 igrd = 1 … … 96 96 llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir) ! possibly every direction, T points 97 97 CASE('orlanski', 'orlanski_npo') 98 llsend1(:) = llsend1(:) .OR. lsend_bdy (ib_bdy,1,:,ir) ! possibly every direction, T points99 llrecv1(:) = llrecv1(:) .OR. lrecv_bdy (ib_bdy,1,:,ir) ! possibly every direction, T points98 llsend1(:) = llsend1(:) .OR. lsend_bdyolr(ib_bdy,1,:,ir) ! possibly every direction, T points 99 llrecv1(:) = llrecv1(:) .OR. lrecv_bdyolr(ib_bdy,1,:,ir) ! possibly every direction, T points 100 100 END SELECT 101 101 END DO -
NEMO/trunk/src/OCE/LBC/lbc_lnk_call_generic.h90
r15048 r15354 52 52 REAL(PRECISION) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 53 53 INTEGER , OPTIONAL , INTENT(in ) :: khls ! halo size, default = nn_hls 54 LOGICAL, DIMENSION( 4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out54 LOGICAL, DIMENSION(8), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 55 55 LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 56 56 !! -
NEMO/trunk/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
r15301 r15354 9 9 REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 10 10 INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls 11 LOGICAL, DIMENSION( 4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc11 LOGICAL, DIMENSION(8),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 12 12 LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 13 13 ! … … 74 74 ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not. 75 75 IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs 76 CALL ctl_stop( 'STOP', 'mpp_nc_generic+BDY not yet implemented') 77 !!$ ---> llsend(:) = lsend(:) ; llrecv(:) = lrecv(:) ??? 76 CALL ctl_stop( 'STOP', 'mpp_nc_generic+lsend and lrecv not yet implemented') 78 77 ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN 79 78 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' -
NEMO/trunk/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90
r15302 r15354 10 10 REAL(PRECISION), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 11 11 INTEGER , OPTIONAL, INTENT(in ) :: khls ! halo size, default = nn_hls 12 LOGICAL, DIMENSION( 4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc12 LOGICAL, DIMENSION(8),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 13 13 LOGICAL, OPTIONAL, INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 14 14 ! … … 72 72 ! define llsend and llrecv: logicals which say if mpi-neibourgs for send or receive exist or not. 73 73 IF ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN ! localy defined neighbourgs 74 llsend( 1:4) = lsend(1:4) ; llrecv(1:4) = lrecv(1:4)74 llsend(:) = lsend(:) ; llrecv(:) = lrecv(:) 75 75 ELSE IF( PRESENT(lsend) .OR. PRESENT(lrecv) ) THEN 76 76 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' -
NEMO/trunk/src/TOP/trcbdy.F90
r13527 r15354 50 50 REAL(wp), POINTER, DIMENSION(:,:) :: ztrc 51 51 LOGICAL :: llrim0 ! indicate if rim 0 is treated 52 LOGICAL, DIMENSION( 4) :: llsend1, llrecv1 ! indicate how communications are to be carried out52 LOGICAL, DIMENSION(8) :: llsend1, llrecv1 ! indicate how communications are to be carried out 53 53 !!---------------------------------------------------------------------- 54 54 ! … … 98 98 llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir) ! possibly every direction, T points 99 99 CASE('orlanski','orlanski_npo') 100 llsend1(:) = llsend1(:) .OR. lsend_bdy (ib_bdy,1,:,ir) ! possibly every direction, T points101 llrecv1(:) = llrecv1(:) .OR. lrecv_bdy (ib_bdy,1,:,ir) ! possibly every direction, T points100 llsend1(:) = llsend1(:) .OR. lsend_bdyolr(ib_bdy,1,:,ir) ! possibly every direction, T points 101 llrecv1(:) = llrecv1(:) .OR. lrecv_bdyolr(ib_bdy,1,:,ir) ! possibly every direction, T points 102 102 END SELECT 103 103 END DO
Note: See TracChangeset
for help on using the changeset viewer.
