Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Send/receive layers to reduce buffer transfer time #49

Merged
merged 3 commits into from
Sep 9, 2024
Merged

Send/receive layers to reduce buffer transfer time #49

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
465351d
Send/receive layers to reduce buffer transfer time
DavidHuber-NOAA Aug 8, 2024
dd449af
Merge branch 'develop' into fix/send_recv
DavidHuber-NOAA Aug 20, 2024
c65e7ec
Merge branch 'develop' into fix/send_recv
DavidHuber-NOAA Sep 6, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 34 additions & 11 deletions src/netcdf_io/interp_inc.fd/driver.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ program interp_inc
!---------------------------------------------------------------------

use netcdf
use mpi
use mpi_f08
#ifdef IP_V4
use ip_mod, only: ipolates, ipolatev
#endif
Expand Down Expand Up @@ -61,9 +61,12 @@ program interp_inc
integer :: header_buffer_val = 16384
integer :: kgds_in(200), kgds_out(200)
integer :: ip, ipopt(20), no
integer :: klev
integer, allocatable :: ibi(:), ibo(:), levs(:)

integer :: mpierr, mype, npes, mpistat(mpi_status_size)
integer :: mpierr, mype, npes

type (MPI_Status) :: mpistat

logical*1, allocatable :: li(:,:), lo(:,:)

Expand All @@ -76,6 +79,7 @@ program interp_inc
real(8), allocatable :: slat(:), wlat(:)
real(8), allocatable :: rlon(:), rlat(:), crot(:), srot(:)
real(8), allocatable :: gi(:,:), gi2(:,:), go(:,:), go2(:,:), go3(:,:)
real(8), allocatable :: send_layer(:), recv_layer(:)


! NOTE: u_inc,v_inc must be consecutive
Expand Down Expand Up @@ -351,6 +355,8 @@ program interp_inc
allocate(go(mo,lev))
allocate(go2(mo,lev))
allocate(go3(mo,lev))
allocate(send_layer(mo))
allocate(recv_layer(mo))

call mpi_barrier(mpi_comm_world, mpierr)
do rec = 1, num_recs
Expand Down Expand Up @@ -397,10 +403,18 @@ program interp_inc
print*,'FATAL ERROR: ipolatev returned wrong number of pts ',no
stop 77
endif
call mpi_send(go(1,1), size(go), mpi_double_precision, &
npes-1, 1000+rec, mpi_comm_world, mpierr)
call mpi_send(go3(1,1), size(go3), mpi_double_precision, &
npes-1, 2000+rec, mpi_comm_world, mpierr)

do klev=1, lev
send_layer=go(:,klev)
call mpi_send(send_layer, size(send_layer), mpi_double_precision, &
npes-1, 1000+rec, mpi_comm_world, mpierr)
enddo

do klev=1, lev
send_layer=go3(:,klev)
call mpi_send(send_layer, size(send_layer), mpi_double_precision, &
npes-1, 2000+rec, mpi_comm_world, mpierr)
enddo
else
call ipolates(ip, ipopt, kgds_in, kgds_out, mi, mo, &
lev, ibi, li, gi, no, rlat, rlon, ibo, &
Expand All @@ -415,22 +429,31 @@ program interp_inc
endif
!dummy_out = reshape(go, (/lon_out,lat_out,lev/))
!print *, lon_out, lat_out, lev, 'send'
call mpi_send(go(1,1), size(go), mpi_double_precision, &
npes-1, 1000+rec, mpi_comm_world, mpierr)
do klev=1, lev
send_layer=go(:,klev)
call mpi_send(send_layer, size(send_layer), mpi_double_precision, &
npes-1, 1000+rec, mpi_comm_world, mpierr)
enddo
endif
else if (mype == npes-1) then
!print *, lon_out, lat_out, lev, 'recv'
call mpi_recv(go2(1,1), size(go2), mpi_double_precision, &
do klev=1, lev
call mpi_recv(recv_layer, size(recv_layer), mpi_double_precision, &
rec-1, 1000+rec, mpi_comm_world, mpistat, mpierr)
go2(:,klev) = recv_layer
enddo
dummy_out = reshape(go2, (/lon_out,lat_out,lev/))
error = nf90_inq_varid(ncid_out, trim(records(rec)), id_var)
call netcdf_err(error, 'inquiring ' // trim(records(rec)) // ' id for file='//trim(outfile) )
error = nf90_put_var(ncid_out, id_var, dummy_out)
call netcdf_err(error, 'writing ' // trim(records(rec)) // ' for file='//trim(outfile) )
if (trim(records(rec)) .eq. 'u_inc') then
! process v_inc also.
call mpi_recv(go2(1,1), size(go2), mpi_double_precision, &
rec-1, 2000+rec, mpi_comm_world, mpistat, mpierr)
do klev=1, lev
call mpi_recv(recv_layer, size(recv_layer), mpi_double_precision, &
rec-1, 2000+rec, mpi_comm_world, mpistat, mpierr)
go2(:,klev) = recv_layer
enddo
dummy_out = reshape(go2, (/lon_out,lat_out,lev/))
error = nf90_inq_varid(ncid_out, 'v_inc', id_var)
call netcdf_err(error, 'inquiring v_inc id for file='//trim(outfile) )
Expand Down
Loading