- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/ICB/icblbc.F90
r14229 r15574 105 105 IF( l_Jperio) CALL ctl_stop(' north-south periodicity not implemented for icebergs') 106 106 ! north fold 107 IF( npolj /= 0) CALL icb_lbc_nfld()107 IF( l_IdoNFold ) CALL icb_lbc_nfld() 108 108 ! 109 109 END SUBROUTINE icb_lbc … … 179 179 ipe_W = -1 180 180 ipe_E = -1 181 IF( nbondi .EQ. 0 .OR. nbondi .EQ. 1) ipe_W = nowe182 IF( nbondi .EQ. -1 .OR. nbondi .EQ. 0) ipe_E = noea183 IF( nbondj .EQ. 0 .OR. nbondj .EQ. 1) ipe_S = noso184 IF( nbondj .EQ. -1 .OR. nbondj .EQ. 0) ipe_N = nono181 IF( mpinei(jpwe) >= 0 ) ipe_W = mpinei(jpwe) 182 IF( mpinei(jpea) >= 0 ) ipe_E = mpinei(jpea) 183 IF( mpinei(jpso) >= 0 ) ipe_S = mpinei(jpso) 184 IF( mpinei(jpno) >= 0 ) ipe_N = mpinei(jpno) 185 185 ! 186 186 ! at northern line of processors with north fold handle bergs differently 187 IF( npolj > 0 )ipe_N = -1187 IF( l_IdoNFold ) ipe_N = -1 188 188 189 189 ! if there's only one processor in x direction then don't let mpp try to handle periodicity … … 200 200 WRITE(numicb,*) 'processor nimpp : ', nimpp 201 201 WRITE(numicb,*) 'processor njmpp : ', njmpp 202 WRITE(numicb,*) 'processor nbondi: ', nbondi203 WRITE(numicb,*) 'processor nbondj: ', nbondj204 202 CALL flush( numicb ) 205 203 ENDIF … … 231 229 DO WHILE (ASSOCIATED(this)) 232 230 pt => this%current_point 233 IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN231 IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) ) THEN 234 232 tmpberg => this 235 233 this => this%next … … 244 242 CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 245 243 CALL icb_utl_delete(first_berg, tmpberg) 246 ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN244 ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) ) THEN 247 245 tmpberg => this 248 246 this => this%next … … 271 269 ! pattern here is copied from lib_mpp code 272 270 273 SELECT CASE ( nbondi ) 274 CASE( -1 ) 275 zwebergs(1) = ibergs_to_send_e 276 CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req1) 277 CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 278 CALL mpi_wait( iml_req1, iml_stat, iml_err ) 279 ibergs_rcvd_from_e = INT( zewbergs(2) ) 280 CASE( 0 ) 281 zewbergs(1) = ibergs_to_send_w 282 zwebergs(1) = ibergs_to_send_e 283 CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2) 284 CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3) 285 CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 286 CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 287 CALL mpi_wait( iml_req2, iml_stat, iml_err ) 288 CALL mpi_wait( iml_req3, iml_stat, iml_err ) 289 ibergs_rcvd_from_e = INT( zewbergs(2) ) 290 ibergs_rcvd_from_w = INT( zwebergs(2) ) 291 CASE( 1 ) 292 zewbergs(1) = ibergs_to_send_w 293 CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req4) 294 CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 295 CALL mpi_wait( iml_req4, iml_stat, iml_err ) 296 ibergs_rcvd_from_w = INT( zwebergs(2) ) 297 END SELECT 271 IF( mpinei(jpwe) >= 0 ) zewbergs(1) = ibergs_to_send_w 272 IF( mpinei(jpea) >= 0 ) zwebergs(1) = ibergs_to_send_e 273 IF( mpinei(jpwe) >= 0 ) CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2) 274 IF( mpinei(jpea) >= 0 ) CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3) 275 IF( mpinei(jpea) >= 0 ) CALL mpprecv( 11, zewbergs(2), 1, ipe_E ) 276 IF( mpinei(jpwe) >= 0 ) CALL mpprecv( 12, zwebergs(2), 1, ipe_W ) 277 IF( mpinei(jpwe) >= 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 278 IF( mpinei(jpea) >= 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 279 IF( mpinei(jpea) >= 0 ) ibergs_rcvd_from_e = INT( zewbergs(2) ) 280 IF( mpinei(jpwe) >= 0 ) ibergs_rcvd_from_w = INT( zwebergs(2) ) 281 298 282 IF( nn_verbose_level >= 3) THEN 299 283 WRITE(numicb,*) 'bergstep ',nktberg,' recv ew: ', ibergs_rcvd_from_w, ibergs_rcvd_from_e 300 284 CALL flush(numicb) 301 285 ENDIF 302 303 SELECT CASE ( nbondi ) 304 CASE( -1 ) 305 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req1 ) 306 IF( ibergs_rcvd_from_e > 0 ) THEN 307 CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 308 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 309 ENDIF 310 IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 311 DO i = 1, ibergs_rcvd_from_e 312 IF( nn_verbose_level >= 4 ) THEN 313 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east' 314 CALL flush( numicb ) 315 ENDIF 316 CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i) 317 ENDDO 318 CASE( 0 ) 319 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 ) 320 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 ) 321 IF( ibergs_rcvd_from_e > 0 ) THEN 322 CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 323 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 324 ENDIF 325 IF( ibergs_rcvd_from_w > 0 ) THEN 326 CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 327 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 328 ENDIF 329 IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 330 IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 331 DO i = 1, ibergs_rcvd_from_e 332 IF( nn_verbose_level >= 4 ) THEN 333 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east' 334 CALL flush( numicb ) 335 ENDIF 336 CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i) 337 END DO 338 DO i = 1, ibergs_rcvd_from_w 339 IF( nn_verbose_level >= 4 ) THEN 340 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west' 341 CALL flush( numicb ) 342 ENDIF 343 CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i) 344 ENDDO 345 CASE( 1 ) 346 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req4 ) 347 IF( ibergs_rcvd_from_w > 0 ) THEN 348 CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 349 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 350 ENDIF 351 IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 352 DO i = 1, ibergs_rcvd_from_w 353 IF( nn_verbose_level >= 4 ) THEN 354 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west' 355 CALL flush( numicb ) 356 ENDIF 357 CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i) 358 END DO 359 END SELECT 286 287 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 ) 288 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 ) 289 IF( ibergs_rcvd_from_e > 0 ) THEN 290 CALL icb_increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 291 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 292 ENDIF 293 IF( ibergs_rcvd_from_w > 0 ) THEN 294 CALL icb_increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 295 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 296 ENDIF 297 IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 298 IF( ibergs_to_send_e > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 299 DO i = 1, ibergs_rcvd_from_e 300 IF( nn_verbose_level >= 4 ) THEN 301 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east' 302 CALL FLUSH( numicb ) 303 ENDIF 304 CALL icb_unpack_from_buffer(first_berg, ibuffer_e, i) 305 END DO 306 DO i = 1, ibergs_rcvd_from_w 307 IF( nn_verbose_level >= 4 ) THEN 308 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west' 309 CALL FLUSH( numicb ) 310 ENDIF 311 CALL icb_unpack_from_buffer(first_berg, ibuffer_w, i) 312 END DO 360 313 361 314 ! Find number of bergs that headed north/south … … 368 321 DO WHILE (ASSOCIATED(this)) 369 322 pt => this%current_point 370 IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN323 IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 371 324 tmpberg => this 372 325 this => this%next … … 378 331 CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 379 332 CALL icb_utl_delete(first_berg, tmpberg) 380 ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN333 ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) ) THEN 381 334 tmpberg => this 382 335 this => this%next … … 400 353 ! send bergs north 401 354 ! and receive bergs from south (ie ones sent north) 402 403 SELECT CASE ( nbondj ) 404 CASE( -1 ) 405 zsnbergs(1) = ibergs_to_send_n 406 CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req1) 407 CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 408 CALL mpi_wait( iml_req1, iml_stat, iml_err ) 409 ibergs_rcvd_from_n = INT( znsbergs(2) ) 410 CASE( 0 ) 411 znsbergs(1) = ibergs_to_send_s 412 zsnbergs(1) = ibergs_to_send_n 413 CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2) 414 CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3) 415 CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 416 CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 417 CALL mpi_wait( iml_req2, iml_stat, iml_err ) 418 CALL mpi_wait( iml_req3, iml_stat, iml_err ) 419 ibergs_rcvd_from_n = INT( znsbergs(2) ) 420 ibergs_rcvd_from_s = INT( zsnbergs(2) ) 421 CASE( 1 ) 422 znsbergs(1) = ibergs_to_send_s 423 CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req4) 424 CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 425 CALL mpi_wait( iml_req4, iml_stat, iml_err ) 426 ibergs_rcvd_from_s = INT( zsnbergs(2) ) 427 END SELECT 428 if( nn_verbose_level >= 3) then 429 write(numicb,*) 'bergstep ',nktberg,' recv ns: ', ibergs_rcvd_from_s, ibergs_rcvd_from_n 430 call flush(numicb) 431 endif 432 433 SELECT CASE ( nbondj ) 434 CASE( -1 ) 435 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req1 ) 436 IF( ibergs_rcvd_from_n > 0 ) THEN 437 CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 438 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 439 ENDIF 440 IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 441 DO i = 1, ibergs_rcvd_from_n 442 IF( nn_verbose_level >= 4 ) THEN 443 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north' 444 CALL flush( numicb ) 445 ENDIF 446 CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i) 447 END DO 448 CASE( 0 ) 449 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 ) 450 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 ) 451 IF( ibergs_rcvd_from_n > 0 ) THEN 452 CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 453 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 454 ENDIF 455 IF( ibergs_rcvd_from_s > 0 ) THEN 456 CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 457 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 458 ENDIF 459 IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 460 IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 461 DO i = 1, ibergs_rcvd_from_n 462 IF( nn_verbose_level >= 4 ) THEN 463 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north' 464 CALL flush( numicb ) 465 ENDIF 466 CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i) 467 END DO 468 DO i = 1, ibergs_rcvd_from_s 469 IF( nn_verbose_level >= 4 ) THEN 470 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south' 471 CALL flush( numicb ) 472 ENDIF 473 CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i) 474 ENDDO 475 CASE( 1 ) 476 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req4 ) 477 IF( ibergs_rcvd_from_s > 0 ) THEN 478 CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 479 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 480 ENDIF 481 IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 482 DO i = 1, ibergs_rcvd_from_s 483 IF( nn_verbose_level >= 4 ) THEN 484 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south' 485 CALL flush( numicb ) 486 ENDIF 487 CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i) 488 END DO 489 END SELECT 490 355 356 IF( mpinei(jpso) >= 0 ) znsbergs(1) = ibergs_to_send_s 357 IF( mpinei(jpno) >= 0 ) zsnbergs(1) = ibergs_to_send_n 358 IF( mpinei(jpso) >= 0 ) CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2) 359 IF( mpinei(jpno) >= 0 ) CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3) 360 IF( mpinei(jpno) >= 0 ) CALL mpprecv( 15, znsbergs(2), 1, ipe_N ) 361 IF( mpinei(jpso) >= 0 ) CALL mpprecv( 16, zsnbergs(2), 1, ipe_S ) 362 IF( mpinei(jpso) >= 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 363 IF( mpinei(jpno) >= 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 364 IF( mpinei(jpno) >= 0 ) ibergs_rcvd_from_n = INT( znsbergs(2) ) 365 IF( mpinei(jpso) >= 0 ) ibergs_rcvd_from_s = INT( zsnbergs(2) ) 366 367 IF( nn_verbose_level >= 3) THEN 368 WRITE(numicb,*) 'bergstep ',nktberg,' recv ns: ', ibergs_rcvd_from_s, ibergs_rcvd_from_n 369 CALL FLUSH(numicb) 370 ENDIF 371 372 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 ) 373 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 ) 374 IF( ibergs_rcvd_from_n > 0 ) THEN 375 CALL icb_increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 376 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 377 ENDIF 378 IF( ibergs_rcvd_from_s > 0 ) THEN 379 CALL icb_increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 380 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 381 ENDIF 382 IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) 383 IF( ibergs_to_send_n > 0 ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 384 DO i = 1, ibergs_rcvd_from_n 385 IF( nn_verbose_level >= 4 ) THEN 386 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north' 387 CALL FLUSH( numicb ) 388 ENDIF 389 CALL icb_unpack_from_buffer(first_berg, ibuffer_n, i) 390 END DO 391 DO i = 1, ibergs_rcvd_from_s 392 IF( nn_verbose_level >= 4 ) THEN 393 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south' 394 CALL FLUSH( numicb ) 395 ENDIF 396 CALL icb_unpack_from_buffer(first_berg, ibuffer_s, i) 397 END DO 398 491 399 IF( nn_verbose_level > 0 ) THEN 492 400 ! compare the number of icebergs on this processor from the start to the end … … 527 435 ! deal with north fold if we necessary when there is more than one top row processor 528 436 ! note that for jpni=1 north fold has been dealt with above in call to icb_lbc 529 IF( npolj /= 0.AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( )437 IF( l_IdoNFold .AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( ) 530 438 531 439 IF( nn_verbose_level > 0 ) THEN … … 534 442 DO WHILE (ASSOCIATED(this)) 535 443 pt => this%current_point 536 IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp .OR. &537 pt%xi > REAL(mig(nicbei),wp) + 0.5_wp .OR. &538 pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp .OR. &539 pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN444 IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp - (nn_hls-1) .OR. & 445 pt%xi > REAL(mig(nicbei),wp) + 0.5_wp - (nn_hls-1) .OR. & 446 pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp - (nn_hls-1) .OR. & 447 pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 540 448 i = i + 1 541 449 WRITE(numicb,*) 'berg lost in halo: ', this%number(:) … … 606 514 DO WHILE (ASSOCIATED(this)) 607 515 pt => this%current_point 608 iine = INT( pt%xi + 0.5 ) 516 iine = INT( pt%xi + 0.5 ) + (nn_hls-1) 609 517 iproc = nicbflddest(mi1(iine)) 610 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN518 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 611 519 IF( iproc == ifldproc ) THEN 612 520 ! … … 684 592 DO WHILE (ASSOCIATED(this)) 685 593 pt => this%current_point 686 iine = INT( pt%xi + 0.5 ) 687 ijne = INT( pt%yj + 0.5 ) 594 iine = INT( pt%xi + 0.5 ) + (nn_hls-1) 595 ijne = INT( pt%yj + 0.5 ) + (nn_hls-1) 688 596 ipts = nicbfldpts (mi1(iine)) 689 597 iproc = nicbflddest(mi1(iine)) 690 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN598 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp - (nn_hls-1) ) THEN 691 599 IF( iproc == ifldproc ) THEN 692 600 !
Note: See TracChangeset
for help on using the changeset viewer.