From 13ad4e485a30c7dcfd4313748c7c3752321893a6 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 30 Oct 2024 13:40:34 -0400 Subject: [PATCH 1/2] Adds a test to the test reading in a slice of the z axis --- test_fms/fms2_io/test_domain_io.F90 | 69 +++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/test_fms/fms2_io/test_domain_io.F90 b/test_fms/fms2_io/test_domain_io.F90 index 5b00d8c9fe..ec865f1080 100644 --- a/test_fms/fms2_io/test_domain_io.F90 +++ b/test_fms/fms2_io/test_domain_io.F90 @@ -131,6 +131,9 @@ program test_domain_read call read_data_wrapper(fileobj, "var3", 3, var_data_out, var_data_in) call read_data_wrapper(fileobj, "var4", 4, var_data_out, var_data_in) call read_data_wrapper(fileobj, "var5", 5, var_data_out, var_data_in) + call read_data_wrapper(fileobj, "var3", 6, var_data_out, var_data_in) + call read_data_wrapper(fileobj, "var4", 7, var_data_out, var_data_in) + call read_data_wrapper(fileobj, "var5", 8, var_data_out, var_data_in) call close_file(fileobj) endif @@ -295,6 +298,72 @@ subroutine read_data_wrapper(fileob, var_name, dim, var_data, ref_data) call read_data(fileob, trim(var_name)//"_i8", var_data%var_i8(:,:,:,:,:)) call compare_var_data(mpp_chksum(var_data%var_i8(:,:,:,:,:)), mpp_chksum(ref_data%var_i8(:,:,:,:,:)), "var5_i8") + case(6) + !Only read the second third dimension (3d case) + call var_data_init(var_data) + call read_data(fileob, trim(var_name)//"_r4", var_data%var_r4(:,:,1:1,1,1), & + corner=(/1, 1, 2/), edge_lengths=(/ nx, ny, 1/)) + call compare_var_data(mpp_chksum(var_data%var_r4(:,:,1:1,1,1)), mpp_chksum(ref_data%var_r4(:,:,2:2,1,1)), & + "var3_r4-slice") + + call read_data(fileob, trim(var_name)//"_r8", var_data%var_r8(:,:,1:1,1,1), & + corner=(/1, 1, 2/), edge_lengths=(/ nx, ny, 1/)) + call compare_var_data(mpp_chksum(var_data%var_r8(:,:,1:1,1,1)), mpp_chksum(ref_data%var_r8(:,:,2:2,1,1)), & + "var3_r8-slice") + + call read_data(fileob, trim(var_name)//"_i4", var_data%var_i4(:,:,1:1,1,1), & + corner=(/1, 1, 2/), edge_lengths=(/ nx, ny, 1/)) + call compare_var_data(mpp_chksum(var_data%var_i4(:,:,1:1,1,1)), mpp_chksum(ref_data%var_i4(:,:,2:2,1,1)), & + "var3_i4-slice") + + call read_data(fileob, trim(var_name)//"_i8", var_data%var_i8(:,:,1:1,1,1), & + corner=(/1, 1, 2/), edge_lengths=(/ nx, ny, 1/)) + call compare_var_data(mpp_chksum(var_data%var_i8(:,:,1:1,1,1)), mpp_chksum(ref_data%var_i8(:,:,2:2,1,1)), & + "var3_i8-slice") + case(7) + !Only read the second third dimension (4d case) + call var_data_init(var_data) + call read_data(fileob, trim(var_name)//"_r4", var_data%var_r4(:,:,1:1,:,1), & + corner=(/1, 1, 2, 1/), edge_lengths=(/ nx, ny, 1, ndim4/)) + 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), & + 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), & + 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), & + 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") + case(8) + !Only read the second third dimension (5d case) + call var_data_init(var_data) + call read_data(fileob, trim(var_name)//"_r4", var_data%var_r4(:,:,1:1,:,:), & + corner=(/1, 1, 2, 1, 1/), edge_lengths=(/ nx, ny, 1, ndim4, ndim5/)) + 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), & + 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), & + 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), & + 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") end select end subroutine read_data_wrapper From 100a9edf5700dcfed7b6099badfe5dba78a36a4a Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 3 Dec 2024 14:17:05 -0500 Subject: [PATCH 2/2] Fix the issue where domain_read was not reading z slices correctly --- fms2_io/include/domain_read.inc | 41 ++++++++++++----------------- test_fms/fms2_io/test_domain_io.F90 | 12 ++++----- 2 files changed, 23 insertions(+), 30 deletions(-) diff --git a/fms2_io/include/domain_read.inc b/fms2_io/include/domain_read.inc index 13f142c19a..3afdbded3f 100644 --- a/fms2_io/include/domain_read.inc +++ b/fms2_io/include/domain_read.inc @@ -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) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/test_fms/fms2_io/test_domain_io.F90 b/test_fms/fms2_io/test_domain_io.F90 index ec865f1080..90d399bf3d 100644 --- a/test_fms/fms2_io/test_domain_io.F90 +++ b/test_fms/fms2_io/test_domain_io.F90 @@ -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") @@ -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")