Changeset 4671 for trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
- Timestamp:
- 2014-06-17T17:00:51+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4645 r4671 2026 2026 ijpjm1 = 3 2027 2027 ! 2028 znorthloc(:,:,:) = 0 2028 2029 DO jk = 1, jpk 2029 2030 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d … … 2036 2037 itaille = jpi * jpk * ijpj 2037 2038 2038 2039 2039 IF ( l_north_nogather ) THEN 2040 2040 ! 2041 2041 ztabr(:,:,:) = 0 2042 ztabl(:,:,:) = 0 2043 2042 2044 DO jk = 1, jpk 2043 2045 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2044 2046 ij = jj - nlcj + ijpj 2045 DO ji = 1, nlci2047 DO ji = nfsloop, nfeloop 2046 2048 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 2047 2049 END DO … … 2050 2052 2051 2053 DO jr = 1,nsndto 2052 IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 2054 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2055 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 2056 ENDIF 2053 2057 END DO 2054 2058 DO jr = 1,nsndto 2055 iproc = isendto(jr) 2056 ildi = nldit (iproc) 2057 ilei = nleit (iproc) 2058 iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 2059 IF(isendto(jr) .ne. narea) THEN 2060 CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 2059 iproc = nfipproc(isendto(jr),jpnj) 2060 IF(iproc .ne. -1) THEN 2061 ilei = nleit (iproc+1) 2062 ildi = nldit (iproc+1) 2063 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2064 ENDIF 2065 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2066 CALL mpprecv(5, zfoldwk, itaille, iproc) 2061 2067 DO jk = 1, jpk 2062 2068 DO jj = 1, ijpj 2063 DO ji = 1, ilei2069 DO ji = ildi, ilei 2064 2070 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 2065 2071 END DO 2066 2072 END DO 2067 2073 END DO 2068 ELSE 2074 ELSE IF (iproc .eq. (narea-1)) THEN 2069 2075 DO jk = 1, jpk 2070 2076 DO jj = 1, ijpj 2071 DO ji = 1, ilei2077 DO ji = ildi, ilei 2072 2078 ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 2073 2079 END DO … … 2078 2084 IF (l_isend) THEN 2079 2085 DO jr = 1,nsndto 2080 IF ( isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)2086 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2081 2087 END DO 2082 2088 ENDIF 2083 2089 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition 2084 !2085 2090 DO jk = 1, jpk 2086 2091 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d … … 2190 2195 ! 2191 2196 ztabr(:,:) = 0 2197 ztabl(:,:) = 0 2198 2192 2199 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array 2193 2200 ij = jj - nlcj + ijpj 2194 DO ji = 1, nlci2201 DO ji = nfsloop, nfeloop 2195 2202 ztabl(ji,ij) = pt2d(ji,jj) 2196 2203 END DO … … 2198 2205 2199 2206 DO jr = 1,nsndto 2200 IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 2207 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2208 CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 2209 ENDIF 2201 2210 END DO 2202 2211 DO jr = 1,nsndto 2203 iproc = isendto(jr) 2204 ildi = nldit (iproc) 2205 ilei = nleit (iproc) 2206 iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 2207 IF(isendto(jr) .ne. narea) THEN 2208 CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 2212 iproc = nfipproc(isendto(jr),jpnj) 2213 IF(iproc .ne. -1) THEN 2214 ilei = nleit (iproc+1) 2215 ildi = nldit (iproc+1) 2216 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 2217 ENDIF 2218 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 2219 CALL mpprecv(5, zfoldwk, itaille, iproc) 2209 2220 DO jj = 1, ijpj 2210 DO ji = 1, ilei2221 DO ji = ildi, ilei 2211 2222 ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 2212 2223 END DO 2213 2224 END DO 2214 ELSE 2225 ELSE IF (iproc .eq. (narea-1)) THEN 2215 2226 DO jj = 1, ijpj 2216 DO ji = 1, ilei2227 DO ji = ildi, ilei 2217 2228 ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 2218 2229 END DO … … 2222 2233 IF (l_isend) THEN 2223 2234 DO jr = 1,nsndto 2224 IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2235 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 2236 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 2237 ENDIF 2225 2238 END DO 2226 2239 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.