- Timestamp:
- 2020-07-03T19:15:31+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ICB/icblbc.F90
r12377 r13247 81 81 TYPE(iceberg), POINTER :: this 82 82 TYPE(point) , POINTER :: pt 83 INTEGER :: iine84 83 !!---------------------------------------------------------------------- 85 84 … … 92 91 DO WHILE( ASSOCIATED(this) ) 93 92 pt => this%current_point 94 iine = INT( pt%xi + 0.5 ) 95 IF( iine > mig(nicbei) ) THEN 93 IF( pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN 96 94 pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp 97 ELSE IF( iine < mig(nicbdi)) THEN95 ELSE IF( pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 98 96 pt%xi = ricb_left + MOD(pt%xi, 1._wp ) 99 97 ENDIF … … 128 126 pt => this%current_point 129 127 ijne = INT( pt%yj + 0.5 ) 130 IF( ijne .GT. mjg(nicbej)) THEN128 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 131 129 ! 132 130 iine = INT( pt%xi + 0.5 ) … … 170 168 INTEGER :: ibergs_rcvd_from_n, ibergs_rcvd_from_s 171 169 INTEGER :: i, ibergs_start, ibergs_end 172 INTEGER :: iine, ijne173 170 INTEGER :: ipe_N, ipe_S, ipe_W, ipe_E 174 171 REAL(wp), DIMENSION(2) :: zewbergs, zwebergs, znsbergs, zsnbergs … … 234 231 DO WHILE (ASSOCIATED(this)) 235 232 pt => this%current_point 236 iine = INT( pt%xi + 0.5 ) 237 IF( ipe_E >= 0 .AND. iine > mig(nicbei) ) THEN 233 IF( ipe_E >= 0 .AND. pt%xi > REAL(mig(nicbei),wp) + 0.5_wp ) THEN 238 234 tmpberg => this 239 235 this => this%next … … 248 244 CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 249 245 CALL icb_utl_delete(first_berg, tmpberg) 250 ELSE IF( ipe_W >= 0 .AND. iine < mig(nicbdi)) THEN246 ELSE IF( ipe_W >= 0 .AND. pt%xi < REAL(mig(nicbdi),wp) - 0.5_wp ) THEN 251 247 tmpberg => this 252 248 this => this%next … … 372 368 DO WHILE (ASSOCIATED(this)) 373 369 pt => this%current_point 374 ijne = INT( pt%yj + 0.5 ) 375 IF( ipe_N >= 0 .AND. ijne .GT. mjg(nicbej) ) THEN 370 IF( ipe_N >= 0 .AND. pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 376 371 tmpberg => this 377 372 this => this%next … … 383 378 CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 384 379 CALL icb_utl_delete(first_berg, tmpberg) 385 ELSE IF( ipe_S >= 0 .AND. ijne .LT. mjg(nicbdj)) THEN380 ELSE IF( ipe_S >= 0 .AND. pt%yj < REAL(mjg(nicbdj),wp) - 0.5_wp ) THEN 386 381 tmpberg => this 387 382 this => this%next … … 539 534 DO WHILE (ASSOCIATED(this)) 540 535 pt => this%current_point 541 iine = INT( pt%xi + 0.5 ) 542 ijne = INT( pt%yj + 0.5 ) 543 IF( iine .LT. mig(nicbdi) .OR. & 544 iine .GT. mig(nicbei) .OR. & 545 ijne .LT. mjg(nicbdj) .OR. & 546 ijne .GT. mjg(nicbej)) THEN 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 ) THEN 547 540 i = i + 1 548 WRITE(numicb,*) 'berg lost in halo: ', this%number(:) ,iine,ijne541 WRITE(numicb,*) 'berg lost in halo: ', this%number(:) 549 542 WRITE(numicb,*) ' ', nimpp, njmpp 550 543 WRITE(numicb,*) ' ', nicbdi, nicbei, nicbdj, nicbej … … 614 607 pt => this%current_point 615 608 iine = INT( pt%xi + 0.5 ) 616 ijne = INT( pt%yj + 0.5 )617 609 iproc = nicbflddest(mi1(iine)) 618 IF( ijne .GT. mjg(nicbej)) THEN610 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 619 611 IF( iproc == ifldproc ) THEN 620 612 ! … … 696 688 ipts = nicbfldpts (mi1(iine)) 697 689 iproc = nicbflddest(mi1(iine)) 698 IF( ijne .GT. mjg(nicbej)) THEN690 IF( pt%yj > REAL(mjg(nicbej),wp) + 0.5_wp ) THEN 699 691 IF( iproc == ifldproc ) THEN 700 692 !
Note: See TracChangeset
for help on using the changeset viewer.