Skip to content

Commit

Permalink
Fix the issue where domain_read was not reading z slices correctly
Browse files Browse the repository at this point in the history
  • Loading branch information
@uramirez8707
uramirez8707 committed Dec 3, 2024
1 parent 8c94e3b commit 100a9ed
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 30 deletions.
41 changes: 17 additions & 24 deletions fms2_io/include/domain_read.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -334,7 +334,10 @@ subroutine domain_read_3d(fileobj, variable_name, vdata, unlim_dim_level, &
xpos, ypos, isd, isc, xc_size, jsd, jsc, yc_size, buffer_includes_halos, &
msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name))
c(:) = 1
if (present(corner)) c = corner
e(:) = shape(vdata)
if (present(edge_lengths)) e = edge_lengths
call mpp_get_global_domain(io_domain, xbegin=xgbegin, xsize=xgsize, position=xpos)
call mpp_get_global_domain(io_domain, ybegin=ygbegin, ysize=ygsize, position=ypos)
Expand Down Expand Up @@ -503,6 +506,7 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name))
c(:) = 1
e(:) = shape(vdata)
if (present(edge_lengths)) e = edge_lengths
!I/O root reads in the data and scatters it.
if (fileobj%is_root) then
Expand All @@ -515,6 +519,7 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
call mpp_get_global_domain(io_domain, xbegin=xgmin, position=xpos)
call mpp_get_global_domain(io_domain, ybegin=ygmin, position=ypos)
do i = 1, size(fileobj%pelist)
if (present(corner)) c = corner
c(xdim_index) = pe_isc(i)
c(ydim_index) = pe_jsc(i)
if (fileobj%adjust_indices) then
Expand All @@ -532,13 +537,11 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_i4_kind, vdata, c, e)
else
Expand All @@ -555,13 +558,11 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_i8_kind, vdata, c, e)
else
Expand All @@ -578,13 +579,11 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_r4_kind, vdata, c, e)
else
Expand All @@ -601,13 +600,11 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_r8_kind, vdata, c, e)
else
Expand All @@ -626,6 +623,7 @@ subroutine domain_read_4d(fileobj, variable_name, vdata, unlim_dim_level, &
deallocate(pe_jsc)
deallocate(pe_jcsize)
else
c = 1
if (buffer_includes_halos) then
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
Expand Down Expand Up @@ -724,6 +722,7 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
msg="file:"//trim(fileobj%path)//" and variable:"//trim(variable_name))
c(:) = 1
e(:) = shape(vdata)
if (present(edge_lengths)) e = edge_lengths
!I/O root reads in the data and scatters it.
if (fileobj%is_root) then
Expand All @@ -737,6 +736,7 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
call mpp_get_global_domain(io_domain, ybegin=ygmin, position=ypos)
do i = 1, size(fileobj%pelist)
!Calculate the indices of the domain-decomposed chunk relative to its position in the file.
if (present(corner)) c = corner
c(xdim_index) = pe_isc(i)
c(ydim_index) = pe_jsc(i)
if (fileobj%adjust_indices) then
Expand All @@ -755,13 +755,11 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
if (i .eq. 1) then
!Root rank stores data directly. Re-adjust the indicies relative
!to the input buffer vdata.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_i4_kind, vdata, c, e)
else
Expand All @@ -778,13 +776,11 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_i8_kind, vdata, c, e)
else
Expand All @@ -801,13 +797,11 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_r4_kind, vdata, c, e)
else
Expand All @@ -824,13 +818,11 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
corner=c, edge_lengths=e, broadcast=.false.)
if (i .eq. 1) then
!Root rank stores data directly.
c = 1
if (buffer_includes_halos) then
!Adjust if the input buffer has room for halos.
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
else
c(xdim_index) = 1
c(ydim_index) = 1
endif
call put_array_section(buf_r8_kind, vdata, c, e)
else
Expand All @@ -849,6 +841,7 @@ subroutine domain_read_5d(fileobj, variable_name, vdata, unlim_dim_level, &
deallocate(pe_jsc)
deallocate(pe_jcsize)
else
c = 1
if (buffer_includes_halos) then
c(xdim_index) = isc - isd + 1
c(ydim_index) = jsc - jsd + 1
Expand Down
12 changes: 6 additions & 6 deletions test_fms/fms2_io/test_domain_io.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -328,17 +328,17 @@ subroutine read_data_wrapper(fileob, var_name, dim, var_data, ref_data)
call compare_var_data(mpp_chksum(var_data%var_r4(:,:,1:1,:,1)), mpp_chksum(ref_data%var_r4(:,:,2:2,:,1)), &
"var4_r4-slice")

call read_data(fileob, trim(var_name)//"_r8", var_data%var_r8(:,:,1:1,1,1), &
call read_data(fileob, trim(var_name)//"_r8", var_data%var_r8(:,:,1:1,:,1), &
corner=(/1, 1, 2, 1/), edge_lengths=(/ nx, ny, 1, ndim4/))
call compare_var_data(mpp_chksum(var_data%var_r8(:,:,1:1,:,1)), mpp_chksum(ref_data%var_r8(:,:,2:2,:,1)), &
"var4_r8-slice")

call read_data(fileob, trim(var_name)//"_i4", var_data%var_i4(:,:,1:1,1,1), &
call read_data(fileob, trim(var_name)//"_i4", var_data%var_i4(:,:,1:1,:,1), &
corner=(/1, 1, 2, 1/), edge_lengths=(/ nx, ny, 1, ndim4/))
call compare_var_data(mpp_chksum(var_data%var_i4(:,:,1:1,:,1)), mpp_chksum(ref_data%var_i4(:,:,2:2,:,1)), &
"var4_i4-slice")

call read_data(fileob, trim(var_name)//"_i8", var_data%var_i8(:,:,1:1,1,1), &
call read_data(fileob, trim(var_name)//"_i8", var_data%var_i8(:,:,1:1,:,1), &
corner=(/1, 1, 2, 1/), edge_lengths=(/ nx, ny, 1, ndim4/))
call compare_var_data(mpp_chksum(var_data%var_i8(:,:,1:1,:,1)), mpp_chksum(ref_data%var_i8(:,:,2:2,:,1)), &
"var4_i8-slice")
Expand All @@ -350,17 +350,17 @@ subroutine read_data_wrapper(fileob, var_name, dim, var_data, ref_data)
call compare_var_data(mpp_chksum(var_data%var_r4(:,:,1:1,:,:)), mpp_chksum(ref_data%var_r4(:,:,2:2,:,:)), &
"var5_r4-slice")

call read_data(fileob, trim(var_name)//"_r8", var_data%var_r8(:,:,1:1,1,1), &
call read_data(fileob, trim(var_name)//"_r8", var_data%var_r8(:,:,1:1,:,:), &
corner=(/1, 1, 2, 1, 1/), edge_lengths=(/ nx, ny, 1, ndim4, ndim5/))
call compare_var_data(mpp_chksum(var_data%var_r8(:,:,1:1,:,:)), mpp_chksum(ref_data%var_r8(:,:,2:2,:,:)), &
"var5_r8-slice")

call read_data(fileob, trim(var_name)//"_i4", var_data%var_i4(:,:,1:1,1,1), &
call read_data(fileob, trim(var_name)//"_i4", var_data%var_i4(:,:,1:1,:,:), &
corner=(/1, 1, 2, 1, 1/), edge_lengths=(/ nx, ny, 1, ndim4, ndim5/))
call compare_var_data(mpp_chksum(var_data%var_i4(:,:,1:1,:,:)), mpp_chksum(ref_data%var_i4(:,:,2:2,:,:)), &
"var5_i4-slice")

call read_data(fileob, trim(var_name)//"_i8", var_data%var_i8(:,:,1:1,1,1), &
call read_data(fileob, trim(var_name)//"_i8", var_data%var_i8(:,:,1:1,:,:), &
corner=(/1, 1, 2, 1, 1/), edge_lengths=(/ nx, ny, 1, ndim4, ndim5/))
call compare_var_data(mpp_chksum(var_data%var_i8(:,:,1:1,:,:)), mpp_chksum(ref_data%var_i8(:,:,2:2,:,:)), &
"var5_i8-slice")
Expand Down

0 comments on commit 100a9ed

Please sign in to comment.