Changeset 14651
- Timestamp:
- 2021-03-26T18:51:55+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ICB/icblbc.F90
r14644 r14651 43 43 44 44 TYPE, PUBLIC :: buffer 45 INTEGER :: size = 046 REAL(wp), DIMENSION(:,:), POINTER :: data45 INTEGER :: buff_size = 0 46 REAL(wp), DIMENSION(:,:), POINTER :: buff_data 47 47 END TYPE buffer 48 48 … … 285 285 ENDIF 286 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 )287 IF( ibergs_to_send_w > 0 ) CALL mppsend( 13, obuffer_w%buff_data, ibergs_to_send_w*jp_buffer_width, ipe_W, iml_req2 ) 288 IF( ibergs_to_send_e > 0 ) CALL mppsend( 14, obuffer_e%buff_data, ibergs_to_send_e*jp_buffer_width, ipe_E, iml_req3 ) 289 289 IF( ibergs_rcvd_from_e > 0 ) THEN 290 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 )291 CALL mpprecv( 13, ibuffer_e%buff_data, ibergs_rcvd_from_e*jp_buffer_width ) 292 292 ENDIF 293 293 IF( ibergs_rcvd_from_w > 0 ) THEN 294 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 )295 CALL mpprecv( 14, ibuffer_w%buff_data, ibergs_rcvd_from_w*jp_buffer_width ) 296 296 ENDIF 297 297 IF( ibergs_to_send_w > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) … … 299 299 DO i = 1, ibergs_rcvd_from_e 300 300 IF( nn_verbose_level >= 4 ) THEN 301 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e% data(16,i)),' from east'301 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_e%buff_data(16,i)),' from east' 302 302 CALL FLUSH( numicb ) 303 303 ENDIF … … 306 306 DO i = 1, ibergs_rcvd_from_w 307 307 IF( nn_verbose_level >= 4 ) THEN 308 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w% data(16,i)),' from west'308 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_w%buff_data(16,i)),' from west' 309 309 CALL FLUSH( numicb ) 310 310 ENDIF … … 370 370 ENDIF 371 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 )372 IF( ibergs_to_send_s > 0 ) CALL mppsend( 17, obuffer_s%buff_data, ibergs_to_send_s*jp_buffer_width, ipe_S, iml_req2 ) 373 IF( ibergs_to_send_n > 0 ) CALL mppsend( 18, obuffer_n%buff_data, ibergs_to_send_n*jp_buffer_width, ipe_N, iml_req3 ) 374 374 IF( ibergs_rcvd_from_n > 0 ) THEN 375 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 )376 CALL mpprecv( 17, ibuffer_n%buff_data, ibergs_rcvd_from_n*jp_buffer_width ) 377 377 ENDIF 378 378 IF( ibergs_rcvd_from_s > 0 ) THEN 379 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 )380 CALL mpprecv( 18, ibuffer_s%buff_data, ibergs_rcvd_from_s*jp_buffer_width ) 381 381 ENDIF 382 382 IF( ibergs_to_send_s > 0 ) CALL mpi_wait( iml_req2, iml_stat, iml_err ) … … 384 384 DO i = 1, ibergs_rcvd_from_n 385 385 IF( nn_verbose_level >= 4 ) THEN 386 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n% data(16,i)),' from north'386 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_n%buff_data(16,i)),' from north' 387 387 CALL FLUSH( numicb ) 388 388 ENDIF … … 391 391 DO i = 1, ibergs_rcvd_from_s 392 392 IF( nn_verbose_level >= 4 ) THEN 393 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s% data(16,i)),' from south'393 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_s%buff_data(16,i)),' from south' 394 394 CALL FLUSH( numicb ) 395 395 ENDIF … … 637 637 638 638 IF( ibergs_to_send > 0 ) & 639 CALL mppsend( 12, obuffer_f% data, ibergs_to_send*jp_buffer_width, ifldproc-1, nicbfldreq(jn) )639 CALL mppsend( 12, obuffer_f%buff_data, ibergs_to_send*jp_buffer_width, ifldproc-1, nicbfldreq(jn) ) 640 640 ! 641 641 ENDIF … … 652 652 IF( ibergs_to_rcv > 0 ) THEN 653 653 CALL icb_increase_ibuffer(ibuffer_f, ibergs_to_rcv) 654 CALL mpprecv( 12, ibuffer_f% data, ibergs_to_rcv*jp_buffer_width, ifldproc-1 )654 CALL mpprecv( 12, ibuffer_f%buff_data, ibergs_to_rcv*jp_buffer_width, ifldproc-1 ) 655 655 ENDIF 656 656 ! 657 657 DO jk = 1, ibergs_to_rcv 658 658 IF( nn_verbose_level >= 4 ) THEN 659 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_f% data(16,jk)),' from north fold'659 WRITE(numicb,*) 'bergstep ',nktberg,' unpacking berg ',INT(ibuffer_f%buff_data(16,jk)),' from north fold' 660 660 CALL flush( numicb ) 661 661 ENDIF … … 690 690 ! 691 691 IF( .NOT. ASSOCIATED(pbuff) ) CALL icb_increase_buffer( pbuff, jp_delta_buf ) 692 IF( kb .GT. pbuff% size ) CALL icb_increase_buffer( pbuff, jp_delta_buf )692 IF( kb .GT. pbuff%buff_size ) CALL icb_increase_buffer( pbuff, jp_delta_buf ) 693 693 694 694 !! pack points into buffer 695 695 696 pbuff% data( 1,kb) = berg%current_point%lon697 pbuff% data( 2,kb) = berg%current_point%lat698 pbuff% data( 3,kb) = berg%current_point%uvel699 pbuff% data( 4,kb) = berg%current_point%vvel700 pbuff% data( 5,kb) = berg%current_point%xi701 pbuff% data( 6,kb) = berg%current_point%yj702 pbuff% data( 7,kb) = float(berg%current_point%year)703 pbuff% data( 8,kb) = berg%current_point%day704 pbuff% data( 9,kb) = berg%current_point%mass705 pbuff% data(10,kb) = berg%current_point%thickness706 pbuff% data(11,kb) = berg%current_point%width707 pbuff% data(12,kb) = berg%current_point%length708 pbuff% data(13,kb) = berg%current_point%mass_of_bits709 pbuff% data(14,kb) = berg%current_point%heat_density710 711 pbuff% data(15,kb) = berg%mass_scaling696 pbuff%buff_data( 1,kb) = berg%current_point%lon 697 pbuff%buff_data( 2,kb) = berg%current_point%lat 698 pbuff%buff_data( 3,kb) = berg%current_point%uvel 699 pbuff%buff_data( 4,kb) = berg%current_point%vvel 700 pbuff%buff_data( 5,kb) = berg%current_point%xi 701 pbuff%buff_data( 6,kb) = berg%current_point%yj 702 pbuff%buff_data( 7,kb) = float(berg%current_point%year) 703 pbuff%buff_data( 8,kb) = berg%current_point%day 704 pbuff%buff_data( 9,kb) = berg%current_point%mass 705 pbuff%buff_data(10,kb) = berg%current_point%thickness 706 pbuff%buff_data(11,kb) = berg%current_point%width 707 pbuff%buff_data(12,kb) = berg%current_point%length 708 pbuff%buff_data(13,kb) = berg%current_point%mass_of_bits 709 pbuff%buff_data(14,kb) = berg%current_point%heat_density 710 711 pbuff%buff_data(15,kb) = berg%mass_scaling 712 712 DO k=1,nkounts 713 pbuff% data(15+k,kb) = REAL( berg%number(k), wp )713 pbuff%buff_data(15+k,kb) = REAL( berg%number(k), wp ) 714 714 END DO 715 715 ! … … 729 729 !!---------------------------------------------------------------------- 730 730 ! 731 pt%lon = pbuff% data( 1,kb)732 pt%lat = pbuff% data( 2,kb)733 pt%uvel = pbuff% data( 3,kb)734 pt%vvel = pbuff% data( 4,kb)735 pt%xi = pbuff% data( 5,kb)736 pt%yj = pbuff% data( 6,kb)737 pt%year = INT( pbuff% data( 7,kb) )738 pt%day = pbuff% data( 8,kb)739 pt%mass = pbuff% data( 9,kb)740 pt%thickness = pbuff% data(10,kb)741 pt%width = pbuff% data(11,kb)742 pt%length = pbuff% data(12,kb)743 pt%mass_of_bits = pbuff% data(13,kb)744 pt%heat_density = pbuff% data(14,kb)745 746 currentberg%mass_scaling = pbuff% data(15,kb)731 pt%lon = pbuff%buff_data( 1,kb) 732 pt%lat = pbuff%buff_data( 2,kb) 733 pt%uvel = pbuff%buff_data( 3,kb) 734 pt%vvel = pbuff%buff_data( 4,kb) 735 pt%xi = pbuff%buff_data( 5,kb) 736 pt%yj = pbuff%buff_data( 6,kb) 737 pt%year = INT( pbuff%buff_data( 7,kb) ) 738 pt%day = pbuff%buff_data( 8,kb) 739 pt%mass = pbuff%buff_data( 9,kb) 740 pt%thickness = pbuff%buff_data(10,kb) 741 pt%width = pbuff%buff_data(11,kb) 742 pt%length = pbuff%buff_data(12,kb) 743 pt%mass_of_bits = pbuff%buff_data(13,kb) 744 pt%heat_density = pbuff%buff_data(14,kb) 745 746 currentberg%mass_scaling = pbuff%buff_data(15,kb) 747 747 DO ik = 1, nkounts 748 currentberg%number(ik) = INT( pbuff% data(15+ik,kb) )748 currentberg%number(ik) = INT( pbuff%buff_data(15+ik,kb) ) 749 749 END DO 750 750 ! … … 764 764 ! 765 765 IF( .NOT. ASSOCIATED(old) ) THEN ; inew_size = kdelta 766 ELSE ; inew_size = old% size + kdelta766 ELSE ; inew_size = old%buff_size + kdelta 767 767 ENDIF 768 768 ALLOCATE( new ) 769 ALLOCATE( new% data( jp_buffer_width, inew_size) )770 new% size = inew_size769 ALLOCATE( new%buff_data( jp_buffer_width, inew_size) ) 770 new%buff_size = inew_size 771 771 IF( ASSOCIATED(old) ) THEN 772 new% data(:,1:old%size) = old%data(:,1:old%size)773 DEALLOCATE(old% data)772 new%buff_data(:,1:old%buff_size) = old%buff_data(:,1:old%buff_size) 773 DEALLOCATE(old%buff_data) 774 774 DEALLOCATE(old) 775 775 ENDIF … … 793 793 iold_size = 0 794 794 ELSE 795 iold_size = old% size796 IF( kdelta .LT. old% size ) THEN797 inew_size = old% size + kdelta795 iold_size = old%buff_size 796 IF( kdelta .LT. old%buff_size ) THEN 797 inew_size = old%buff_size + kdelta 798 798 ELSE 799 799 inew_size = kdelta + jp_delta_buf … … 803 803 IF( iold_size .NE. inew_size ) THEN 804 804 ALLOCATE( new ) 805 ALLOCATE( new% data( jp_buffer_width, inew_size) )806 new% size = inew_size805 ALLOCATE( new%buff_data( jp_buffer_width, inew_size) ) 806 new%buff_size = inew_size 807 807 IF( ASSOCIATED(old) ) THEN 808 new% data(:,1:old%size) = old%data(:,1:old%size)809 DEALLOCATE(old% data)808 new%buff_data(:,1:old%buff_size) = old%buff_data(:,1:old%buff_size) 809 DEALLOCATE(old%buff_data) 810 810 DEALLOCATE(old) 811 811 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
