-
Notifications
You must be signed in to change notification settings - Fork 19
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #3045 from GEOS-ESM/feature/wdboggs/#3021_condense…
…d_array Get array size of a condensed rank-3 array pointer formed from ESMF_Field Fortran pointer
- Loading branch information
Showing
18 changed files
with
543 additions
and
198 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,25 @@ | ||
| set(MODULE_DIRECTORY "${esma_include}/MAPL.esmf_utils.tests") | ||
|
|
||
| set (test_srcs | ||
| Test_FieldDimensionInfo.pf | ||
| ) | ||
|
|
||
| add_pfunit_ctest(MAPL.esmf_utils.tests | ||
| TEST_SOURCES ${test_srcs} | ||
| LINK_LIBRARIES MAPL.esmf_utils MAPL.pfunit | ||
| EXTRA_INITIALIZE Initialize | ||
| EXTRA_USE MAPL_pFUnit_Initialize | ||
| WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} | ||
| MAX_PES 1 | ||
| ) | ||
| set_target_properties(MAPL.esmf_utils.tests PROPERTIES Fortran_MODULE_DIRECTORY ${MODULE_DIRECTORY}) | ||
| set_tests_properties(MAPL.esmf_utils.tests PROPERTIES LABELS "ESSENTIAL") | ||
|
|
||
| if (APPLE) | ||
| set(LD_PATH "DYLD_LIBRARY_PATH") | ||
| else() | ||
| set(LD_PATH "LD_LIBRARY_PATH") | ||
| endif () | ||
| set_property(TEST MAPL.esmf_utils.tests PROPERTY ENVIRONMENT "${LD_PATH}=${CMAKE_CURRENT_BINARY_DIR}/esmf_utils:$ENV{${LD_PATH}}") | ||
|
|
||
| add_dependencies(build-tests MAPL.esmf_utils.tests) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,72 @@ | ||
| #include "MAPL_Generic.h" | ||
| module mapl3g_FieldCondensedArray | ||
| use, intrinsic :: iso_c_binding, only: c_ptr, c_f_pointer | ||
| use mapl3g_FieldCondensedArray_private, only: ARRAY_RANK, get_shape => get_fptr_shape | ||
| use mapl3g_FieldDimensionInfo, only: get_vertical_dim_spec_name | ||
| use MAPL_FieldPointerUtilities, only: FieldGetLocalElementCount, assign_fptr | ||
| use MAPL_ExceptionHandling | ||
| use ESMF, only: ESMF_Field, ESMF_FieldGet | ||
| use ESMF, only: ESMF_KIND_R4, ESMF_KIND_R8, ESMF_KIND_I8 | ||
|
|
||
| implicit none | ||
| private | ||
| public :: assign_fptr_condensed_array | ||
|
|
||
| interface assign_fptr_condensed_array | ||
| module procedure :: assign_fptr_condensed_array_r4 | ||
| module procedure :: assign_fptr_condensed_array_r8 | ||
| end interface assign_fptr_condensed_array | ||
|
|
||
| contains | ||
|
|
||
| subroutine assign_fptr_condensed_array_r4(x, fptr, rc) | ||
| type(ESMF_Field), intent(inout) :: x | ||
| real(kind=ESMF_KIND_R4), pointer, intent(out) :: fptr(:,:,:) | ||
| integer, optional, intent(out) :: rc | ||
| integer(ESMF_KIND_I8) :: fp_shape(ARRAY_RANK) | ||
| integer :: status | ||
|
|
||
| fp_shape = get_fptr_shape(x, _RC) | ||
| call assign_fptr(x, fp_shape, fptr, _RC) | ||
| _RETURN(_SUCCESS) | ||
|
|
||
| end subroutine assign_fptr_condensed_array_r4 | ||
|
|
||
| subroutine assign_fptr_condensed_array_r8(x, fptr, rc) | ||
| type(ESMF_Field), intent(inout) :: x | ||
| real(kind=ESMF_KIND_R8), pointer, intent(out) :: fptr(:,:,:) | ||
| integer, optional, intent(out) :: rc | ||
| integer(ESMF_KIND_I8) :: fp_shape(ARRAY_RANK) | ||
| integer :: status | ||
|
|
||
| fp_shape = get_fptr_shape(x, _RC) | ||
| call assign_fptr(x, fp_shape, fptr, _RC) | ||
| _RETURN(_SUCCESS) | ||
|
|
||
| end subroutine assign_fptr_condensed_array_r8 | ||
|
|
||
| function get_fptr_shape(f, rc) result(fptr_shape) | ||
| integer :: fptr_shape(ARRAY_RANK) | ||
| type(ESMF_Field), intent(inout) :: f | ||
| integer, optional, intent(out) :: rc | ||
| integer :: status | ||
| integer :: rank | ||
| integer, allocatable :: gridToFieldMap(:) | ||
| integer, allocatable :: localElementCount(:) | ||
| logical :: has_vertical | ||
| character(len=:), allocatable :: spec_name | ||
| character(len=*), parameter :: VERTICAL_DIM_NONE_NAME = 'VERTICAL_DIM_NONE' | ||
|
|
||
| call ESMF_FieldGet(f, gridToFieldMap=gridToFieldMap, _RC) | ||
| call ESMF_FieldGet(f, rank=rank, _RC) | ||
| allocate(localElementCount(rank)) | ||
| ! Due to an ESMF bug, getting the localElementCount must use the module function. | ||
| ! See FieldGetLocalElementCount (specific function) comments. | ||
| localElementCount = FieldGetLocalElementCount(f, _RC) | ||
| spec_name = get_vertical_dim_spec_name(f, _RC) | ||
| has_vertical = spec_name /= VERTICAL_DIM_NONE_NAME | ||
| fptr_shape = get_shape(gridToFieldMap, localElementCount, has_vertical, _RC) | ||
|
|
||
| end function get_fptr_shape | ||
|
|
||
| end module mapl3g_FieldCondensedArray |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,44 @@ | ||
| #include "MAPL_Generic.h" | ||
| module mapl3g_FieldCondensedArray_private | ||
|
|
||
| use MAPL_ExceptionHandling | ||
| implicit none | ||
|
|
||
| private | ||
| public :: get_fptr_shape, ARRAY_RANK | ||
|
|
||
| integer, parameter :: ARRAY_RANK = 3 | ||
|
|
||
| contains | ||
|
|
||
| function get_fptr_shape(gridToFieldMap, localElementCount, has_vertical, rc) & | ||
| &result(fptr_shape) | ||
| integer :: fptr_shape(ARRAY_RANK) | ||
| integer, intent(in) :: gridToFieldMap(:) | ||
| integer, intent(in) :: localElementCount(:) | ||
| logical, intent(in) :: has_vertical | ||
| integer, optional, intent(out) :: rc | ||
| integer :: rank, i | ||
| integer, allocatable :: grid_dims(:) | ||
| integer, allocatable :: ungridded_dims(:) | ||
| integer :: horz_size, vert_size, ungridded_size | ||
| integer :: vert_dim | ||
|
|
||
| vert_dim = 0 | ||
| vert_size = 1 | ||
|
|
||
| rank = size(localElementCount) | ||
| grid_dims = pack(gridToFieldMap, gridToFieldMap /= 0) | ||
| _ASSERT(all(grid_dims <= size(grid_dims)), 'MAPL expects geom dims before ungridded.') | ||
| if(has_vertical) vert_dim = 1 | ||
| if(size(grid_dims) > 0) vert_dim = maxval(grid_dims) + vert_dim | ||
| ungridded_dims = pack([(i,i=1,rank)], [(all([vert_dim, grid_dims] /= i), i=1, rank)]) | ||
| horz_size = product([(localElementCount(grid_dims(i)), i=1, size(grid_dims))]) | ||
| if(has_vertical) vert_size = localElementCount(vert_dim) | ||
| ungridded_size = product([(localElementCount(ungridded_dims(i)), i=1, size(ungridded_dims))]) | ||
| fptr_shape = [horz_size, vert_size, ungridded_size] | ||
| _RETURN(_SUCCESS) | ||
|
|
||
| end function get_fptr_shape | ||
|
|
||
| end module mapl3g_FieldCondensedArray_private |
Oops, something went wrong.