- Timestamp:
- 2021-03-03T16:04:57+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ICB
- Files:
-
- 5 edited
-
icbdia.F90 (modified) (5 diffs)
-
icbdyn.F90 (modified) (7 diffs)
-
icbini.F90 (modified) (2 diffs)
-
icblbc.F90 (modified) (6 diffs)
-
icbutl.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ICB/icbdia.F90
r10570 r14574 86 86 INTEGER :: nbergs_start, nbergs_end, nbergs_calved 87 87 INTEGER :: nbergs_melted 88 INTEGER :: nspeeding_tickets 88 INTEGER :: nspeeding_tickets, nspeeding_tickets_all 89 89 INTEGER , DIMENSION(nclasses) :: nbergs_calved_by_class 90 90 … … 125 125 nbergs_calved_by_class(:) = 0 126 126 nspeeding_tickets = 0 127 nspeeding_tickets_all = 0 127 128 stored_heat_end = 0._wp 128 129 floating_heat_end = 0._wp … … 271 272 CALL mpp_sum( 'icbdia', nsumbuf(1:nclasses+4), nclasses+4 ) 272 273 ! 273 nbergs_end = nsumbuf(1)274 nbergs_calved = nsumbuf(2)275 nbergs_melted = nsumbuf(3)276 nspeeding_tickets = nsumbuf(4)274 nbergs_end = nsumbuf(1) 275 nbergs_calved = nsumbuf(2) 276 nbergs_melted = nsumbuf(3) 277 nspeeding_tickets_all = nsumbuf(4) 277 278 DO ik = 1,nclasses 278 279 nbergs_calved_by_class(ik)= nsumbuf(4+ik) … … 329 330 IF (nn_verbose_level > 0) THEN 330 331 WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses) 331 IF( nspeeding_tickets > 0 ) WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets 332 IF( nspeeding_tickets_all > 0 ) THEN 333 WRITE( numicb, '("speeding tickets issued (this domain) = ",i6)') nspeeding_tickets 334 WRITE( numicb, '("speeding tickets issued (all domains) = ",i6)') nspeeding_tickets_all 335 END IF 332 336 ENDIF 333 337 ! … … 338 342 nbergs_calved_by_class(:) = 0 339 343 nspeeding_tickets = 0 344 nspeeding_tickets_all = 0 340 345 stored_heat_start = stored_heat_end 341 346 floating_heat_start = floating_heat_end -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ICB/icbdyn.F90
r14030 r14574 85 85 86 86 ! !** A1 = A(X1,V1) 87 CALL icb_accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1, &88 & zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 )87 CALL icb_accel( kt, berg , zxi1, ze1, zuvel1, zuvel1, zax1, & 88 & zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2, 0.5_wp ) 89 89 ! 90 90 zu1 = zuvel1 / ze1 !** V1 in d(i,j)/dt … … 102 102 103 103 ! !** A2 = A(X2,V2) 104 CALL icb_accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2, &105 & zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 )104 CALL icb_accel( kt, berg , zxi2, ze1, zuvel2, zuvel1, zax2, & 105 & zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2, 0.5_wp ) 106 106 ! 107 107 zu2 = zuvel2 / ze1 !** V2 in d(i,j)/dt … … 114 114 zyj3 = zyj1 + zdt_2 * zv2 ; zvvel3 = zvvel1 + zdt_2 * zay2 115 115 ! 116 CALL icb_ground( berg, zxi3, zxi1, zu 3, &117 & zyj3, zyj1, zv 3, ll_bounced )116 CALL icb_ground( berg, zxi3, zxi1, zu2, & 117 & zyj3, zyj1, zv2, ll_bounced ) 118 118 119 119 ! !** A3 = A(X3,V3) 120 CALL icb_accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3, &121 & zyj3, ze2, zvvel3, zvvel1, zay3, zdt )120 CALL icb_accel( kt, berg , zxi3, ze1, zuvel3, zuvel1, zax3, & 121 & zyj3, ze2, zvvel3, zvvel1, zay3, zdt, 1._wp ) 122 122 ! 123 123 zu3 = zuvel3 / ze1 !** V3 in d(i,j)/dt … … 130 130 zyj4 = zyj1 + zdt * zv3 ; zvvel4 = zvvel1 + zdt * zay3 131 131 132 CALL icb_ground( berg, zxi4, zxi1, zu 4, &133 & zyj4, zyj1, zv 4, ll_bounced )132 CALL icb_ground( berg, zxi4, zxi1, zu3, & 133 & zyj4, zyj1, zv3, ll_bounced ) 134 134 135 135 ! !** A4 = A(X4,V4) 136 CALL icb_accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4, &137 & zyj4, ze2, zvvel4, zvvel1, zay4, zdt )136 CALL icb_accel( kt, berg , zxi4, ze1, zuvel4, zuvel1, zax4, & 137 & zyj4, ze2, zvvel4, zvvel1, zay4, zdt, 1._wp ) 138 138 139 139 zu4 = zuvel4 / ze1 !** V4 in d(i,j)/dt … … 255 255 256 256 257 SUBROUTINE icb_accel( berg , pxi, pe1, puvel, puvel0, pax,&258 & pyj, pe2, pvvel, pvvel0, pay, pdt)257 SUBROUTINE icb_accel( kt, berg , pxi, pe1, puvel, puvel0, pax, & 258 & pyj, pe2, pvvel, pvvel0, pay, pdt, pcfl_scale ) 259 259 !!---------------------------------------------------------------------- 260 260 !! *** ROUTINE icb_accel *** … … 265 265 !!---------------------------------------------------------------------- 266 266 TYPE(iceberg ), POINTER, INTENT(in ) :: berg ! berg 267 INTEGER , INTENT(in ) :: kt ! time step 268 REAL(wp) , INTENT(in ) :: pcfl_scale 267 269 REAL(wp) , INTENT(in ) :: pxi , pyj ! berg position in (i,j) referential 268 270 REAL(wp) , INTENT(in ) :: puvel , pvvel ! berg velocity [m/s] … … 404 406 zspeed = SQRT( zuveln*zuveln + zvveln*zvveln ) ! Speed of berg 405 407 IF( zspeed > 0._wp ) THEN 406 zloc_dx = MIN( pe1, pe2 ) ! minimum grid spacing 407 zspeed_new = zloc_dx / pdt * rn_speed_limit ! Speed limit as a factor of dx / dt 408 zloc_dx = MIN( pe1, pe2 ) ! minimum grid spacing 409 ! cfl scale is function of the RK4 step 410 zspeed_new = zloc_dx / pdt * rn_speed_limit * pcfl_scale ! Speed limit as a factor of dx / dt 408 411 IF( zspeed_new < zspeed ) THEN 409 zuveln = zuveln * ( zspeed_new / zspeed ) ! Scale velocity to reduce speed 410 zvveln = zvveln * ( zspeed_new / zspeed ) ! without changing the direction 412 zuveln = zuveln * ( zspeed_new / zspeed ) ! Scale velocity to reduce speed 413 zvveln = zvveln * ( zspeed_new / zspeed ) ! without changing the direction 414 pax = (zuveln - puvel0)/pdt 415 pay = (zvveln - pvvel0)/pdt 416 ! 417 ! print speeding ticket 418 IF (nn_verbose_level > 0) THEN 419 WRITE(numicb, 9200) 'icb speeding : ',kt, nknberg, zspeed, & 420 & pxi, pyj, zuo, zvo, zua, zva, zui, zvi 421 9200 FORMAT(a,i9,i6,f9.2,1x,4(1x,2f9.2)) 422 END IF 423 ! 411 424 CALL icb_dia_speed() 412 425 ENDIF -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ICB/icbini.F90
r14030 r14574 189 189 190 190 ! north fold 191 IF( npolj > 0) THEN191 IF( l_IdoNFold ) THEN 192 192 ! 193 193 ! icebergs in row nicbej+1 get passed across fold … … 235 235 WRITE(numicb,*) "j point" 236 236 WRITE(numicb,*) (INT(src_calving(ji,jj)), jj=1,jpj) 237 IF( npolj > 0) THEN237 IF( l_IdoNFold ) THEN 238 238 WRITE(numicb,*) 'north fold destination points ' 239 239 WRITE(numicb,*) nicbfldpts -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ICB/icblbc.F90
r14229 r14574 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 … … 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 … … 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 -
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/ICB/icbutl.F90
r14118 r14574 320 320 ! 321 321 IF ( ierr > 0 ) THEN 322 WRITE(numout,*) 'bottom left corner T point out of bound' 323 WRITE(numout,*) pi, kii, mig( 1 ), mig(jpi) 324 WRITE(numout,*) pj, kij, mjg( 1 ), mjg(jpj) 325 WRITE(numout,*) pmsk 326 CALL ctl_stop('STOP','icb_utl_bilin_h: an icebergs coordinates is out of valid range (out of bound error)') 322 WRITE(numicb,*) 'bottom left corner T point out of bound' 323 WRITE(numicb,*) pi, kii, mig( 1 ), mig(jpi) 324 WRITE(numicb,*) pj, kij, mjg( 1 ), mjg(jpj) 325 WRITE(numicb,*) pmsk 326 CALL FLUSH(numicb) 327 CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error).' , & 328 & 'This can be fixed using rn_speed_limit=0.4 in &namberg.' , & 329 & 'More details in the corresponding iceberg.stat file (nn_verbose_level > 0).' ) 327 330 END IF 328 331 END IF
Note: See TracChangeset
for help on using the changeset viewer.
