![(please configure the [header_logo] section in trac.ini)](site/little_nemo.jpg)
- Timestamp:
- 06/18/13 18:06:22 (11 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r72 r75 163 163 164 164 ! Arrays used in mpp_lbc_north_3d() 165 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc166 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio167 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: zfoldwk ! Workspace for message transfers avoiding mpi_allgather165 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc 166 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio 167 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: xfoldwk ! Workspace for message transfers avoiding mpi_allgather 168 168 169 169 ! Arrays used in mpp_lbc_north_2d() 170 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d171 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d172 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: zfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather170 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d 171 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d 172 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: xfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather 173 173 174 174 ! Arrays used in mpp_lbc_north_e() 175 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_e, znorthloc_e176 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e175 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e 176 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e 177 177 178 178 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public … … 213 213 & tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , & 214 214 ! 215 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , &216 & zfoldwk(jpi,4,jpk) , &217 ! 218 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , &219 & zfoldwk_2d(jpi,4) , &220 ! 221 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , &215 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , & 216 & xfoldwk(jpi,4,jpk) , & 217 ! 218 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , & 219 & xfoldwk_2d(jpi,4) , & 220 ! 221 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , & 222 222 ! 223 223 & STAT=lib_mpp_alloc ) … … 2234 2234 ityp = -1 2235 2235 ijpjm1 = 3 2236 ztab(:,:,:) = 0.e02237 ! 2238 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d2236 tab_3d(:,:,:) = 0.e0 2237 ! 2238 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d 2239 2239 ij = jj - nlcj + ijpj 2240 znorthloc(:,ij,:) = pt3d(:,jj,:)2240 xnorthloc(:,ij,:) = pt3d(:,jj,:) 2241 2241 END DO 2242 2242 ! 2243 ! ! Build in procs of ncomm_north the znorthgloio2243 ! ! Build in procs of ncomm_north the xnorthgloio 2244 2244 itaille = jpi * jpk * ijpj 2245 2245 IF ( l_north_nogather ) THEN … … 2251 2251 ij = jj - nlcj + ijpj 2252 2252 DO ji = 1, nlci 2253 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2253 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2254 2254 END DO 2255 2255 END DO … … 2276 2276 2277 2277 DO jr = 1,nsndto(ityp) 2278 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2278 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2279 2279 END DO 2280 2280 DO jr = 1,nsndto(ityp) 2281 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))2281 CALL mpprecv(5, xfoldwk, itaille, isendto(jr,ityp)) 2282 2282 iproc = isendto(jr,ityp) + 1 2283 2283 ildi = nldit (iproc) … … 2286 2286 DO jj = 1, ijpj 2287 2287 DO ji = ildi, ilei 2288 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)2288 tab_3d(ji+iilb-1,jj,:) = xfoldwk(ji,jj,:) 2289 2289 END DO 2290 2290 END DO … … 2301 2301 2302 2302 IF ( ityp .lt. 0 ) THEN 2303 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, &2304 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2303 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, & 2304 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2305 2305 ! 2306 2306 DO jr = 1, ndim_rank_north ! recover the global north array … … 2311 2311 DO jj = 1, ijpj 2312 2312 DO ji = ildi, ilei 2313 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)2313 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr) 2314 2314 END DO 2315 2315 END DO … … 2317 2317 ENDIF 2318 2318 ! 2319 ! The ztabarray has been either:2319 ! The tab_3d array has been either: 2320 2320 ! a. Fully populated by the mpi_allgather operation or 2321 2321 ! b. Had the active points for this domain and northern neighbours populated … … 2324 2324 ! this domain will be identical. 2325 2325 ! 2326 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition2326 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition 2327 2327 ! 2328 2328 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2329 2329 ij = jj - nlcj + ijpj 2330 2330 DO ji= 1, nlci 2331 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)2331 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:) 2332 2332 END DO 2333 2333 END DO … … 2366 2366 ityp = -1 2367 2367 ijpjm1 = 3 2368 ztab_2d(:,:) = 0.e02369 ! 2370 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc_2d the last 4 jlines of pt2d2368 tab_2d(:,:) = 0.e0 2369 ! 2370 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2d the last 4 jlines of pt2d 2371 2371 ij = jj - nlcj + ijpj 2372 znorthloc_2d(:,ij) = pt2d(:,jj)2372 xnorthloc_2d(:,ij) = pt2d(:,jj) 2373 2373 END DO 2374 2374 2375 ! ! Build in procs of ncomm_north the znorthgloio_2d2375 ! ! Build in procs of ncomm_north the xnorthgloio_2d 2376 2376 itaille = jpi * ijpj 2377 2377 IF ( l_north_nogather ) THEN … … 2383 2383 ij = jj - nlcj + ijpj 2384 2384 DO ji = 1, nlci 2385 ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2385 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 2386 2386 END DO 2387 2387 END DO … … 2409 2409 2410 2410 DO jr = 1,nsndto(ityp) 2411 CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2411 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2412 2412 END DO 2413 2413 DO jr = 1,nsndto(ityp) 2414 CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))2414 CALL mpprecv(5, xfoldwk_2d, itaille, isendto(jr,ityp)) 2415 2415 iproc = isendto(jr,ityp) + 1 2416 2416 ildi = nldit (iproc) … … 2419 2419 DO jj = 1, ijpj 2420 2420 DO ji = ildi, ilei 2421 ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)2421 tab_2d(ji+iilb-1,jj) = xfoldwk_2d(ji,jj) 2422 2422 END DO 2423 2423 END DO … … 2434 2434 2435 2435 IF ( ityp .lt. 0 ) THEN 2436 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, &2437 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2436 CALL MPI_ALLGATHER( xnorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2437 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2438 2438 ! 2439 2439 DO jr = 1, ndim_rank_north ! recover the global north array … … 2444 2444 DO jj = 1, ijpj 2445 2445 DO ji = ildi, ilei 2446 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)2446 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr) 2447 2447 END DO 2448 2448 END DO … … 2457 2457 ! this domain will be identical. 2458 2458 ! 2459 CALL lbc_nfd( ztab_2d, cd_type, psgn ) ! North fold boundary condition2459 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition 2460 2460 ! 2461 2461 ! … … 2463 2463 ij = jj - nlcj + ijpj 2464 2464 DO ji = 1, nlci 2465 pt2d(ji,jj) = ztab_2d(ji+nimpp-1,ij)2465 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij) 2466 2466 END DO 2467 2467 END DO … … 2496 2496 ! 2497 2497 ijpj=4 2498 ztab_e(:,:) = 0.e02498 tab_e(:,:) = 0.e0 2499 2499 2500 2500 ij=0 2501 ! put in znorthloc_e the last 4 jlines of pt2d2501 ! put in xnorthloc_e the last 4 jlines of pt2d 2502 2502 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2503 2503 ij = ij + 1 2504 2504 DO ji = 1, jpi 2505 znorthloc_e(ji,ij)=pt2d(ji,jj)2505 xnorthloc_e(ji,ij)=pt2d(ji,jj) 2506 2506 END DO 2507 2507 END DO 2508 2508 ! 2509 2509 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2510 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2511 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2510 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2511 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2512 2512 ! 2513 2513 DO jr = 1, ndim_rank_north ! recover the global north array … … 2518 2518 DO jj = 1, ijpj+2*jpr2dj 2519 2519 DO ji = ildi, ilei 2520 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)2520 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr) 2521 2521 END DO 2522 2522 END DO … … 2526 2526 ! 2. North-Fold boundary conditions 2527 2527 ! ---------------------------------- 2528 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2528 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2529 2529 2530 2530 ij = jpr2dj … … 2533 2533 ij = ij +1 2534 2534 DO ji= 1, nlci 2535 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)2535 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij) 2536 2536 END DO 2537 2537 END DO
Note: See TracChangeset
for help on using the changeset viewer.
