diff --git a/base/CMakeLists.txt b/base/CMakeLists.txt index 43061d3ce143..b0c18e85c7ff 100644 --- a/base/CMakeLists.txt +++ b/base/CMakeLists.txt @@ -56,6 +56,7 @@ set (srcs MAPL_XYGridFactory.F90 MAPL_NetCDF.F90 Plain_netCDF_Time.F90 MAPL_DateTime_Parsing_ESMF.F90 MAPL_ObsUtil.F90 + MAPL_ESMF_InfoKeys.F90 # Orphaned program: should not be in this library. # tstqsat.F90 ) diff --git a/base/MAPL_ESMF_InfoKeys.F90 b/base/MAPL_ESMF_InfoKeys.F90 new file mode 100644 index 000000000000..38b798916373 --- /dev/null +++ b/base/MAPL_ESMF_InfoKeys.F90 @@ -0,0 +1,76 @@ +#include "MAPL_Exceptions.h" +module mapl3g_esmf_info_keys + + use MAPL_ErrorHandling + + implicit none + + public :: KEY_UNGRIDDED_DIMS + public :: KEY_VERT_DIM + public :: KEY_VERT_GEOM + public :: KEY_UNITS + public :: KEY_LONG_NAME + public :: KEY_STANDARD_NAME + public :: KEY_NUM_LEVELS + public :: KEY_VLOC + public :: KEY_NUM_UNGRID_DIMS + public :: KEYSTUB_DIM + public :: KEY_UNGRIDDED_NAME + public :: KEY_UNGRIDDED_UNITS + public :: KEY_UNGRIDDED_COORD + public :: KEY_DIM_STRINGS + public :: make_dim_key + private + + ! FieldSpec info keys + character(len=*), parameter :: PREFIX = 'MAPL/' + character(len=*), parameter :: KEY_UNGRIDDED_DIMS = PREFIX // 'ungridded_dims/' + character(len=*), parameter :: KEY_VERT_DIM = PREFIX // 'vertical_dim/' + character(len=*), parameter :: KEY_VERT_GEOM = PREFIX // 'vertical_geom/' + character(len=*), parameter :: KEY_UNITS = PREFIX // 'units' + character(len=*), parameter :: KEY_LONG_NAME = PREFIX // 'long_name' + character(len=*), parameter :: KEY_STANDARD_NAME = PREFIX // 'standard_name' + + ! VerticalGeom info keys + character(len=*), parameter :: KEY_NUM_LEVELS = KEY_VERT_GEOM // 'num_levels' + + ! VerticalDimSpec info keys + character(len=*), parameter :: KEY_VLOC = KEY_VERT_DIM // 'vloc' + + ! UngriddedDims info keys + character(len=*), parameter :: KEY_NUM_UNGRID_DIMS = KEY_UNGRIDDED_DIMS // 'num_ungridded_dimensions' + character(len=*), parameter :: KEYSTUB_DIM = KEY_UNGRIDDED_DIMS // 'dim_' + + ! UngriddedDim info keys + character(len=*), parameter :: KEY_UNGRIDDED_NAME = 'name' + character(len=*), parameter :: KEY_UNGRIDDED_UNITS = 'units' + 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'] + +contains + + function make_dim_key(n, rc) result(key) + character(len=:), allocatable :: key + integer, intent(in) :: n + integer, optional, intent(out) :: rc + integer :: status + character(len=32) :: raw + + key = '' + _ASSERT(n > 0, 'Index must be positive.') + if(n <= size(KEY_DIM_STRINGS)) then + key = KEY_DIM_STRINGS(n) + _RETURN(_SUCCESS) + end if + write(raw, fmt='(I0)', iostat=status) n + _ASSERT(status == 0, 'Write failed') + key = KEYSTUB_DIM // trim(raw) + _RETURN(_SUCCESS) + + end function make_dim_key + +end module mapl3g_esmf_info_keys diff --git a/generic3g/specs/UngriddedDim.F90 b/generic3g/specs/UngriddedDim.F90 index e74713fc3773..4fdf1442f5fd 100644 --- a/generic3g/specs/UngriddedDim.F90 +++ b/generic3g/specs/UngriddedDim.F90 @@ -28,6 +28,7 @@ module mapl3g_UngriddedDim interface UngriddedDim module procedure new_UngriddedDim_extent + module procedure new_UngriddedDim_name_and_extent module procedure new_UngriddedDim_name_and_coords module procedure new_UngriddedDim_name_units_and_coords end interface UngriddedDim @@ -42,7 +43,6 @@ module mapl3g_UngriddedDim character(*), parameter :: UNKNOWN_DIM_NAME = 'NONE' character(*), parameter :: UNKNOWN_DIM_UNITS = 'NONE' - contains @@ -66,13 +66,19 @@ pure function new_UngriddedDim_name_and_coords(name, coordinates) result(spec) end function new_UngriddedDim_name_and_coords + pure function new_UngriddedDim_name_and_extent(name, extent) result(spec) + character(*), intent(in) :: name + integer, intent(in) :: extent + type(UngriddedDim) :: spec + spec = UngriddedDim(name, default_coords(extent)) + end function new_UngriddedDim_name_and_extent + pure function new_UngriddedDim_extent(extent) result(spec) integer, intent(in) :: extent type(UngriddedDim) :: spec spec = UngriddedDim(UNKNOWN_DIM_NAME, default_coords(extent)) end function new_UngriddedDim_extent - pure function default_coords(extent, lbound) result(coords) real, allocatable :: coords(:) integer, intent(in) :: extent diff --git a/gridcomps/History3G/CMakeLists.txt b/gridcomps/History3G/CMakeLists.txt index 94c01dc49788..8e9a2e70a79a 100644 --- a/gridcomps/History3G/CMakeLists.txt +++ b/gridcomps/History3G/CMakeLists.txt @@ -5,7 +5,8 @@ set(srcs HistoryGridComp.F90 HistoryCollectionGridComp.F90 HistoryCollectionGridComp_private.F90 - ) + OutputInfo.F90 + ) find_package (MPI REQUIRED) diff --git a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 index d32d0d88f352..b2459de21485 100644 --- a/gridcomps/History3G/HistoryCollectionGridComp_private.F90 +++ b/gridcomps/History3G/HistoryCollectionGridComp_private.F90 @@ -10,6 +10,9 @@ module mapl3g_HistoryCollectionGridComp_private use MAPL_NewArthParserMod, only: parser_variables_in_expression use MAPL_TimeStringConversion use MAPL_BaseMod, only: MAPL_UnpackTime + use mapl3g_output_info, only: get_num_levels, get_vertical_dim_spec_names + use mapl3g_output_info, only: get_vertical_dim_spec_name, get_ungridded_dims + use gFTL2_StringSet implicit none private @@ -62,7 +65,12 @@ subroutine register_imports(gridcomp, hconfig, rc) type(StringVector) :: variable_names integer :: status - var_list = ESMF_HConfigCreateAt(hconfig, keystring=VAR_LIST_KEY, _RC) + var_list = ESMF_HConfigCreateAt(hconfig, keystring=VAR_LIST_KEY, rc=status) + if(status==ESMF_RC_NOT_FOUND) then + _FAIL(VAR_LIST_KEY // ' was not found.') + end if + _VERIFY(status) + iter_begin = ESMF_HConfigIterBegin(var_list,_RC) iter_end = ESMF_HConfigIterEnd(var_list,_RC) iter = iter_begin diff --git a/gridcomps/History3G/OutputInfo.F90 b/gridcomps/History3G/OutputInfo.F90 new file mode 100644 index 000000000000..cf83feb162f0 --- /dev/null +++ b/gridcomps/History3G/OutputInfo.F90 @@ -0,0 +1,344 @@ +#include "MAPL_Generic.h" +module mapl3g_output_info + + use mapl3g_UngriddedDim + use mapl3g_UngriddedDimVector + use mapl3g_UngriddedDims + use mapl3g_esmf_info_keys + use gFTL2_StringVector + use esmf, only: ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + use esmf, only: ESMF_Info, ESMF_InfoIsPresent + use esmf, only: ESMF_InfoDestroy, ESMF_InfoCreate + use esmf, only: ESMF_InfoGet, ESMF_InfoGetFromHost + use esmf, only: ESMF_InfoGetAlloc, ESMF_InfoGetCharAlloc + use esmf, only: ESMF_InfoPrint + use Mapl_ErrorHandling + + implicit none + + private + + public :: get_num_levels + public :: get_vertical_dim_spec_names + public :: get_vertical_dim_spec_name + public :: get_ungridded_dims + public :: get_num_levels_bundle_info + public :: get_vertical_dim_spec_names_bundle_info + public :: get_ungridded_dims_bundle_info + + interface get_num_levels + module procedure :: get_num_levels_bundle + module procedure :: get_num_levels_field + end interface get_num_levels + + interface get_vertical_dim_spec_names + module procedure :: get_vertical_dim_spec_names_bundle + end interface get_vertical_dim_spec_names + + interface get_vertical_dim_spec_name + module procedure :: get_vertical_dim_spec_name_field + end interface get_vertical_dim_spec_name + + interface get_ungridded_dims + module procedure :: get_ungridded_dims_bundle + module procedure :: get_ungridded_dims_field + end interface get_ungridded_dims + +contains + + integer function get_num_levels_bundle(bundle, rc) result(num) + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info), allocatable :: info(:) + + info = create_bundle_info(bundle, _RC) + num = get_num_levels_bundle_info(info, _RC) + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) + + end function get_num_levels_bundle + + integer function get_num_levels_bundle_info(info, rc) result(num) + type(ESMF_Info), intent(in) :: info(:) + integer, optional, intent(out) :: rc + integer :: status + integer :: i, n + + num = get_num_levels_info(info(1), _RC) + do i=2, size(info) + n = get_num_levels_info(info(i), _RC) + _ASSERT(n == num, 'All fields must have the same number of vertical levels.') + end do + _RETURN(_SUCCESS) + + end function get_num_levels_bundle_info + + integer function get_num_levels_field(field, rc) result(num) + type(ESMF_Field), intent(in) :: field + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: info + + call ESMF_InfoGetFromHost(field, info, _RC) + num = get_num_levels_info(info, _RC) + call ESMF_InfoDestroy(info, _RC) + _RETURN(_SUCCESS) + + end function get_num_levels_field + + integer function get_num_levels_info(info, rc) result(num) + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + logical :: key_present + + num = 0 + key_present = ESMF_InfoIsPresent(info, key=KEY_NUM_LEVELS, _RC) + if(key_present) then + call ESMF_InfoGet(info, key=KEY_NUM_LEVELS, value=num, _RC) + end if + _RETURN(_SUCCESS) + + end function get_num_levels_info + + function get_vertical_dim_spec_names_bundle(bundle, rc) result(names) + type(StringVector) :: names + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info), allocatable :: info(:) + + info = create_bundle_info(bundle, _RC) + names = get_vertical_dim_spec_names_bundle_info(info, _RC) + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) + + end function get_vertical_dim_spec_names_bundle + + function get_vertical_dim_spec_names_bundle_info(info, rc) result(names) + type(StringVector) :: names + type(ESMF_Info), intent(in) :: info(:) + integer, optional, intent(out) :: rc + integer :: status + integer :: i + character(len=:), allocatable :: name + + names = StringVector() + do i=1, size(info) + name = get_vertical_dim_spec_info(info(i), _RC) + if(find_index(names, name) == 0) call names%push_back(name) + end do + _RETURN(_SUCCESS) + + end function get_vertical_dim_spec_names_bundle_info + + function get_vertical_dim_spec_name_field(field, rc) result(spec_name) + character(len=:), allocatable :: spec_name + type(ESMF_Field), intent(inout) :: field + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: info + + call ESMF_InfoGetFromHost(field, info, _RC) + spec_name = get_vertical_dim_spec_info(info, _RC) + call ESMF_InfoDestroy(info, _RC) + _RETURN(_SUCCESS) + + end function get_vertical_dim_spec_name_field + + function get_vertical_dim_spec_info(info, rc) result(spec_name) + character(len=:), allocatable :: spec_name + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + integer :: n + + spec_name = '' + n = get_num_levels_info(info, _RC) + _RETURN_UNLESS(n > 0) + call ESMF_InfoGetCharAlloc(info, key=KEY_VLOC, value=spec_name, _RC) + _RETURN(_SUCCESS) + + end function get_vertical_dim_spec_info + + function get_ungridded_dims_bundle(bundle, rc) result(dims) + type(UngriddedDims) :: dims + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info), allocatable :: info(:) + type(UngriddedDimVector) :: vec + + info = create_bundle_info(bundle, _RC) + vec = get_ungridded_dims_bundle_info(info, _RC) + dims = UngriddedDims(vec) + call destroy_bundle_info(info, _RC) + _RETURN(_SUCCESS) + + end function get_ungridded_dims_bundle + + function get_ungridded_dims_bundle_info(info, rc) result(vec) + type(UngriddedDimVector) :: vec + type(ESMF_Info), intent(in) :: info(:) + integer, optional, intent(out) :: rc + integer :: status + integer :: i + type(UngriddedDims) :: dims + + do i=1, size(info) + dims = make_ungridded_dims(info(i), _RC) + call push_ungridded_dims(vec, dims, rc) + end do + _RETURN(_SUCCESS) + + end function get_ungridded_dims_bundle_info + + function get_ungridded_dims_field(field, rc) result(ungridded) + type(UngriddedDims) :: ungridded + type(ESMF_Field), intent(inout) :: field + integer, optional, intent(out) :: rc + integer :: status + type(ESMF_Info) :: info + + call ESMF_InfoGetFromHost(field, info, _RC) + ungridded = make_ungridded_dims(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 ESMF_InfoGet(info, key=KEY_NUM_UNGRID_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) + type(UngriddedDim) :: make_ungridded_dim + integer, intent(in) :: n + type(ESMF_Info), intent(in) :: info + integer, optional, intent(out) :: rc + integer :: status + character(len=:), allocatable :: key + type(ESMF_Info) :: dim_info + 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) + end if + _ASSERT(is_present, 'Key ' // key // ' not found in ' // trim(json_repr)) + dim_info = ESMF_InfoCreate(info, key=key, _RC) + call ESMF_InfoGetCharAlloc(dim_info, key=KEY_UNGRIDDED_NAME, value=name, _RC) + call ESMF_InfoGetCharAlloc(dim_info, key=KEY_UNGRIDDED_UNITS, value=units, _RC) + call ESMF_InfoGetAlloc(dim_info, key=KEY_UNGRIDDED_COORD, values=coordinates, _RC) + call ESMF_InfoDestroy(dim_info, _RC) + make_ungridded_dim = UngriddedDim(name, units, coordinates) + _RETURN(_SUCCESS) + + end function make_ungridded_dim + + subroutine push_ungridded_dims(vec, dims, rc) + class(UngriddedDimVector), intent(inout) :: vec + class(UngriddedDims), intent(in) :: dims + integer, optional, intent(out) :: rc + integer :: status + integer :: i + + do i = 1, dims%get_num_ungridded() + call check_duplicate(vec, dims%get_ith_dim_spec(i), _RC) + call vec%push_back(dims%get_ith_dim_spec(i), _RC) + end do + _RETURN(_SUCCESS) + + end subroutine push_ungridded_dims + + integer function find_index(v, name) result(i) + class(StringVector), intent(in) :: v + character(len=*), intent(in) :: name + type(StringVectorIterator) :: iter + + i = 0 + iter = v%begin() + do while (iter /= v%end()) + i = i+1 + if(iter%of() == name) return + call iter%next() + end do + i = 0 + + end function find_index + + subroutine check_duplicate(vec, udim, rc) + class(UngriddedDimVector), intent(in) :: vec + class(UngriddedDim), intent(in) :: udim + integer, optional, intent(out) :: rc + integer :: status + type(UngriddedDimVectorIterator) :: iter + type(UngriddedDim) :: vdim + + iter = vec%ftn_begin() + do while(iter < vec%ftn_end()) + call iter%next() + vdim = iter%of() + if(udim%get_name() /= vdim%get_name()) cycle + _ASSERT(udim == vdim, 'UngriddedDim mismatch.') + end do + + _RETURN(_SUCCESS) + + end subroutine check_duplicate + + function create_bundle_info(bundle, rc) result(bundle_info) + type(ESMF_Info), allocatable :: bundle_info(:) + type(ESMF_FieldBundle), intent(in) :: bundle + integer, optional, intent(out) :: rc + integer :: status + integer :: field_count, i + type(ESMF_Field) :: field + type(ESMF_Field), allocatable :: fields(:) + type(ESMF_Info) :: info + + status = 0 + call ESMF_FieldBundleGet(bundle, fieldCount=field_count, _RC) + _ASSERT(field_count > 0, 'Empty bundle') + allocate(fields(field_count)) + call ESMF_FieldBundleGet(bundle, fieldList=fields, _RC) + allocate(bundle_info(field_count)) + do i=1, field_count + call ESMF_InfoGetFromHost(field, info, _RC) + bundle_info(i) = info + end do + _RETURN(_SUCCESS) + + end function create_bundle_info + + subroutine destroy_bundle_info(bundle_info, rc) + type(ESMF_Info), intent(inout) :: bundle_info(:) + integer, optional, intent(out) :: rc + integer :: status, i + + do i=1, size(bundle_info) + call ESMF_InfoDestroy(bundle_info(i), _RC) + end do + _RETURN(_SUCCESS) + + end subroutine destroy_bundle_info + +end module mapl3g_output_info diff --git a/gridcomps/History3G/tests/CMakeLists.txt b/gridcomps/History3G/tests/CMakeLists.txt index 439f98730b52..431cdc92d582 100644 --- a/gridcomps/History3G/tests/CMakeLists.txt +++ b/gridcomps/History3G/tests/CMakeLists.txt @@ -3,9 +3,9 @@ set(MODULE_DIRECTORY "${esma_include}/MAPL.history3g.tests") set (test_srcs Test_HistoryGridComp.pf Test_HistoryCollectionGridComp.pf + Test_OutputInfo.pf ) - add_pfunit_ctest(MAPL.history3g.tests TEST_SOURCES ${test_srcs} LINK_LIBRARIES MAPL.history3g MAPL.pfunit diff --git a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf index 1fe898c88388..225ca92fa402 100644 --- a/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf +++ b/gridcomps/History3G/tests/Test_HistoryCollectionGridComp.pf @@ -7,6 +7,7 @@ module Test_HistoryCollectionGridComp use mapl3g_HistoryCollectionGridComp_private use esmf use gFTL2_StringVector + implicit none contains @@ -77,7 +78,6 @@ contains call ESMF_GridDestroy(grid, nogarbage=.true., _RC) call ESMF_GeomDestroy(geom, _RC) - end subroutine test_create_output_bundle @Test diff --git a/gridcomps/History3G/tests/Test_OutputInfo.pf b/gridcomps/History3G/tests/Test_OutputInfo.pf new file mode 100644 index 000000000000..3e8ca30b8fcc --- /dev/null +++ b/gridcomps/History3G/tests/Test_OutputInfo.pf @@ -0,0 +1,253 @@ +#if defined SET_RC +# undef SET_RC +#endif +#define SET_RC(A) if(present(rc)) rc = A +#define _SUCCESS 0 +#define _FAILURE _SUCCESS-1 +#include "MAPL_TestErr.h" +module Test_OutputInfo + use mapl3g_output_info + use mapl3g_esmf_info_keys + use mapl3g_UngriddedDim + use mapl3g_UngriddedDimVector + use pfunit + use esmf + use gFTL2_StringVector + + implicit none + + integer, parameter :: NUM_FIELDS_DEFAULT = 2 + integer, parameter :: NUM_LEVELS_DEFAULT = 3 + character(len=*), parameter :: VLOC_DEFAULT = 'VERTICAL_DIM_CENTER' + integer, parameter :: NUM_UNGRIDDED_DEFAULT = 3 + character(len=*), parameter :: NAME_DEFAULT = 'A1' + character(len=*), parameter :: UNITS_DEFAULT = 'stones' + real, parameter :: COORDINATES_DEFAULT(*) = [2.0, 2.4, 2.5] + + type(ESMF_Info), allocatable :: bundle_info(:) + +contains + + @Test + subroutine test_get_num_levels() + integer :: status + integer, parameter :: EXPECTED_NUM_LEVELS = 3 + integer :: num_levels + integer :: i + + call safe_dealloc(bundle_info) + allocate(bundle_info(2)) + do i=1, size(bundle_info) + bundle_info(i) = make_esmf_info(num_levels=EXPECTED_NUM_LEVELS, _RC) + end do + num_levels = get_num_levels_bundle_info(bundle_info, _RC) + @assertEqual(EXPECTED_NUM_LEVELS, num_levels, 'num_levels does not match.') + + call safe_dealloc(bundle_info) + + end subroutine test_get_num_levels + + @Test + subroutine test_get_vertical_dim_spec_names() + integer :: status + character(len=*), parameter :: EXPECTED_NAME_1 = 'VERTICAL_DIM_CENTER' + character(len=*), parameter :: EXPECTED_NAME_2 = 'VERTICAL_DIM_EDGE' + type(StringVector), allocatable :: names + integer :: sz + + call safe_dealloc(bundle_info) + allocate(bundle_info(3)) + bundle_info(1) = make_esmf_info(vloc=EXPECTED_NAME_1, _RC) + bundle_info(2) = make_esmf_info(vloc=EXPECTED_NAME_2, _RC) + bundle_info(3) = make_esmf_info(vloc=EXPECTED_NAME_1, _RC) + names = get_vertical_dim_spec_names_bundle_info(bundle_info, _RC) + sz = names%size() + @assertEqual(2, sz, 'There should only be two unique vertical_dim_spec names.') + @assertEqual(EXPECTED_NAME_1, names%at(1), 'vertical_dim_spec_name 1 does not match.') + @assertEqual(EXPECTED_NAME_2, names%at(2), 'vertical_dim_spec_name 2 does not match.') + call safe_dealloc(bundle_info) + + end subroutine test_get_vertical_dim_spec_names + + @Test + subroutine test_get_ungridded_dims() + integer :: status + integer :: i + integer, parameter :: N = 2 + integer, parameter :: D = 3 + character(len=*), parameter :: EXPECTED_NAMES(N) = ['color', 'phase'] + character(len=*), parameter :: EXPECTED_UNITS(N) = ['K ', 'rad'] + real, parameter :: REAL_ARRAY(D) = [1.0, 2.0, 3.0] + real :: EXPECTED_COORDINATES(N, D) + character(len=:), allocatable :: name + character(len=:), allocatable :: units + real, allocatable :: coordinates(:) + type(UngriddedDimVector) :: vec + type(UngriddedDim) :: undim + + call safe_dealloc(bundle_info) + + do i=1, N + EXPECTED_COORDINATES(i,:) = REAL_ARRAY + end do + + allocate(bundle_info(N)) + do i=1, N + bundle_info(i) = make_esmf_info(names=EXPECTED_NAMES, units_array=EXPECTED_UNITS, coordinates=EXPECTED_COORDINATES, _RC) + end do + vec = get_ungridded_dims_bundle_info(bundle_info, _RC) + do i=1, N + undim = vec%at(i) + name = undim%get_name() + @assertEqual(EXPECTED_NAMES(i), name, 'ungridded dimension name does not match.') + units = undim%get_units() + @assertEqual(EXPECTED_UNITS(i), units, 'ungridded dimension units does not match.') + coordinates = undim%get_coordinates() + @assertEqual(EXPECTED_COORDINATES(i, :), coordinates, 0.01, 'ungridded dimensions coordinates does not match.') + end do + call safe_dealloc(bundle_info) + + end subroutine test_get_ungridded_dims + + function make_esmf_info(num_levels, vloc, num_ungridded, names, units_array, coordinates, rc) & + result(info) + type(ESMF_Info) :: info + integer, optional, intent(in) :: num_levels + character(len=*), optional, intent(in) :: vloc + integer, optional, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + real, optional, intent(in) :: coordinates(:, :) + integer, optional, intent(out) :: rc + integer :: status + integer :: num_levels_, num_ungridded_ + character(len=:), allocatable :: vloc_ + + num_ungridded_ = -1 + num_levels_ = NUM_LEVELS_DEFAULT + if(present(num_levels)) num_levels_ = num_levels + vloc_ = VLOC_DEFAULT + if(present(vloc)) vloc_ = vloc + info = ESMF_InfoCreate(_RC) + call make_vertical_dim(info, vloc_, _RC) + call make_vertical_geom(info, num_levels_, _RC) + + SET_RC(status) + + if(present(names) .and. present(units_array)) then + if(size(names) /= size(units_array)) return + num_ungridded_ = size(names) + end if + if(present(num_ungridded)) then + if((num_ungridded_ >= 0) .and. (num_ungridded /= num_ungridded)) return + num_ungridded_ = num_ungridded + end if + call make_ungridded_dims_info(info, num_ungridded_, names, units_array, coordinates, _RC) + SET_RC(status) + + end function make_esmf_info + + subroutine make_vertical_dim(info, vloc, rc) + type(ESMF_Info), intent(inout) :: info + character(len=*), intent(in) :: vloc + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, KEY_VLOC, vloc, _RC) + SET_RC(status) + + end subroutine make_vertical_dim + + subroutine make_vertical_geom(info, num_levels, rc) + type(ESMF_Info), intent(inout) :: info + integer, intent(in) :: num_levels + integer, optional, intent(out) :: rc + integer :: status + + call ESMF_InfoSet(info, KEY_NUM_LEVELS, num_levels, _RC) + SET_RC(status) + + end subroutine make_vertical_geom + + subroutine make_ungridded_dims_info(info, num_ungridded, names, units_array, coordinates, rc) + type(ESMF_Info), intent(inout) :: info + integer, intent(in) :: num_ungridded + character(len=*), optional, intent(in) :: names(:) + character(len=*), optional, intent(in) :: units_array(:) + real, optional, intent(in) :: coordinates(:, :) + integer, optional, intent(out) :: rc + integer :: status, i + character(len=:), allocatable :: names_(:), units_(:) + real, allocatable :: coordinates_(:, :) + character(len=:), allocatable :: key + character(len=:), allocatable :: name, units + real, allocatable :: coord(:) + + if(present(rc)) rc = -1 + + allocate(character(len=len(NAME_DEFAULT)) :: names_(num_ungridded)) + names_ = NAME_DEFAULT + if(present(names)) then + if(size(names) /= num_ungridded) return + names_ = names + end if + + allocate(character(len=len(UNITS_DEFAULT)) :: units_(num_ungridded)) + units_ = UNITS_DEFAULT + if(present(units_array)) then + if(size(units_array) /= num_ungridded) return + units_ = units_array + end if + + allocate(coordinates_(num_ungridded, size(COORDINATES_DEFAULT))) + do i=1, num_ungridded + coordinates_(i, :) = COORDINATES_DEFAULT + end do + + if(present(rc)) rc = -1 + if(present(coordinates)) then + if(size(coordinates, 1) /= num_ungridded) return + if(allocated(coordinates_)) deallocate(coordinates_) + coordinates_ = coordinates + end if + + call ESMF_InfoSet(info, KEY_NUM_UNGRID_DIMS, num_ungridded, _RC) + + do i=1, num_ungridded + key = make_dim_key(i, _RC) + name = names_(i) + units = units_(i) + coord = coordinates_(i, :) + call ESMF_InfoSet(info, key // '/' // KEY_UNGRIDDED_NAME, name, _RC) + call ESMF_InfoSet(info, key // '/' // KEY_UNGRIDDED_UNITS, units, _RC) + call ESMF_InfoSet(info, key // '/' // KEY_UNGRIDDED_COORD, coord, _RC) + end do + + SET_RC(status) + + end subroutine make_ungridded_dims_info + + subroutine destroy_all(info) + type(ESMF_Info), allocatable, intent(inout) :: info(:) + integer :: i + + do i = 1, size(info) + call ESMF_InfoDestroy(info(i)) + end do + + end subroutine destroy_all + + subroutine deallocate_destroy(info) + type(ESMF_Info), allocatable, intent(inout) :: info(:) + + call destroy_all(info) + deallocate(info) + + end subroutine deallocate_destroy + + subroutine safe_dealloc(info) + type(ESMF_Info), allocatable, intent(inout) :: info(:) + if(allocated(info)) call deallocate_destroy(info) + end subroutine safe_dealloc + +end module Test_OutputInfo