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.

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

On read, change order of dealing with redist vs undist #169

Merged
merged 3 commits into from
Aug 10, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
160 changes: 152 additions & 8 deletions src/Infrastructure/Field/tests/ESMF_FieldIOUTest.F90
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,7 @@ program ESMF_FieldIOUTest
type(ESMF_Mesh) :: elem_mesh
type(ESMF_Field) :: field_att, field_ugd_att
type(ESMF_Field) :: field_ug, field_ug2
type(ESMF_Field) :: field_ug_w2DE, field_ug_r2DE

type(ESMF_DistGrid) :: dg_debl
type(ESMF_DistGridConnection), allocatable :: connectionList(:)
Expand All @@ -75,6 +76,8 @@ program ESMF_FieldIOUTest

real(ESMF_KIND_R8), pointer :: Farray_DE0_w(:,:) => null (), Farray_DE0_r(:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_DE1_w(:,:) => null (), Farray_DE1_r(:,:) => null ()
real(ESMF_KIND_R8), pointer :: Farray_ug_DE0_w(:,:,:) => null(), Farray_ug_DE0_r(:,:,:) => null()
real(ESMF_KIND_R8), pointer :: Farray_ug_DE1_w(:,:,:) => null(), Farray_ug_DE1_r(:,:,:) => null()

integer :: rc, ncstat, ncid
integer, allocatable :: computationalLBound(:),computationalUBound(:)
Expand All @@ -84,7 +87,7 @@ program ESMF_FieldIOUTest
integer :: elem_tlb(1), elem_tub(1), elem_tc(1)
integer :: tlb3(3), tub3(3), tlb4(3), tub4(3)
integer :: i, j, t, endtime, k
logical :: failed
logical :: failed, allEqual
real(ESMF_KIND_R8) :: Maxvalue, diff
#if defined ESMF_NETCDF
integer :: dim1id, dim2id, dim1len, dim2len, varid, ndims
Expand Down Expand Up @@ -1173,13 +1176,6 @@ program ESMF_FieldIOUTest
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy globally indexed 2DE Grid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_GridDestroy(grid_2DE, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

!------------------------------------------------------------------------
! Mesh Write test
!------------------------------------------------------------------------
Expand Down Expand Up @@ -1681,10 +1677,154 @@ program ESMF_FieldIOUTest
deallocate (deBlockList, connectionList)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
! Tests with both (a) multiple DEs per PET and (b) ungridded dimensions
! (Note that these are exhaustive-only unit tests.)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Create Field
field_ug_w2DE=ESMF_FieldCreate(grid_2DE, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a Field from 2DE grid with 1 ungridded dim"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Fill Field for DE0
call ESMF_FieldGet(field_ug_w2DE, localDe=0, farrayPtr=Farray_ug_DE0_w, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill farray from field_ug_w2DE, DE 0"
if (rc == ESMF_SUCCESS) then
do k = lbound(Farray_ug_DE0_w, 3), ubound(Farray_ug_DE0_w, 3)
do j = lbound(Farray_ug_DE0_w, 2), ubound(Farray_ug_DE0_w, 2)
do i = lbound(Farray_ug_DE0_w, 1), ubound(Farray_ug_DE0_w, 1)
Farray_ug_DE0_w(i,j,k) = (localPet+1) * real(k*1000 + j*100 + i, ESMF_KIND_R8)
end do
end do
end do
end if
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Fill Field for DE1
call ESMF_FieldGet(field_ug_w2DE, localDe=1, farrayPtr=Farray_ug_DE1_w, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get and fill farray from field_ug_w2DE, DE 1"
if (rc == ESMF_SUCCESS) then
do k = lbound(Farray_ug_DE1_w, 3), ubound(Farray_ug_DE1_w, 3)
do j = lbound(Farray_ug_DE1_w, 2), ubound(Farray_ug_DE1_w, 2)
do i = lbound(Farray_ug_DE1_w, 1), ubound(Farray_ug_DE1_w, 1)
Farray_ug_DE1_w(i,j,k) = 7 * (localPet+1) * real(k*1000 + j*100 + i, ESMF_KIND_R8)
end do
end do
end do
end if
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Write Field with both (a) multiple DEs per PET and (b) ungridded dimensions
call ESMF_FieldWrite(field_ug_w2DE, fileName="field_ug_2DE.nc", &
iofmt=ESMF_IOFMT_NETCDF, &
status=ESMF_FILESTATUS_REPLACE, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Write Field from 2DE grid with 1 ungridded dim"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Create Field
field_ug_r2DE=ESMF_FieldCreate(grid_2DE, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/2/), &
name="temperature", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Create a Field from 2DE grid with 1 ungridded dim for read"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Read Field with both (a) multiple DEs per PET and (b) ungridded dimensions
call ESMF_FieldRead(field_ug_r2DE, fileName="field_ug_2DE.nc", rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Read Field from 2DE grid with 1 ungridded dim"
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
call ESMF_Test((rc==ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
#else
write(failMsg, *) "Did not return ESMF_RC_LIB_NOT_PRESENT"
call ESMF_Test((rc==ESMF_RC_LIB_NOT_PRESENT), name, failMsg, result, ESMF_SRCLINE)
#endif
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Get Farray from read-in Field on DE 0
call ESMF_FieldGet(field_ug_r2DE, localDe=0, farrayPtr=Farray_ug_DE0_r, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get farray from field_ug_r2DE, DE 0"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Compare read-in Field with original for DE 0
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
allEqual = all(Farray_ug_DE0_r == Farray_ug_DE0_w)
#else
allEqual = .true.
#endif
write(failMsg, *) "Some read-in values differ from original"
write(name, *) "Comparison of read-in Field from 2DE grid with 1 ungridded dim vs original, DE 0"
call ESMF_Test(allEqual, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Get Farray from read-in Field on DE 1
call ESMF_FieldGet(field_ug_r2DE, localDe=1, farrayPtr=Farray_ug_DE1_r, rc=rc)
write(failMsg, *) "Did not return ESMF_SUCCESS"
write(name, *) "Get farray from field_ug_r2DE, DE 1"
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!EX_UTest_Multi_Proc_Only
! Compare read-in Field with original for DE 1
#if (defined ESMF_PIO && ( defined ESMF_NETCDF || defined ESMF_PNETCDF))
allEqual = all(Farray_ug_DE1_r == Farray_ug_DE1_w)
#else
allEqual = .true.
#endif
write(failMsg, *) "Some read-in values differ from original"
write(name, *) "Comparison of read-in Field from 2DE grid with 1 ungridded dim vs original, DE 1"
call ESMF_Test(allEqual, name, failMsg, result, ESMF_SRCLINE)
!------------------------------------------------------------------------

!------------------------------------------------------------------------
! Destroy all Fields and cleanup
!------------------------------------------------------------------------

!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Destroy globally indexed 2DE Grid"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_GridDestroy(grid_2DE, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)

!------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
! Verifying that a Field with no data can be destroyed
Expand Down Expand Up @@ -1723,6 +1863,10 @@ program ESMF_FieldIOUTest
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug2, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug_w2DE, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_ug_r2DE, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(elem_field, rc=rc)
if (rc /= ESMF_SUCCESS) countfail = countfail + 1
call ESMF_FieldDestroy(field_debl, rc=rc)
Expand Down
59 changes: 34 additions & 25 deletions src/Infrastructure/IO/src/ESMCI_IO.C
Original file line number Diff line number Diff line change
Expand Up @@ -336,28 +336,11 @@ int IO::read(
localrc = ESMF_STATUS_UNALLOCATED;
break;
case IO_ARRAY:
// Check for undistributed dimensions
has_undist = undist_check (temp_array_p, &localrc);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc))
return rc;

if (has_undist) {
temp_array_undist_p = temp_array_p;
// Create an aliased Array which treats all dimensions as distributed.
// std::cout << ESMC_METHOD << ": calling undist_arraycreate_alldist" << std::endl;
undist_arraycreate_alldist (temp_array_undist_p, &temp_array_p, &localrc);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) {
// Close the file but return original error even if close fails.
localrc = close();
return rc;
}
}

// Check for redistribution (when DE/PET != 1)
need_redist = redist_check(temp_array_p, &localrc);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT,
&rc)) {
// Close the file but return original error even if close fails.
&rc)) {
// Close the file but return original error even if close fails.
localrc = close();
return rc;
}
Expand All @@ -366,8 +349,27 @@ int IO::read(
// std::cout << ESMC_METHOD << ": calling redist_arraycreate1de" << std::endl;
redist_arraycreate1de((*it)->getArray(), &temp_array_p, petCount, &localrc);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT,
&rc)) {
// Close the file but return original error even if close fails.
&rc)) {
// Close the file but return original error even if close fails.
localrc = close();
return rc;
}
}

// Check for undistributed dimensions
has_undist = undist_check (temp_array_p, &localrc);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc))
return rc;

// Save a version of the temporary array that possibly has undistributed dimensions
temp_array_undist_p = temp_array_p;

if (has_undist) {
// Create an aliased Array which treats all dimensions as distributed.
// std::cout << ESMC_METHOD << ": calling undist_arraycreate_alldist" << std::endl;
undist_arraycreate_alldist (temp_array_undist_p, &temp_array_p, &localrc);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc)) {
// Close the file but return original error even if close fails.
localrc = close();
return rc;
}
Expand All @@ -383,24 +385,31 @@ int IO::read(
if (need_redist) {
// Redistribute into the caller supplied Array
// std::cout << ESMC_METHOD << ": DE count > 1 - redistStore" << std::endl;
localrc = ESMCI::Array::redistStore(temp_array_p, (*it)->getArray(), &rh, NULL);

// Note that, if has_undist is true, then we need to redistribute from the view
// prior to the aliasing that treated all dimensions as distributed - i.e.,
// temp_array_undist_p. Further note that, even though the arrayRead read into
// temp_array_p, this also filled the data in temp_array_undist_p, since those two
// are aliases of each other (i.e., with DATACOPY_REFERENCE). If has_undist is
// false, then temp_array_undist_p is identical to temp_array_p.
localrc = ESMCI::Array::redistStore(temp_array_undist_p, (*it)->getArray(), &rh, NULL);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc))
return rc;

// std::cout << ESMC_METHOD << ": DE count > 1 - redistribute data" << std::endl;
localrc = ESMCI::Array::redist(temp_array_p, (*it)->getArray(), &rh,
localrc = ESMCI::Array::redist(temp_array_undist_p, (*it)->getArray(), &rh,
ESMF_COMM_BLOCKING, NULL, NULL, ESMC_REGION_TOTAL);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc))
return rc;

localrc = temp_array_p->redistRelease(rh);
localrc = temp_array_undist_p->redistRelease(rh);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc))
return rc;
// std::cout << ESMC_METHOD << ": DE count > 1 - redistribute complete!" << std::endl;

// Cleanups
// std::cout << ESMC_METHOD << ": cleaning up" << std::endl;
localrc = ESMCI::Array::destroy(&temp_array_p);
localrc = ESMCI::Array::destroy(&temp_array_undist_p);
if (ESMC_LogDefault.MsgFoundError(localrc, ESMCI_ERR_PASSTHRU, ESMC_CONTEXT, &rc))
return rc;
}
Expand Down