diff --git a/components/lfric-xios/source/lfric_xios_read_mod.F90 b/components/lfric-xios/source/lfric_xios_read_mod.F90 index 456ce5f3d..639c49c82 100644 --- a/components/lfric-xios/source/lfric_xios_read_mod.F90 +++ b/components/lfric-xios/source/lfric_xios_read_mod.F90 @@ -15,7 +15,9 @@ module lfric_xios_read_mod use constants_mod, only: i_def, l_def, str_def, r_def, rmdi, & LARGE_DP_NEGATIVE use lfric_xios_constants_mod, only: dp_xios + use key_value_mod, only: abstract_value_type use io_value_mod, only: io_value_type + use integer_io_value_mod, only: integer_io_value_type use field_mod, only: field_type, field_proxy_type use field_real32_mod, only: field_real32_type, field_real32_proxy_type use field_real64_mod, only: field_real64_type, field_real64_proxy_type @@ -61,11 +63,18 @@ module lfric_xios_read_mod private public :: checkpoint_read_xios, & checkpoint_read_value, & + checkpoint_read_r_def_value, & + checkpoint_read_integer_value, & read_field_generic, & read_state, & read_checkpoint, & read_field_time_var + interface checkpoint_read_value + procedure :: checkpoint_read_r_def_value + procedure :: checkpoint_read_integer_value + end interface checkpoint_read_value + contains !> @brief I/O handler for reading an XIOS netcdf checkpoint @@ -112,17 +121,55 @@ subroutine checkpoint_read_xios(xios_field_name, file_name, field_proxy) end subroutine checkpoint_read_xios -!> @brief Read the data from an XIOS checkpoint file into the io_value +!> @brief Read r_def data from an XIOS checkpoint file into the io_value !> @param[in,out] io_value The io_value to read data into +!> @param[in] value_name The id defined in the XIOS context !> -subroutine checkpoint_read_value(io_value, value_name) +subroutine checkpoint_read_r_def_value(io_value, value_name) class(io_value_type), intent(inout) :: io_value character(*), optional, intent(in) :: value_name character(str_def) :: restart_id integer(i_def) :: array_dims integer(tik) :: timing_id + real(dp_xios), allocatable :: dp_equiv(:) + + if ( LPROF ) call start_timing(timing_id, 'lfric_xios.chkpt_readrv') + + if(present(value_name)) then + restart_id = trim(value_name) + else + restart_id = "restart_" // trim(io_value%io_id) + end if + array_dims = size(io_value%data) + + if ( xios_is_valid_field(trim(restart_id)) ) then + allocate(dp_equiv(array_dims)) + call xios_recv_field( trim(restart_id), & + dp_equiv(1:array_dims) ) + io_value%data = real(dp_equiv,r_def) + deallocate(dp_equiv) + else + call log_event( 'No XIOS field with id="'//trim(restart_id)//'" is defined', & + LOG_LEVEL_ERROR ) + end if + + if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.chkpt_readrv') + +end subroutine checkpoint_read_r_def_value + +!> @brief Read int data from an XIOS checkpoint file into the io_value +!> @param[in,out] io_value The io_value to read data into +!> @param[in] value_name The id defined in the XIOS context +!> +subroutine checkpoint_read_integer_value(io_value, value_name) + class(integer_io_value_type), intent(inout) :: io_value + character(*), optional, intent(in) :: value_name + character(str_def) :: restart_id + integer(i_def) :: array_dims + integer(tik) :: timing_id + real(dp_xios), allocatable :: dp_equiv(:) - if ( LPROF ) call start_timing(timing_id, 'lfric_xios.chkpt_readv') + if ( LPROF ) call start_timing(timing_id, 'lfric_xios.chkpt_readiv') if(present(value_name)) then restart_id = trim(value_name) @@ -132,15 +179,19 @@ subroutine checkpoint_read_value(io_value, value_name) array_dims = size(io_value%data) if ( xios_is_valid_field(trim(restart_id)) ) then + allocate(dp_equiv(array_dims)) call xios_recv_field( trim(restart_id), & - io_value%data(1:array_dims) ) + dp_equiv(1:array_dims) ) + io_value%data = int(dp_equiv,i_def) + deallocate(dp_equiv) else call log_event( 'No XIOS field with id="'//trim(restart_id)//'" is defined', & LOG_LEVEL_ERROR ) end if - if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.chkpt_readv') -end subroutine checkpoint_read_value + if ( LPROF ) call stop_timing(timing_id, 'lfric_xios.chkpt_readiv') + +end subroutine checkpoint_read_integer_value !> @brief Post-processing after reading field data !> @details Performs a halo swap if necessary diff --git a/components/lfric-xios/source/lfric_xios_write_mod.F90 b/components/lfric-xios/source/lfric_xios_write_mod.F90 index 634aefd1b..29d70e2d2 100644 --- a/components/lfric-xios/source/lfric_xios_write_mod.F90 +++ b/components/lfric-xios/source/lfric_xios_write_mod.F90 @@ -18,6 +18,7 @@ module lfric_xios_write_mod use field_real32_mod, only: field_real32_type, field_real32_proxy_type use field_real64_mod, only: field_real64_type, field_real64_proxy_type use io_value_mod, only: io_value_type + use integer_io_value_mod, only: integer_io_value_type use key_value_mod, only: key_value_type, abstract_key_value_type, & abstract_value_type use key_value_collection_mod, & @@ -67,39 +68,74 @@ module lfric_xios_write_mod write_field_generic, & write_empty_field, & checkpoint_write_value, & + checkpoint_write_r_def_value, & + checkpoint_write_integer_value, & write_value_generic, & write_state, & write_checkpoint, & create_checkpoint_list + interface checkpoint_write_value + procedure :: checkpoint_write_r_def_value + procedure :: checkpoint_write_integer_value + end interface checkpoint_write_value + contains !> @brief Write io_value data via XIOS !> @details This routine assumes there is a XIOS field defined !> with a field id the same as the io_value id -!> @param[in,out] io_value The io_value to write data from +!> @param[in] io_value The io_value to write data from +!> @param[in] value_name The id defined in the XIOS context !> subroutine write_value_generic(io_value, value_name) - class(io_value_type), intent(inout) :: io_value + class(abstract_value_type), intent(in) :: io_value character(*), optional, intent(in) :: value_name - integer(i_def) :: array_dims - character(:), allocatable :: value_id + integer(i_def) :: array_dims + character(:), allocatable :: value_id + real(dp_xios), allocatable :: dp_equiv(:) - if (present(value_name)) then - value_id = value_name - else - value_id = io_value%io_id - end if + select type(io_value) + type is (io_value_type) + if (present(value_name)) then + value_id = value_name + else + value_id = io_value%io_id + end if - array_dims = size(io_value%data) - if ( xios_is_valid_field(trim(value_id)) ) then - call xios_send_field( trim(value_id), & - reshape(io_value%data, (/ 1, array_dims /)) ) - else - call log_event( 'No XIOS field with id="'//trim(io_value%io_id)//'" is defined', & - LOG_LEVEL_ERROR ) - end if + array_dims = size(io_value%data) + if ( xios_is_valid_field(trim(value_id)) ) then + ! Support 32-bit and 64-bit input by converting to XIOS real kind + allocate(dp_equiv(array_dims)) + dp_equiv = real(io_value%data, dp_xios) + call xios_send_field( trim(value_id), & + reshape(dp_equiv, (/ 1, array_dims /)) ) + deallocate(dp_equiv) + else + call log_event( 'No XIOS field with id="'//trim(io_value%io_id)//'" is defined', & + LOG_LEVEL_ERROR ) + end if + type is (integer_io_value_type) + if (present(value_name)) then + value_id = value_name + else + value_id = io_value%io_id + end if + + array_dims = size(io_value%data) + if ( xios_is_valid_field(trim(value_id)) ) then + ! Integers must be converted to XIOS real kind + allocate(dp_equiv(array_dims)) + dp_equiv = real(io_value%data,dp_xios) + call xios_send_field( trim(value_id), & + reshape(dp_equiv, (/ 1, array_dims /)) ) + deallocate(dp_equiv) + else + call log_event( 'No XIOS field with id="'//trim(io_value%io_id)//'" is defined', & + LOG_LEVEL_ERROR ) + end if + end select end subroutine write_value_generic @@ -181,17 +217,52 @@ subroutine write_empty_field(field_name, field_proxy) end subroutine write_empty_field -!> @brief Checkpoint an io_value with XIOS +!> @brief Checkpoint an r_def io_value with XIOS +!> @details This routine assumes there is an XIOS field +!> with the "checkpoint_" prefix +!> @param[in] io_value The io_value to write data from +!> @param[in] value_name The id defined in the XIOS context +!> +subroutine checkpoint_write_r_def_value(io_value, value_name) + class(io_value_type), intent(in) :: io_value + character(*), optional, intent(in) :: value_name + + character(str_def) :: checkpoint_id + integer(i_def) :: array_dims + real(dp_xios), allocatable :: dp_equiv(:) + + if(present(value_name)) then + checkpoint_id = trim(value_name) + else + checkpoint_id = trim(io_value%io_id) + end if + array_dims = size(io_value%data) + if ( xios_is_valid_field(trim(checkpoint_id)) ) then + allocate(dp_equiv(array_dims)) + dp_equiv = real(io_value%data, dp_xios) + call xios_send_field( trim(checkpoint_id), & + reshape(dp_equiv, (/ 1, array_dims /)) ) + deallocate(dp_equiv) + else + call log_event( 'No XIOS field with id="'//trim(checkpoint_id)//'" is defined', & + LOG_LEVEL_ERROR ) + end if + +end subroutine checkpoint_write_r_def_value + +!> @brief Checkpoint an integer io_value with XIOS !> @details This routine assumes there is an XIOS field !> with the "checkpoint_" prefix -!> @param[in,out] io_value The io_value to write data from +!> @param[in] io_value The io_value to write data from +!> @param[in] value_name The id defined in the XIOS context !> -subroutine checkpoint_write_value(io_value, value_name) - class(io_value_type), intent(inout) :: io_value +subroutine checkpoint_write_integer_value(io_value, value_name) + class(integer_io_value_type), intent(in) :: io_value character(*), optional, intent(in) :: value_name character(str_def) :: checkpoint_id integer(i_def) :: array_dims + real(dp_xios), allocatable :: dp_equiv(:) if(present(value_name)) then checkpoint_id = trim(value_name) @@ -200,14 +271,17 @@ subroutine checkpoint_write_value(io_value, value_name) end if array_dims = size(io_value%data) if ( xios_is_valid_field(trim(checkpoint_id)) ) then + allocate(dp_equiv(array_dims)) + dp_equiv = real(io_value%data, dp_xios) call xios_send_field( trim(checkpoint_id), & - reshape(io_value%data, (/ 1, array_dims /)) ) + reshape(dp_equiv, (/ 1, array_dims /)) ) + deallocate(dp_equiv) else call log_event( 'No XIOS field with id="'//trim(checkpoint_id)//'" is defined', & LOG_LEVEL_ERROR ) end if -end subroutine checkpoint_write_value +end subroutine checkpoint_write_integer_value !> @brief I/O handler for writing an XIOS netcdf checkpoint !> @details Note this routine accepts a filename but doesn't use it - this is @@ -482,6 +556,14 @@ subroutine write_checkpoint( fields, values, clock, checkpoint_stem_name, & call io_value_object%write_checkpoint( & trim(field_prefix) // trim(io_value_object%io_id)) end if + type is (integer_io_value_type) + if(io_value_object%can_write_checkpoint()) then + call log_event( 'Writing checkpoint for ' // & + trim(io_value_object%io_id), & + LOG_LEVEL_INFO ) + call io_value_object%write_checkpoint( & + trim(field_prefix) // trim(io_value_object%io_id)) + end if end select end select end do diff --git a/components/lfric-xios/unit-test/lfric_xios_read_mod_test.pf b/components/lfric-xios/unit-test/lfric_xios_read_mod_test.pf index ca17f13fc..d2cb1d310 100644 --- a/components/lfric-xios/unit-test/lfric_xios_read_mod_test.pf +++ b/components/lfric-xios/unit-test/lfric_xios_read_mod_test.pf @@ -7,11 +7,13 @@ !> module lfric_xios_read_mod_test - use constants_mod, only : i_def + use constants_mod, only : i_def, r_def use lfric_xios_constants_mod, only : dp_xios use lfric_xios_utils_mod, only : set_prime_io_mesh use halo_routing_collection_mod, only : halo_routing_collection_type, & halo_routing_collection + use io_value_mod, only : io_value_type + use integer_io_value_mod, only : integer_io_value_type use function_space_collection_mod, only : function_space_collection_type, & function_space_collection use local_mesh_mod, only : local_mesh_type @@ -37,6 +39,8 @@ module lfric_xios_read_mod_test type(function_space_type), pointer :: w2h_fs => null() type(function_space_type), pointer :: wth_fs => null() type(function_space_type), pointer :: w3_fs => null() + type(io_value_type) :: value_real + type(integer_io_value_type) :: value_integer type(mesh_type), pointer :: mesh => null() type(local_mesh_type) :: unit_test_local_mesh contains @@ -123,6 +127,8 @@ contains use lfric_xios_read_mod, only: checkpoint_read_xios, & read_field_generic, & + checkpoint_read_r_def_value, & + checkpoint_read_integer_value, & read_state, & read_field_time_var @@ -133,30 +139,58 @@ contains ! Fields to be read into type(field_type) :: W0_field, W2H_field, WTheta_field, W3_field type(field_proxy_type) :: test_proxy - real(dp_xios), allocatable :: W0_data(:), W2H_data(:), WTheta_data(:), W3_data(:) + real(r_def), allocatable :: W0_data(:), W2H_data(:), WTheta_data(:), W3_data(:) + real(r_def), allocatable :: expected_real_result(:) + integer(i_def), allocatable :: int_data(:), expected_int_result(:) + integer(i_def) :: i !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Setup expected data arrays + ! The mock xios_recv_field routine returns sequential real values in XIOS + ! order (layer-by-layer). The arrays below are expected data for fields + ! as the data would be reordered columnwise. Also, the API will convert to + ! the correct real kind for the field and io_value type. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - W0_data = (/ 1.0_dp_xios, 10.0_dp_xios, 19.0_dp_xios, 28.0_dp_xios, 2.0_dp_xios, 11.0_dp_xios, 20.0_dp_xios, 29.0_dp_xios, 3.0_dp_xios, 12.0_dp_xios, 21.0_dp_xios, 30.0_dp_xios, & - 4.0_dp_xios, 13.0_dp_xios, 22.0_dp_xios, 31.0_dp_xios, 5.0_dp_xios, 14.0_dp_xios, 23.0_dp_xios, 32.0_dp_xios, 6.0_dp_xios, 15.0_dp_xios, 24.0_dp_xios, 33.0_dp_xios, & - 7.0_dp_xios, 16.0_dp_xios, 25.0_dp_xios, 34.0_dp_xios, 8.0_dp_xios, 17.0_dp_xios, 26.0_dp_xios, 35.0_dp_xios, 9.0_dp_xios, 18.0_dp_xios, 27.0_dp_xios, 36.0_dp_xios /) - - W2H_data = (/ 1.00_dp_xios, 19.0_dp_xios, 37.0_dp_xios, 2.00_dp_xios, 20.0_dp_xios, 38.0_dp_xios, 3.00_dp_xios, 21.0_dp_xios, 39.0_dp_xios, & - 4.00_dp_xios, 22.0_dp_xios, 40.0_dp_xios, 5.00_dp_xios, 23.0_dp_xios, 41.0_dp_xios, 6.00_dp_xios, 24.0_dp_xios, 42.0_dp_xios, & - 7.00_dp_xios, 25.0_dp_xios, 43.0_dp_xios, 8.00_dp_xios, 26.0_dp_xios, 44.0_dp_xios, 9.00_dp_xios, 27.0_dp_xios, 45.0_dp_xios, & - 10.0_dp_xios, 28.0_dp_xios, 46.0_dp_xios, 11.0_dp_xios, 29.0_dp_xios, 47.0_dp_xios, 12.0_dp_xios, 30.0_dp_xios, 48.0_dp_xios, & - 13.0_dp_xios, 31.0_dp_xios, 49.0_dp_xios, 14.0_dp_xios, 32.0_dp_xios, 50.0_dp_xios, 15.0_dp_xios, 33.0_dp_xios, 51.0_dp_xios, & - 16.0_dp_xios, 34.0_dp_xios, 52.0_dp_xios, 17.0_dp_xios, 35.0_dp_xios, 53.0_dp_xios, 18.0_dp_xios, 36.0_dp_xios, 54.0_dp_xios /) - - WTheta_data = (/ 1.0_dp_xios, 10.0_dp_xios, 19.0_dp_xios, 28.0_dp_xios, 2.0_dp_xios, 11.0_dp_xios, 20.0_dp_xios, 29.0_dp_xios, 3.0_dp_xios, 12.0_dp_xios, 21.0_dp_xios, 30.0_dp_xios, & - 4.0_dp_xios, 13.0_dp_xios, 22.0_dp_xios, 31.0_dp_xios, 5.0_dp_xios, 14.0_dp_xios, 23.0_dp_xios, 32.0_dp_xios, 6.0_dp_xios, 15.0_dp_xios, 24.0_dp_xios, 33.0_dp_xios, & - 7.0_dp_xios, 16.0_dp_xios, 25.0_dp_xios, 34.0_dp_xios, 8.0_dp_xios, 17.0_dp_xios, 26.0_dp_xios, 35.0_dp_xios, 9.0_dp_xios, 18.0_dp_xios, 27.0_dp_xios, 36.0_dp_xios /) - - W3_data = (/ 1.0_dp_xios, 10.0_dp_xios, 19.0_dp_xios, 2.0_dp_xios, 11.0_dp_xios, 20.0_dp_xios, 3.0_dp_xios, 12.0_dp_xios, 21.0_dp_xios, & - 4.0_dp_xios, 13.0_dp_xios, 22.0_dp_xios, 5.0_dp_xios, 14.0_dp_xios, 23.0_dp_xios, 6.0_dp_xios, 15.0_dp_xios, 24.0_dp_xios, & - 7.0_dp_xios, 16.0_dp_xios, 25.0_dp_xios, 8.0_dp_xios, 17.0_dp_xios, 26.0_dp_xios, 9.0_dp_xios, 18.0_dp_xios, 27.0_dp_xios /) + allocate(W0_data(36), source = (/ & + 1.0_r_def, 10.0_r_def, 19.0_r_def, 28.0_r_def, 2.0_r_def, & + 11.0_r_def, 20.0_r_def, 29.0_r_def, 3.0_r_def, 12.0_r_def, & + 21.0_r_def, 30.0_r_def, 4.0_r_def, 13.0_r_def, 22.0_r_def, & + 31.0_r_def, 5.0_r_def, 14.0_r_def, 23.0_r_def, 32.0_r_def, & + 6.0_r_def, 15.0_r_def, 24.0_r_def, 33.0_r_def, 7.0_r_def, & + 16.0_r_def, 25.0_r_def, 34.0_r_def, 8.0_r_def, 17.0_r_def, & + 26.0_r_def, 35.0_r_def, 9.0_r_def, 18.0_r_def, 27.0_r_def, & + 36.0_r_def /) ) + + allocate (W2H_data(54), source = (/ & + 1.00_r_def, 19.0_r_def, 37.0_r_def, 2.00_r_def, 20.0_r_def, & + 38.0_r_def, 3.00_r_def, 21.0_r_def, 39.0_r_def, 4.00_r_def, & + 22.0_r_def, 40.0_r_def, 5.00_r_def, 23.0_r_def, 41.0_r_def, & + 6.00_r_def, 24.0_r_def, 42.0_r_def, 7.00_r_def, 25.0_r_def, & + 43.0_r_def, 8.00_r_def, 26.0_r_def, 44.0_r_def, 9.00_r_def, & + 27.0_r_def, 45.0_r_def, 10.0_r_def, 28.0_r_def, 46.0_r_def, & + 11.0_r_def, 29.0_r_def, 47.0_r_def, 12.0_r_def, 30.0_r_def, & + 48.0_r_def, 13.0_r_def, 31.0_r_def, 49.0_r_def, 14.0_r_def, & + 32.0_r_def, 50.0_r_def, 15.0_r_def, 33.0_r_def, 51.0_r_def, & + 16.0_r_def, 34.0_r_def, 52.0_r_def, 17.0_r_def, 35.0_r_def, & + 53.0_r_def, 18.0_r_def, 36.0_r_def, 54.0_r_def /) ) + + allocate (WTheta_data(36), source = (/ & + 1.0_r_def, 10.0_r_def, 19.0_r_def, 28.0_r_def, 2.0_r_def, & + 11.0_r_def, 20.0_r_def, 29.0_r_def, 3.0_r_def, 12.0_r_def, & + 21.0_r_def, 30.0_r_def, 4.0_r_def, 13.0_r_def, 22.0_r_def, & + 31.0_r_def, 5.0_r_def, 14.0_r_def, 23.0_r_def, 32.0_r_def, & + 6.0_r_def, 15.0_r_def, 24.0_r_def, 33.0_r_def, 7.0_r_def, & + 16.0_r_def, 25.0_r_def, 34.0_r_def, 8.0_r_def, 17.0_r_def, & + 26.0_r_def, 35.0_r_def, 9.0_r_def, 18.0_r_def, 27.0_r_def, & + 36.0_r_def /) ) + + allocate (W3_data(27), source = (/ & + 1.0_r_def, 10.0_r_def, 19.0_r_def, 2.0_r_def, 11.0_r_def, & + 20.0_r_def, 3.0_r_def, 12.0_r_def, 21.0_r_def, 4.0_r_def, & + 13.0_r_def, 22.0_r_def, 5.0_r_def, 14.0_r_def, 23.0_r_def, & + 6.0_r_def, 15.0_r_def, 24.0_r_def, 7.0_r_def, 16.0_r_def, & + 25.0_r_def, 8.0_r_def, 17.0_r_def, 26.0_r_def, 9.0_r_def, & + 18.0_r_def, 27.0_r_def /) ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Test node read @@ -194,6 +228,30 @@ contains @assertEqual( W3_data, test_proxy%data ) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Test io_value_type read + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + allocate( int_data(size(W0_data)) ) + allocate( expected_real_result(size(W0_data)) ) + allocate( expected_int_result(size(W0_data)) ) + + ! Mock xios_recv_field returns sequential numbers + expected_real_result = real((/(i,i=1,size(W0_data))/), r_def) + expected_int_result = (/(i,i=1,size(W0_data))/) + + int_data=999 + call this%value_real%init("my_real",W0_data) + call this%value_integer%init("my_integer",int_data) + + call checkpoint_read_r_def_value(this%value_real) + call checkpoint_read_integer_value(this%value_integer) + + @assertEqual(this%value_real%data, real(expected_real_result, r_def)) + @assertEqual(this%value_integer%data, expected_int_result) + + deallocate(int_data, expected_real_result, expected_int_result) + end subroutine test_lfric_xios_read end module lfric_xios_read_mod_test diff --git a/components/lfric-xios/unit-test/lfric_xios_write_mod_test.pf b/components/lfric-xios/unit-test/lfric_xios_write_mod_test.pf index a6c6d3d74..662355543 100644 --- a/components/lfric-xios/unit-test/lfric_xios_write_mod_test.pf +++ b/components/lfric-xios/unit-test/lfric_xios_write_mod_test.pf @@ -7,11 +7,13 @@ !> module lfric_xios_write_mod_test - use constants_mod, only : i_def + use constants_mod, only : i_def, r_def use lfric_xios_constants_mod, only : dp_xios use lfric_xios_utils_mod, only : set_prime_io_mesh use halo_routing_collection_mod, only : halo_routing_collection_type, & halo_routing_collection + use io_value_mod, only : io_value_type + use integer_io_value_mod, only : integer_io_value_type use function_space_collection_mod, only : function_space_collection_type, & function_space_collection use local_mesh_mod, only : local_mesh_type @@ -38,6 +40,8 @@ module lfric_xios_write_mod_test type(function_space_type), pointer :: w2h_fs => null() type(function_space_type), pointer :: wth_fs => null() type(function_space_type), pointer :: w3_fs => null() + type(io_value_type) :: value_real + type(integer_io_value_type) :: value_integer type(mesh_type), pointer :: mesh => null() type(local_mesh_type) :: unit_test_local_mesh @@ -124,7 +128,10 @@ contains @Test subroutine test_lfric_xios_write( this ) - use lfric_xios_write_mod, only: write_field_generic, & + use lfric_xios_write_mod, only: write_field_generic, & + checkpoint_write_r_def_value, & + checkpoint_write_integer_value, & + write_value_generic, & write_state implicit none @@ -134,31 +141,57 @@ contains ! Fields to be written type(field_type) :: W0_field, W2H_field, WTheta_field, W3_field type(field_proxy_type) :: test_proxy - real(dp_xios), allocatable :: W0_data(:), W2H_data(:), WTheta_data(:), W3_data(:) + real(r_def), allocatable :: W0_data(:), W2H_data(:), WTheta_data(:), W3_data(:) + ! Return values from XIOS use XIOS kind which might be different from r_def real(dp_xios), allocatable :: W0_result(:), W2H_result(:), WTheta_result(:), W3_result(:) + integer(i_def), allocatable :: int_data(:), int_result(:) + integer(i_def) :: i !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Setup expected data arrays + ! Setup sample data arrays which can contain any numbers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - W0_data = (/ 1.0_dp_xios, 10.0_dp_xios, 19.0_dp_xios, 28.0_dp_xios, 2.0_dp_xios, 11.0_dp_xios, 20.0_dp_xios, 29.0_dp_xios, 3.0_dp_xios, 12.0_dp_xios, 21.0_dp_xios, 30.0_dp_xios, & - 4.0_dp_xios, 13.0_dp_xios, 22.0_dp_xios, 31.0_dp_xios, 5.0_dp_xios, 14.0_dp_xios, 23.0_dp_xios, 32.0_dp_xios, 6.0_dp_xios, 15.0_dp_xios, 24.0_dp_xios, 33.0_dp_xios, & - 7.0_dp_xios, 16.0_dp_xios, 25.0_dp_xios, 34.0_dp_xios, 8.0_dp_xios, 17.0_dp_xios, 26.0_dp_xios, 35.0_dp_xios, 9.0_dp_xios, 18.0_dp_xios, 27.0_dp_xios, 36.0_dp_xios /) + allocate(W0_data(36), source = (/ & + 1.0_r_def, 10.0_r_def, 19.0_r_def, 28.0_r_def, 2.0_r_def, & + 11.0_r_def, 20.0_r_def, 29.0_r_def, 3.0_r_def, 12.0_r_def, & + 21.0_r_def, 30.0_r_def, 4.0_r_def, 13.0_r_def, 22.0_r_def, & + 31.0_r_def, 5.0_r_def, 14.0_r_def, 23.0_r_def, 32.0_r_def, & + 6.0_r_def, 15.0_r_def, 24.0_r_def, 33.0_r_def, 7.0_r_def, & + 16.0_r_def, 25.0_r_def, 34.0_r_def, 8.0_r_def, 17.0_r_def, & + 26.0_r_def, 35.0_r_def, 9.0_r_def, 18.0_r_def, 27.0_r_def, & + 36.0_r_def /) ) + + allocate (W2H_data(54), source = (/ & + 1.00_r_def, 19.0_r_def, 37.0_r_def, 2.00_r_def, 20.0_r_def, & + 38.0_r_def, 3.00_r_def, 21.0_r_def, 39.0_r_def, 4.00_r_def, & + 22.0_r_def, 40.0_r_def, 5.00_r_def, 23.0_r_def, 41.0_r_def, & + 6.00_r_def, 24.0_r_def, 42.0_r_def, 7.00_r_def, 25.0_r_def, & + 43.0_r_def, 8.00_r_def, 26.0_r_def, 44.0_r_def, 9.00_r_def, & + 27.0_r_def, 45.0_r_def, 10.0_r_def, 28.0_r_def, 46.0_r_def, & + 11.0_r_def, 29.0_r_def, 47.0_r_def, 12.0_r_def, 30.0_r_def, & + 48.0_r_def, 13.0_r_def, 31.0_r_def, 49.0_r_def, 14.0_r_def, & + 32.0_r_def, 50.0_r_def, 15.0_r_def, 33.0_r_def, 51.0_r_def, & + 16.0_r_def, 34.0_r_def, 52.0_r_def, 17.0_r_def, 35.0_r_def, & + 53.0_r_def, 18.0_r_def, 36.0_r_def, 54.0_r_def /) ) + + allocate (WTheta_data(36), source = (/ & + 1.0_r_def, 10.0_r_def, 19.0_r_def, 28.0_r_def, 2.0_r_def, & + 11.0_r_def, 20.0_r_def, 29.0_r_def, 3.0_r_def, 12.0_r_def, & + 21.0_r_def, 30.0_r_def, 4.0_r_def, 13.0_r_def, 22.0_r_def, & + 31.0_r_def, 5.0_r_def, 14.0_r_def, 23.0_r_def, 32.0_r_def, & + 6.0_r_def, 15.0_r_def, 24.0_r_def, 33.0_r_def, 7.0_r_def, & + 16.0_r_def, 25.0_r_def, 34.0_r_def, 8.0_r_def, 17.0_r_def, & + 26.0_r_def, 35.0_r_def, 9.0_r_def, 18.0_r_def, 27.0_r_def, & + 36.0_r_def /) ) + + allocate (W3_data(27), source = (/ & + 1.0_r_def, 10.0_r_def, 19.0_r_def, 2.0_r_def, 11.0_r_def, & + 20.0_r_def, 3.0_r_def, 12.0_r_def, 21.0_r_def, 4.0_r_def, & + 13.0_r_def, 22.0_r_def, 5.0_r_def, 14.0_r_def, 23.0_r_def, & + 6.0_r_def, 15.0_r_def, 24.0_r_def, 7.0_r_def, 16.0_r_def, & + 25.0_r_def, 8.0_r_def, 17.0_r_def, 26.0_r_def, 9.0_r_def, & + 18.0_r_def, 27.0_r_def /) ) - W2H_data = (/ 1.00_dp_xios, 19.0_dp_xios, 37.0_dp_xios, 2.00_dp_xios, 20.0_dp_xios, 38.0_dp_xios, 3.00_dp_xios, 21.0_dp_xios, 39.0_dp_xios, & - 4.00_dp_xios, 22.0_dp_xios, 40.0_dp_xios, 5.00_dp_xios, 23.0_dp_xios, 41.0_dp_xios, 6.00_dp_xios, 24.0_dp_xios, 42.0_dp_xios, & - 7.00_dp_xios, 25.0_dp_xios, 43.0_dp_xios, 8.00_dp_xios, 26.0_dp_xios, 44.0_dp_xios, 9.00_dp_xios, 27.0_dp_xios, 45.0_dp_xios, & - 10.0_dp_xios, 28.0_dp_xios, 46.0_dp_xios, 11.0_dp_xios, 29.0_dp_xios, 47.0_dp_xios, 12.0_dp_xios, 30.0_dp_xios, 48.0_dp_xios, & - 13.0_dp_xios, 31.0_dp_xios, 49.0_dp_xios, 14.0_dp_xios, 32.0_dp_xios, 50.0_dp_xios, 15.0_dp_xios, 33.0_dp_xios, 51.0_dp_xios, & - 16.0_dp_xios, 34.0_dp_xios, 52.0_dp_xios, 17.0_dp_xios, 35.0_dp_xios, 53.0_dp_xios, 18.0_dp_xios, 36.0_dp_xios, 54.0_dp_xios /) - - WTheta_data = (/ 1.0_dp_xios, 10.0_dp_xios, 19.0_dp_xios, 28.0_dp_xios, 2.0_dp_xios, 11.0_dp_xios, 20.0_dp_xios, 29.0_dp_xios, 3.0_dp_xios, 12.0_dp_xios, 21.0_dp_xios, 30.0_dp_xios, & - 4.0_dp_xios, 13.0_dp_xios, 22.0_dp_xios, 31.0_dp_xios, 5.0_dp_xios, 14.0_dp_xios, 23.0_dp_xios, 32.0_dp_xios, 6.0_dp_xios, 15.0_dp_xios, 24.0_dp_xios, 33.0_dp_xios, & - 7.0_dp_xios, 16.0_dp_xios, 25.0_dp_xios, 34.0_dp_xios, 8.0_dp_xios, 17.0_dp_xios, 26.0_dp_xios, 35.0_dp_xios, 9.0_dp_xios, 18.0_dp_xios, 27.0_dp_xios, 36.0_dp_xios /) - - W3_data = (/ 1.0_dp_xios, 10.0_dp_xios, 19.0_dp_xios, 2.0_dp_xios, 11.0_dp_xios, 20.0_dp_xios, 3.0_dp_xios, 12.0_dp_xios, 21.0_dp_xios, & - 4.0_dp_xios, 13.0_dp_xios, 22.0_dp_xios, 5.0_dp_xios, 14.0_dp_xios, 23.0_dp_xios, 6.0_dp_xios, 15.0_dp_xios, 24.0_dp_xios, & - 7.0_dp_xios, 16.0_dp_xios, 25.0_dp_xios, 8.0_dp_xios, 17.0_dp_xios, 26.0_dp_xios, 9.0_dp_xios, 18.0_dp_xios, 27.0_dp_xios /) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Test node write @@ -210,6 +243,55 @@ contains deallocate( W0_result, W2H_result, WTheta_result, W3_result ) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Test writing io_value_type + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Reuse the above W0 array for testing io_value_type and writing of arrays + ! Create a separate array of the same size for integer_io_value_type + allocate( int_data(size(W0_data)) ) + ! API converts integers to XIOS real kind (real64) and back, which is OK for + ! int32 and real64. But if conversion were to use real32, some integers + ! greater than 2**24 get rounded to different values. So, we test for this. + do i = 1,size(W0_data) + int_data(i) = 2**25 + i + end do + + call this%value_real%init("my_real",W0_data) + call this%value_integer%init("my_integer",int_data) + + allocate( W0_result(size(W0_data)) ) + allocate( int_result(size(int_data)) ) + W0_result = -999.0_dp_xios + + ! Test the checkpoint write methods + call checkpoint_write_r_def_value(this%value_real) + call get_latest_data(W0_result) + ! In applications, the read process would convert back to r_def + @assertEqual(this%value_real%data,real(W0_result, r_def)) + + ! Underlying code converts this to a real for writing to XIOS + call checkpoint_write_integer_value(this%value_integer) + call get_latest_data(W0_result) + ! In applications, the read process would convert back to integer + int_result = int(W0_result,i_def) + @assertEqual(this%value_integer%data,int_result) + + ! Test the generic write methods + W0_result = -999.0_dp_xios + call write_value_generic(this%value_real) + call get_latest_data(W0_result) + ! Allow for IO value data to be a real32 XIOS reals + @assertEqual(real(this%value_real%data, dp_xios),W0_result) + + W0_result = -999.0_dp_xios + call write_value_generic(this%value_integer) + call get_latest_data(W0_result) + ! Allow for IO value data to be a real32 XIOS reals + @assertEqual(this%value_integer%data, int(W0_result)) + + deallocate(W0_result, int_result, int_data) + end subroutine test_lfric_xios_write end module lfric_xios_write_mod_test diff --git a/infrastructure/source/io/integer_io_value_mod.f90 b/infrastructure/source/io/integer_io_value_mod.f90 new file mode 100644 index 000000000..a5196c76e --- /dev/null +++ b/infrastructure/source/io/integer_io_value_mod.f90 @@ -0,0 +1,182 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2024 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- + +module integer_io_value_mod + + use constants_mod, only : str_def, i_def, r_double, l_def + use key_value_mod, only : abstract_value_type + use key_value_collection_mod, only : key_value_collection_type + use log_mod, only : log_event, & + LOG_LEVEL_ERROR + + implicit none + + private + + public :: integer_io_value_type, get_integer_io_value + public :: integer_io_read_interface, integer_io_write_interface + + !> @brief Value with associated I/O methods + !> that can be stored in a key-value pair + type, extends(abstract_value_type) :: integer_io_value_type + character(str_def) :: io_id + integer(kind=i_def), allocatable :: data(:) + procedure(integer_io_write_interface), pointer :: write_method => null() + procedure(integer_io_read_interface), pointer :: checkpoint_read_method => null() + procedure(integer_io_write_interface), pointer :: checkpoint_write_method => null() + contains + procedure, public :: init + procedure, public :: set_write_behaviour + procedure, public :: set_checkpoint_write_behaviour + procedure, public :: set_checkpoint_read_behaviour + procedure, public :: can_write_checkpoint + procedure, public :: write_value + procedure, public :: write_checkpoint + procedure, public :: read_checkpoint + end type integer_io_value_type + + abstract interface + subroutine integer_io_read_interface(self, value_name) + import integer_io_value_type + class(integer_io_value_type), intent(inout) :: self + character(*), optional, intent(in) :: value_name + end subroutine integer_io_read_interface + end interface + + abstract interface + subroutine integer_io_write_interface(self, value_name) + import integer_io_value_type + class(integer_io_value_type), intent(in) :: self + character(*), optional, intent(in) :: value_name + end subroutine integer_io_write_interface + end interface + +contains + +!> @brief Initialiser for the integer_io_value_type +!> @param[in] io_id The ID used for managing I/O operations +!> @param[in] data An array holding the data +subroutine init(self, io_id, data) + class(integer_io_value_type), intent(inout) :: self + + character(len=*), intent(in) :: io_id + integer(kind=i_def), intent(in) :: data(:) + + self%io_id = io_id + allocate(self%data, source=data) + +end subroutine init + +!> @brief Sets the diagnostic write behaviour for integer_io_value +!> @param[in] write_behaviour Pointer to procedure implementing the write method +subroutine set_write_behaviour(self, write_behaviour) + class(integer_io_value_type), intent(inout) :: self + procedure(integer_io_write_interface), pointer, intent(in) :: write_behaviour + + self%write_method => write_behaviour +end subroutine set_write_behaviour + +!> @brief Sets the checkpoint write behaviour for the integer_io_value +!> @param[in] write_behaviour A pointer to the checkpoint write behaviour +subroutine set_checkpoint_write_behaviour(self, write_behaviour) + class(integer_io_value_type), intent(inout) :: self + procedure(integer_io_write_interface), pointer, intent(in) :: write_behaviour + + self%checkpoint_write_method => write_behaviour +end subroutine set_checkpoint_write_behaviour + +!> @brief Sets the checkpoint read behavoiur for the integer_io_value +!> @param[in] read_behaviour A pointer to the checkpoint read behaviour +subroutine set_checkpoint_read_behaviour(self, read_behaviour) + class(integer_io_value_type), intent(inout) :: self + procedure(integer_io_read_interface), pointer, intent(in) :: read_behaviour + + self%checkpoint_read_method => read_behaviour +end subroutine set_checkpoint_read_behaviour + +!> @brief Subroutine to write to the diagnostic file with write behaviour +subroutine write_value(self, value_name) + class(integer_io_value_type), intent(inout) :: self + character(*), optional, intent(in) :: value_name + if ( associated(self%write_method) ) then + call self%write_method(value_name) + else + call log_event( 'Error trying to write value ' // trim(self%io_id) // & + ', write method not set', LOG_LEVEL_ERROR ) + end if + +end subroutine write_value + +!> @brief Subroutine to write to a checkpoint file with write behaviour +subroutine write_checkpoint(self, value_name) + class(integer_io_value_type), intent(inout) :: self + character(*), optional, intent(in) :: value_name + + if ( associated(self%checkpoint_write_method) ) then + call self%checkpoint_write_method(value_name) + else + call log_event( 'Error trying to write value ' // trim(self%io_id) // & + ', checkpoint write method not set', LOG_LEVEL_ERROR ) + end if + +end subroutine write_checkpoint + +!> @brief Subroutine to read data from the checkpoint file to the value +subroutine read_checkpoint(self, value_name) + class(integer_io_value_type), intent(inout) :: self + character(*), optional, intent(in) :: value_name + + if ( associated(self%checkpoint_read_method) ) then + call self%checkpoint_read_method(value_name) + else + call log_event( 'Error trying to read value ' // trim(self%io_id) // & + ', checkpoint read method not set', LOG_LEVEL_ERROR ) + end if + +end subroutine read_checkpoint + +!> @brief A helper function to determine if the integer_io_value_type +!> can be written to a checkpoint file +!> + +!> @return .true. or .false. +function can_write_checkpoint(self) result(checkpointable) + + implicit none + + class(integer_io_value_type), intent(in) :: self + logical(l_def) :: checkpointable + + if (associated(self%checkpoint_write_method)) then + checkpointable = .true. + else + checkpointable = .false. + end if + +end function can_write_checkpoint + +!> @brief A helper function to retrieve an integer_io_value_type object +!> from a key-value collection +!> @param[in] collection The collection from which to get the integer_io_value +!> @param[in] key The key of the integer_io_value +!> @return io_value Pointer to the extracted io_value; null if there is none +function get_integer_io_value(collection, key) result(io_value) + type(key_value_collection_type), intent(in) :: collection + character(*), intent(in) :: key + + type(integer_io_value_type), pointer :: io_value + class(abstract_value_type), pointer :: abstract_value + + call collection%get_value(trim(key), abstract_value) + io_value => null() + select type (abstract_value) + type is (integer_io_value_type) + io_value => abstract_value + end select + +end function get_integer_io_value + +end module integer_io_value_mod diff --git a/infrastructure/source/io/io_value_mod.f90 b/infrastructure/source/io/io_value_mod.f90 index d9c0562b9..b9023cabf 100644 --- a/infrastructure/source/io/io_value_mod.f90 +++ b/infrastructure/source/io/io_value_mod.f90 @@ -16,16 +16,16 @@ module io_value_mod private - public :: io_value_type, get_io_value, io_operation_interface + public :: io_value_type, get_io_value, io_read_interface, io_write_interface !> @brief Value with associated I/O methods !> that can be stored in a key-value pair type, extends(abstract_value_type) :: io_value_type character(str_def) :: io_id real(kind=r_def), allocatable :: data(:) - procedure(io_operation_interface), pointer :: write_method => null() - procedure(io_operation_interface), pointer :: checkpoint_read_method => null() - procedure(io_operation_interface), pointer :: checkpoint_write_method => null() + procedure(io_write_interface), pointer :: write_method => null() + procedure(io_read_interface), pointer :: checkpoint_read_method => null() + procedure(io_write_interface), pointer :: checkpoint_write_method => null() contains procedure, public :: init procedure, public :: set_write_behaviour @@ -38,11 +38,19 @@ module io_value_mod end type io_value_type abstract interface - subroutine io_operation_interface(self, value_name) + subroutine io_read_interface(self, value_name) import io_value_type class(io_value_type), intent(inout) :: self + character(*), optional, intent(in) :: value_name + end subroutine io_read_interface + end interface + + abstract interface + subroutine io_write_interface(self, value_name) + import io_value_type + class(io_value_type), intent(in) :: self character(*), optional, intent(in) :: value_name - end subroutine io_operation_interface + end subroutine io_write_interface end interface contains @@ -65,7 +73,7 @@ end subroutine init !> @param[in] write_behaviour Pointer to procedure implementing the write method subroutine set_write_behaviour(self, write_behaviour) class(io_value_type), intent(inout) :: self - procedure(io_operation_interface), pointer, intent(in) :: write_behaviour + procedure(io_write_interface), pointer, intent(in) :: write_behaviour self%write_method => write_behaviour end subroutine set_write_behaviour @@ -74,7 +82,7 @@ end subroutine set_write_behaviour !> @param[in] write_behaviour A pointer to the checkpoint write behaviour subroutine set_checkpoint_write_behaviour(self, write_behaviour) class(io_value_type), intent(inout) :: self - procedure(io_operation_interface), pointer, intent(in) :: write_behaviour + procedure(io_write_interface), pointer, intent(in) :: write_behaviour self%checkpoint_write_method => write_behaviour end subroutine set_checkpoint_write_behaviour @@ -83,7 +91,7 @@ end subroutine set_checkpoint_write_behaviour !> @param[in] read_behaviour A pointer to the checkpoint read behaviour subroutine set_checkpoint_read_behaviour(self, read_behaviour) class(io_value_type), intent(inout) :: self - procedure(io_operation_interface), pointer, intent(in) :: read_behaviour + procedure(io_read_interface), pointer, intent(in) :: read_behaviour self%checkpoint_read_method => read_behaviour end subroutine set_checkpoint_read_behaviour @@ -170,4 +178,4 @@ function get_io_value(collection, key) result(io_value) end function get_io_value -end module io_value_mod \ No newline at end of file +end module io_value_mod