Changeset 12601 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
- Timestamp:
- 2020-03-25T12:51:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE
- Files:
-
- 2 edited
-
LBC/lbc_nfd_nogather_generic.h90 (modified) (7 diffs)
-
TRA/traadv_mus.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_nogather_generic.h90
r12586 r12601 64 64 ! 65 65 INTEGER :: ji, jj, jk, jn, ii, jl, jh, jf ! dummy loop indices 66 INTEGER :: ipi, ipj, ipk, ipl, ipf, i jj ! dimension of the input array66 INTEGER :: ipi, ipj, ipk, ipl, ipf, iij, ijj ! dimension of the input array 67 67 INTEGER :: ijt, iju, ijta, ijua, jia, startloop, endloop 68 68 LOGICAL :: l_fast_exchanges … … 109 109 ijj = nlcj -jj +1 110 110 DO ii = 1, nn_hls 111 ARRAY_IN(1-ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,jk,jl,jf)111 ARRAY_IN(1-ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,jk,jl,jf) 112 112 END DO 113 113 END DO … … 284 284 CASE ( 5, 6 ) ! * North fold F-point pivot 285 285 ! 286 WRITE(*,*) 'extrahalo not handled in this case', __FILE__, __LINE__287 286 SELECT CASE ( NAT_IN(jf) ) 288 287 CASE ( 'T' , 'W' ) ! T-, W-point 289 288 DO jl = 1, ipl; DO jk = 1, ipk 290 291 ijj = nlcj-jj+1292 293 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3294 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf)295 END DO296 289 DO jj = 1, nn_hls 290 ijj = nlcj-jj+1 291 DO ji = 1, nlci 292 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 293 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 294 END DO 295 END DO 297 296 END DO; END DO 298 297 ! 299 298 CASE ( 'U' ) ! U-point 300 IF( nimpp + nlci - 1/= jpiglo ) THEN299 IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 301 300 endloop = nlci 302 301 ELSE 303 endloop = nlci - 1 304 ENDIF 305 DO jl = 1, ipl; DO jk = 1, ipk 306 DO ji = 1, endloop 307 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 308 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,jk,jl,jf) 309 END DO 310 END DO; END DO 311 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 312 DO jl = 1, ipl; DO jk = 1, ipk 313 ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 302 endloop = nlci - nn_hls 303 ENDIF 304 DO jl = 1, ipl; DO jk = 1, ipk 305 DO jj = 1, nn_hls 306 ijj = nlcj-jj+1 307 DO ji = 1, endloop 308 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 309 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 310 END DO 311 END DO 312 END DO; END DO 313 IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN 314 DO jl = 1, ipl; DO jk = 1, ipk 315 DO jj = 1, nn_hls 316 ijj = nlcj-jj+1 317 DO ii = 1, nn_hls 318 iij = nlci-ii+1 319 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii-1,nlcj-2*nn_hls+jj,jk,jl,jf) 320 END DO 321 END DO 314 322 END DO; END DO 315 323 ENDIF … … 318 326 DO jl = 1, ipl; DO jk = 1, ipk 319 327 DO ji = 1, nlci 320 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 321 ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,jk,jl,jf) 328 DO jj = 1, nn_hls 329 ijj = nlcj -jj +1 330 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 331 ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 332 END DO 322 333 END DO 323 334 END DO; END DO 324 335 325 336 IF ( .NOT. l_fast_exchanges ) THEN 326 IF( nimpp >= jpiglo/2+1 ) THEN327 startloop = 1 328 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN329 startloop = jpiglo/2+1 - nimpp + 1337 IF( nimpp -nn_hls+1 >= jpiglo/2+1 ) THEN 338 startloop = 1-nn_hls+1 339 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls+1 < jpiglo/2+1 ) THEN 340 startloop = jpiglo/2+1 - nimpp + nn_hls 330 341 ELSE 331 342 startloop = nlci + 1 … … 333 344 IF( startloop <= nlci ) THEN 334 345 DO jl = 1, ipl; DO jk = 1, ipk 335 DO ji = startloop, nlci336 337 ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf)338 END DO346 DO ji = startloop, nlci 347 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 348 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 349 END DO 339 350 END DO; END DO 340 351 ENDIF … … 342 353 ! 343 354 CASE ( 'F' ) ! F-point 344 IF( nimpp + nlci - 1/= jpiglo ) THEN355 IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 345 356 endloop = nlci 346 357 ELSE 347 endloop = nlci - 1 348 ENDIF 349 DO jl = 1, ipl; DO jk = 1, ipk 350 DO ji = 1, endloop 351 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 352 ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,jk,jl,jf) 353 END DO 354 END DO; END DO 355 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 356 DO jl = 1, ipl; DO jk = 1, ipk 357 ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf) 358 END DO; END DO 359 ENDIF 360 ! 361 IF ( .NOT. l_fast_exchanges ) THEN 362 IF( nimpp + nlci - 1 /= jpiglo ) THEN 358 endloop = nlci - nn_hls 359 ENDIF 360 DO jl = 1, ipl; DO jk = 1, ipk 361 DO jj = 1, nn_hls 362 ijj = nlcj -jj +1 363 DO ji = 1, endloop 364 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 365 ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 366 END DO 367 END DO 368 END DO; END DO 369 IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN 370 DO jl = 1, ipl; DO jk = 1, ipk 371 DO jj = 1, nn_hls 372 ijj = nlcj -jj +1 373 DO ii = 1, nn_hls 374 iij = nlci -ii+1 375 ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii-1,nlcj-2*nn_hls+jj-1,jk,jl,jf) 376 END DO 377 END DO 378 END DO; END DO 379 ENDIF 380 ! 381 IF ( .NOT. l_fast_exchanges ) THEN 382 IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 363 383 endloop = nlci 364 384 ELSE 365 endloop = nlci - 1366 ENDIF 367 IF( nimpp >= jpiglo/2+1 ) THEN368 startloop = 1 369 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN370 startloop = jpiglo/2+1 - nimpp + 1385 endloop = nlci - nn_hls 386 ENDIF 387 IF( nimpp - nn_hls+1 >= jpiglo/2+1 ) THEN 388 startloop = 1 - nn_hls+1 389 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls+1 < jpiglo/2+1 ) THEN 390 startloop = jpiglo/2+1 - nimpp + nn_hls 371 391 ELSE 372 392 startloop = endloop + 1 … … 376 396 DO ji = startloop, endloop 377 397 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 378 ARRAY_IN(ji,nlcj- 1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf)398 ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 379 399 END DO 380 400 END DO; END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90
r12586 r12601 114 114 CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 115 115 CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 116 CALL halo_mng_resize(pU, 'U', 1._wp)117 CALL halo_mng_resize(pV, 'V', 1._wp)116 CALL halo_mng_resize(pU, 'U', -1._wp) 117 CALL halo_mng_resize(pV, 'V', -1._wp) 118 118 CALL halo_mng_resize(pW, 'W', 1._wp) 119 119 ! … … 166 166 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 167 167 END_3D 168 ! lateral boundary conditions (changed sign) 169 CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1. ) ! lateral boundary conditions (changed sign) 170 CALL lbc_lnk( 'traadv_mus', zwy, 'V', -1. ) ! lateral boundary conditions (changed sign) 168 ! 171 169 ! !-- Slopes of tracer 172 170 zslpx(:,:,jpk) = 0._wp ! bottom values … … 204 202 zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 205 203 END_3D 206 CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1. ) ! lateral boundary conditions (changed sign)207 CALL lbc_lnk( 'traadv_mus', zwy, 'V', -1. ) ! lateral boundary conditions (changed sign)208 204 ! 209 205 DO_3D_30_30( 1, jpkm1 )
Note: See TracChangeset
for help on using the changeset viewer.
