diff --git a/src/netcdf_io/interp_inc.fd/driver.F90 b/src/netcdf_io/interp_inc.fd/driver.F90 index d01a5d13..7b1d384e 100644 --- a/src/netcdf_io/interp_inc.fd/driver.F90 +++ b/src/netcdf_io/interp_inc.fd/driver.F90 @@ -23,7 +23,7 @@ program interp_inc !--------------------------------------------------------------------- use netcdf - use mpi + use mpi_f08 #ifdef IP_V4 use ip_mod, only: ipolates, ipolatev #endif @@ -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(:,:) @@ -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 @@ -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 @@ -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, & @@ -415,13 +429,19 @@ 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) ) @@ -429,8 +449,11 @@ program interp_inc 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) )