Changeset 4921 for branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

Timestamp:

2014-11-28T14:59:01+01:00 (9 years ago)

Author:

timgraham

Message:

merged with revision 4879 of trunk

File:

• branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 (modified) (7 diffs)

branches/2014/dev_r4650_UKMO13_CICE_changes_take2/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

@@ -2026 +2026 @@
       ijpjm1 = 3
       !
+      znorthloc(:,:,:) = 0
       DO jk = 1, jpk
          DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
@@ -2036 +2037 @@
       itaille = jpi * jpk * ijpj
 
-
       IF ( l_north_nogather ) THEN
          !
         ztabr(:,:,:) = 0
+        ztabl(:,:,:) = 0
+
         DO jk = 1, jpk
            DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
               ij = jj - nlcj + ijpj
-              DO ji = 1, nlci
+              DO ji = nfsloop, nfeloop
                  ztabl(ji,ij,jk) = pt3d(ji,jj,jk)
               END DO
@@ -2050 +2052 @@
 
          DO jr = 1,nsndto
-            IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) )
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )
+            ENDIF
          END DO
          DO jr = 1,nsndto
-            iproc = isendto(jr)
-            ildi = nldit (iproc)
-            ilei = nleit (iproc)
-            iilb = nimppt(isendto(jr)) - nimppt(isendto(1))
-            IF(isendto(jr) .ne. narea) THEN
-              CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1)
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
               DO jk = 1, jpk
                  DO jj = 1, ijpj
-                    DO ji = 1, ilei
+                    DO ji = ildi, ilei
                        ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)
                     END DO
                  END DO
               END DO
-           ELSE
+           ELSE IF (iproc .eq. (narea-1)) THEN
               DO jk = 1, jpk
                  DO jj = 1, ijpj
-                    DO ji = 1, ilei
+                    DO ji = ildi, ilei
                        ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)
                     END DO
@@ -2078 +2084 @@
          IF (l_isend) THEN
             DO jr = 1,nsndto
-               IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF    
             END DO
          ENDIF
          CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition
-         !
          DO jk = 1, jpk
             DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
@@ -2190 +2197 @@
          !
          ztabr(:,:) = 0
+         ztabl(:,:) = 0
+
          DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
             ij = jj - nlcj + ijpj
-            DO ji = 1, nlci
+              DO ji = nfsloop, nfeloop
                ztabl(ji,ij) = pt2d(ji,jj)
             END DO
@@ -2198 +2207 @@
 
          DO jr = 1,nsndto
-            IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr))
+            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))
+            ENDIF
          END DO
          DO jr = 1,nsndto
-            iproc = isendto(jr)
-            ildi = nldit (iproc)
-            ilei = nleit (iproc)
-            iilb = nimppt(isendto(jr)) - nimppt(isendto(1))
-            IF(isendto(jr) .ne. narea) THEN
-              CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1)
+            iproc = nfipproc(isendto(jr),jpnj)
+            IF(iproc .ne. -1) THEN
+               ilei = nleit (iproc+1)
+               ildi = nldit (iproc+1)
+               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)
+            ENDIF
+            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN
+              CALL mpprecv(5, zfoldwk, itaille, iproc)
               DO jj = 1, ijpj
-                 DO ji = 1, ilei
+                 DO ji = ildi, ilei
                     ztabr(iilb+ji,jj) = zfoldwk(ji,jj)
                  END DO
               END DO
-            ELSE
+            ELSE IF (iproc .eq. (narea-1)) THEN
               DO jj = 1, ijpj
-                 DO ji = 1, ilei
+                 DO ji = ildi, ilei
                     ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)
                  END DO
@@ -2222 +2235 @@
          IF (l_isend) THEN
             DO jr = 1,nsndto
-               IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               ENDIF
             END DO
          ENDIF