Changes from NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 at r14776 to NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 at r14574

File:

• NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 (modified) (2 diffs)

NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LBC/lbc_lnk_neicoll_generic.h90

@@ -26 +26 @@
       INTEGER, DIMENSION(8)  ::   isizej, ishtSj, ishtRj, ishtPj
       INTEGER, DIMENSION(8)  ::   ifill, iszall
-      INTEGER, DIMENSION(8)  ::   jnf
       INTEGER, DIMENSION(:), ALLOCATABLE  ::   iScnt, iRcnt    ! number of elements to be sent/received
       INTEGER, DIMENSION(:), ALLOCATABLE  ::   iSdpl, iRdpl    ! displacement in halos arrays
@@ -193 +192 @@
       !
       idx = 1
-      ! MPI3 bug fix when domain decomposition has 2 columns/rows
-      IF (jpni .eq. 2) THEN
-         IF (jpnj .eq. 2) THEN
-            jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /)
-         ELSE
-            jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /)
-         ENDIF
-      ELSE
-         IF (jpnj .eq. 2) THEN
-            jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /)
-         ELSE
-            jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /)
-         ENDIF
-      ENDIF
-
       DO jn = 1, 8
-         ishti = ishtRi(jnf(jn))
-         ishtj = ishtRj(jnf(jn))
-         SELECT CASE ( ifill(jnf(jn)) )
+         ishti = ishtRi(jn)
+         ishtj = ishtRj(jn)
+         SELECT CASE ( ifill(jn) )
          CASE ( jpfillnothing )               ! no filling 
          CASE ( jpfillmpi   )                 ! fill with data received by MPI
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx)
                idx = idx + 1
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillperio )                 ! use periodicity
-            ishti2 = ishtPi(jnf(jn))
-            ishtj2 = ishtPj(jnf(jn))
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
+            ishti2 = ishtPi(jn)
+            ishtj2 = ishtPj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillcopy  )                 ! filling with inner domain values
-            ishti2 = ishtSi(jnf(jn))
-            ishtj2 = ishtSj(jnf(jn))
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
+            ishti2 = ishtSi(jn)
+            ishtj2 = ishtSj(jn)
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl)
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO
          CASE ( jpfillcst   )                 ! filling with constant value
-            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn))
+            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn)
                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland
             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO