Changeset 11955


Ignore:
Timestamp:
2019-11-22T18:44:17+01:00 (8 months ago)
Author:
mocavero
Message:

Bug fix for MPI3 neighbourhood collectives halo exchange. See ticket #2011

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11470_HPC_12_mpi3/src/OCE/LBC/mpp_nc_generic.h90

    r11940 r11955  
    183183      ! --------------------------------------------------- ! 
    184184      ! 
    185       ! 2.1 fill weastern halo 
     185      !!! Patch to solve MPI3 bug when we have only two processes columns 
     186      IF(jpni .eq. 2) THEN 
     187         ! --------------------- 
     188         ! 2.2 fill eastern halo 
     189         ! --------------------- 
     190         idx = 1 
     191         ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi  
     192         SELECT CASE ( ifill_ea ) 
     193         CASE ( jpfillnothing )               ! no filling  
     194         CASE ( jpfillmpi   )                 ! use data received by MPI  
     195            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     196               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx)   ! jpi - ihl + 1 -> jpi 
     197               idx = idx + 1 
     198            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     199         CASE ( jpfillperio )                 ! use east-weast periodicity 
     200            ishift2 = ihl 
     201            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     202               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
     203            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     204            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     205         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     206            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     207               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
     208            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     209            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     210         CASE ( jpfillcst   )                 ! filling with constant value 
     211            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     212               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
     213            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     214            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     215         END SELECT 
     216         ! ---------------------- 
     217         ! 2.1 fill weastern halo 
     218         ! ---------------------- 
     219         SELECT CASE ( ifill_we ) 
     220         CASE ( jpfillnothing )               ! no filling  
     221         CASE ( jpfillmpi   )                 ! use data received by MPI  
     222            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     223               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> ihl 
     224               idx = idx + 1 
     225            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     226         CASE ( jpfillperio )                 ! use east-weast periodicity 
     227            ishift2 = jpi - 2 * ihl 
     228            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     229               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
     230            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     231            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     232         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     233            DO jf = 1, ipf                               ! number of arrays to be treated 
     234               IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
     235                  DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     236                     ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 
     237                  END DO   ;   END DO   ;   END DO   ;   END DO 
     238               ENDIF 
     239            END DO 
     240            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     241         CASE ( jpfillcst   )                 ! filling with constant value 
     242            DO jf = 1, ipf                               ! number of arrays to be treated 
     243               IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
     244                  DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     245                     ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     246                  END DO;   END DO   ;   END DO   ;   END DO 
     247               ENDIF 
     248            END DO 
     249            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     250         END SELECT 
     251 
     252      ELSE 
     253         ! ---------------------- 
     254         ! 2.1 fill weastern halo 
     255         ! ---------------------- 
     256         idx = 1 
     257         SELECT CASE ( ifill_we ) 
     258         CASE ( jpfillnothing )               ! no filling  
     259         CASE ( jpfillmpi   )                 ! use data received by MPI  
     260            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     261               ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> ihl 
     262               idx = idx + 1 
     263            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     264         CASE ( jpfillperio )                 ! use east-weast periodicity 
     265            ishift2 = jpi - 2 * ihl 
     266            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     267               ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
     268            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     269            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     270         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     271            DO jf = 1, ipf                               ! number of arrays to be treated 
     272               IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
     273                  DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     274                     ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 
     275                  END DO   ;   END DO   ;   END DO   ;   END DO 
     276               ENDIF 
     277            END DO 
     278            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     279         CASE ( jpfillcst   )                 ! filling with constant value 
     280            DO jf = 1, ipf                               ! number of arrays to be treated 
     281               IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
     282                  DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     283                     ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     284                  END DO;   END DO   ;   END DO   ;   END DO 
     285               ENDIF 
     286            END DO 
     287            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     288         END SELECT 
     289         ! --------------------- 
     290         ! 2.2 fill eastern halo 
     291         ! --------------------- 
     292         ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi  
     293         SELECT CASE ( ifill_ea ) 
     294         CASE ( jpfillnothing )               ! no filling  
     295         CASE ( jpfillmpi   )                 ! use data received by MPI  
     296            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     297               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx)   ! jpi - ihl + 1 -> jpi 
     298               idx = idx + 1 
     299            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     300         CASE ( jpfillperio )                 ! use east-weast periodicity 
     301            ishift2 = ihl 
     302            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     303               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
     304            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     305            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     306         CASE ( jpfillcopy  )                 ! filling with inner domain values 
     307            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     308               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
     309            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     310            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     311         CASE ( jpfillcst   )                 ! filling with constant value 
     312            DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
     313               ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
     314            END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     315            idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
     316         END SELECT 
     317      END IF 
    186318      ! ---------------------- 
    187       idx = 1 
    188       SELECT CASE ( ifill_we ) 
    189       CASE ( jpfillnothing )               ! no filling  
    190       CASE ( jpfillmpi   )                 ! use data received by MPI  
    191          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    192             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx)   ! 1 -> ihl 
    193             idx = idx + 1 
    194          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    195       CASE ( jpfillperio )                 ! use east-weast periodicity 
    196          ishift2 = jpi - 2 * ihl 
    197          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    198             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    199          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    200          idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
    201       CASE ( jpfillcopy  )                 ! filling with inner domain values 
    202          DO jf = 1, ipf                               ! number of arrays to be treated 
    203             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    204                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    205                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 
    206                END DO   ;   END DO   ;   END DO   ;   END DO 
    207             ENDIF 
    208          END DO 
    209          idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
    210       CASE ( jpfillcst   )                 ! filling with constant value 
    211          DO jf = 1, ipf                               ! number of arrays to be treated 
    212             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    213                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    214                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    215                END DO;   END DO   ;   END DO   ;   END DO 
    216             ENDIF 
    217          END DO 
    218          idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
    219       END SELECT 
    220       ! 
    221       ! 2.2 fill eastern halo 
    222       ! --------------------- 
    223       ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi  
    224       SELECT CASE ( ifill_ea ) 
    225       CASE ( jpfillnothing )               ! no filling  
    226       CASE ( jpfillmpi   )                 ! use data received by MPI  
    227          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    228             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx)   ! jpi - ihl + 1 -> jpi 
    229             idx = idx + 1 
    230          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    231       CASE ( jpfillperio )                 ! use east-weast periodicity 
    232          ishift2 = ihl 
    233          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    234             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    235          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    236          idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
    237       CASE ( jpfillcopy  )                 ! filling with inner domain values 
    238          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    239             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
    240          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    241          idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
    242       CASE ( jpfillcst   )                 ! filling with constant value 
    243          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = ihl + 1, jpj - ihl   ;   DO ji = 1, ihl 
    244             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
    245          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    246          idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 
    247       END SELECT 
    248       ! 
    249319      ! 2.3 fill southern halo 
    250320      ! ---------------------- 
     
    281351         idx = idx + (jpi-2*ihl)*ihl*ipk*ipl*ipf 
    282352      END SELECT 
    283       ! 
     353      ! ---------------------- 
    284354      ! 2.4 fill northern halo 
    285355      ! ---------------------- 
Note: See TracChangeset for help on using the changeset viewer.