Changeset 3360
- Timestamp:
- 2012-04-18T13:43:39+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
r3359 r3360 56 56 TYPE(buffer), POINTER :: obuffer_f=>NULL() , ibuffer_f=>NULL() 57 57 58 INTEGER, PARAMETER, P UBLIC :: pp_delta_buf = 25 ! Size by which to increment buffers59 INTEGER, PARAMETER, P UBLIC :: pp_buffer_width = 15+nkounts ! items to store for each berg58 INTEGER, PARAMETER, PRIVATE :: jp_delta_buf = 25 ! Size by which to increment buffers 59 INTEGER, PARAMETER, PRIVATE :: jp_buffer_width = 15+nkounts ! items to store for each berg 60 60 61 61 #endif … … 325 325 SELECT CASE ( nbondi ) 326 326 CASE( -1 ) 327 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e* pp_buffer_width, ipe_E, iml_req1 )327 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req1 ) 328 328 IF( ibergs_rcvd_from_e > 0 ) THEN 329 329 CALL increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 330 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e* pp_buffer_width )330 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 331 331 ENDIF 332 332 IF( ibergs_to_send_e > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) … … 339 339 ENDDO 340 340 CASE( 0 ) 341 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w* pp_buffer_width, ipe_W, iml_req2 )342 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e* pp_buffer_width, ipe_E, iml_req3 )341 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 ) 342 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 ) 343 343 IF( ibergs_rcvd_from_e > 0 ) THEN 344 344 CALL increase_ibuffer(ibuffer_e, ibergs_rcvd_from_e) 345 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e* pp_buffer_width )345 CALL mpprecv( 13, ibuffer_e%data, ibergs_rcvd_from_e*jp_buffer_width ) 346 346 ENDIF 347 347 IF( ibergs_rcvd_from_w > 0 ) THEN 348 348 CALL increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 349 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w* pp_buffer_width )349 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 350 350 ENDIF 351 351 IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) … … 366 366 ENDDO 367 367 CASE( 1 ) 368 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w* pp_buffer_width, ipe_W, iml_req4 )368 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req4 ) 369 369 IF( ibergs_rcvd_from_w > 0 ) THEN 370 370 CALL increase_ibuffer(ibuffer_w, ibergs_rcvd_from_w) 371 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w* pp_buffer_width )371 CALL mpprecv( 14, ibuffer_w%data, ibergs_rcvd_from_w*jp_buffer_width ) 372 372 ENDIF 373 373 IF( ibergs_to_send_w > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) … … 456 456 SELECT CASE ( nbondj ) 457 457 CASE( -1 ) 458 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n* pp_buffer_width, ipe_N, iml_req1 )458 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req1 ) 459 459 IF( ibergs_rcvd_from_n > 0 ) THEN 460 460 CALL increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 461 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n* pp_buffer_width )461 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 462 462 ENDIF 463 463 IF( ibergs_to_send_n > 0 .AND. l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err ) … … 470 470 ENDDO 471 471 CASE( 0 ) 472 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s* pp_buffer_width, ipe_S, iml_req2 )473 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n* pp_buffer_width, ipe_N, iml_req3 )472 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 ) 473 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 ) 474 474 IF( ibergs_rcvd_from_n > 0 ) THEN 475 475 CALL increase_ibuffer(ibuffer_n, ibergs_rcvd_from_n) 476 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n* pp_buffer_width )476 CALL mpprecv( 17, ibuffer_n%data, ibergs_rcvd_from_n*jp_buffer_width ) 477 477 ENDIF 478 478 IF( ibergs_rcvd_from_s > 0 ) THEN 479 479 CALL increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 480 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s* pp_buffer_width )480 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 481 481 ENDIF 482 482 IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) … … 497 497 ENDDO 498 498 CASE( 1 ) 499 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s* pp_buffer_width, ipe_S, iml_req4 )499 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req4 ) 500 500 IF( ibergs_rcvd_from_s > 0 ) THEN 501 501 CALL increase_ibuffer(ibuffer_s, ibergs_rcvd_from_s) 502 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s* pp_buffer_width )502 CALL mpprecv( 18, ibuffer_s%data, ibergs_rcvd_from_s*jp_buffer_width ) 503 503 ENDIF 504 504 IF( ibergs_to_send_s > 0 .AND. l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err ) … … 669 669 670 670 IF( ibergs_to_send > 0 ) & 671 CALL mppsend( 12, obuffer_f%data, ibergs_to_send* pp_buffer_width, ifldproc-1, iml_req2 )671 CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, iml_req2 ) 672 672 IF( ibergs_to_rcv > 0 ) THEN 673 673 CALL increase_ibuffer(ibuffer_f, ibergs_to_rcv) 674 CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv* pp_buffer_width )674 CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width ) 675 675 ENDIF 676 676 IF( ibergs_to_send > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) … … 724 724 INTEGER :: k 725 725 726 IF( .NOT. ASSOCIATED(pbuff) ) CALL increase_buffer( pbuff, pp_delta_buf )727 IF( kb .GT. pbuff%size ) CALL increase_buffer( pbuff, pp_delta_buf )726 IF( .NOT. ASSOCIATED(pbuff) ) CALL increase_buffer( pbuff, jp_delta_buf ) 727 IF( kb .GT. pbuff%size ) CALL increase_buffer( pbuff, jp_delta_buf ) 728 728 729 729 !! pack points into buffer … … 803 803 ENDIF 804 804 ALLOCATE( new ) 805 ALLOCATE( new%data( pp_buffer_width, inew_size) )805 ALLOCATE( new%data( jp_buffer_width, inew_size) ) 806 806 new%size = inew_size 807 807 IF( ASSOCIATED(old) ) THEN … … 825 825 826 826 IF( .NOT. ASSOCIATED(old) ) THEN 827 inew_size = kdelta + pp_delta_buf827 inew_size = kdelta + jp_delta_buf 828 828 iold_size = 0 829 829 ELSE … … 832 832 inew_size = old%size + kdelta 833 833 ELSE 834 inew_size = kdelta + pp_delta_buf834 inew_size = kdelta + jp_delta_buf 835 835 ENDIF 836 836 ENDIF … … 838 838 IF( iold_size .NE. inew_size ) THEN 839 839 ALLOCATE( new ) 840 ALLOCATE( new%data( pp_buffer_width, inew_size) )840 ALLOCATE( new%data( jp_buffer_width, inew_size) ) 841 841 new%size = inew_size 842 842 IF( ASSOCIATED(old) ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
