diff --git a/esmf_utils/FieldDimensionInfo.F90 b/esmf_utils/FieldDimensionInfo.F90 index af831dc61db..84d537e251c 100644 --- a/esmf_utils/FieldDimensionInfo.F90 +++ b/esmf_utils/FieldDimensionInfo.F90 @@ -12,7 +12,7 @@ module mapl3g_FieldDimensionInfo use esmf, only: ESMF_InfoPrint use Mapl_ErrorHandling - implicit none + implicit none (type, external) private @@ -183,8 +183,8 @@ function get_ungridded_dims_bundle_info(info, rc) result(vec) type(UngriddedDims) :: dims do i=1, size(info) - dims = make_ungridded_dims(info(i), _RC) - call push_ungridded_dims(vec, dims, rc) + dims = make_ungriddedDims(info(i), key=KEY_UNGRIDDED_DIMS, _RC) + call merge_ungridded_dims(vec, dims, rc) end do _RETURN(_SUCCESS) @@ -198,60 +198,14 @@ function get_ungridded_dims_field(field, rc) result(ungridded) type(ESMF_Info) :: info info = MAPL_InfoCreateFromInternal(field, _RC) - ungridded = make_ungridded_dims(info, _RC) + ungridded = make_UngriddedDims(info, key=KEY_UNGRIDDED_DIMS, _RC) call ESMF_InfoDestroy(info, _RC) _RETURN(_SUCCESS) end function get_ungridded_dims_field - function make_ungridded_dims(info, rc) result(dims) - type(UngriddedDims) :: dims - type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc - integer :: status - integer :: num_dims, i - type(UngriddedDim) :: ungridded - - call MAPL_InfoGet(info, key=KEY_NUM_UNGRIDDED_DIMS, value=num_dims, _RC) - do i=1, num_dims - ungridded = make_ungridded_dim(info, i, _RC) - call dims%add_dim(ungridded, _RC) - end do - _RETURN(_SUCCESS) - - end function make_ungridded_dims - - function make_ungridded_dim(info, n, rc) result(ungridded_dim) - type(UngriddedDim) :: ungridded_dim - integer, intent(in) :: n - type(ESMF_Info), intent(in) :: info - integer, optional, intent(out) :: rc - integer :: status - type(ESMF_Info) :: dim_info - character(len=:), allocatable :: key - character(len=:), allocatable :: name - character(len=:), allocatable :: units - real, allocatable :: coordinates(:) - logical :: is_present - character(len=1024) :: json_repr - - key = make_dim_key(n, _RC) - call ESMF_InfoGet(info, key=key, isPresent=is_present, _RC) - if(.not. is_present) then - call ESMF_InfoPrint(info, unit=json_repr, _RC) - _FAIL('Key ' // trim(key) // ' not found in ' // trim(json_repr)) - end if - dim_info = ESMF_InfoCreate(info, key=key, _RC) - call MAPL_InfoGet(dim_info, key=KEY_UNGRIDDED_NAME, value=name, _RC) - call MAPL_InfoGet(dim_info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) - call MAPL_InfoGet(dim_info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) - call ESMF_InfoDestroy(dim_info, _RC) - ungridded_dim = UngriddedDim(coordinates, name=name, units=units) - _RETURN(_SUCCESS) - - end function make_ungridded_dim - subroutine push_ungridded_dims(vec, dims, rc) + subroutine merge_ungridded_dims(vec, dims, rc) class(UngriddedDimVector), intent(inout) :: vec class(UngriddedDims), intent(in) :: dims integer, optional, intent(out) :: rc @@ -264,7 +218,7 @@ subroutine push_ungridded_dims(vec, dims, rc) end do _RETURN(_SUCCESS) - end subroutine push_ungridded_dims + end subroutine merge_ungridded_dims integer function find_index(v, name) result(i) class(StringVector), intent(in) :: v diff --git a/esmf_utils/UngriddedDim.F90 b/esmf_utils/UngriddedDim.F90 index 9e0bd65b9ae..27a26b27431 100644 --- a/esmf_utils/UngriddedDim.F90 +++ b/esmf_utils/UngriddedDim.F90 @@ -1,5 +1,6 @@ #include "MAPL_Generic.h" module mapl3g_UngriddedDim + use mapl3g_InfoUtilities use mapl3g_LU_Bound use mapl_ErrorHandling use esmf, only: ESMF_Info @@ -9,6 +10,7 @@ module mapl3g_UngriddedDim private public :: UngriddedDim + public :: make_ungriddedDim public :: operator(==) public :: operator(/=) @@ -166,4 +168,18 @@ function make_info(this, rc) result(info) _RETURN(_SUCCESS) end function make_info + function make_ungriddedDim(info, rc) result(dim) + type(UngriddedDim) :: dim + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + + call MAPL_InfoGet(info, key='name', value=dim%name, _RC) + call MAPL_InfoGet(info, key='units', value=dim%units, _RC) + call MAPL_InfoGet(info, key='coordinates', values=dim%coordinates, _RC) + + _RETURN(_SUCCESS) + end function make_ungriddedDim + end module mapl3g_UngriddedDim + diff --git a/esmf_utils/UngriddedDims.F90 b/esmf_utils/UngriddedDims.F90 index 1907b7f121d..100e4203e90 100644 --- a/esmf_utils/UngriddedDims.F90 +++ b/esmf_utils/UngriddedDims.F90 @@ -1,6 +1,8 @@ #include "MAPL_Generic.h" module mapl3g_UngriddedDims + use mapl3g_InfoUtilities + use mapl3g_ESMF_Info_Keys use mapl3g_UngriddedDimVector use mapl3g_UngriddedDim use mapl3g_LU_Bound @@ -14,6 +16,7 @@ module mapl3g_UngriddedDims private public :: UngriddedDims + public :: make_UngriddedDims public :: mirror_ungridded_dims public :: operator(==) public :: operator(/=) @@ -179,16 +182,16 @@ function make_info(this, rc) result(info) integer :: i type(UngriddedDim), pointer :: dim_spec type(ESMF_Info) :: dim_info - character(5) :: dim_key + character(:), allocatable :: dim_key info = ESMF_InfoCreate(_RC) - call ESMF_InfoSet(info, key='num_ungridded_dimensions', value=this%get_num_ungridded(), _RC) + call MAPL_InfoSet(info, key='num_ungridded_dimensions', value=this%get_num_ungridded(), _RC) do i = 1, this%get_num_ungridded() dim_spec => this%get_ith_dim_spec(i, _RC) dim_info = dim_spec%make_info(_RC) - write(dim_key, '("dim_", i0)') i + dim_key = make_dim_key(i) call ESMF_InfoSet(info, key=dim_key, value=dim_info, _RC) call ESMF_InfoDestroy(dim_info, _RC) end do @@ -197,5 +200,40 @@ function make_info(this, rc) result(info) _RETURN(_SUCCESS) end function make_info + function make_ungriddedDims(info, key, rc) result(ungridded_dims) + type(UngriddedDims) :: ungridded_dims + type(ESMF_Info), intent(in) :: info + character(*), optional, intent(in) :: key + integer, optional, intent(out) :: rc + + integer :: status + integer :: num_ungridded_dims + integer :: i + type(ESMF_Info) :: dim_info + character(:), allocatable :: dim_key + type(UngriddedDim), allocatable :: dim_specs(:) + character(:), allocatable :: full_key + + ungridded_dims = UngriddedDims() + full_key = KEY_NUM_UNGRIDDED_DIMS + if (present(key)) then + full_key = key // full_key + end if + + call MAPL_InfoGet(info, key=full_key, value=num_ungridded_dims, _RC) + allocate(dim_specs(num_ungridded_dims)) + + do i = 1, num_ungridded_dims + dim_key = make_dim_key(i, _RC) + dim_info = ESMF_InfoCreate(info, key=dim_key, _RC) + dim_specs(i) = make_ungriddedDim(dim_info, _RC) + call ESMF_InfoDestroy(dim_info, _RC) + end do + + ungridded_dims = UngriddedDims(dim_specs) + + _RETURN(_SUCCESS) + end function make_ungriddedDims + end module mapl3g_UngriddedDims diff --git a/esmf_utils/tests/CMakeLists.txt b/esmf_utils/tests/CMakeLists.txt index d14d9cab86e..6ed5da9859c 100644 --- a/esmf_utils/tests/CMakeLists.txt +++ b/esmf_utils/tests/CMakeLists.txt @@ -3,6 +3,7 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.esmf_utils.tests") set (test_srcs Test_FieldDimensionInfo.pf Test_InfoUtilities.pf + Test_Ungridded.pf ) add_pfunit_ctest(MAPL.esmf_utils.tests diff --git a/esmf_utils/tests/Test_FieldDimensionInfo.pf b/esmf_utils/tests/Test_FieldDimensionInfo.pf index 33bbcaed66c..cdbee53eb7c 100644 --- a/esmf_utils/tests/Test_FieldDimensionInfo.pf +++ b/esmf_utils/tests/Test_FieldDimensionInfo.pf @@ -209,7 +209,7 @@ contains coordinates_ = coordinates end if - call ESMF_InfoSet(info, KEY_NUM_UNGRIDDED_DIMS, num_ungridded, _RC) + call ESMF_InfoSet(info, KEY_UNGRIDDED_DIMS // KEY_NUM_UNGRIDDED_DIMS, num_ungridded, _RC) do i=1, num_ungridded key = make_dim_key(i, _RC) diff --git a/esmf_utils/tests/Test_Ungridded.pf b/esmf_utils/tests/Test_Ungridded.pf new file mode 100644 index 00000000000..93e83708d38 --- /dev/null +++ b/esmf_utils/tests/Test_Ungridded.pf @@ -0,0 +1,47 @@ +#include "MAPL_TestErr.h" + +module Test_Ungridded + use mapl3g_UngriddedDim + use mapl3g_UngriddedDims + use funit + use esmf + implicit none + +contains + + @test + subroutine test_make_ungridded_dim() + type(UngriddedDim) :: a, b + type(ESMF_Info) :: info + + integer :: status + + a = UngriddedDim(name='a', units='m', coordinates=[2.,3.,5.]) + info = a%make_info(_RC) + + b = make_UngriddedDim(info, _RC) + + @assert_that(a == b, is(true())) + + end subroutine test_make_ungridded_dim + + @test + subroutine test_make_ungridded_dims() + type(UngriddedDims) :: a, b + type(ESMF_Info) :: info + + integer :: status + + a = UngriddedDims() + call a%add_dim(UngriddedDim(name='a1', units='m', coordinates=[2.,3.,5.])) + call a%add_dim(UngriddedDim(name='a2', units='cm', extent=5)) + + info = a%make_info(_RC) + + b = make_UngriddedDims(info, _RC) + + @assert_that(a == b, is(true())) + + end subroutine test_make_ungridded_dims + +end module Test_Ungridded diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index 18a82a44c54..0f68d9185d1 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -281,39 +281,7 @@ subroutine create(this, rc) _RETURN(ESMF_SUCCESS) end subroutine create - subroutine MAPL_FieldEmptySet(field, geom, rc) - type(ESMF_Field), intent(inout) :: field - type(ESMF_Geom), intent(inout) :: geom - integer, optional, intent(out) ::rc - - type(ESMF_GeomType_Flag) :: geom_type - type(ESMF_Grid) :: grid - type(ESMF_Mesh) :: mesh - type(ESMF_XGrid) :: xgrid - type(ESMF_LocStream) :: locstream - integer :: status - - call ESMF_GeomGet(geom, geomtype=geom_type, _RC) - if(geom_type == ESMF_GEOMTYPE_GRID) then - call ESMF_GeomGet(geom, grid=grid, _RC) - call ESMF_FieldEmptySet(field, grid, _RC) - else if (geom_type == ESMF_GEOMTYPE_MESH) then - call ESMF_GeomGet(geom, mesh=mesh, _RC) - call ESMF_FieldEmptySet(field, mesh, _RC) - else if (geom_type == ESMF_GEOMTYPE_XGRID) then - call ESMF_GeomGet(geom, xgrid=xgrid, _RC) - call ESMF_FieldEmptySet(field, xgrid, _RC) - else if (geom_type == ESMF_GEOMTYPE_LOCSTREAM) then - call ESMF_GeomGet(geom, locstream=locstream, _RC) - call ESMF_FieldEmptySet(field, locstream, _RC) - else - _FAIL('Unsupported type of Geom') - end if - - _RETURN(ESMF_SUCCESS) - end subroutine MAPL_FieldEmptySet - - subroutine destroy(this, rc) + subroutine destroy(this, rc) class(FieldSpec), intent(inout) :: this integer, optional, intent(out) :: rc @@ -339,7 +307,7 @@ subroutine allocate(this, rc) call ESMF_FieldGet(this%payload, status=fstatus, _RC) _RETURN_IF(fstatus == ESMF_FIELDSTATUS_COMPLETE) - call MAPL_FieldEmptySet(this%payload, this%geom, _RC) + call ESMF_FieldEmptySet(this%payload, this%geom, _RC) bounds = get_ungridded_bounds(this, _RC) call ESMF_FieldEmptyComplete(this%payload, this%typekind, & diff --git a/shared/MAPL_ESMF_InfoKeys.F90 b/shared/MAPL_ESMF_InfoKeys.F90 index 3502b6f9f72..c77c2d29a87 100644 --- a/shared/MAPL_ESMF_InfoKeys.F90 +++ b/shared/MAPL_ESMF_InfoKeys.F90 @@ -45,8 +45,8 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEY_VLOC = KEY_VERT_DIM // '/vloc' ! UngriddedDims info keys - character(len=*), parameter :: KEY_NUM_UNGRIDDED_DIMS = KEY_UNGRIDDED_DIMS // '/num_ungridded_dimensions' - character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIMS // '/dim_' + character(len=*), parameter :: KEY_NUM_UNGRIDDED_DIMS = '/num_ungridded_dimensions' + character(len=*), parameter :: KEYSTUB_DIM = '/dim_' ! UngriddedDim info keys character(len=*), parameter :: KEY_UNGRIDDED_NAME = 'name' @@ -54,9 +54,9 @@ module mapl3g_esmf_info_keys character(len=*), parameter :: KEY_UNGRIDDED_COORD = 'coordinates' character(len=*), parameter :: KEY_DIM_STRINGS(9) = [ & - KEYSTUB_DIM // '/1', KEYSTUB_DIM // '/2', KEYSTUB_DIM // '/3', & - KEYSTUB_DIM // '/4', KEYSTUB_DIM // '/5', KEYSTUB_DIM // '/6', & - KEYSTUB_DIM // '/7', KEYSTUB_DIM // '/8', KEYSTUB_DIM // '/9'] + KEYSTUB_DIM // '1', KEYSTUB_DIM // '2', KEYSTUB_DIM // '3', & + KEYSTUB_DIM // '4', KEYSTUB_DIM // '5', KEYSTUB_DIM // '6', & + KEYSTUB_DIM // '7', KEYSTUB_DIM // '8', KEYSTUB_DIM // '9'] contains