Changeset 13266 for NEMO

Timestamp:

2020-07-08T14:49:37+02:00 (4 years ago)

Author:

acc

Message:

Extra_Halo: revert previous bugfix in mppini.F90 and fix, instead, the ordering and treatment of processors in the north-fold communicator. Now passes all SETTE including an extra version of ORCA2_ICE_PISCES, REPRO_8_4 with land-suppression and ln_nnogather=F. run.stat differences from trunk@13218 in ORCA2_ICE_PISCES associated with calving (REPRO tests which have ln_calving=F match). Also tracer.stat differences after 42 timesteps (unexplained).

Location:

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC

Files:

• lib_mpp.F90 (modified) (2 diffs)
• mpp_lbc_north_icb_generic.h90 (modified) (3 diffs)
• mpp_nfd_generic.h90 (modified) (5 diffs)
• mppini.F90 (modified) (1 diff)

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lib_mpp.F90

@@ -1098 +1098 @@
       ! Look for how many procs on the northern boundary
       ndim_rank_north = 0
-      DO jjproc = 1, jpnij
-         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
+      DO jjproc = 1, jpni
+         IF( nfproc(jjproc) /= -1 )   ndim_rank_north = ndim_rank_north + 1
       END DO
       !
@@ -1109 +1109 @@
       ! Note : the rank start at 0 in MPI
       ii = 0
-      DO ji = 1, jpnij
-         IF ( njmppt(ji) == njmppmax   ) THEN
+      DO ji = 1, jpni
+         IF ( nfproc(ji) /= -1   ) THEN
             ii=ii+1
-            nrank_north(ii)=ji-1
+            nrank_north(ii)=nfproc(ji)
          END IF
       END DO

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lbc_north_icb_generic.h90

@@ -36 +36 @@
       !
       INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, iis0, iie0, iilb
-      INTEGER ::   ipj, ij, iproc
+      INTEGER ::   ierr, itaille
+      INTEGER ::   ipj, ij, iproc, ijnr, ii1, ipi, impp
       !
       REAL(PRECISION), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
@@ -47 +47 @@
       ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       &
      &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       &
-     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni)    )
+     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,ndim_rank_north)    )
       !
 # if defined SINGLE_PRECISION
@@ -73 +73 @@
       IF( ln_timing ) CALL tic_tac(.FALSE.)
       !
+      ijnr = 0
       DO jr = 1, ndim_rank_north            ! recover the global north array
-         iproc = nrank_north(jr) + 1
-    iis0 = nis0all(iproc) 
-    iie0 = nie0all(iproc)
-         iilb = nimppt(iproc)
-         DO jj = 1-kextj, ipj+kextj
-            DO ji = iis0, iie0
-               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
+         iproc = nfproc(jr)
+         IF( iproc /= -1 ) THEN
+            impp = nfimpp(jr)
+            ipi  = nfjpi(jr)
+            ijnr = ijnr + 1
+            DO jj = 1-kextj, ipj+kextj
+               DO ji = 1, ipi
+                  ii1 = impp + ji - 1       ! corresponds to mig(ji) but for subdomain iproc
+                  ztab_e(ii1,jj) = znorthgloio_e(ji,jj,ijnr)
+               END DO
             END DO
-         END DO
+         ENDIF
       END DO
 

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

@@ -90 +90 @@
       INTEGER  ::   ii1, ii2, ij1, ij2
       INTEGER  ::   ipimax, i0max
-      INTEGER  ::   ij, iproc, ipni
+      INTEGER  ::   ij, iproc, ipni, ijnr
       INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather
       INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather
@@ -298 +298 @@
          i0max = jpimax - 2 * nn_hls
          ibuffsize = i0max * ipj * ipk * ipl * ipf
-         ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,jpni) )
+         ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) )
          !
          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! put in znorthloc ipj j-lines of ptab
@@ -307 +307 @@
                   znorthloc(ji,jj,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf)
                END DO
-               DO ji = Nie0+1, i0max
+               DO ji = Ni_0+1, i0max
                   znorthloc(ji,jj,jk,jl,jf) = HUGE(0._wp)   ! avoid sending uninitialized values (make sure we don't use it)
                END DO
@@ -322 +322 @@
          !
          ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines
+         ijnr = 0
          DO jr = 1, jpni                                                        ! recover the global north array
             iproc = nfproc(jr)
@@ -352 +353 @@
                !
             ELSE
+               ijnr = ijnr + 1
                DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk
                   DO jj = 1, ipj
                      DO ji = 1, ipi
                         ii1 = impp + nn_hls + ji - 1             ! corresponds to mig(nn_hls + ji) but for subdomain iproc
-                        ztabglo(ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,jr)
+                        ztabglo(ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,ijnr)
                      END DO
                   END DO

NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90

@@ -351 +351 @@
       CALL mpp_getnum( llisoce, ipproc, iin, ijn )
       !
-      DO jn = 1, jpni
-         jproc = ipproc(jn,jpnj)
-         ii = iin(jproc+1)
-         ij = ijn(jproc+1)
-         nfproc(jn) = jproc
-         nfimpp(jn) = iimppt(ii,ij)
-         nfjpi (jn) =   ijpi(ii,ij)
-      END DO
+      !DO jn = 1, jpni
+      !   jproc = ipproc(jn,jpnj)
+      !   ii = iin(jproc+1)
+      !   ij = ijn(jproc+1)
+      !   nfproc(jn) = jproc
+      !   nfimpp(jn) = iimppt(ii,ij)
+      !   nfjpi (jn) =   ijpi(ii,ij)
+      !END DO
+      nfproc(:) = ipproc(:,jpnj) 
+      nfimpp(:) = iimppt(:,jpnj) 
+      nfjpi (:) =   ijpi(:,jpnj)
       !
       IF(lwp) THEN