- Timestamp:
- 2019-05-13T11:43:03+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_mirror_text_diagnostics/src/OCE/ICB/icblbc.F90
r10888 r10968 194 194 ENDIF 195 195 196 IF( nn_verbose_level >= 2 ) THEN196 IF( nn_verbose_level >= 2 .AND. numicb /= -1) THEN 197 197 WRITE(numicb,*) 'processor west : ', ipe_W 198 198 WRITE(numicb,*) 'processor east : ', ipe_E … … 237 237 this => this%next 238 238 ibergs_to_send_e = ibergs_to_send_e + 1 239 IF( nn_verbose_level >= 4 ) THEN239 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 240 240 WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to east' 241 241 CALL flush( numicb ) … … 250 250 this => this%next 251 251 ibergs_to_send_w = ibergs_to_send_w + 1 252 IF( nn_verbose_level >= 4 ) THEN252 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 253 253 WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to west' 254 254 CALL flush( numicb ) … … 264 264 END DO 265 265 ENDIF 266 IF( nn_verbose_level >= 3 ) THEN266 IF( nn_verbose_level >= 3 .AND. numicb /= -1) THEN 267 267 WRITE(numicb,*) 'bergstep ',nktberg,' send ew: ', ibergs_to_send_e, ibergs_to_send_w 268 268 CALL flush(numicb) … … 298 298 ibergs_rcvd_from_w = INT( zwebergs(2) ) 299 299 END SELECT 300 IF( nn_verbose_level >= 3 ) THEN300 IF( nn_verbose_level >= 3 .AND. numicb /= -1 ) THEN 301 301 WRITE(numicb,*) 'bergstep ',nktberg,' recv ew: ', ibergs_rcvd_from_w, ibergs_rcvd_from_e 302 302 CALL flush(numicb) … … 312 312 IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 313 313 DO i = 1, ibergs_rcvd_from_e 314 IF( nn_verbose_level >= 4 ) THEN314 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 315 315 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east' 316 316 CALL flush( numicb ) … … 332 332 IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 333 333 DO i = 1, ibergs_rcvd_from_e 334 IF( nn_verbose_level >= 4 ) THEN334 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 335 335 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%data(16,i)),' from east' 336 336 CALL flush( numicb ) … … 339 339 END DO 340 340 DO i = 1, ibergs_rcvd_from_w 341 IF( nn_verbose_level >= 4 ) THEN341 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 342 342 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west' 343 343 CALL flush( numicb ) … … 353 353 IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 354 354 DO i = 1, ibergs_rcvd_from_w 355 IF( nn_verbose_level >= 4 ) THEN355 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 356 356 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%data(16,i)),' from west' 357 357 CALL flush( numicb ) … … 375 375 this => this%next 376 376 ibergs_to_send_n = ibergs_to_send_n + 1 377 IF( nn_verbose_level >= 4 ) THEN377 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 378 378 WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to north' 379 379 CALL flush( numicb ) … … 385 385 this => this%next 386 386 ibergs_to_send_s = ibergs_to_send_s + 1 387 IF( nn_verbose_level >= 4 ) THEN387 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 388 388 WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for transfer to south' 389 389 CALL flush( numicb ) … … 396 396 END DO 397 397 ENDIF 398 if( nn_verbose_level >= 3 ) then398 if( nn_verbose_level >= 3 .AND. numicb /= -1 ) then 399 399 write(numicb,*) 'bergstep ',nktberg,' send ns: ', ibergs_to_send_n, ibergs_to_send_s 400 400 call flush(numicb) … … 429 429 ibergs_rcvd_from_s = INT( zsnbergs(2) ) 430 430 END SELECT 431 if( nn_verbose_level >= 3 ) then431 if( nn_verbose_level >= 3 .AND. numicb /= -1) then 432 432 write(numicb,*) 'bergstep ',nktberg,' recv ns: ', ibergs_rcvd_from_s, ibergs_rcvd_from_n 433 433 call flush(numicb) … … 443 443 IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) 444 444 DO i = 1, ibergs_rcvd_from_n 445 IF( nn_verbose_level >= 4 ) THEN445 IF( nn_verbose_level >= 4 .AND. numicb /= -1 ) THEN 446 446 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north' 447 447 CALL flush( numicb ) … … 463 463 IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err ) 464 464 DO i = 1, ibergs_rcvd_from_n 465 IF( nn_verbose_level >= 4 ) THEN465 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 466 466 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%data(16,i)),' from north' 467 467 CALL flush( numicb ) … … 470 470 END DO 471 471 DO i = 1, ibergs_rcvd_from_s 472 IF( nn_verbose_level >= 4 ) THEN472 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 473 473 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south' 474 474 CALL flush( numicb ) … … 484 484 IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) 485 485 DO i = 1, ibergs_rcvd_from_s 486 IF( nn_verbose_level >= 4 ) THEN486 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 487 487 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%data(16,i)),' from south' 488 488 CALL flush( numicb ) … … 497 497 i = ( ibergs_rcvd_from_n + ibergs_rcvd_from_s + ibergs_rcvd_from_e + ibergs_rcvd_from_w ) - & 498 498 ( ibergs_to_send_n + ibergs_to_send_s + ibergs_to_send_e + ibergs_to_send_w ) 499 IF( ibergs_end-(ibergs_start+i) .NE. 0 ) THEN499 IF( ibergs_end-(ibergs_start+i) .NE. 0 .AND. numicb /= -1) THEN 500 500 WRITE( numicb,* ) 'send_bergs_to_other_pes: net change in number of icebergs' 501 501 WRITE( numicb,1000) 'send_bergs_to_other_pes: ibergs_end=', & … … 532 532 IF( npolj /= 0 .AND. jpni > 1 ) CALL icb_lbc_mpp_nfld( ) 533 533 534 IF( nn_verbose_level > 0 534 IF( nn_verbose_level > 0) THEN 535 535 i = 0 536 536 this => first_berg … … 544 544 ijne .GT. mjg(nicbej)) THEN 545 545 i = i + 1 546 WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne 547 WRITE(numicb,*) ' ', nimpp, njmpp 548 WRITE(numicb,*) ' ', nicbdi, nicbei, nicbdj, nicbej 549 CALL flush( numicb ) 546 IF(numicb /= -1) THEN 547 WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne 548 WRITE(numicb,*) ' ', nimpp, njmpp 549 WRITE(numicb,*) ' ', nicbdi, nicbei, nicbdj, nicbej 550 CALL flush( numicb ) 551 ENDIF 550 552 ENDIF 551 553 this => this%next … … 553 555 CALL mpp_sum('icblbc', i) 554 556 IF( i .GT. 0 ) THEN 555 WRITE( numicb,'(a,i4)') 'send_bergs_to_other_pes: # of bergs outside computational domain = ',i 557 IF(numicb /= -1) THEN 558 WRITE( numicb,'(a,i4)') 'send_bergs_to_other_pes: # of bergs outside computational domain = ',i 559 ELSE 560 WRITE( *,'(a,i4)') 'send_bergs_to_other_pes: # of bergs outside computational domain = ',i 561 ENDIF 556 562 CALL ctl_stop('send_bergs_to_other_pes: there are bergs still in halos!') 557 563 ENDIF ! root_pe … … 656 662 IF( nicbfldproc(jjn) .eq. INT(znbergs(1)) ) EXIT 657 663 END DO 658 IF( jjn .GT. jpni .AND. nn_verbose_level > 0 ) write(numicb,*) 'ICB ERROR'664 IF( jjn .GT. jpni .AND. nn_verbose_level > 0 .AND. numicb /= -1 ) write(numicb,*) 'ICB ERROR' 659 665 nicbfldexpect(jjn) = INT( znbergs(2) ) 660 666 !IF ( nicbfldexpect(jjn) .GT. 0 .AND. nn_verbose_level > 0 ) write(numicb,*) 'ICB expecting ',nicbfldexpect(jjn),' from ', nicbfldproc(jjn) … … 711 717 tmpberg => this 712 718 ibergs_to_send = ibergs_to_send + 1 713 IF( nn_verbose_level >= 4 ) THEN719 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 714 720 WRITE(numicb,*) 'bergstep ',nktberg,' packing berg ',tmpberg%number(:),' for north fold' 715 721 CALL flush( numicb ) … … 724 730 END DO 725 731 ENDIF 726 if( nn_verbose_level >= 3 ) then732 if( nn_verbose_level >= 3 .AND. numicb /= -1) then 727 733 write(numicb,*) 'bergstep ',nktberg,' send nfld: ', ibergs_to_send 728 734 call flush(numicb) … … 755 761 ! 756 762 DO jk = 1, ibergs_to_rcv 757 IF( nn_verbose_level >= 4 ) THEN763 IF( nn_verbose_level >= 4 .AND. numicb /= -1) THEN 758 764 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_f%data(16,jk)),' from north fold' 759 765 CALL flush( numicb )
Note: See TracChangeset
for help on using the changeset viewer.
