Changeset 13561


Ignore:
Timestamp:
2020-10-04T11:18:11+02:00 (4 months ago)
Author:
mocavero
Message:

Add neighborhood collectives lbc routines for both 5-points and 9-points stencil - ticket #2496

Location:
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_rhg_evp.F90

    r13295 r13561  
    184184         zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    185185      END_2D 
    186       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
     186      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zfmask, 'F', 1._wp) 
    187187 
    188188      ! Lateral boundary conditions on velocity (modify zfmask) 
     
    209209         ENDIF 
    210210      END DO 
    211       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
     211      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
    212212 
    213213      !------------------------------------------------------------------------------! 
     
    300300 
    301301      END_2D 
    302       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
     302      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    303303      ! 
    304304      !                                  !== Landfast ice parameterization ==! 
     
    319319            tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    320320         END_2D 
    321          CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 
     321         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 
    322322         ! 
    323323      ELSE                               !-- no landfast 
     
    395395           
    396396         END_2D 
    397          CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 
    398  
     397         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 
    399398         DO_2D( 1, 0, 1, 0 ) 
    400399 
     
    484483               ENDIF 
    485484            END_2D 
    486             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
     485            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    487486            ! 
    488487#if defined key_agrif 
     
    533532               ENDIF 
    534533            END_2D 
    535             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
     534            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    536535            ! 
    537536#if defined key_agrif 
     
    584583               ENDIF 
    585584            END_2D 
    586             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
     585            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    587586            ! 
    588587#if defined key_agrif 
     
    633632               ENDIF 
    634633            END_2D 
    635             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
     634            CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    636635            ! 
    637636#if defined key_agrif 
     
    694693 
    695694      END_2D 
    696       CALL lbc_lnk_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp ) 
     695      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp ) 
    697696       
    698697      ! --- Store the stress tensor for the next time step --- ! 
    699       CALL lbc_lnk_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
     698      CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 
    700699      pstress1_i (:,:) = zs1 (:,:) 
    701700      pstress2_i (:,:) = zs2 (:,:) 
     
    714713         & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    715714         ! 
    716          CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
     715         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 
    717716            &                                  ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    718717         ! 
     
    752751            zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 
    753752         END_2D 
    754          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp ) 
     753         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp ) 
    755754         ! 
    756755         CALL iom_put( 'isig1' , zsig1 ) 
     
    769768         & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    770769         ! 
    771          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
     770         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 
    772771            &                                  zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 
    773772 
     
    802801         END_2D 
    803802 
    804          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
     803         CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 
    805804            &                                  zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 
    806805            &                                  zdiag_xatrp    , 'U', -1.0_wp, zdiag_yatrp    , 'V', -1.0_wp ) 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/DOM/dom_oce.F90

    r13286 r13561  
    8787   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
    8888   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
     89   INTEGER, PUBLIC ::   nones, nonws        !: north-east, north-west directions for sending  
     90   INTEGER, PUBLIC ::   noses, nosws        !: south-east, south-west directions for sending 
     91   INTEGER, PUBLIC ::   noner, nonwr        !: north-east, north-west directions for receiving 
     92   INTEGER, PUBLIC ::   noser, noswr        !: south-east, south-west directions for receiving 
    8993   INTEGER, PUBLIC ::   nidom             !: ??? 
    9094 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/lbc_lnk_nc_generic.h90

    r13303 r13561  
    3939      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    4040      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
    41       &                    , kfillmode, pfillval, lsend, lrecv ) 
     41      &                    , kfillmode, pfillval, lsend, lrecv, ncsten ) 
    4242      !!--------------------------------------------------------------------- 
    4343      CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
     
    5151      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
    5252      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
     53      LOGICAL            , OPTIONAL      , INTENT(in   ) :: ncsten 
    5354      !! 
    5455      INTEGER                          ::   kfld        ! number of elements that will be attributed 
     
    7576      IF( PRESENT(psgn11) )   CALL ROUTINE_NC_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    7677      ! 
    77       CALL lbc_lnk_nc    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
     78      CALL lbc_lnk_nc    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
    7879      ! 
    7980   END SUBROUTINE ROUTINE_MULTI_NC 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/lib_mpp.F90

    r13303 r13561  
    139139   ! variables used for MPI3 neighbourhood collectives 
    140140   INTEGER, PUBLIC :: mpi_nc_com                   ! MPI3 neighbourhood collectives communicator 
    141    INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: nranks 
     141   INTEGER, PUBLIC :: mpi_nc_all_com               ! MPI3 neighbourhood collectives communicator (with diagionals) 
    142142 
    143143   ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) 
     
    10741074      !!               ***  routine mpp_ini_nc  *** 
    10751075      !! 
    1076       !! ** Purpose :   Initialize special communicator for MPI3 neighbourhood 
     1076      !! ** Purpose :   Initialize special communicators for MPI3 neighbourhood 
    10771077      !!                collectives 
    10781078      !! 
    1079       !! ** Method  : - Create a graph communicator starting from the processes    
     1079      !! ** Method  : - Create graph communicators starting from the processes    
    10801080      !!                distribution along i and j directions 
    10811081      ! 
    10821082      !! ** output 
    10831083      !!         mpi_nc_com = MPI3 neighbourhood collectives communicator 
    1084       !! 
    1085       !!---------------------------------------------------------------------- 
    1086       INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh 
    1087       INTEGER :: ideg, icont 
    1088       INTEGER :: iinfo, ierr 
     1084      !!         mpi_nc_all_com = MPI3 neighbourhood collectives communicator 
     1085      !!                          (with diagonals) 
     1086      !! 
     1087      !!---------------------------------------------------------------------- 
     1088      INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr 
     1089      INTEGER :: ideg, idegalls, idegallr, icont, icont1 
     1090      INTEGER :: ierr 
    10891091      LOGICAL, PARAMETER :: ireord = .FALSE. 
    10901092 
    10911093#if defined key_mpp_mpi 
     1094 
    10921095      ideg = 0 
     1096      idegalls = 0 
     1097      idegallr = 0 
    10931098      icont = 0 
     1099      icont1 = 0 
    10941100 
    10951101      IF (nbondi .eq. 1) THEN 
     
    11091115      ENDIF 
    11101116 
     1117      idegalls = ideg 
     1118      idegallr = ideg 
     1119 
     1120      IF (nones .ne. -1) idegalls = idegalls + 1 
     1121      IF (nonws .ne. -1) idegalls = idegalls + 1 
     1122      IF (noses .ne. -1) idegalls = idegalls + 1 
     1123      IF (nosws .ne. -1) idegalls = idegalls + 1 
     1124      IF (noner .ne. -1) idegallr = idegallr + 1 
     1125      IF (nonwr .ne. -1) idegallr = idegallr + 1 
     1126      IF (noser .ne. -1) idegallr = idegallr + 1 
     1127      IF (noswr .ne. -1) idegallr = idegallr + 1 
     1128 
    11111129      ALLOCATE(ineigh(ideg)) 
     1130      ALLOCATE(ineighalls(idegalls)) 
     1131      ALLOCATE(ineighallr(idegallr)) 
    11121132 
    11131133      IF (nbondi .eq. 1) THEN 
    11141134         icont = icont + 1 
    11151135         ineigh(icont) = nowe 
     1136         ineighalls(icont) = nowe 
     1137         ineighallr(icont) = nowe 
    11161138      ELSEIF (nbondi .eq. -1) THEN 
    11171139         icont = icont + 1 
    11181140         ineigh(icont) = noea 
     1141         ineighalls(icont) = noea 
     1142         ineighallr(icont) = noea 
    11191143      ELSEIF (nbondi .eq. 0) THEN 
    11201144         icont = icont + 1 
    11211145         ineigh(icont) = nowe 
     1146         ineighalls(icont) = nowe 
     1147         ineighallr(icont) = nowe 
    11221148         icont = icont + 1 
    11231149         ineigh(icont) = noea 
     1150         ineighalls(icont) = noea 
     1151         ineighallr(icont) = noea 
    11241152      ENDIF 
    11251153 
     
    11271155         icont = icont + 1 
    11281156         ineigh(icont) = noso 
     1157         ineighalls(icont) = noso 
     1158         ineighallr(icont) = noso 
    11291159      ELSEIF (nbondj .eq. -1) THEN 
    11301160         icont = icont + 1 
    11311161         ineigh(icont) = nono 
     1162         ineighalls(icont) = nono 
     1163         ineighallr(icont) = nono 
    11321164      ELSEIF (nbondj .eq. 0) THEN 
    11331165         icont = icont + 1 
    11341166         ineigh(icont) = noso 
     1167         ineighalls(icont) = noso 
     1168         ineighallr(icont) = noso 
    11351169         icont = icont + 1 
    11361170         ineigh(icont) = nono 
     1171         ineighalls(icont) = nono 
     1172         ineighallr(icont) = nono 
     1173      ENDIF 
     1174 
     1175      icont1 = icont 
     1176      IF (nosws .ne. -1) THEN 
     1177         icont = icont + 1 
     1178         ineighalls(icont) = nosws 
     1179      ENDIF 
     1180      IF (noses .ne. -1) THEN 
     1181         icont = icont + 1 
     1182         ineighalls(icont) = noses 
     1183      ENDIF 
     1184      IF (nonws .ne. -1) THEN 
     1185         icont = icont + 1 
     1186         ineighalls(icont) = nonws 
     1187      ENDIF 
     1188      IF (nones .ne. -1) THEN 
     1189         icont = icont + 1 
     1190         ineighalls(icont) = nones 
     1191      ENDIF 
     1192      IF (noswr .ne. -1) THEN 
     1193         icont1 = icont1 + 1 
     1194         ineighallr(icont1) = noswr 
     1195      ENDIF 
     1196      IF (noser .ne. -1) THEN 
     1197         icont1 = icont1 + 1 
     1198         ineighallr(icont1) = noser 
     1199      ENDIF 
     1200      IF (nonwr .ne. -1) THEN 
     1201         icont1 = icont1 + 1 
     1202         ineighallr(icont1) = nonwr 
     1203      ENDIF 
     1204      IF (noner .ne. -1) THEN 
     1205         icont1 = icont1 + 1 
     1206         ineighallr(icont1) = noner 
    11371207      ENDIF 
    11381208 
    11391209      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, ideg, ineigh, MPI_UNWEIGHTED, ideg, ineigh, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com, ierr) 
     1210      CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, idegallr, ineighallr, MPI_UNWEIGHTED, idegalls, ineighalls, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_all_com, ierr) 
     1211 
    11401212      DEALLOCATE (ineigh) 
     1213      DEALLOCATE (ineighalls) 
     1214      DEALLOCATE (ineighallr) 
    11411215#endif 
    11421216   END SUBROUTINE mpp_ini_nc 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/mpp_nc_generic.h90

    r13303 r13561  
    4141#   endif 
    4242 
    43    SUBROUTINE ROUTINE_NC( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv ) 
     43   SUBROUTINE ROUTINE_NC( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 
    4444      INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    4545      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
     
    5050      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    5151      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    52       ! 
    53       INTEGER  ::   ji,  jj,  jk,  jl,  jf                                  ! dummy loop indices 
    54       INTEGER  ::   ipi, ipj, ipk, ipl, ipf                                 ! dimension of the input array 
    55       INTEGER  ::   ishift, ishift2, idx, idim, icount, isizet, izsnds      ! local integers 
     52      LOGICAL,              OPTIONAL, INTENT(in   ) ::   ncsten      ! 5-point or 9-point stencil 
     53      ! 
     54      INTEGER  ::   ji,  jj,  jk,  jl,  jf                                      ! dummy loop indices 
     55      INTEGER  ::   ipi, ipj, ipk, ipl, ipf                                     ! dimension of the input array 
     56      INTEGER  ::   ishift, ishift2, idx, icount, icount1                       ! local integers 
     57      INTEGER  ::   idims, idimr, isizet, isizets, isizetr, izsnd, izrcv        ! local integers 
    5658      INTEGER  ::   ierr 
    5759      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no 
    5860      REAL(wp) ::   zland 
    59       INTEGER , DIMENSION(MPI_STATUS_SIZE)                        ::   istate          ! for mpi_isend 
    60       REAL(PRECISION), DIMENSION(:), ALLOCATABLE                  ::   zsnd, zrcv      ! halos arrays 
    61       INTEGER , DIMENSION(:), ALLOCATABLE                         ::   isizes          ! number of elements to be sent/received 
    62       INTEGER , DIMENSION(:), ALLOCATABLE                         ::   idataty         ! datatype of halos arrays 
    63       INTEGER (KIND=MPI_ADDRESS_KIND), DIMENSION (:), ALLOCATABLE ::   idispls           ! displacement in halos arrays 
     61      INTEGER , DIMENSION(MPI_STATUS_SIZE)                        ::   istate              ! for mpi_isend 
     62      REAL(PRECISION), DIMENSION(:), ALLOCATABLE                  ::   zsnd, zrcv          ! halos arrays 
     63      INTEGER , DIMENSION(:), ALLOCATABLE                         ::   isizes              ! number of elements to be sent 
     64      INTEGER , DIMENSION(:), ALLOCATABLE                         ::   isizer              ! number of elements to be received 
     65      INTEGER , DIMENSION(:), ALLOCATABLE                         ::   idatatys, idatatyr  ! datatype of halos arrays 
     66      INTEGER (KIND=MPI_ADDRESS_KIND), DIMENSION (:), ALLOCATABLE ::   idispls, idisplr    ! displacement in halos arrays 
    6467      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send 
    6568      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive  
    6669      LOGICAL  ::   lldo_nfd                                     ! do north pole folding 
     70      LOGICAL  ::   llncall = .TRUE.                                 ! default: 9-point stencil 
    6771 
    6872      !!---------------------------------------------------------------------- 
     
    124128      END IF 
    125129      ! 
     130      IF(PRESENT(ncsten)) llncall = ncsten  
    126131#if defined PRINT_CAUTION 
    127132      ! 
     
    138143      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    139144 
    140       idim = 0 
    141       izsnds = 0 
    142  
    143       IF(llsend_we) idim = idim + 1 
    144       IF(llsend_ea) idim = idim + 1 
    145       IF(llsend_so) idim = idim + 1 
    146       IF(llsend_no) idim = idim + 1 
     145      idims = 0 
     146      idimr = 0 
     147      izsnd = 0 
     148      izrcv = 0 
     149 
     150      IF(llsend_we) idims = idims + 1 
     151      IF(llsend_ea) idims = idims + 1 
     152      IF(llsend_so) idims = idims + 1 
     153      IF(llsend_no) idims = idims + 1 
     154 
     155      idimr = idims 
     156 
     157      IF(llncall) THEN 
     158         IF(noswr .ne. -1) idimr = idimr + 1 
     159         IF(noser .ne. -1) idimr = idimr + 1 
     160         IF(nonwr .ne. -1) idimr = idimr + 1 
     161         IF(noner .ne. -1) idimr = idimr + 1 
    147162       
    148       IF(llsend_we) izsnds = izsnds + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 
    149       IF(llsend_ea) izsnds = izsnds + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 
    150       IF(llsend_so) izsnds = izsnds + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 
    151       IF(llsend_no) izsnds = izsnds + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 
    152  
    153       ALLOCATE(zsnd(izsnds)) 
    154       ALLOCATE(zrcv(izsnds)) 
    155       ALLOCATE(isizes(idim)) 
    156       ALLOCATE(idataty(idim)) 
    157       ALLOCATE(idispls(idim)) 
     163         IF(nosws .ne. -1) idims = idims + 1 
     164         IF(noses .ne. -1) idims = idims + 1 
     165         IF(nonws .ne. -1) idims = idims + 1 
     166         IF(nones .ne. -1) idims = idims + 1 
     167      END IF 
     168 
     169      IF(llsend_we) izsnd = izsnd + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 
     170      IF(llsend_ea) izsnd = izsnd + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 
     171      IF(llsend_so) izsnd = izsnd + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 
     172      IF(llsend_no) izsnd = izsnd + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 
     173 
     174      izrcv = izsnd 
     175       
     176      IF(llncall) THEN 
     177         IF(noswr .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 
     178         IF(noser .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 
     179         IF(nonwr .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 
     180         IF(noner .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 
     181 
     182         IF(nosws .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 
     183         IF(noses .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 
     184         IF(nonws .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 
     185         IF(nones .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 
     186      END IF 
     187 
     188      ALLOCATE(zsnd(izsnd)) 
     189      ALLOCATE(zrcv(izrcv)) 
     190      ALLOCATE(isizes(idims)) 
     191      ALLOCATE(isizer(idimr)) 
     192      ALLOCATE(idatatys(idims)) 
     193      ALLOCATE(idatatyr(idimr)) 
     194      ALLOCATE(idispls(idims)) 
     195      ALLOCATE(idisplr(idimr)) 
    158196 
    159197      zrcv(:)=-1 
    160198      zsnd(:)=-1 
    161199      isizes(:) = 0 
     200      isizer(:) = 0 
    162201      idispls(:) = 0 
     202      idisplr(:) = 0 
    163203      isizet = 0  
    164204      
     
    204244      END IF 
    205245 
    206  
    207246      IF(llsend_no) THEN 
    208247         ishift = jpj-2*nn_hls 
     
    219258      END IF 
    220259 
    221       idataty(:) = MPI_TYPE 
    222  
    223       IF( ln_timing ) CALL tic_tac(.TRUE.) 
    224  
    225       CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idataty, zrcv, isizes, idispls, idataty, mpi_nc_com, ierr) 
    226  
    227       IF( ln_timing ) CALL tic_tac(.FALSE.) 
     260      isizer(:) = isizes(:) 
     261      idisplr(:) = idispls(:) 
     262       
     263      icount1 = icount 
     264      isizets = isizet  
     265      isizetr = isizet  
     266 
     267      IF(llncall) THEN 
     268         IF(noswr .ne. -1) THEN 
     269            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 
     270            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 
     271            idisplr(icount1) = jpbyt*isizetr 
     272            icount1 = icount1 + 1 
     273         END IF 
     274         IF(noser .ne. -1) THEN 
     275            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 
     276            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 
     277            idisplr(icount1) = jpbyt*isizetr 
     278            icount1 = icount1 + 1 
     279         END IF 
     280         IF(nonwr .ne. -1) THEN 
     281            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 
     282            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 
     283            idisplr(icount1) = jpbyt*isizetr 
     284            icount1 = icount1 + 1 
     285         END IF 
     286         IF(noner .ne. -1) THEN 
     287            isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 
     288            IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 
     289            idisplr(icount1) = jpbyt*isizetr 
     290            icount1 = icount1 + 1 
     291         END IF 
     292 
     293         IF(nosws .ne. -1) THEN 
     294            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls 
     295               zsnd(idx) = ARRAY_IN(nn_hls+ji,nn_hls+jj,jk,jl,jf) 
     296               idx = idx + 1 
     297            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     298 
     299            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 
     300            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 
     301            idispls(icount) = jpbyt*isizets 
     302            icount = icount + 1 
     303         END IF 
     304         IF(noses .ne. -1) THEN 
     305            ishift = jpi-2*nn_hls 
     306            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls 
     307               zsnd(idx) = ARRAY_IN(ji+ishift,nn_hls+jj,jk,jl,jf) 
     308               idx = idx + 1 
     309            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     310 
     311            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 
     312            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 
     313            idispls(icount) = jpbyt*isizets 
     314            icount = icount + 1 
     315         END IF 
     316         IF(nonws .ne. -1) THEN 
     317            ishift = jpj-2*nn_hls 
     318            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls 
     319               zsnd(idx) = ARRAY_IN(nn_hls+ji,jj+ishift,jk,jl,jf) 
     320               idx = idx + 1 
     321            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     322 
     323            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 
     324            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 
     325            idispls(icount) = jpbyt*isizets 
     326            icount = icount + 1 
     327         END IF 
     328         IF(nones .ne. -1) THEN 
     329            ishift = jpi-2*nn_hls 
     330            ishift2 = jpj-2*nn_hls 
     331            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1, nn_hls  ;  DO ji = 1, nn_hls 
     332               zsnd(idx) = ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) 
     333               idx = idx + 1 
     334            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     335 
     336            isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 
     337            IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 
     338            idispls(icount) = jpbyt*isizets 
     339            icount = icount + 1 
     340         END IF 
     341      END IF 
     342 
     343      idatatys(:) = MPI_TYPE 
     344      idatatyr(:) = MPI_TYPE 
     345 
     346      IF(llncall) THEN 
     347         IF( ln_timing ) CALL tic_tac(.TRUE.) 
     348         CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idatatys, zrcv, isizer, idisplr, idatatyr, mpi_nc_all_com, ierr) 
     349         IF( ln_timing ) CALL tic_tac(.FALSE.) 
     350      ELSE 
     351         IF( ln_timing ) CALL tic_tac(.TRUE.) 
     352         CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idatatys, zrcv, isizer, idisplr, idatatyr, mpi_nc_com, ierr) 
     353         IF( ln_timing ) CALL tic_tac(.FALSE.) 
     354      END IF 
    228355 
    229356      ! --------------------------------------------------- ! 
     
    337464         END SELECT 
    338465      ENDIF 
    339       ! ---------------------- 
    340       ! 2.3 fill southern halo 
    341       ! ---------------------- 
    342       SELECT CASE ( ifill_so ) 
    343       CASE ( jpfillnothing )               ! no filling  
    344       CASE ( jpfillmpi   )                 ! use data received by MPI  
    345          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    346             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls 
    347             idx = idx + 1 
    348          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    349       CASE ( jpfillperio )                 ! use north-south periodicity 
    350          ishift2 = jpj - 2 * nn_hls 
    351          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    352             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    353          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    354       CASE ( jpfillcopy  )                 ! filling with inner domain values 
    355          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    356             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
    357          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    358       CASE ( jpfillcst   )                 ! filling with constant value 
    359          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    360             ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    361          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    362       END SELECT 
    363       ! ---------------------- 
    364       ! 2.4 fill northern halo 
    365       ! ---------------------- 
    366       ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
    367       SELECT CASE ( ifill_no ) 
    368       CASE ( jpfillnothing )               ! no filling  
    369       CASE ( jpfillmpi   )                 ! use data received by MPI  
    370          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = nn_hls + 1, jpi - nn_hls 
    371             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx)   ! jpj-nn_hls+1 -> jpj 
    372             idx = idx + 1 
    373          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    374       CASE ( jpfillperio )                 ! use north-south periodicity 
    375          ishift2 = nn_hls 
    376          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    377             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    378          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    379       CASE ( jpfillcopy  )                 ! filling with inner domain values 
    380          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    381             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
    382          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    383       CASE ( jpfillcst   )                 ! filling with constant value 
    384          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
    385             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
    386          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    387       END SELECT 
     466 
     467      !!! Patch to solve MPI3 bug when we have only two processes rows 
     468      IF(jpnj .eq. 2) THEN 
     469         ! ---------------------- 
     470         ! 2.3 fill northern halo 
     471         ! ---------------------- 
     472         ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
     473         SELECT CASE ( ifill_no ) 
     474         CASE ( jpfillnothing )               ! no filling  
     475         CASE ( jpfillmpi   )                 ! use data received by MPI  
     476            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = nn_hls + 1, jpi - nn_hls 
     477               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx)   ! jpj-nn_hls+1 -> jpj 
     478               idx = idx + 1 
     479            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     480         CASE ( jpfillperio )                 ! use north-south periodicity 
     481            ishift2 = nn_hls 
     482            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     483               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
     484            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     485         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     486            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     487               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
     488            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     489         CASE ( jpfillcst   )                 ! filling with constant value 
     490            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     491               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
     492            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     493         END SELECT 
     494         ! ---------------------- 
     495         ! 2.4 fill southern halo 
     496         ! ---------------------- 
     497         SELECT CASE ( ifill_so ) 
     498         CASE ( jpfillnothing )               ! no filling  
     499         CASE ( jpfillmpi   )                 ! use data received by MPI  
     500            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     501               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls 
     502               idx = idx + 1 
     503            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     504         CASE ( jpfillperio )                 ! use north-south periodicity 
     505            ishift2 = jpj - 2 * nn_hls 
     506            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     507               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
     508            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     509         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     510            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     511               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
     512            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     513         CASE ( jpfillcst   )                 ! filling with constant value 
     514            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     515               ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     516            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     517         END SELECT 
     518      ELSE 
     519         ! ---------------------- 
     520         ! 2.3 fill southern halo 
     521         ! ---------------------- 
     522         SELECT CASE ( ifill_so ) 
     523         CASE ( jpfillnothing )               ! no filling  
     524         CASE ( jpfillmpi   )                 ! use data received by MPI  
     525            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     526               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> nn_hls 
     527               idx = idx + 1 
     528            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     529         CASE ( jpfillperio )                 ! use north-south periodicity 
     530            ishift2 = jpj - 2 * nn_hls 
     531            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     532               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
     533            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     534         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     535            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     536               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
     537            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     538         CASE ( jpfillcst   )                 ! filling with constant value 
     539            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     540               ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     541            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     542         END SELECT 
     543         ! ---------------------- 
     544         ! 2.4 fill northern halo 
     545         ! ---------------------- 
     546         ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
     547         SELECT CASE ( ifill_no ) 
     548         CASE ( jpfillnothing )               ! no filling  
     549         CASE ( jpfillmpi   )                 ! use data received by MPI  
     550            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = nn_hls + 1, jpi - nn_hls 
     551               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx)   ! jpj-nn_hls+1 -> jpj 
     552               idx = idx + 1 
     553            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     554         CASE ( jpfillperio )                 ! use north-south periodicity 
     555            ishift2 = nn_hls 
     556            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     557               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
     558            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     559         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     560            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     561               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
     562            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     563         CASE ( jpfillcst   )                 ! filling with constant value 
     564            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = nn_hls + 1, jpi - nn_hls 
     565               ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
     566            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     567         END SELECT 
     568      ENDIF 
     569 
     570      IF(llncall) THEN 
     571 
     572         !!! Patch to solve MPI3 bug when we have only two processes columns 
     573         IF(jpni .eq. 2) THEN 
     574            !!! Patch to solve MPI3 bug when we have only two processes rows 
     575            IF(jpnj .eq. 2) THEN 
     576               ! --------------------------- 
     577               ! 2.5 fill east-nouthern halo 
     578               ! --------------------------- 
     579                 IF(noner .ne. -1) THEN 
     580                    ishift = jpi - nn_hls 
     581                    ishift2 = jpj - nn_hls 
     582                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     583                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 
     584                       idx = idx + 1 
     585                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     586                 END IF 
     587               ! --------------------------- 
     588               ! 2.6 fill west-nouthern halo 
     589               ! --------------------------- 
     590                 IF(nonwr .ne. -1) THEN 
     591                    ishift = jpj - nn_hls 
     592                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     593                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 
     594                       idx = idx + 1 
     595                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     596                 END IF 
     597               ! --------------------------- 
     598               ! 2.7 fill east-southern halo 
     599               ! --------------------------- 
     600                 IF(noser .ne. -1) THEN 
     601                    ishift = jpi - nn_hls 
     602                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     603                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 
     604                       idx = idx + 1 
     605                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     606                 END IF 
     607               ! --------------------------- 
     608               ! 2.8 fill west-southern halo 
     609               ! --------------------------- 
     610                 IF(noswr .ne. -1) THEN 
     611                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     612                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 
     613                       idx = idx + 1 
     614                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     615                 END IF 
     616 
     617            ELSE 
     618               ! --------------------------- 
     619               ! 2.5 fill east-southern halo 
     620               ! --------------------------- 
     621                 IF(noser .ne. -1) THEN 
     622                    ishift = jpi - nn_hls 
     623                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     624                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 
     625                       idx = idx + 1 
     626                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     627                 END IF 
     628               ! --------------------------- 
     629               ! 2.6 fill west-southern halo 
     630               ! --------------------------- 
     631                 IF(noswr .ne. -1) THEN 
     632                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     633                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 
     634                       idx = idx + 1 
     635                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     636                 END IF 
     637               ! --------------------------- 
     638               ! 2.7 fill east-nouthern halo 
     639               ! --------------------------- 
     640                 IF(noner .ne. -1) THEN 
     641                    ishift = jpi - nn_hls 
     642                    ishift2 = jpj - nn_hls 
     643                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     644                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 
     645                       idx = idx + 1 
     646                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     647                 END IF 
     648               ! --------------------------- 
     649               ! 2.8 fill west-nouthern halo 
     650               ! --------------------------- 
     651                 IF(nonwr .ne. -1) THEN 
     652                    ishift = jpj - nn_hls 
     653                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     654                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 
     655                       idx = idx + 1 
     656                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     657                 END IF 
     658            ENDIF 
     659         ELSE 
     660            !!! Patch to solve MPI3 bug when we have only two processes rows 
     661            IF(jpnj .eq. 2) THEN 
     662               ! --------------------------- 
     663               ! 2.5 fill west-nouthern halo 
     664               ! --------------------------- 
     665                 IF(nonwr .ne. -1) THEN 
     666                    ishift = jpj - nn_hls 
     667                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     668                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 
     669                       idx = idx + 1 
     670                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     671                 END IF 
     672               ! --------------------------- 
     673               ! 2.6 fill east-nouthern halo 
     674               ! --------------------------- 
     675                 IF(noner .ne. -1) THEN 
     676                    ishift = jpi - nn_hls 
     677                    ishift2 = jpj - nn_hls 
     678                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     679                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 
     680                       idx = idx + 1 
     681                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     682                 END IF 
     683               ! --------------------------- 
     684               ! 2.7 fill west-southern halo 
     685               ! --------------------------- 
     686                 IF(noswr .ne. -1) THEN 
     687                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     688                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 
     689                       idx = idx + 1 
     690                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     691                 END IF 
     692               ! --------------------------- 
     693               ! 2.8 fill east-southern halo 
     694               ! --------------------------- 
     695                 IF(noser .ne. -1) THEN 
     696                    ishift = jpi - nn_hls 
     697                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     698                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 
     699                       idx = idx + 1 
     700                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     701                 END IF 
     702 
     703            ELSE 
     704               ! --------------------------- 
     705               ! 2.5 fill west-southern halo 
     706               ! --------------------------- 
     707                 IF(noswr .ne. -1) THEN 
     708                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     709                       ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 
     710                       idx = idx + 1 
     711                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     712                 END IF 
     713               ! --------------------------- 
     714               ! 2.6 fill east-southern halo 
     715               ! --------------------------- 
     716                 IF(noser .ne. -1) THEN 
     717                    ishift = jpi - nn_hls 
     718                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     719                       ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 
     720                       idx = idx + 1 
     721                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     722                 END IF 
     723               ! --------------------------- 
     724               ! 2.7 fill west-nouthern halo 
     725               ! --------------------------- 
     726                 IF(nonwr .ne. -1) THEN 
     727                    ishift = jpj - nn_hls 
     728                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     729                       ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 
     730                       idx = idx + 1 
     731                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     732                 END IF 
     733               ! --------------------------- 
     734               ! 2.8 fill east-nouthern halo 
     735               ! --------------------------- 
     736                 IF(noner .ne. -1) THEN 
     737                    ishift = jpi - nn_hls 
     738                    ishift2 = jpj - nn_hls 
     739                    DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;  DO ji = 1, nn_hls 
     740                       ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 
     741                       idx = idx + 1 
     742                    END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     743                 END IF 
     744            ENDIF 
     745         END IF 
     746      END IF 
     747 
     748 
    388749      ! 
    389750      ! -------------------------------------------- ! 
     
    394755      DEALLOCATE( zrcv ) 
    395756      DEALLOCATE(isizes) 
    396       DEALLOCATE(idataty) 
     757      DEALLOCATE(isizer) 
     758      DEALLOCATE(idatatys) 
     759      DEALLOCATE(idatatyr) 
    397760      DEALLOCATE(idispls) 
     761      DEALLOCATE(idisplr) 
    398762      ! 
    399763      ! ------------------------------- ! 
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/mppini.F90

    r13303 r13561  
    547547      ij = ijn(narea) 
    548548      ! 
    549       ! set default neighbours 
    550       noso = ii_noso(narea) 
    551       nowe = ii_nowe(narea) 
    552       noea = ii_noea(narea) 
    553       nono = ii_nono(narea) 
    554549      jpi    = ijpi(ii,ij)   
    555550!!$      Nis0  = iis0(ii,ij) 
     
    563558      njmpp = ijmppt(ii,ij) 
    564559      jpk = jpkglo                              ! third dim 
     560 
     561      ! set default neighbours 
     562      noso = ii_noso(narea) 
     563      nowe = ii_nowe(narea) 
     564      noea = ii_noea(narea) 
     565      nono = ii_nono(narea) 
     566 
     567      nones = -1 
     568      nonws = -1 
     569      noses = -1 
     570      nosws = -1 
     571       
     572      noner = -1 
     573      nonwr = -1 
     574      noser = -1 
     575      noswr = -1 
     576 
     577      IF((nbondi .eq. -1) .or. (nbondi .eq. 0)) THEN ! east neighbour exists 
     578         IF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 0) THEN 
     579            nones = ii_nono(noea+1)                  ! east neighbour has north and south neighbours 
     580            noses = ii_noso(noea+1) 
     581         ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. -1) THEN 
     582            nones = ii_nono(noea+1)                  ! east neighbour has north neighbour 
     583         ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 1) THEN 
     584            noses = ii_noso(noea+1)                  ! east neighbour has south neighbour 
     585         END IF 
     586      END IF 
     587      IF((nbondi .eq. 1) .or. (nbondi .eq. 0)) THEN  ! west neighbour exists 
     588         IF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 0) THEN 
     589            nonws = ii_nono(nowe+1)                  ! west neighbour has north and south neighbours 
     590            nosws = ii_noso(nowe+1) 
     591         ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. -1) THEN 
     592            nonws = ii_nono(nowe+1)                  ! west neighbour has north neighbour 
     593         ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 1)  THEN 
     594            nosws = ii_noso(nowe+1)                  ! west neighbour has north neighbour 
     595         END IF 
     596      END IF 
     597 
     598      IF((nbondj .eq. -1) .or. (nbondj .eq. 0)) THEN ! north neighbour exists 
     599         IF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 0) THEN 
     600            noner = ii_noea(nono+1)                  ! north neighbour has east and west neighbours 
     601            nonwr = ii_nowe(nono+1) 
     602         ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. -1) THEN 
     603            noner = ii_noea(nono+1)                  ! north neighbour has east neighbour 
     604         ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 1) THEN 
     605            nonwr = ii_nowe(nono+1)                  ! north neighbour has west neighbour 
     606         END IF 
     607      END IF 
     608      IF((nbondj .eq. 1) .or. (nbondj .eq. 0)) THEN  ! south neighbour exists 
     609         IF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 0) THEN 
     610            noser = ii_noea(noso+1)                  ! south neighbour has east and west neighbours 
     611            noswr = ii_nowe(noso+1) 
     612         ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. -1) THEN 
     613            noser = ii_noea(noso+1)                  ! south neighbour has east neighbour 
     614         ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 1) THEN 
     615            noswr = ii_nowe(noso+1)                  ! south neighbour has west neighbour 
     616         END IF 
     617      END IF 
     618 
    565619      ! 
    566620      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)  
  • NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/TRA/traadv_fct.F90

    r13303 r13561  
    9797         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    9898      ENDIF 
     99 
    99100      !! -- init to 0 
    100101      zwi(:,:,:) = 0._wp 
     
    439440         END_2D 
    440441      END DO 
    441       CALL lbc_lnk_nc_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp)   ! lateral boundary cond. (unchanged sign) 
     442      CALL lbc_lnk_nc_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp )   ! lateral boundary cond. (unchanged sign) 
    442443 
    443444      ! 3. monotonic flux in the i & j direction (paa & pbb) 
     
    461462         pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 
    462463      END_3D 
    463       CALL lbc_lnk_nc_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp) ! lateral boundary condition (changed sign) 
     464      CALL lbc_lnk_nc_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp ) ! lateral boundary condition (changed sign) 
    464465      ! 
    465466   END SUBROUTINE nonosc 
Note: See TracChangeset for help on using the changeset viewer.