diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index cd068f3b7..55ed241cd 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -4,8 +4,9 @@ | andrewcoughtrie | Andrew Coughtrie | Met Office | 2025.12.12 | | james-bruten-mo | James Bruten | Met Office | 2025-12-09 | | jennyhickson | Jenny Hickson | Met Office | 2025-12-10 | -| mo-marqh | Mark Hedley | Met Office | 2025-12-11 | | mike-hobson | Mike Hobson | Met Office | 2025-12-17 | +| mo-marqh | Mark Hedley | Met Office | 2025-12-11 | +| mo-rickywong | Ricky Wong | Met Office | 2025-12-11 | | MatthewHambley | Matthew Hambley | Met Office | 2025-12-15 | | yaswant | Yaswant Pradhan | Met Office | 2025-12-16 | | harry-shepherd | Harry Shepherd | Met Office | 2026-01-08 | diff --git a/applications/coupled/source/coupled.f90 b/applications/coupled/source/coupled.f90 index 9f7fcf09f..b1e4f280a 100644 --- a/applications/coupled/source/coupled.f90 +++ b/applications/coupled/source/coupled.f90 @@ -43,6 +43,7 @@ program coupled call modeldb%values%initialise( 'values', 5 ) call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise( program_name ) write(log_scratch_space,'(A)') & 'Application built with '// trim(precision_real) // & @@ -53,8 +54,12 @@ program coupled call modeldb%values%add_key_value('cpl_name', cpl_component_name) call init_comm( "coupled", modeldb ) - call init_config( filename, coupled_required_namelists, & - modeldb%configuration ) + + call init_config( filename, & + coupled_required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config ) + call init_logger( modeldb%mpi%get_comm(), & program_name//"_"//cpl_component_name ) call init_collections() diff --git a/applications/coupled/source/driver/coupled_driver_mod.f90 b/applications/coupled/source/driver/coupled_driver_mod.f90 index 892f59215..2f525142c 100644 --- a/applications/coupled/source/driver/coupled_driver_mod.f90 +++ b/applications/coupled/source/driver/coupled_driver_mod.f90 @@ -32,7 +32,7 @@ module coupled_driver_mod LOG_LEVEL_INFO use mesh_mod, only : mesh_type use mesh_collection_mod, only : mesh_collection - use namelist_mod, only : namelist_type + use sci_checksum_alg_mod, only : checksum_alg implicit none @@ -69,10 +69,6 @@ subroutine initialise( program_name, modeldb, calendar ) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: planet_nml - type(namelist_type), pointer :: extrusion_nml - character(str_def) :: prime_mesh_name integer(i_def) :: stencil_depth @@ -89,18 +85,12 @@ subroutine initialise( program_name, modeldb, calendar ) ! Extract namelist variables - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() ! Initialise mesh ! Determine the required meshes @@ -118,7 +108,7 @@ subroutine initialise( program_name, modeldb, calendar ) LOG_LEVEL_ERROR) end select allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) diff --git a/applications/coupled/source/driver/init_coupled_mod.X90 b/applications/coupled/source/driver/init_coupled_mod.X90 index 54402acf7..3028d5a06 100644 --- a/applications/coupled/source/driver/init_coupled_mod.X90 +++ b/applications/coupled/source/driver/init_coupled_mod.X90 @@ -21,8 +21,8 @@ module init_coupled_mod use field_collection_mod, only : field_collection_type use field_mod, only : field_type use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, element_order_v use function_space_collection_mod, only : function_space_collection + use function_space_mod, only : function_space_type use fs_continuity_mod, only : W3 use log_mod, only : log_event, & LOG_LEVEL_INFO, & @@ -40,11 +40,12 @@ module init_coupled_mod !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels !> @param[in,out] modeldb The structure that holds model state - subroutine init_coupled( mesh, chi, panel_id, modeldb) + subroutine init_coupled(mesh, chi, panel_id, modeldb) implicit none type(mesh_type), intent(in), pointer :: mesh + ! Coordinate field type( field_type ), intent(inout) :: chi(:) type( field_type ), intent(inout) :: panel_id @@ -74,19 +75,23 @@ module init_coupled_mod procedure(write_interface), pointer :: tmp_ptr + integer(i_def) :: order_h, order_v + type(function_space_type), pointer :: fs + call log_event( 'coupled: Initialising app ...', LOG_LEVEL_INFO ) ! Get the name of the coupling component call modeldb%values%get_value("cpl_name", cpl_component_name) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + fs => function_space_collection%get_fs(mesh, order_h, order_v, W3) + ! Create prognostic fields ! Creates a field in the W3 function space (fully discontinuous field) - call field_1%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, element_order_v, W3), & - name="field_1") - call field_2%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, element_order_v, W3), & - name="field_2") + call field_1%initialise(fs, name="field_1") + call field_2%initialise(fs, name="field_2") ! Add field to modeldb depository => modeldb%fields%get_field_collection("depository") diff --git a/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 b/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 index 009919d39..e42ccba00 100644 --- a/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_alg_mod.x90 @@ -6,16 +6,18 @@ !>@brief Module containing io_demo_alg module io_demo_alg_mod + use constants_mod, only: i_def,r_def + use driver_modeldb_mod, only: modeldb_type use log_mod, only: log_event, & LOG_LEVEL_INFO, & LOG_LEVEL_TRACE use mesh_mod, only: mesh_type + use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, & - element_order_v - use fs_continuity_mod, only: Wtheta, W2 + use fs_continuity_mod, only: Wtheta use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use operator_mod, only: operator_type use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use io_demo_constants_mod, only: get_dx_at_w2 @@ -31,11 +33,14 @@ module io_demo_alg_mod contains !> @details Calculates the diffusion increment for a field, and adds it to said field. + !> @param[in] modeldb Application state object !> @param[inout] field_in Input Wtheta field - subroutine io_demo_alg( field_in ) + subroutine io_demo_alg( modeldb, field_in ) implicit none + type(modeldb_type), intent(in) :: modeldb + ! Prognostic fields type( field_type ), intent( inout ) :: field_in @@ -44,20 +49,27 @@ contains type( field_type ) :: visc real(r_def), parameter :: visc_val = 100000.0_r_def - type(mesh_type), pointer :: mesh => null() integer(kind=i_def), parameter :: stencil_depth = 1_i_def - type( field_type ), pointer :: dx_at_w2 => null() + type(mesh_type), pointer :: mesh + type(field_type), pointer :: dx_at_w2 + type(function_space_type), pointer :: fs + + integer(i_def) :: order_h, order_v call log_event( "io_demo: Running algorithm", LOG_LEVEL_TRACE ) - mesh => field_in%get_mesh() + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + mesh => field_in%get_mesh() dx_at_w2 => get_dx_at_w2(mesh) - call dfield_in%initialise( & - function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) - call visc%initialise( & - function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) + + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + + call dfield_in%initialise(fs) + call visc%initialise(fs) + call invoke( name = "compute_diffusion", & setval_c(visc, visc_val), & setval_c(dfield_in, 0.0_r_def), & diff --git a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 index 9bce8269f..217b373b5 100644 --- a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 @@ -15,30 +15,30 @@ module io_demo_constants_mod ! Infrastructure - use constants_mod, only: i_def, r_def, & + use constants_mod, only: i_def, r_def, l_def, & str_def, str_short + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type use timer_mod, only: timer ! Kernels - use sci_calc_dA_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type - use sci_calc_detj_at_w2_kernel_mod, only: calc_detj_at_w2_kernel_type - use sci_multiplicity_kernel_mod, only: multiplicity_kernel_type + use sci_calc_dA_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type + use sci_calc_detj_at_w2_kernel_mod, only: calc_detj_at_w2_kernel_type + use sci_multiplicity_kernel_mod, only: multiplicity_kernel_type implicit none private ! Objects for dx_at_w2 functionality - type(field_collection_type) :: dx_at_w2_collection + type(field_collection_type) :: dx_at_w2_collection private :: add_dx_at_w2 @@ -48,19 +48,24 @@ module io_demo_constants_mod contains !> @brief Subroutine to create the finite element constants + !> @param[in] modeldb Application state object !> @param[in] mesh The prime model mesh !> @param[in] chi Coordinate fields !> @param[in] panel_id Panel_id field - subroutine create_io_demo_constants(mesh, & - chi, & - panel_id ) + subroutine create_io_demo_constants(modeldb, mesh, chi, panel_id) implicit none ! Arguments - type(mesh_type), pointer, intent(in) :: mesh - type(field_type), target, intent(in) :: chi(:) - type(field_type), target, intent(in) :: panel_id + type(modeldb_type), intent(in) :: modeldb + + type(mesh_type), pointer, intent(in) :: mesh + type(field_type), target, intent(in) :: chi(:) + type(field_type), target, intent(in) :: panel_id + + logical(l_def) :: subroutine_timers + + subroutine_timers = modeldb%config%io%subroutine_timers() if ( subroutine_timers ) call timer('io_demo_constants_alg') call log_event( "io_demo: creating runtime constants", LOG_LEVEL_TRACE ) diff --git a/applications/io_demo/source/driver/init_io_demo_mod.F90 b/applications/io_demo/source/driver/init_io_demo_mod.F90 index 1ba932375..0be601260 100644 --- a/applications/io_demo/source/driver/init_io_demo_mod.F90 +++ b/applications/io_demo/source/driver/init_io_demo_mod.F90 @@ -12,22 +12,19 @@ module init_io_demo_mod use sci_assign_field_random_range_alg_mod, only: assign_field_random_range - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, l_def use driver_modeldb_mod, only : modeldb_type use field_collection_mod, only : field_collection_type use field_mod, only : field_type use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, & - element_order_v use function_space_collection_mod, only : function_space_collection + use function_space_mod, only : function_space_type use fs_continuity_mod, only : Wtheta use key_value_mod, only : abstract_value_type use log_mod, only : log_event, & LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only : mesh_type - use io_config_mod, only : write_diag, & - use_xios_io use lfric_xios_write_mod, only : write_field_generic use io_demo_constants_mod, only : create_io_demo_constants use random_number_generator_mod, only : random_number_generator_type @@ -37,20 +34,21 @@ module init_io_demo_mod contains !> @details Initialises everything needed to run the io_demo miniapp + !> @param[in,out] modeldb The structure that holds model state !> @param[in] mesh Representation of the mesh the code will run on !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels - !> @param[in,out] modeldb The structure that holds model state - subroutine init_io_demo( mesh, chi, panel_id, modeldb) + subroutine init_io_demo(modeldb, mesh, chi, panel_id) implicit none - type(mesh_type), intent(in), pointer :: mesh + type(modeldb_type), intent(inout) :: modeldb + type(mesh_type), intent(in), pointer :: mesh ! Coordinate field - type(field_type), intent(inout) :: chi(:) - type(field_type), intent(inout) :: panel_id - type(modeldb_type), intent(inout) :: modeldb + type(field_type), intent(inout) :: chi(:) + type(field_type), intent(inout) :: panel_id + class(abstract_value_type), pointer :: abstract_value type(random_number_generator_type), pointer :: rng type(field_type) :: diffusion_field @@ -59,8 +57,20 @@ subroutine init_io_demo( mesh, chi, panel_id, modeldb) real(kind=r_def), parameter :: min_val = 280.0_r_def real(kind=r_def), parameter :: max_val = 330.0_r_def + type(function_space_type), pointer :: fs + + integer(i_def) :: order_h, order_v + logical(l_def) :: write_diag + logical(l_def) :: use_xios_io + call log_event( 'io_demo: Initialising miniapp ...', LOG_LEVEL_TRACE ) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + write_diag = modeldb%config%io%write_diag() + use_xios_io = modeldb%config%io%use_xios_io() + ! seed the random number generator call modeldb%values%get_value("rng", abstract_value) select type(abstract_value) @@ -76,10 +86,8 @@ subroutine init_io_demo( mesh, chi, panel_id, modeldb) ! Create prognostic fields ! Creates a field in the Wtheta function space - call diffusion_field%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, Wtheta), & - name="diffusion_field") + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + call diffusion_field%initialise(fs, name="diffusion_field") ! Set up field with an IO behaviour (XIOS only at present) if (write_diag .and. use_xios_io) then @@ -98,7 +106,7 @@ subroutine init_io_demo( mesh, chi, panel_id, modeldb) ! Create io_demo runtime constants. This creates various things ! needed by the fem algorithms such as mass matrix operators, mass ! matrix diagonal fields and the geopotential field - call create_io_demo_constants(mesh, chi, panel_id) + call create_io_demo_constants(modeldb, mesh, chi, panel_id) call log_event( 'io_demo: Miniapp initialised', LOG_LEVEL_TRACE ) diff --git a/applications/io_demo/source/driver/io_demo_driver_mod.f90 b/applications/io_demo/source/driver/io_demo_driver_mod.f90 index 6d8733d99..73fd63c24 100644 --- a/applications/io_demo/source/driver/io_demo_driver_mod.f90 +++ b/applications/io_demo/source/driver/io_demo_driver_mod.f90 @@ -36,10 +36,8 @@ module io_demo_driver_mod use model_clock_mod, only : model_clock_type use multifile_field_setup_mod, only : create_multifile_io_fields use multifile_io_mod, only : init_multifile_io, step_multifile_io - use namelist_mod, only : namelist_type - - use io_demo_alg_mod, only : io_demo_alg + use io_demo_alg_mod, only : io_demo_alg use sci_field_minmax_alg_mod, only : log_field_minmax !------------------------------------ @@ -47,14 +45,13 @@ module io_demo_driver_mod !------------------------------------ use base_mesh_config_mod, only: GEOMETRY_SPHERICAL, & GEOMETRY_PLANAR - use io_config_mod, only: write_diag implicit none private - type(inventory_by_mesh_type) :: chi_inventory - type(inventory_by_mesh_type) :: panel_id_inventory + type(inventory_by_mesh_type) :: chi_inventory + type(inventory_by_mesh_type) :: panel_id_inventory public initialise, step, finalise @@ -63,17 +60,17 @@ module io_demo_driver_mod !> Sets up required state in preparation for run. !> @param [in] program_name An identifier given to the model being run !> @param [in,out] modeldb The structure that holds model state - subroutine initialise( program_name, modeldb) + subroutine initialise(program_name, modeldb) implicit none - character(*), intent(in) :: program_name - type(modeldb_type), intent(inout) :: modeldb + character(*), intent(in) :: program_name + type(modeldb_type), intent(inout) :: modeldb ! Coordinate field - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() - type(mesh_type), pointer :: mesh => null() + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id + type(mesh_type), pointer :: mesh character(str_def), allocatable :: base_mesh_names(:) character(str_def), allocatable :: twod_names(:) @@ -81,11 +78,6 @@ subroutine initialise( program_name, modeldb) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml => null() - type(namelist_type), pointer :: planet_nml => null() - type(namelist_type), pointer :: extrusion_nml => null() - type(namelist_type), pointer :: io_nml => null() - character(str_def) :: prime_mesh_name integer(i_def) :: stencil_depth @@ -101,26 +93,20 @@ subroutine initialise( program_name, modeldb) integer(i_def), parameter :: one_layer = 1_i_def integer(i_def) :: i + nullify(chi) + nullify(panel_id) + nullify(mesh) + !======================================================================= ! Extract configuration variables !======================================================================= - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - io_nml => modeldb%configuration%get_namelist('io') - - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - call io_nml%get_value( 'multifile_io', multifile_io) - - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() - io_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() + multifile_io = modeldb%config%io%multifile_io() !======================================================================= ! Mesh @@ -191,7 +177,7 @@ subroutine initialise( program_name, modeldb) !======================================================================= ! Setup multifile reading !======================================================================= - if(multifile_io) then + if (multifile_io) then call create_multifile_io_fields(modeldb) call init_multifile_io(modeldb) end if @@ -210,7 +196,7 @@ subroutine initialise( program_name, modeldb) mesh => mesh_collection%get_mesh(prime_mesh_name) call chi_inventory%get_field_array(mesh, chi) call panel_id_inventory%get_field(mesh, panel_id) - call init_io_demo( mesh, chi, panel_id, modeldb ) + call init_io_demo(modeldb, mesh, chi, panel_id) nullify(mesh, chi, panel_id) deallocate(base_mesh_names) @@ -227,16 +213,19 @@ subroutine step( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb + type( field_collection_type ), pointer :: depository type( field_collection_type ), pointer :: multifile_col type( field_type ), pointer :: diffusion_field type( field_type ), pointer :: multifile_field - type(namelist_type), pointer :: io_nml => null() + logical :: multifile_io + logical :: write_diag + + multifile_io = modeldb%config%io%multifile_io() + write_diag = modeldb%config%io%write_diag() - io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value( 'multifile_io', multifile_io) - if( multifile_io ) then + if (multifile_io) then call step_multifile_io(modeldb, chi_inventory, panel_id_inventory) multifile_col => modeldb%fields%get_field_collection("multifile_io_fields") call multifile_col%get_field("multifile_field", multifile_field) @@ -248,7 +237,7 @@ subroutine step( program_name, modeldb ) ! Call an algorithm call log_event(program_name//": Calculating diffusion", LOG_LEVEL_INFO) - call io_demo_alg(diffusion_field) + call io_demo_alg(modeldb, diffusion_field) if (write_diag) then ! Write out output file @@ -268,23 +257,23 @@ subroutine finalise( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb + type( field_collection_type ), pointer :: depository type( field_type ), pointer :: diffusion_field type( field_collection_type ), pointer :: multifile_col type( field_type ), pointer :: multifile_field - type(namelist_type), pointer :: io_nml logical :: multifile_io + + multifile_io = modeldb%config%io%multifile_io() + !------------------------------------------------------------------------- ! Checksum output !------------------------------------------------------------------------- depository => modeldb%fields%get_field_collection("depository") call depository%get_field("diffusion_field", diffusion_field) - io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value( 'multifile_io', multifile_io) - - if( multifile_io ) then + if (multifile_io) then multifile_col => modeldb%fields%get_field_collection("multifile_io_fields") call multifile_col%get_field("multifile_field", multifile_field) call checksum_alg(program_name, & diff --git a/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 b/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 index a4c2e7352..9d73c3f22 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_field_setup_mod.f90 @@ -16,10 +16,10 @@ module multifile_field_setup_mod use field_parent_mod, only: read_interface use fs_continuity_mod, only: Wtheta use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use lfric_xios_read_mod, only: read_field_generic use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection - use namelist_mod, only: namelist_type implicit none @@ -30,41 +30,40 @@ module multifile_field_setup_mod !> @details Creates the fields needed for the multifile IO !> @param[in,out] modeldb The model database in which to store model data. subroutine create_multifile_io_fields(modeldb) + implicit none type(modeldb_type), intent(inout) :: modeldb - type(mesh_type), pointer :: mesh type(field_collection_type), pointer :: multifile_io_fields - type( field_type ) :: multifile_io_field - procedure(read_interface), pointer :: tmp_ptr + type(field_type) :: multifile_io_field + procedure(read_interface), pointer :: tmp_ptr + + type(function_space_type), pointer :: fs + type(mesh_type), pointer :: mesh - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: finite_element_nml character(str_def) :: prime_mesh_name - integer(i_def) :: element_order_h - integer(i_def) :: element_order_v + integer(i_def) :: order_h + integer(i_def) :: order_v + + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - finite_element_nml => modeldb%configuration%get_namelist('finite_element') - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call finite_element_nml%get_value('element_order_h', element_order_h) - call finite_element_nml%get_value('element_order_v', element_order_v) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() mesh => mesh_collection%get_mesh(prime_mesh_name) + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) call modeldb%fields%add_empty_field_collection("multifile_io_fields") multifile_io_fields => modeldb%fields%get_field_collection("multifile_io_fields") - call multifile_io_field%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, Wtheta), & - name="multifile_field") + + call multifile_io_field%initialise(fs, name="multifile_field") + tmp_ptr => read_field_generic call multifile_io_field%set_read_behaviour(tmp_ptr) call multifile_io_fields%add_field(multifile_io_field) end subroutine create_multifile_io_fields - -end module multifile_field_setup_mod \ No newline at end of file +end module multifile_field_setup_mod diff --git a/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 b/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 index ac1ea68a2..6fb812c77 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_file_setup_mod.f90 @@ -9,21 +9,13 @@ !> from them. module multifile_file_setup_mod - use constants_mod, only: i_def, & - str_def, str_max_filename + use constants_mod, only: i_def, str_def, l_def + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use file_mod, only: file_type, FILE_MODE_READ use lfric_xios_file_mod, only: lfric_xios_file_type, OPERATION_ONCE, & OPERATION_TIMESERIES use linked_list_mod, only: linked_list_type - use log_mod, only: log_event, log_level_error - use driver_modeldb_mod, only: modeldb_type - - ! Configuration modules - use io_config_mod, only: use_xios_io, & - diagnostic_frequency - use time_config_mod, only: timestep_start, & - timestep_end implicit none @@ -38,21 +30,29 @@ subroutine init_multifile_files(files_list, modeldb, filename) implicit none - type(linked_list_type), intent(out) :: files_list - type(modeldb_type), intent(inout) :: modeldb - character(str_def), intent(in) :: filename + type(linked_list_type), intent(out) :: files_list + type(modeldb_type), intent(inout) :: modeldb + character(str_def), intent(in) :: filename - integer(i_def) :: ts_start, ts_end - integer(i_def) :: rc + character(str_def) :: timestep_start, timestep_end + + integer(i_def) :: ts_start, ts_end + integer(i_def) :: rc + logical(l_def) :: use_xios_io type(field_collection_type), pointer :: multifile_fields - multifile_fields => modeldb%fields%get_field_collection("multifile_io_fields") + + use_xios_io = modeldb%config%io%use_xios_io() + timestep_start = modeldb%config%time%timestep_start() + timestep_end = modeldb%config%time%timestep_end() + + multifile_fields => modeldb%fields%get_field_collection("multifile_io_fields") ! Get time configuration in integer form - read(timestep_start,*,iostat=rc) ts_start - read(timestep_end,*,iostat=rc) ts_end + read(timestep_start,*,iostat=rc) ts_start + read(timestep_end, *,iostat=rc) ts_end - if ( use_xios_io) then + if (use_xios_io) then call files_list%insert_item( & lfric_xios_file_type( filename, & @@ -66,4 +66,4 @@ subroutine init_multifile_files(files_list, modeldb, filename) end subroutine init_multifile_files -end module multifile_file_setup_mod \ No newline at end of file +end module multifile_file_setup_mod diff --git a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 index 85be25ac0..52ef2e959 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 @@ -8,11 +8,10 @@ !> the multifile IO. module multifile_io_mod - use base_mesh_config_mod, only: prime_mesh_name use calendar_mod, only: calendar_type use constants_mod, only: str_def, i_def - use driver_modeldb_mod, only: modeldb_type use driver_model_data_mod, only: model_data_type + use driver_modeldb_mod, only: modeldb_type use empty_io_context_mod, only: empty_io_context_type use event_mod, only: event_action use event_actor_mod, only: event_actor_type @@ -22,7 +21,7 @@ module multifile_io_mod use inventory_by_mesh_mod, only: inventory_by_mesh_type use io_context_collection_mod, only: io_context_collection_type use io_context_mod, only: io_context_type, callback_clock_arg - use io_config_mod, only: use_xios_io, subroutine_timers + use log_mod, only: log_event, log_level_error, & log_level_trace, log_level_info, & log_scratch_space @@ -32,9 +31,11 @@ module multifile_io_mod use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection use model_clock_mod, only: model_clock_type - use namelist_mod, only: namelist_type use step_calendar_mod, only: step_calendar_type + use multifile_io_nml_iterator_mod, only: multifile_io_nml_iterator_type + use multifile_io_nml_mod, only: multifile_io_nml_type + implicit none private @@ -48,35 +49,35 @@ module multifile_io_mod !> @brief Initialise the multifile IO !> @param[inout] modeldb Modeldb object subroutine init_multifile_io(modeldb) + implicit none type(modeldb_type), intent(inout) :: modeldb - type(lfric_xios_context_type), pointer :: io_context - type(namelist_type), pointer :: multifile_nml + type(lfric_xios_context_type), pointer :: io_context character(str_def) :: context_name - integer(i_def) :: multifile_start_timestep - integer(i_def) :: multifile_stop_timestep + integer(i_def) :: start_timestep + integer(i_def) :: stop_timestep character(str_def) :: filename - character(str_def), allocatable :: multifile_io_profiles(:) - integer(i_def) :: i type(linked_list_type), pointer :: file_list - allocate(multifile_io_profiles, source=modeldb%configuration%get_namelist_profiles("multifile_io")) + type(multifile_io_nml_iterator_type) :: iter + type(multifile_io_nml_type), pointer :: multifile_nml + + call iter%initialise(modeldb%config%multifile_io) + do while (iter%has_next()) + + multifile_nml => iter%next() - do i=1, size(multifile_io_profiles) + filename = multifile_nml%filename() + start_timestep = multifile_nml%start_timestep() + stop_timestep = multifile_nml%stop_timestep() - multifile_nml => modeldb%configuration%get_namelist('multifile_io', & - profile_name=trim(multifile_io_profiles(i))) - call multifile_nml%get_value('filename', filename) - call multifile_nml%get_value('start_timestep', multifile_start_timestep) - call multifile_nml%get_value('stop_timestep', multifile_stop_timestep) context_name = "multifile_context_" // trim(filename) - call context_init(modeldb, context_name, multifile_start_timestep, & - multifile_stop_timestep) + call context_init(modeldb, context_name, start_timestep, stop_timestep) call modeldb%io_contexts%get_io_context(context_name, io_context) @@ -85,8 +86,6 @@ subroutine init_multifile_io(modeldb) end do - deallocate(multifile_io_profiles) - end subroutine init_multifile_io !> @brief Step the multifile IO @@ -96,71 +95,76 @@ end subroutine init_multifile_io !> @param[in] panel_id_inventory Inventory object, containing all of !! the fields with the ID of mesh panels subroutine step_multifile_io(modeldb, chi_inventory, panel_id_inventory) + implicit none - type(modeldb_type), intent(inout) :: modeldb - type(inventory_by_mesh_type), intent(in) :: chi_inventory - type(inventory_by_mesh_type), intent(in) :: panel_id_inventory - type(lfric_xios_context_type), pointer :: io_context + type(modeldb_type), intent(inout) :: modeldb + type(inventory_by_mesh_type), intent(in) :: chi_inventory + type(inventory_by_mesh_type), intent(in) :: panel_id_inventory + + type(lfric_xios_context_type), pointer :: io_context + class(event_actor_type), pointer :: event_actor_ptr - type(mesh_type), pointer :: mesh => null() - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() + + type(mesh_type), pointer :: mesh + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id class(calendar_type), allocatable :: tmp_calendar - type(namelist_type), pointer :: multifile_nml - type(namelist_type), pointer :: time_nml + type(multifile_io_nml_iterator_type) :: iter + type(multifile_io_nml_type), pointer :: multifile_nml + character(str_def) :: context_name + character(str_def) :: prime_mesh_name character(str_def) :: filename - character(str_def) :: time_origin character(str_def) :: time_start - character(str_def), allocatable :: multifile_io_profiles(:) - integer(i_def) :: i - procedure(event_action), pointer :: context_advance procedure(callback_clock_arg), pointer :: before_close - + nullify(mesh) + nullify(chi) + nullify(panel_id) nullify(before_close) - allocate(multifile_io_profiles, source=modeldb%configuration%get_namelist_profiles("multifile_io")) - - do i=1, size(multifile_io_profiles) + call iter%initialise(modeldb%config%multifile_io) + do while (iter%has_next()) - multifile_nml => modeldb%configuration%get_namelist('multifile_io', & - profile_name=trim(multifile_io_profiles(i))) - call multifile_nml%get_value('filename', filename) + multifile_nml => iter%next() + filename = multifile_nml%filename() context_name = "multifile_context_" // trim(filename) + call modeldb%io_contexts%get_io_context(context_name, io_context) if (modeldb%clock%get_step() == io_context%get_stop_time()) then + ! Finalise XIOS context call io_context%set_current() call io_context%set_active(.false.) call modeldb%clock%remove_event(context_name) call io_context%finalise_xios_context() - elseif (modeldb%clock%get_step() == io_context%get_start_time()) then + else if (modeldb%clock%get_step() == io_context%get_start_time()) then + + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + time_origin = modeldb%config%time%calendar_origin() + time_start = modeldb%config%time%calendar_start() + ! Initialise XIOS context mesh => mesh_collection%get_mesh(prime_mesh_name) call chi_inventory%get_field_array(mesh, chi) call panel_id_inventory%get_field(mesh, panel_id) - time_nml => modeldb%configuration%get_namelist('time') - - call time_nml%get_value('calendar_origin', time_origin) - call time_nml%get_value('calendar_start', time_start) - allocate(tmp_calendar, source=step_calendar_type(time_origin, time_start)) call io_context%initialise_xios_context( modeldb%mpi%get_comm(), & chi, panel_id, & modeldb%clock, tmp_calendar, & - before_close, start_at_zero=.true. ) + before_close, & + start_at_zero=.true. ) ! Attach context advancement to the model's clock context_advance => advance_read_only @@ -173,8 +177,6 @@ subroutine step_multifile_io(modeldb, chi_inventory, panel_id_inventory) call modeldb%io_contexts%get_io_context("io_demo", io_context) call io_context%set_current() - deallocate(multifile_io_profiles) - end subroutine step_multifile_io !> @brief Helper function for initialising the lfric IO context and adding it @@ -188,8 +190,10 @@ subroutine context_init(modeldb, & multifile_start_timestep, & multifile_stop_timestep) implicit none + type(modeldb_type), intent(inout) :: modeldb - character(*), intent(in) :: context_name + + character(*), intent(in) :: context_name integer(i_def), intent(in) :: multifile_start_timestep integer(i_def), intent(in) :: multifile_stop_timestep diff --git a/applications/io_demo/source/io_demo.f90 b/applications/io_demo/source/io_demo.f90 index 0ed2566e1..d298f80b4 100644 --- a/applications/io_demo/source/io_demo.f90 +++ b/applications/io_demo/source/io_demo.f90 @@ -21,8 +21,9 @@ program io_demo log_level_trace, & log_scratch_space use random_number_generator_mod, only : random_number_generator_type - use io_demo_mod, only : io_demo_required_namelists - use io_demo_driver_mod, only : initialise, step, finalise + + use io_demo_mod, only: io_demo_required_namelists + use io_demo_driver_mod, only: initialise, step, finalise implicit none @@ -36,6 +37,7 @@ program io_demo call parse_command_line( filename ) call modeldb%values%initialise() call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise(program_name) write(log_scratch_space,& '("Application built with ", A, "-bit real numbers")') & @@ -43,9 +45,12 @@ program io_demo call log_event( log_scratch_space, log_level_trace ) modeldb%mpi => global_mpi call init_comm(program_name, modeldb) - call init_config( filename, & - io_demo_required_namelists, & - modeldb%configuration ) + + call init_config(filename, & + io_demo_required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config) + deallocate( filename ) call init_logger( modeldb%mpi%get_comm(), program_name ) diff --git a/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 b/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 index 4a0aebc6c..63dcab0a1 100644 --- a/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 +++ b/applications/lbc_demo/source/algorithm/init_lam_fields_alg_mod.x90 @@ -20,7 +20,6 @@ module init_lam_fields_alg_mod use field_parent_mod, only: field_parent_type use integer_field_mod, only: integer_field_type use mesh_mod, only: mesh_type - use namelist_mod, only: namelist_type ! Procedures use create_field_set_mod, only: create_field_set @@ -46,7 +45,6 @@ subroutine init_lam_fields( mesh, modeldb ) class(field_parent_type), pointer :: field type(field_type), pointer :: tmp_real_field type(integer_field_type), pointer :: tmp_int_field - type(namelist_type), pointer :: io_nml logical :: use_xios_io logical :: write_diag @@ -58,17 +56,15 @@ subroutine init_lam_fields( mesh, modeldb ) real(r_def), parameter :: lam_real_value = 9.0_r_def integer(i_def), parameter :: lam_int_value = 9_i_def - io_nml => modeldb%configuration%get_namelist('io') - - call io_nml%get_value('write_diag', write_diag) - call io_nml%get_value('use_xios_io', use_xios_io) + write_diag = modeldb%config%io%write_diag() + use_xios_io = modeldb%config%io%use_xios_io() fld_collection => modeldb%fields%get_field_collection( field_collection_name ) !===================================== ! Create LAM fields !===================================== - call create_field_set( fld_collection, mesh, modeldb%configuration ) + call create_field_set(modeldb, fld_collection, mesh) !===================================== ! Set up field with an IO behaviour diff --git a/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 b/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 index c536a35b4..7c43f89fa 100644 --- a/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 +++ b/applications/lbc_demo/source/algorithm/init_lbc_fields_alg_mod.x90 @@ -25,7 +25,6 @@ module init_lbc_fields_alg_mod use integer_field_mod, only: integer_field_type use inventory_by_mesh_mod, only: inventory_by_mesh_type use mesh_mod, only: mesh_type - use namelist_mod, only: namelist_type ! Kernels use set_lbc_int_kernel_mod, only: set_lbc_int_kernel_type @@ -95,25 +94,14 @@ module init_lbc_fields_alg_mod type(function_space_type), pointer :: fs - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: finite_element_nml - type(namelist_type), pointer :: lbc_demo_nml - type(namelist_type), pointer :: io_nml - - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - finite_element_nml => modeldb%configuration%get_namelist('finite_element') - io_nml => modeldb%configuration%get_namelist('io') - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - - call base_mesh_nml%get_value( 'geometry', geometry) - call io_nml%get_value( 'use_xios_io', use_xios_io) - call io_nml%get_value( 'write_diag', write_diag) - - call lbc_demo_nml%get_value( 'enable_lbc', enable_lbc ) - call lbc_demo_nml%get_value( 'lbc_source', lbc_source ) - call lbc_demo_nml%get_value( 'set_lbc', set_lbc ) - call lbc_demo_nml%get_value( 'write_lbc', write_lbc ) - call lbc_demo_nml%get_value( 'read_lbc', read_lbc ) + geometry = modeldb%config%base_mesh%geometry() + use_xios_io = modeldb%config%io%use_xios_io() + write_diag = modeldb%config%io%write_diag() + enable_lbc = modeldb%config%lbc_demo%enable_lbc() + lbc_source = modeldb%config%lbc_demo%lbc_source() + set_lbc = modeldb%config%lbc_demo%set_lbc() + write_lbc = modeldb%config%lbc_demo%write_lbc() + read_lbc = modeldb%config%lbc_demo%read_lbc() lbc_mesh_name = trim(mesh%get_mesh_name())//'-lbc' @@ -132,7 +120,7 @@ module init_lbc_fields_alg_mod !===================================== ! Create an LBC field !===================================== - call create_field_set( fld_collection, lbc_mesh, modeldb%configuration ) + call create_field_set(modeldb, fld_collection, lbc_mesh) !===================================== ! Set up field with an IO behaviour diff --git a/applications/lbc_demo/source/driver/create_field_set_mod.F90 b/applications/lbc_demo/source/driver/create_field_set_mod.F90 index 8ffc409e9..9fc99328a 100644 --- a/applications/lbc_demo/source/driver/create_field_set_mod.F90 +++ b/applications/lbc_demo/source/driver/create_field_set_mod.F90 @@ -6,11 +6,10 @@ module create_field_set_mod use constants_mod, only: i_def + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type use integer_field_mod, only: integer_field_type - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use fs_continuity_mod, only: W0, W2H, W2V, W3, Wtheta @@ -29,20 +28,18 @@ module create_field_set_mod contains !> @brief Instantiates field set for lbc_demo application +!! @param[in, out] modeldb Application state object !! @param[in, out] fld_collection Field collection to add field set !! @param[in] mesh Mesh to use for field set -!! @param[in] configuration Configuration namelist -subroutine create_field_set( fld_collection, mesh, configuration ) +subroutine create_field_set(modeldb, fld_collection, mesh) implicit none + type(modeldb_type), intent(in) :: modeldb - type(field_collection_type), pointer, intent(inout) :: fld_collection - type(mesh_type), pointer, intent(in) :: mesh - type(namelist_collection_type), intent(in) :: configuration + type(field_collection_type), pointer, intent(inout) :: fld_collection + type(mesh_type), pointer, intent(in) :: mesh - type(namelist_type), pointer :: finite_element_nml - type(namelist_type), pointer :: lbc_demo_nml type(field_type) :: fld type(integer_field_type) :: int_fld @@ -57,12 +54,9 @@ subroutine create_field_set( fld_collection, mesh, configuration ) ! Enumerations integer :: test_field_type - lbc_demo_nml => configuration%get_namelist('lbc_demo') - finite_element_nml => configuration%get_namelist('finite_element') - - call lbc_demo_nml%get_value( 'field_type', test_field_type ) - call finite_element_nml%get_value( 'element_order_h', order_h ) - call finite_element_nml%get_value( 'element_order_v', order_v ) + test_field_type = modeldb%config%lbc_demo%field_type() + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() mesh_2d => mesh_collection%get_mesh(mesh, twod) diff --git a/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 b/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 index 02b814d53..45880fcbd 100644 --- a/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 +++ b/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 @@ -32,7 +32,6 @@ module lbc_demo_driver_mod log_level_trace use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection - use namelist_mod, only: namelist_type !------------------------------------ ! Configuration modules @@ -40,8 +39,8 @@ module lbc_demo_driver_mod use base_mesh_config_mod, only: geometry_spherical, & geometry_planar, & topology_non_periodic - use lbc_demo_config_mod, only: lbc_source_file, & - field_type_real + use lbc_demo_config_mod, only: field_type_real + implicit none private @@ -78,12 +77,6 @@ subroutine initialise( program_name, modeldb) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: planet_nml - type(namelist_type), pointer :: extrusion_nml - type(namelist_type), pointer :: io_nml - type(namelist_type), pointer :: lbc_demo_nml - character(str_def) :: prime_mesh_name character(str_def) :: lbc_mesh_name character(str_def) :: output_mesh_name @@ -103,7 +96,6 @@ subroutine initialise( program_name, modeldb) logical :: enable_lbc logical :: apply_lbc logical :: write_lbc - integer :: lbc_source integer :: topology integer :: i @@ -113,26 +105,20 @@ subroutine initialise( program_name, modeldb) !======================================================================= ! Extract configuration variables !======================================================================= - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - io_nml => modeldb%configuration%get_namelist('io') - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) - - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - call io_nml%get_value( 'write_diag', write_diag) - - call lbc_demo_nml%get_value( 'enable_lbc', enable_lbc ) - call lbc_demo_nml%get_value( 'apply_lbc', apply_lbc ) - call lbc_demo_nml%get_value( 'write_lbc', write_lbc ) - call lbc_demo_nml%get_value( 'lbc_source', lbc_source ) + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() + + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + + scaled_radius = modeldb%config%planet%scaled_radius() + write_diag = modeldb%config%io%write_diag() + + enable_lbc = modeldb%config%lbc_demo%enable_lbc() + apply_lbc = modeldb%config%lbc_demo%apply_lbc() + write_lbc = modeldb%config%lbc_demo%write_lbc() !======================================================================= ! Mesh setup @@ -278,21 +264,17 @@ subroutine step( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb - type( field_collection_type ), pointer :: output_diags - type(namelist_type), pointer :: io_nml - type(namelist_type), pointer :: lbc_demo_nml + type(field_collection_type), pointer :: output_diags logical :: apply_lbc, write_diag, write_lbc, enable_lbc character(str_def) :: suffix - io_nml => modeldb%configuration%get_namelist('io') - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - - call io_nml%get_value( 'write_diag', write_diag) + nullify(output_diags) - call lbc_demo_nml%get_value( 'apply_lbc', apply_lbc ) - call lbc_demo_nml%get_value( 'enable_lbc', enable_lbc ) - call lbc_demo_nml%get_value( 'write_lbc', write_lbc ) + write_diag = modeldb%config%io%write_diag() + enable_lbc = modeldb%config%lbc_demo%enable_lbc() + apply_lbc = modeldb%config%lbc_demo%apply_lbc() + write_lbc = modeldb%config%lbc_demo%write_lbc() if (apply_lbc) then ! Update prognostic with LBC fields @@ -301,7 +283,6 @@ subroutine step( program_name, modeldb ) if (write_diag) then ! Write out output file - if (enable_lbc .and. write_lbc) then output_diags => modeldb%fields%get_field_collection('lbc') suffix=':lbc' @@ -311,7 +292,6 @@ subroutine step( program_name, modeldb ) end if call write_field_set(output_diags, suffix) - end if end subroutine step @@ -329,12 +309,10 @@ subroutine finalise( program_name, modeldb ) type(modeldb_type), intent(inout) :: modeldb type(field_collection_type), pointer :: depository - type(namelist_type), pointer :: lbc_demo_nml integer(i_def) :: lbc_field_type - lbc_demo_nml => modeldb%configuration%get_namelist('lbc_demo') - call lbc_demo_nml%get_value( 'field_type', lbc_field_type ) + lbc_field_type = modeldb%config%lbc_demo%field_type() !------------------------------------------------------------------------- ! Checksum output - Only for real fields diff --git a/applications/lbc_demo/source/lbc_demo.f90 b/applications/lbc_demo/source/lbc_demo.f90 index a79291218..50612d273 100644 --- a/applications/lbc_demo/source/lbc_demo.f90 +++ b/applications/lbc_demo/source/lbc_demo.f90 @@ -24,7 +24,6 @@ program lbc_demo use lfric_mpi_mod, only: global_mpi use lbc_demo_mod, only: required_namelists use lbc_demo_driver_mod, only: initialise, step, finalise - use namelist_mod, only: namelist_type use base_mesh_config_mod, only: geometry_spherical, & topology_fully_periodic @@ -35,7 +34,6 @@ program lbc_demo character(*), parameter :: program_name = "lbc_demo" character(:), allocatable :: filename - type(namelist_type), pointer :: base_mesh_nml integer :: geometry, topology call parse_command_line( filename ) @@ -47,17 +45,18 @@ program lbc_demo ! The technical and scientific state modeldb%mpi => global_mpi call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise( program_name ) call init_comm(program_name, modeldb) - call init_config( filename, required_namelists, & - modeldb%configuration ) + + call init_config(filename, required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config) ! Before anything else, test that the mesh provided was a regional domain. ! This application is not intended for cubed-sphere meshes. - - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) + geometry = modeldb%config%base_mesh%geometry() + topology = modeldb%config%base_mesh%topology() if ( geometry == geometry_spherical .and. & topology == topology_fully_periodic ) then diff --git a/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 b/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 index 9f99a355f..4e1121503 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_alg_mod.x90 @@ -6,15 +6,17 @@ !>@brief Module containing simple_diffusion_alg module simple_diffusion_alg_mod - use constants_mod, only: i_def,r_def + + use constants_mod, only: i_def, r_def + use driver_modeldb_mod, only: modeldb_type use log_mod, only: log_event, & LOG_LEVEL_INFO, & LOG_LEVEL_TRACE use mesh_mod, only: mesh_type use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, element_order_v use fs_continuity_mod, only: Wtheta, W2 use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use operator_mod, only: operator_type use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use simple_diffusion_constants_mod, only: get_dx_at_w2 @@ -30,11 +32,14 @@ module simple_diffusion_alg_mod contains !> @details Calculates the diffusion increment for a field, and adds it to said field. + !> @param[in] modeldb Application state object !> @param[inout] field_in Input Wtheta field - subroutine simple_diffusion_alg( field_in ) + subroutine simple_diffusion_alg( modeldb, field_in ) implicit none + type(modeldb_type), intent( in ) :: modeldb + ! Prognostic fields type( field_type ), intent( inout ) :: field_in @@ -43,18 +48,30 @@ contains type( field_type ) :: visc real(r_def), parameter :: visc_val = 100000.0_r_def - type(mesh_type), pointer :: mesh => null() + type(mesh_type), pointer :: mesh integer(kind=i_def), parameter :: stencil_depth = 1_i_def - type( field_type ), pointer :: dx_at_w2 => null() + type( field_type ), pointer :: dx_at_w2 + + type(function_space_type), pointer :: fs + integer(i_def) :: order_h, order_v call log_event( "simple_diffusion: Running algorithm", LOG_LEVEL_TRACE ) - mesh => field_in%get_mesh() + + nullify(dx_at_w2) + nullify(mesh) + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + mesh => field_in%get_mesh() dx_at_w2 => get_dx_at_w2(mesh) - call dfield_in%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) - call visc%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta)) + + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + + call dfield_in%initialise(fs) + call visc%initialise(fs) + call invoke( name = "compute_diffusion", & setval_c(visc, visc_val), & setval_c(dfield_in, 0.0_r_def), & diff --git a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 index d9f6cef64..cffdabe98 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 @@ -15,14 +15,14 @@ module simple_diffusion_constants_mod ! Infrastructure - use constants_mod, only: i_def, r_def, & + use constants_mod, only: i_def, r_def, l_def, & str_def, str_short + use driver_modeldb_mod, only: modeldb_type use field_collection_mod, only: field_collection_type use field_mod, only: field_type use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type @@ -48,20 +48,28 @@ module simple_diffusion_constants_mod contains !> @brief Subroutine to create the finite element constants + !> @param[in] modeldb Application state object !> @param[in] mesh The prime model mesh !> @param[in] chi Coordinate fields !> @param[in] panel_id Panel_id field - subroutine create_simple_diffusion_constants(mesh, & - chi, & - panel_id ) + subroutine create_simple_diffusion_constants( modeldb, & + mesh, & + chi, & + panel_id ) implicit none + type(modeldb_type), intent(in) :: modeldb + ! Arguments type(mesh_type), pointer, intent(in) :: mesh type(field_type), target, intent(in) :: chi(:) type(field_type), target, intent(in) :: panel_id + logical(l_def) :: subroutine_timers + + subroutine_timers = modeldb%config%io%subroutine_timers() + if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') call log_event( "simple_diffusion: creating runtime constants", LOG_LEVEL_TRACE ) diff --git a/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 b/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 index 6a3f8ac19..1dc960087 100644 --- a/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 +++ b/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 @@ -13,19 +13,17 @@ module init_simple_diffusion_mod use sci_assign_field_random_range_alg_mod, & only: assign_field_random_range - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, l_def use driver_modeldb_mod, only : modeldb_type use field_collection_mod, only : field_collection_type use field_mod, only : field_type use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, element_order_v use function_space_collection_mod, only : function_space_collection + use function_space_mod, only : function_space_type use fs_continuity_mod, only : Wtheta use log_mod, only : log_event, & LOG_LEVEL_TRACE use mesh_mod, only : mesh_type - use io_config_mod, only : write_diag, & - use_xios_io use lfric_xios_write_mod, only : write_field_generic use simple_diffusion_constants_mod, only : create_simple_diffusion_constants @@ -37,7 +35,7 @@ module init_simple_diffusion_mod !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels !> @param[in,out] modeldb The structure that holds model state - subroutine init_simple_diffusion( mesh, chi, panel_id, modeldb) + subroutine init_simple_diffusion(mesh, chi, panel_id, modeldb) implicit none @@ -53,13 +51,24 @@ subroutine init_simple_diffusion( mesh, chi, panel_id, modeldb) real(kind=r_def), parameter :: min_val = 280.0_r_def real(kind=r_def), parameter :: max_val = 330.0_r_def + type(function_space_type), pointer :: fs + + logical(l_def) :: write_diag, use_xios_io + integer(i_def) :: order_h, order_v + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + write_diag = modeldb%config%io%write_diag() + use_xios_io = modeldb%config%io%use_xios_io() + + fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) + call log_event( 'simple_diffusion: Initialising miniapp ...', LOG_LEVEL_TRACE ) + ! Create prognostic fields ! Creates a field in the Wtheta function space - call diffusion_field%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, Wtheta), & - name="diffusion_field") + call diffusion_field%initialise(fs, name="diffusion_field") ! Set up field with an IO behaviour (XIOS only at present) if (write_diag .and. use_xios_io) then @@ -78,7 +87,7 @@ subroutine init_simple_diffusion( mesh, chi, panel_id, modeldb) ! Create simple_diffusion runtime constants. This creates various things ! needed by the fem algorithms such as mass matrix operators, mass ! matrix diagonal fields and the geopotential field - call create_simple_diffusion_constants(mesh, chi, panel_id) + call create_simple_diffusion_constants(modeldb, mesh, chi, panel_id) call log_event( 'simple_diffusion: Miniapp initialised', LOG_LEVEL_TRACE ) diff --git a/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 b/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 index 3710e98d4..6907b7da9 100644 --- a/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 +++ b/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 @@ -11,7 +11,7 @@ module simple_diffusion_driver_mod use add_mesh_map_mod, only : assign_mesh_maps use sci_checksum_alg_mod, only : checksum_alg - use constants_mod, only : i_def, str_def, & + use constants_mod, only : i_def, str_def, l_def, & r_def, r_second use convert_to_upper_mod, only : convert_to_upper use create_mesh_mod, only : create_mesh, create_extrusion @@ -35,7 +35,6 @@ module simple_diffusion_driver_mod LOG_LEVEL_TRACE use mesh_mod, only : mesh_type use mesh_collection_mod, only : mesh_collection - use namelist_mod, only : namelist_type use random_number_generator_mod, only : random_number_generator_type use simple_diffusion_alg_mod, only : simple_diffusion_alg @@ -44,7 +43,6 @@ module simple_diffusion_driver_mod !------------------------------------ use base_mesh_config_mod, only: GEOMETRY_SPHERICAL, & GEOMETRY_PLANAR - use io_config_mod, only: write_diag implicit none @@ -80,10 +78,6 @@ subroutine initialise( program_name, modeldb) class(abstract_value_type), pointer :: abstract_value type(random_number_generator_type), pointer :: rng - type(namelist_type), pointer :: base_mesh_nml => null() - type(namelist_type), pointer :: planet_nml => null() - type(namelist_type), pointer :: extrusion_nml => null() - character(str_def) :: prime_mesh_name integer(i_def) :: stencil_depth @@ -101,20 +95,12 @@ subroutine initialise( program_name, modeldb) !======================================================================= ! 0.0 Extract configuration variables !======================================================================= - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() !======================================================================= ! 1.0 Mesh @@ -146,7 +132,7 @@ subroutine initialise( program_name, modeldb) end select allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) @@ -229,15 +215,20 @@ subroutine step( program_name, modeldb ) character(*), intent(in) :: program_name type(modeldb_type), intent(inout) :: modeldb + type( field_collection_type ), pointer :: depository type( field_type ), pointer :: diffusion_field + logical(l_def) :: write_diag + + write_diag = modeldb%config%io%write_diag() + depository => modeldb%fields%get_field_collection("depository") call depository%get_field("diffusion_field", diffusion_field) ! Call an algorithm call log_event(program_name//": Calculating diffusion", LOG_LEVEL_INFO) - call simple_diffusion_alg(diffusion_field) + call simple_diffusion_alg(modeldb, diffusion_field) if (write_diag) then ! Write out output file diff --git a/applications/simple_diffusion/source/simple_diffusion.f90 b/applications/simple_diffusion/source/simple_diffusion.f90 index 6be295d03..e2b09fce6 100644 --- a/applications/simple_diffusion/source/simple_diffusion.f90 +++ b/applications/simple_diffusion/source/simple_diffusion.f90 @@ -37,6 +37,7 @@ program simple_diffusion call parse_command_line( filename ) call modeldb%values%initialise() call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise( program_name ) write(log_scratch_space,& '("Application built with ", A, "-bit real numbers")') & @@ -44,9 +45,11 @@ program simple_diffusion call log_event( log_scratch_space, log_level_trace ) modeldb%mpi => global_mpi call init_comm(program_name, modeldb) - call init_config( filename, & - simple_diffusion_required_namelists, & - modeldb%configuration ) + + call init_config( filename, simple_diffusion_required_namelists, & + configuration=modeldb%configuration, & + config=modeldb%config ) + deallocate( filename ) call init_logger( modeldb%mpi%get_comm(), program_name ) diff --git a/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 b/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 index 6bcb680b2..dcd6dda1a 100644 --- a/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_alg_mod.x90 @@ -7,14 +7,14 @@ !>@brief Barebones algorithm to help the development of applications module skeleton_alg_mod - use constants_mod, only: i_def,r_def - use log_mod, only: log_event, & - LOG_LEVEL_INFO + use constants_mod, only: r_def, i_def + use log_mod, only: log_event, log_level_info use mesh_mod, only: mesh_type + use driver_modeldb_mod, only: modeldb_type use field_mod, only: field_type - use finite_element_config_mod, only: element_order_h, element_order_v use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type use operator_mod, only: operator_type use matrix_vector_kernel_mod, only: matrix_vector_kernel_type use skeleton_constants_mod, only: get_div @@ -29,30 +29,42 @@ module skeleton_alg_mod contains !> @details An algorithm for developing applications + !> @param[in] modeldb Application state object !> @param[inout] field_1 A prognostic field object - subroutine skeleton_alg(field_1) + subroutine skeleton_alg(modeldb, field_1) implicit none + type(modeldb_type), intent(in) :: modeldb + ! Prognostic fields - type( field_type ), intent( inout ) :: field_1 + type(field_type), intent(inout) :: field_1 ! Diagnostic fields - type( field_type ) :: field_2 + type(field_type) :: field_2 + + type(mesh_type), pointer :: mesh + type(operator_type), pointer :: divergence + type(function_space_type), pointer :: fs + + real(r_def) :: s + + integer(i_def) :: order_h + integer(i_def) :: order_v - real(r_def) :: s - type(mesh_type), pointer :: mesh => null() - type( operator_type ), pointer :: divergence => null() + call log_event( "skeleton: Running algorithm", log_level_info ) - call log_event( "skeleton: Running algorithm", LOG_LEVEL_INFO ) + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() ! Create a new field on the W2 function space - mesh => field_1%get_mesh() - call field_2%initialise( function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2 ) ) + mesh => field_1%get_mesh() + divergence => get_div(mesh) + + fs => function_space_collection%get_fs(mesh, order_h, order_v, W2) + call field_2%initialise(fs) ! Set the new field to a constant value and compute the divergence of it - divergence => get_div(mesh) s = 2.0_r_def call invoke( name = "compute_divergence", & setval_c(field_2, s ), & @@ -63,9 +75,7 @@ contains ! printing the min/max values in field_1 call log_field_minmax( LOG_LEVEL_INFO, 'field_1', field_1 ) - nullify(mesh) - - call log_event( "skeleton: finished algorithm", LOG_LEVEL_INFO ) + call log_event( "skeleton: finished algorithm", log_level_info ) end subroutine skeleton_alg diff --git a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 index 3017c4bb8..2f7b2add7 100644 --- a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 @@ -15,14 +15,14 @@ module skeleton_constants_mod ! Infrastructure - use constants_mod, only: str_def + use constants_mod, only: str_def, i_def, l_def + use driver_modeldb_mod, only: modeldb_type use field_mod, only: field_type use fs_continuity_mod, only: W0, W1, W2, W2broken, & W2H, W2V, W3, Wtheta use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type @@ -31,12 +31,6 @@ module skeleton_constants_mod use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type use timer_mod, only: timer - ! Configuration - use finite_element_config_mod, only: element_order_h, & - element_order_v, & - nqp_h_exact, & - nqp_v_exact - ! Kernels use sci_compute_derham_matrices_kernel_mod, only: compute_derham_matrices_kernel_type @@ -74,49 +68,76 @@ module skeleton_constants_mod contains !> @brief Subroutine to create the finite element constants + !> @param[in] modeldb Application state object !> @param[in] mesh The prime model mesh !> @param[in] chi Coordinate fields !> @param[in] panel_id Panel_id field - subroutine create_skeleton_constants(mesh, & - chi, & - panel_id ) + subroutine create_skeleton_constants( modeldb, mesh, & + chi, panel_id ) implicit none ! Arguments - type(mesh_type), pointer, intent(in) :: mesh - type(field_type), target, intent(in) :: chi(:) - type(field_type), target, intent(in) :: panel_id + type(modeldb_type), intent(in) :: modeldb + + type(mesh_type), pointer, intent(in) :: mesh + type(field_type), target, intent(in) :: chi(:) + type(field_type), target, intent(in) :: panel_id - type(operator_type), pointer :: mm_w0 => null() - type(operator_type), pointer :: mm_w1 => null() - type(operator_type), pointer :: mm_w2 => null() - type(operator_type), pointer :: mm_w2b => null() - type(operator_type), pointer :: mm_w3 => null() - type(operator_type), pointer :: mm_wtheta => null() + type(operator_type), pointer :: mm_w0 + type(operator_type), pointer :: mm_w1 + type(operator_type), pointer :: mm_w2 + type(operator_type), pointer :: mm_w2b + type(operator_type), pointer :: mm_w3 + type(operator_type), pointer :: mm_wtheta ! Differential operators - type(operator_type), pointer :: div => null() - type(operator_type), pointer :: grad => null() - type(operator_type), pointer :: curl => null() - type(operator_type), pointer :: broken_div => null() + type(operator_type), pointer :: div + type(operator_type), pointer :: grad + type(operator_type), pointer :: curl + type(operator_type), pointer :: broken_div ! Internal variables - type(function_space_type), pointer :: w0_fs => null() - type(function_space_type), pointer :: w1_fs => null() - type(function_space_type), pointer :: w2_fs => null() - type(function_space_type), pointer :: w2b_fs => null() - type(function_space_type), pointer :: w2h_fs => null() - type(function_space_type), pointer :: w2v_fs => null() - type(function_space_type), pointer :: w3_fs => null() - type(function_space_type), pointer :: wtheta_fs => null() + type(function_space_type), pointer :: w0_fs + type(function_space_type), pointer :: w1_fs + type(function_space_type), pointer :: w2_fs + type(function_space_type), pointer :: w2b_fs + type(function_space_type), pointer :: w2h_fs + type(function_space_type), pointer :: w2v_fs + type(function_space_type), pointer :: w3_fs + type(function_space_type), pointer :: wtheta_fs + + integer(i_def) :: order_h, order_v + integer(i_def) :: nqp_h_exact, nqp_v_exact + logical(l_def) :: subroutine_timers + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + nqp_h_exact = modeldb%config%finite_element%nqp_h_exact() + nqp_v_exact = modeldb%config%finite_element%nqp_v_exact() + + subroutine_timers = modeldb%config%io%subroutine_timers() if ( subroutine_timers ) call timer('skeleton_constants_alg') call log_event( "Skeleton: creating runtime constants", LOG_LEVEL_INFO ) + !=========== Create function spaces required for setup ==================! + + w0_fs => function_space_collection%get_fs( mesh, order_h, order_v, W0 ) + w1_fs => function_space_collection%get_fs( mesh, order_h, order_v, W1 ) + w2_fs => function_space_collection%get_fs( mesh, order_h, order_v, W2 ) + w2v_fs => function_space_collection%get_fs( mesh, order_h, order_v, W2V ) + w2h_fs => function_space_collection%get_fs( mesh, order_h, order_v, W2H ) + w3_fs => function_space_collection%get_fs( mesh, order_h, order_v, W3 ) + + w2b_fs => function_space_collection%get_fs( mesh, order_h, order_v, & + W2broken ) + wtheta_fs => function_space_collection%get_fs( mesh, order_h, order_v, & + Wtheta ) + !======================== Create quadrature object ========================! - qr = quadrature_xyoz_type(nqp_h_exact, nqp_h_exact, nqp_v_exact, & - quadrature_rule) + qr = quadrature_xyoz_type( nqp_h_exact, nqp_h_exact, nqp_v_exact, & + quadrature_rule ) !======================== Initialise inventories ==========================! @@ -131,25 +152,6 @@ contains call curl_inventory%initialise(name="curl", table_len=5) call broken_div_inventory%initialise(name="broken_div", table_len=5) - !=========== Create function spaces required for setup ==================! - - w0_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W0 ) - w1_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W1 ) - w2_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2 ) - w2b_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2broken ) - w2v_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2V ) - w2h_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W2H ) - w3_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, W3 ) - wtheta_fs => function_space_collection%get_fs( mesh, element_order_h, & - element_order_v, Wtheta ) - !=================== Create de Rham cochain operators ===================! ! Set up all mass matrices and operators diff --git a/applications/skeleton/source/driver/init_skeleton_mod.F90 b/applications/skeleton/source/driver/init_skeleton_mod.F90 index e6f642c82..a33990f10 100644 --- a/applications/skeleton/source/driver/init_skeleton_mod.F90 +++ b/applications/skeleton/source/driver/init_skeleton_mod.F90 @@ -11,63 +11,67 @@ module init_skeleton_mod - use constants_mod, only : i_def, r_def - use driver_modeldb_mod, only : modeldb_type - use field_collection_mod, only : field_collection_type - use field_mod, only : field_type - use field_parent_mod, only : write_interface - use finite_element_config_mod, only : element_order_h, element_order_v - use function_space_collection_mod, only : function_space_collection - use fs_continuity_mod, only : W3 - use log_mod, only : log_event, & - LOG_LEVEL_INFO, & - LOG_LEVEL_ERROR - use mesh_mod, only : mesh_type - use skeleton_constants_mod, only : create_skeleton_constants + use constants_mod, only: i_def + use driver_modeldb_mod, only: modeldb_type + use field_collection_mod, only: field_collection_type + use field_mod, only: field_type + use function_space_collection_mod, only: function_space_collection + use function_space_mod, only: function_space_type + use fs_continuity_mod, only: W3 + use log_mod, only: log_event, log_level_info + use mesh_mod, only: mesh_type + use skeleton_constants_mod, only: create_skeleton_constants implicit none contains !> @details Initialises everything needed to run the skeleton miniapp - !> @param[in] mesh Representation of the mesh the code will run on - !> @param[in,out] chi The co-ordinate field + !> @param[in,out] modeldb The structure that holds model state + !> @param[in] mesh Representation of the mesh the code will run on + !> @param[in,out] chi The co-ordinate field !> @param[in,out] panel_id 2d field giving the id for cubed sphere panels - !> @param[in,out] modeldb The structure that holds model state - subroutine init_skeleton( mesh, chi, panel_id, modeldb) + + subroutine init_skeleton(modeldb, mesh, chi, panel_id) implicit none - type(mesh_type), intent(in), pointer :: mesh + type(modeldb_type), target, intent(inout) :: modeldb + type(mesh_type), pointer, intent(in) :: mesh + ! Coordinate field - type( field_type ), intent(inout) :: chi(:) - type( field_type ), intent(inout) :: panel_id - type(modeldb_type), intent(inout) :: modeldb + type(field_type), intent(inout) :: chi(:) + type(field_type), intent(inout) :: panel_id + + type(field_type) :: field_1 + + type(field_collection_type), pointer :: depository + type(function_space_type), pointer :: fs - type( field_type ) :: field_1 - type( field_collection_type ), pointer :: depository => null() + integer(i_def) :: order_h, order_v - procedure(write_interface), pointer :: tmp_ptr + call log_event('skeleton: Initialising miniapp ...', log_level_info) - call log_event( 'skeleton: Initialising miniapp ...', LOG_LEVEL_INFO ) + depository => modeldb%fields%get_field_collection("depository") + + order_h = modeldb%config%finite_element%element_order_h() + order_v = modeldb%config%finite_element%element_order_v() + + fs => function_space_collection%get_fs(mesh, order_h, order_v, W3) ! Create prognostic fields ! Creates a field in the W3 function space (fully discontinuous field) - call field_1%initialise( vector_space = & - function_space_collection%get_fs(mesh, element_order_h, & - element_order_v, W3), & - name="field_1") + call field_1%initialise(fs, name="field_1") ! Add field to modeldb - depository => modeldb%fields%get_field_collection("depository") call depository%add_field(field_1) ! Create skeleton runtime constants. This creates various things ! needed by the fem algorithms such as mass matrix operators, mass ! matrix diagonal fields and the geopotential field - call create_skeleton_constants(mesh, chi, panel_id) + call create_skeleton_constants(modeldb, mesh, chi, panel_id) - call log_event( 'skeleton: Miniapp initialised', LOG_LEVEL_INFO ) + call log_event('skeleton: Miniapp initialised', log_level_info) end subroutine init_skeleton diff --git a/applications/skeleton/source/driver/skeleton_driver_mod.f90 b/applications/skeleton/source/driver/skeleton_driver_mod.f90 index 42a9597a2..0ea9629ac 100644 --- a/applications/skeleton/source/driver/skeleton_driver_mod.f90 +++ b/applications/skeleton/source/driver/skeleton_driver_mod.f90 @@ -10,11 +10,11 @@ module skeleton_driver_mod use add_mesh_map_mod, only : assign_mesh_maps - use calendar_mod, only : calendar_type use sci_checksum_alg_mod, only : checksum_alg use constants_mod, only : i_def, str_def, & r_def, r_second use convert_to_upper_mod, only : convert_to_upper + use config_mod, only : config_type use create_mesh_mod, only : create_extrusion, create_mesh use driver_mesh_mod, only : init_mesh use driver_modeldb_mod, only : modeldb_type @@ -33,8 +33,6 @@ module skeleton_driver_mod LOG_LEVEL_INFO use mesh_mod, only : mesh_type use mesh_collection_mod, only : mesh_collection - use namelist_mod, only : namelist_type - use skeleton_alg_mod, only : skeleton_alg !------------------------------------ @@ -42,7 +40,6 @@ module skeleton_driver_mod !------------------------------------ use base_mesh_config_mod, only: GEOMETRY_SPHERICAL, & GEOMETRY_PLANAR - use io_config_mod, only: write_diag implicit none @@ -55,32 +52,27 @@ module skeleton_driver_mod !> Sets up required state in preparation for run. !> @param [in] program_name Identifier given to the model being run !> @param [in,out] modeldb The structure that holds model state - !> @param [in] calendar The model calendar - subroutine initialise( program_name, modeldb, calendar ) + subroutine initialise(program_name, modeldb) implicit none - character(*), intent(in) :: program_name - type(modeldb_type), intent(inout) :: modeldb - class(calendar_type), intent(in) :: calendar + character(*), intent(in) :: program_name + type(modeldb_type), intent(inout) :: modeldb ! Coordinate field - type(field_type), pointer :: chi(:) => null() - type(field_type), pointer :: panel_id => null() - type(mesh_type), pointer :: mesh => null() - type(inventory_by_mesh_type) :: chi_inventory - type(inventory_by_mesh_type) :: panel_id_inventory + type(field_type), pointer :: chi(:) + type(field_type), pointer :: panel_id + type(mesh_type), pointer :: mesh - character(str_def), allocatable :: base_mesh_names(:) - character(str_def), allocatable :: twod_names(:) + type(inventory_by_mesh_type) :: chi_inventory + type(inventory_by_mesh_type) :: panel_id_inventory + + character(str_def), allocatable :: base_mesh_names(:) + character(str_def), allocatable :: twod_names(:) class(extrusion_type), allocatable :: extrusion type(uniform_extrusion_type), allocatable :: extrusion_2d - type(namelist_type), pointer :: base_mesh_nml => null() - type(namelist_type), pointer :: planet_nml => null() - type(namelist_type), pointer :: extrusion_nml => null() - character(str_def) :: prime_mesh_name integer(i_def) :: stencil_depth @@ -95,21 +87,21 @@ subroutine initialise( program_name, modeldb, calendar ) integer(i_def) :: i integer(i_def), parameter :: one_layer = 1_i_def + nullify(chi) + nullify(panel_id) + nullify(mesh) + + call log_event( program_name//': Initialising.', log_level_info ) + ! ------------------------------- ! Extract namelist variables ! ------------------------------- - base_mesh_nml => modeldb%configuration%get_namelist('base_mesh') - planet_nml => modeldb%configuration%get_namelist('planet') - extrusion_nml => modeldb%configuration%get_namelist('extrusion') - call base_mesh_nml%get_value( 'prime_mesh_name', prime_mesh_name ) - call base_mesh_nml%get_value( 'geometry', geometry ) - call extrusion_nml%get_value( 'method', method ) - call extrusion_nml%get_value( 'domain_height', domain_height ) - call extrusion_nml%get_value( 'number_of_layers', number_of_layers ) - call planet_nml%get_value( 'scaled_radius', scaled_radius ) - base_mesh_nml => null() - planet_nml => null() - extrusion_nml => null() + prime_mesh_name = modeldb%config%base_mesh%prime_mesh_name() + geometry = modeldb%config%base_mesh%geometry() + method = modeldb%config%extrusion%method() + domain_height = modeldb%config%extrusion%domain_height() + number_of_layers = modeldb%config%extrusion%number_of_layers() + scaled_radius = modeldb%config%planet%scaled_radius() !======================================================================= ! Mesh @@ -133,8 +125,9 @@ subroutine initialise( program_name, modeldb, calendar ) call log_event("Invalid geometry for mesh initialisation", & LOG_LEVEL_ERROR) end select + allocate( extrusion, source=create_extrusion( method, & - domain_height, & + domain_height, & domain_bottom, & number_of_layers, & PRIME_EXTRUSION ) ) @@ -167,7 +160,7 @@ subroutine initialise( program_name, modeldb, calendar ) ! Build the FEM function spaces and coordinate fields !======================================================================= ! Create FEM specifics (function spaces and chi field) - call init_fem( mesh_collection, chi_inventory, panel_id_inventory ) + call init_fem(mesh_collection, chi_inventory, panel_id_inventory) !======================================================================= ! Create and initialise prognostic fields @@ -175,7 +168,7 @@ subroutine initialise( program_name, modeldb, calendar ) mesh => mesh_collection%get_mesh(prime_mesh_name) call chi_inventory%get_field_array(mesh, chi) call panel_id_inventory%get_field(mesh, panel_id) - call init_skeleton( mesh, chi, panel_id, modeldb ) + call init_skeleton(modeldb, mesh, chi, panel_id) nullify(mesh, chi, panel_id) deallocate(base_mesh_names) @@ -186,21 +179,22 @@ end subroutine initialise !> Performs a time step. !> @param [in] program_name An identifier given to the model being run !> @param [in,out] modeldb The structure that holds model state - subroutine step( program_name, modeldb ) + subroutine step(program_name, modeldb) implicit none - character(*), intent(in) :: program_name + character(*), intent(in) :: program_name + type(modeldb_type), intent(inout) :: modeldb - type( field_collection_type ), pointer :: depository - type( field_type ), pointer :: field_1 + type(field_collection_type), pointer :: depository + type(field_type), pointer :: field_1 depository => modeldb%fields%get_field_collection("depository") call depository%get_field("field_1", field_1) ! Call an algorithm - call skeleton_alg(field_1) + call skeleton_alg(modeldb, field_1) ! Write out output file call log_event(program_name//": Writing diagnostic output", LOG_LEVEL_INFO) diff --git a/applications/skeleton/source/skeleton.f90 b/applications/skeleton/source/skeleton.f90 index 332263c08..687fe9fc9 100644 --- a/applications/skeleton/source/skeleton.f90 +++ b/applications/skeleton/source/skeleton.f90 @@ -38,6 +38,7 @@ program skeleton call parse_command_line( filename ) call modeldb%configuration%initialise( program_name, table_len=10 ) + call modeldb%config%initialise(program_name) write(log_scratch_space,'(A)') & 'Application built with '// trim(precision_real) // & @@ -48,7 +49,9 @@ program skeleton call init_comm( "skeleton", modeldb ) call init_config( filename, skeleton_required_namelists, & - modeldb%configuration ) + configuration=modeldb%configuration, & + config=modeldb%config ) + call init_logger( modeldb%mpi%get_comm(), program_name ) call init_collections() call init_time( modeldb ) @@ -60,7 +63,7 @@ program skeleton call modeldb%io_contexts%initialise(program_name, 100) call log_event( 'Initialising ' // program_name // ' ...', log_level_trace ) - call initialise( program_name, modeldb, modeldb%calendar ) + call initialise( program_name, modeldb ) do while (modeldb%clock%tick()) call step( program_name, modeldb ) diff --git a/components/driver/source/driver_config_mod.f90 b/components/driver/source/driver_config_mod.f90 index e66683954..ec7c67d17 100644 --- a/components/driver/source/driver_config_mod.f90 +++ b/components/driver/source/driver_config_mod.f90 @@ -5,9 +5,11 @@ !----------------------------------------------------------------------------- module driver_config_mod - use configuration_mod, only: ensure_configuration, & - final_configuration, & - read_configuration + use config_mod, only: config_type + use config_loader_mod, only: ensure_configuration, & + final_configuration, & + read_configuration + use namelist_collection_mod, only: namelist_collection_type use log_mod, only: log_event, & log_level_debug, & @@ -22,14 +24,15 @@ module driver_config_mod contains subroutine init_config( filename, required_namelists, & - configuration ) + configuration, config ) implicit none character(*), intent(in) :: filename character(*), intent(in) :: required_namelists(:) - type(namelist_collection_type), intent(inout) :: configuration + type(namelist_collection_type), optional, intent(inout) :: configuration + type(config_type), optional, intent(inout) :: config logical, allocatable :: success_map(:) logical :: success @@ -40,9 +43,27 @@ subroutine init_config( filename, required_namelists, & call log_event( 'Loading configuration ...', & log_level_debug ) - call read_configuration( filename, configuration ) + if (present(config) .and. present(configuration)) then + ! TODO Transistion, remove once old configuration access removed + call read_configuration( filename, & + configuration=configuration, & + config=config ) + else if (.not. present(config) .and. present(configuration)) then + ! TODO Deprecated, remove once old configuration access removed + call read_configuration( filename, & + configuration=configuration ) + else if (.not. present(config) .and. present(configuration)) then + call read_configuration( filename, & + config=config ) + else + write(log_scratch_space,'(A)') & + 'At least one optional argument must be provided for '//& + 'init_config.' + call log_event(log_scratch_space, log_level_error) + end if success = ensure_configuration( required_namelists, success_map ) + if (.not. success) then write( log_scratch_space, & '("The following required namelists were not loaded:")' ) diff --git a/components/driver/source/driver_modeldb_mod.f90 b/components/driver/source/driver_modeldb_mod.f90 index 793ed4cbc..d26db8254 100644 --- a/components/driver/source/driver_modeldb_mod.f90 +++ b/components/driver/source/driver_modeldb_mod.f90 @@ -18,6 +18,7 @@ module driver_modeldb_mod use lfric_mpi_mod, only: lfric_mpi_type use model_clock_mod, only: model_clock_type use namelist_collection_mod, only: namelist_collection_type + use config_mod, only: config_type use io_context_collection_mod, only: io_context_collection_type implicit none @@ -33,6 +34,8 @@ module driver_modeldb_mod !> Configuration namelist collection type(namelist_collection_type), public :: configuration + type(config_type), public :: config + !> Stores all the fields used by the model type( model_data_type ), public :: fields diff --git a/components/driver/source/mesh/create_mesh_mod.f90 b/components/driver/source/mesh/create_mesh_mod.f90 index acc22822e..a91e6d5fb 100644 --- a/components/driver/source/mesh/create_mesh_mod.f90 +++ b/components/driver/source/mesh/create_mesh_mod.f90 @@ -58,7 +58,7 @@ module create_mesh_mod !> @brief Creates vertical mesh extrusion. !> @return Resulting extrusion object function create_extrusion( extrusion_method, & - domain_height, & + domain_height, & domain_bottom, & n_layers, & extrusion_id ) result(new) diff --git a/components/driver/source/mesh/runtime_partition_mod.f90 b/components/driver/source/mesh/runtime_partition_mod.f90 index 34cd14101..513832a32 100644 --- a/components/driver/source/mesh/runtime_partition_mod.f90 +++ b/components/driver/source/mesh/runtime_partition_mod.f90 @@ -15,8 +15,6 @@ module runtime_partition_mod log_level_error, & log_level_debug use local_mesh_mod, only: local_mesh_type - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use ncdf_quad_mod, only: ncdf_quad_type use partition_mod, only: partition_type, & partitioner_interface, & diff --git a/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf b/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf index afa3ffb42..2928f43ca 100644 --- a/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf +++ b/components/driver/unit-test/assign_coordinate_alphabetaz_mod_test.pf @@ -47,7 +47,7 @@ contains @after subroutine tear_down() - use configuration_mod, only : final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf b/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf index ac835f039..175ba7ce2 100644 --- a/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf +++ b/components/driver/unit-test/assign_coordinate_lonlatz_mod_test.pf @@ -46,7 +46,7 @@ contains @after subroutine tear_down() - use configuration_mod, only : final_configuration + use config_loader_mod, only : final_configuration implicit none diff --git a/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf b/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf index 8cf102568..8ad3613f9 100644 --- a/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf +++ b/components/driver/unit-test/assign_coordinate_xyz_mod_test.pf @@ -59,7 +59,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only : final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/lfric-xios/integration-test/test_db_mod.f90 b/components/lfric-xios/integration-test/test_db_mod.f90 index 740674d24..028dc97cb 100644 --- a/components/lfric-xios/integration-test/test_db_mod.f90 +++ b/components/lfric-xios/integration-test/test_db_mod.f90 @@ -9,8 +9,9 @@ module test_db_mod use calendar_mod, only: calendar_type use cli_mod, only: parse_command_line - use configuration_mod, only: read_configuration - use constants_mod, only: i_def, r_def, str_def, imdi, r_second, i_timestep + use config_loader_mod, only: read_configuration + use constants_mod, only: i_def, r_def, str_def, imdi, & + r_second, i_timestep use extrusion_mod, only: TWOD use field_collection_mod, only: field_collection_type use field_parent_mod, only: read_interface, write_interface @@ -30,8 +31,7 @@ module test_db_mod finalise_logging, & log_set_level, log_event, & LOG_LEVEL_TRACE, LOG_LEVEL_ERROR - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type + use config_mod, only: config_type use lfric_xios_read_mod, only: read_field_generic use lfric_xios_write_mod, only: write_field_generic use local_mesh_collection_mod, only: local_mesh_collection_type, & @@ -44,16 +44,15 @@ module test_db_mod use fs_continuity_mod, only: Wchi, W0, W2H, W3 use step_calendar_mod, only: step_calendar_type - implicit none !> Object containing infrastructure for testing LFRic-XIOS type, public :: test_db_type private - type(lfric_comm_type), public :: comm - type(namelist_collection_type), public :: config - type(field_type), public :: chi(3) - type(field_type), public :: panel_id + type(lfric_comm_type), public :: comm + type(config_type), public :: config + type(field_type), public :: chi(3) + type(field_type), public :: panel_id type(model_clock_type), public, allocatable :: clock class(calendar_type), public, allocatable :: calendar type(field_collection_type), public :: temporal_fields @@ -77,8 +76,6 @@ subroutine initialise(self) type(mesh_type), target :: mesh, twod_mesh type(mesh_type), pointer :: mesh_ptr type(mesh_type), pointer :: twod_mesh_ptr - type(namelist_type), pointer :: time_nml - type(namelist_type), pointer :: timestepping_nml type(function_space_type), pointer :: wchi_fs type(function_space_type), pointer :: tmp_fs type(field_proxy_type) :: chi_p(3), pid_p, rproxy @@ -112,16 +109,15 @@ subroutine initialise(self) call initialise_logging(self%comm%get_comm_mpi_val(), 'lfric_xios_context_test') call log_set_level(LOG_LEVEL_TRACE) - call self%config%initialise("lfric_xios_integration_tests", table_len=10) - call read_configuration(trim(adjustl(filename)), self%config) + call self%config%initialise("lfric_xios_integration_tests") + call read_configuration(trim(adjustl(filename)), config=self%config) + deallocate(filename) - time_nml => self%config%get_namelist('time') - timestepping_nml => self%config%get_namelist('timestepping') - call time_nml%get_value('calendar_start', start_date) - call time_nml%get_value('timestep_start', timestep_start) - call time_nml%get_value('timestep_end', timestep_end) - call timestepping_nml%get_value('dt', timestep_length) + start_date = self%config%time%calendar_start() + timestep_start = self%config%time%timestep_start() + timestep_end = self%config%time%timestep_end() + timestep_length = self%config%timestepping%dt() ! Create top level mesh collection, function spaces & routing tables local_mesh_collection = local_mesh_collection_type() @@ -227,7 +223,6 @@ subroutine initialise(self) nullify(local_mesh_ptr) nullify(mesh_ptr) - nullify(time_nml) nullify(twod_mesh_ptr) nullify(wchi_fs) nullify(tmp_fs) diff --git a/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf index 373eb81f7..fc4c5c624 100644 --- a/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/dot_product_of_components_kernel_mod_test.pf @@ -43,7 +43,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf index cd3e90429..09c146f73 100644 --- a/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/set_any_dof_kernel_mod_test.pf @@ -46,7 +46,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf index 964159e30..7e99fd66b 100644 --- a/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/set_w1h_dofs_kernel_mod_test.pf @@ -45,7 +45,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf b/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf index a34ba3c04..c54239248 100644 --- a/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/algebra/tri_matrix_vector_kernel_mod_test.pf @@ -38,11 +38,10 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none - class(tri_matrix_vector_kernel_test_type), intent(inout) :: this call final_configuration() diff --git a/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf index 65f37e6fc..35dd156a3 100644 --- a/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_broken_div_operator_kernel_mod_test.pf @@ -70,8 +70,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf index 50888b180..3941363f6 100644 --- a/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_curl_operator_kernel_mod_test.pf @@ -73,8 +73,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf index 50dd756d5..934836e6f 100644 --- a/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_derham_matrices_kernel_mod_test.pf @@ -54,8 +54,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf index 53474e517..ce747ddc1 100644 --- a/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_div_operator_kernel_mod_test.pf @@ -71,8 +71,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf index da1dd8b61..0f980c255 100644 --- a/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_grad_operator_kernel_mod_test.pf @@ -65,8 +65,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf index f4f2296a8..3f690988e 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w0_mod_test.pf @@ -64,7 +64,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf index 1d85c8213..b7201eee2 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w1_mod_test.pf @@ -67,8 +67,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf index 3e499f697..03e1f2046 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2_mod_test.pf @@ -67,8 +67,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf index de1500edb..214c32247 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w2b_mod_test.pf @@ -61,7 +61,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf index 550e039c9..d8e8bf1e7 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_w3_mod_test.pf @@ -67,8 +67,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf index e214ebfb4..b03037328 100644 --- a/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_mass_matrix_kernel_wtheta_mod_test.pf @@ -73,8 +73,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf index e1f46051a..461b82c8e 100644 --- a/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/compute_trace_operator_kernel_mod_test.pf @@ -43,7 +43,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf index eee93bfa4..def8a7352 100644 --- a/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/gp_rhs_kernel_mod_test.pf @@ -82,8 +82,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf index 20f623a67..c68bb9a07 100644 --- a/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/gp_vector_rhs_kernel_mod_test.pf @@ -88,8 +88,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf b/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf index 11bc64083..6e9cc05e9 100644 --- a/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/fem/mg_derham_mat_kernel_mod_test.pf @@ -54,8 +54,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf index fee5e8bbb..1d10f4862 100644 --- a/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_da_at_w2_kernel_mod_test.pf @@ -66,8 +66,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf index 75650dd78..9820a4135 100644 --- a/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_detj_at_w2_kernel_mod_test.pf @@ -67,8 +67,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf index 4d69854d1..6a8135fae 100644 --- a/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_detj_at_w3_kernel_mod_test.pf @@ -66,8 +66,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf index 963c6ecff..ee9614202 100644 --- a/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/calc_directional_detj_at_w2_kernel_mod_test.pf @@ -65,8 +65,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf b/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf index a72fce3f5..3975544d3 100644 --- a/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/chi_transform_mod_test.pf @@ -299,8 +299,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use sci_chi_transform_mod, only: final_chi_transforms - use configuration_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf index 4b686f674..ba4d5217a 100644 --- a/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/compute_latlon_kernel_mod_test.pf @@ -65,7 +65,7 @@ contains subroutine tearDown( this ) use sci_chi_transform_mod, only: final_chi_transforms - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf index 083909300..ed7d1d02b 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_alphabetaz_mod_test.pf @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf index f4f5fd353..dd96612bc 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_lonlatz_mod_test.pf @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf index a560eaaff..5fda132f3 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_stretched_mod_test.pf @@ -65,7 +65,7 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf b/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf index 3f3379bbe..0e509c6f0 100644 --- a/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/coordinate_jacobian_xyz_mod_test.pf @@ -52,8 +52,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf index b633343d3..9dede6d94 100644 --- a/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/get_dz_w3_kernel_mod_test.pf @@ -66,7 +66,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf index 066d58f8d..97ede147b 100644 --- a/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/get_height_kernel_mod_test.pf @@ -70,7 +70,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf index 74df5e0fe..664dec52c 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_alphabetaz_mod_test.pf @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf index 7497009b6..8a32cf7c4 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_lonlatz_mod_test.pf @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf index ae02ad272..a93348f38 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_stretched_mod_test.pf @@ -65,7 +65,7 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf b/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf index 4ccd5b67a..cd7f4c1c0 100644 --- a/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/native_jacobian_xyz_mod_test.pf @@ -52,8 +52,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf index abebdd0af..05e927fbe 100644 --- a/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/nodal_xyz_coordinates_kernel_mod_test.pf @@ -69,7 +69,7 @@ contains subroutine tearDown( this ) use sci_chi_transform_mod, only: final_chi_transforms - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf b/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf index d65dd97f0..514504428 100644 --- a/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/geometry/scale_by_detj_kernel_mod_test.pf @@ -56,8 +56,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf index 1d218ac27..89b220967 100644 --- a/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/compute_map_u_operators_kernel_mod_test.pf @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf index 20d9ce641..9af3b0820 100644 --- a/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/compute_sample_u_ops_kernel_mod_test.pf @@ -71,8 +71,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf index 563bcdab7..4fe973987 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_hcurl_field_kernel_mod_test.pf @@ -62,8 +62,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf index 28e712d54..c384e912f 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_field_kernel_mod_test.pf @@ -62,8 +62,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf index 60ce7e2f2..bba3f3095 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_hdiv_native_kernel_mod_test.pf @@ -62,8 +62,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf index 61802bbd0..8ebf1baef 100644 --- a/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/convert_phys_to_hdiv_kernel_mod_test.pf @@ -63,8 +63,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf index 27cf34cda..1eafa87bb 100644 --- a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_field_kernel_mod_test.pf @@ -65,8 +65,8 @@ contains subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf index 7c263835e..760e355d8 100644 --- a/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/dg_convert_hdiv_native_kernel_mod_test.pf @@ -63,8 +63,8 @@ contains subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf index 0f2f906e9..f4762e276 100644 --- a/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/project_w3_to_w2b_operator_kernel_mod_test.pf @@ -53,8 +53,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf index 1e15845ee..445a8fb9e 100644 --- a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w1_operator_kernel_mod_test.pf @@ -75,8 +75,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf index bd5b4ae33..c60604a6b 100644 --- a/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/project_ws_to_w2_operator_kernel_mod_test.pf @@ -53,8 +53,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf index 5f3633ba0..9f87b1d06 100644 --- a/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/sample_w3_to_wtheta_kernel_mod_test.pf @@ -54,7 +54,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf index 7e67088f5..1f473d77a 100644 --- a/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/sample_wtheta_to_w3_kernel_mod_test.pf @@ -52,7 +52,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf index 79a9b86c9..f7d076412 100644 --- a/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_function_space/w3_to_w2_displacement_kernel_mod_test.pf @@ -69,8 +69,8 @@ contains @after subroutine tear_down() - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf index 5beb63fd6..1f3347da4 100644 --- a/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/apply_w3_to_sh_w3_kernel_mod_test.pf @@ -39,7 +39,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf index dbebf14f7..5d8745c98 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w2_to_sh_w2_kernel_mod_test.pf @@ -42,7 +42,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf index a5c1700db..3300ad325 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w2h_to_sh_w2h_kernel_mod_test.pf @@ -42,7 +42,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf index 1a5b41e8c..5457d524d 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w2v_to_sh_w2v_kernel_mod_test.pf @@ -41,7 +41,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf index 67dbf5a5e..42a142a2f 100644 --- a/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/consist_w3_to_sh_w3_op_kernel_mod_test.pf @@ -54,8 +54,8 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf index 535896cd9..24cad0316 100644 --- a/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/inject_sh_w3_to_wt_kernel_mod_test.pf @@ -52,7 +52,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf index 68872103c..f5467afc2 100644 --- a/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/inject_wt_to_sh_w3_kernel_mod_test.pf @@ -52,7 +52,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf index 8d820b98c..6af43fda9 100644 --- a/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/matrix_vector_shifted_mod_test.pf @@ -39,7 +39,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf index 82aeebcc4..81ac3438a 100644 --- a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_op_kernel_mod_test.pf @@ -65,12 +65,11 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration - use sci_chi_transform_mod, only: final_chi_transforms + use config_loader_mod, only: final_configuration + use sci_chi_transform_mod, only: final_chi_transforms implicit none - class(proj_mr_to_sh_rho_rhs_op_test_type), intent(inout) :: this call final_configuration() diff --git a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf index 5e5d6fab5..6f3662348 100644 --- a/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/proj_mr_to_sh_rho_rhs_update_kernel_mod_test.pf @@ -39,11 +39,10 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none - class(proj_mr_to_sh_rho_rhs_update_kernel_test_type), intent(inout) :: this call final_configuration() diff --git a/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf index 46972ee6e..a4d9ecfab 100644 --- a/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/sample_w2_to_sh_w2_kernel_mod_test.pf @@ -42,7 +42,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none diff --git a/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf b/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf index 2a632b4e7..7f6ed9ec8 100644 --- a/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf +++ b/components/science/unit-test/kernel/inter_mesh/tri_solve_sh_rho_to_mr_kernel_mod_test.pf @@ -37,11 +37,10 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine tearDown( this ) - use configuration_mod, only: final_configuration + use config_loader_mod, only: final_configuration implicit none - class(tri_solve_sh_rho_to_mr_kernel_test_type), intent(inout) :: this call final_configuration() diff --git a/documentation/source/how_it_works/build_system/configurator.rst b/documentation/source/how_it_works/build_system/configurator.rst index 5d3361b94..347ca45fe 100644 --- a/documentation/source/how_it_works/build_system/configurator.rst +++ b/documentation/source/how_it_works/build_system/configurator.rst @@ -18,53 +18,139 @@ these structures and functions to access the configuration choices. To support parallel applications, the generated code manages the distribution of choices to all MPI ranks. -Usage ------ +The Configurator provides several python scripts found in +``infrastructure/build/tools``. Each of these scripts generate +Fortran source code that is specific to an application's metadata. -The Configurator calls three commands which may be found in -``infrastructure/build/tools`` and a separate tool -:ref:`rose_picker` which -converts the extended Rose metadata file into a JSON file. +.. _GenNmlLoader: -The first command takes the JSON file created by ``rose_picker`` and -creates a module for each namelist. Each module has procedures to read -a namelist configuration file for the namelist, to MPI broadcast -configuration choices and to access configuration choices:: +.. dropdown:: **GenerateNamelistLoader** - GenerateNamelist [-help] [-version] [-directory PATH] FILE + Takes a JSON file created by ``rose_picker`` from an applications + ``rose-meta.conf`` file. For each namelist described in the JSON file, a + Fortran module is generated. Each module has procedures to: -The ``-help`` and ``-version`` arguments cause the tool to tell you about -itself, then exit. + * Read the specifc namelist from a configuration file. + * Broadcast the namelist values across MPI ranks. + * Return the current namelist values as a generic/extended ``namelist_type``. -The ``FILE`` argument points to the metadata JSON file to -use. Generated source is put into the current working directory, or -into ``PATH`` if specified. + .. admonition:: Usage -The second command generates the code that calls procedures from the -previously generated namelist loading modules to actually read a -namelist configuration file:: + GenerateNamelistLoader + *[-help][-version][-directory PATH]* FILE - GenerateLoader [-help] [-version] [-verbose] FILE NAMELISTS... + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated source. Default: current working directory. + ``FILE``: + JSON file containing the application metadata. -As before, ``-help`` and ``-version`` options reveal details about -the tool before exiting. +.. _GenConfigLoader: + +.. dropdown:: **GenerateConfigLoader** + + This generates the source module (``config_loader_mod.f90``) which controls + the loading of namelists from file and performs the broadcast of + configuration values to other MPI ranks. This module also retrieves the + namelist objects from the respective namelist configuration modules and + stores them in the applications configuration object (``config_type``). + + .. admonition:: Usage + + GenerateConfigLoader + *[-help][-version][-verbose][-directory PATH][-duplicate LISTNAME]* + NAMELISTS... + + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated ``config_loader_mod.f90`` source. Default: current + working directory. + ``-duplicate LISTNAME``: + Adds LISTNAME to the set of namelists which allow duplicate instances. + ``NAMELISTS...``: + Space-separated list of one or more namelist names that the + ``config_loader_mod`` module will recognise for reading. Each namelist + listed will require a corresponding module generated by the + :ref:`GenerateNamelistLoader` script. + +.. _GenConfigType: + +.. dropdown:: **GenerateConfigType** + + Generates source code ``config_type_mod.f90`` which defines the type storing + the namelists specific to a given application. The ``config_type`` provides + (*mostly*) direct access to an applications configuration values. + + .. admonition:: Usage + + GenerateConfigType + *[-help][-version][-verbose][-directory PATH][-duplicate LISTNAME]* NAMELISTS... + + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated ``config_type_mod.f90``. Defaul: current working + directory. + ``-duplicate LISTNAME``: + Optional argument to add LISTNAME to the set of namelists allowed + to have duplicate instances. + ``NAMELISTS...``: + Space-separated list of one or more namelist names that the ``config_type`` + will store. + +.. _GenExtNmlType: + +.. dropdown:: **GenerateExtendedNamelistType** + + Generates extended namelist type (``_nml_type``) specific to a + given namelist definition. One source module generated per defined namelist. + The resulting extended namelist type will allow direct access to the namelist + member values while remaining read-only. + + .. admonition:: Usage + + GenerateExtendedNamelistType + *[-help][-version][-verbose][-directory PATH]* FILE + + ``-help`` | ``-version``: + Returns script information, then exits. + ``-directory PATH``: + Location of generated source. Default: current working directory. + ``FILE``: + JSON file containing the application metadata. + +.. _GenFeign: + +.. dropdown:: **GenerateFeigns** + + Generates a module which provides procedures to directly configure + the contents of a namelist. This module should not be used within a + normal application. Instead, it is to allow test systems to + :ref:`feign` the reading of a namelist so + they can control the test environment: + + .. admonition:: Usage + + GenerateFeigns + *[-help] [-version] [-output FILE1]* FILE2 + + ``-help`` | ``-version``: + Caused the tool to tell you about itself, then exit. + ``-output FILE1``: + Generated source file is written FILE1, defaults to ``feign_config_mod.f90`` + in the current working directory, + ``FILE2``: + JSON metadata file created by ``rose-picker``. + +Ultimately, these scripts require an applications +extended Rose metadata in the form of a JSON file. + +For convienence, a separate tool, (:ref:`rose_picker`) +is used to convert the extended Rose metadata file into a JSON file. -The ``FILE`` is that of the resulting generated source file. Finally, -the ``NAMELISTS`` are a space-separated list of one or more namelist -names that the code will read. -The final command generates a module which provides procedures to -directly configuring the contents of a namelist. This module ought not -be used within a normal application. Instead, it is to allow test -systems to :ref:`feign ` the reading of a -namelist so they can control the test environment:: - GenerateFeigns [-help] [-version] [-output FILE1] FILE2 -Once again, ``-help`` and ``-version`` cause the command to exit after -giving its details. -The ``FILE2`` argument should point to a JSON metadata file created by -``rose-picker``. The resulting source file is written to ``FILE1``, or -to ``feign_config_mod.f90`` in the current working directory, if -``FILE1`` is not specified. diff --git a/documentation/source/how_to_use_it/components/driver.rst b/documentation/source/how_to_use_it/components/driver.rst index 9194cda64..7b3ac3d46 100644 --- a/documentation/source/how_to_use_it/components/driver.rst +++ b/documentation/source/how_to_use_it/components/driver.rst @@ -70,8 +70,7 @@ configuration files. ``_config_mod``, from which configuration options are extracted. These are the modules that are generated by the Configurator. Therefore, they cannot be found in the code bases of the application! See the - section on :ref:`how to use configuration information` for details of these files. + section on :ref:`how to use configuration information` for details of these files. The ``driver_config_mod`` component provides procedures for reading the configuration files created by the Configurator. @@ -85,25 +84,24 @@ Call the ``init_config`` procedure to read the namelist configuration. use driver_config_mod, only: init_config - type(namelist_collection_type) :: configuration + type(config_type) :: config - + ... - call init_config(filename, required_namelists, configuration) + call init_config(filename, required_namelists, config=config) Arguments are as follows: * ``filename``: The file containing the namelist configuration. * ``required_namelists``: A list of character strings containing the name of all the namelists that the application must read. -* ``configuration`` A ``namelist_collection_type`` which will be - loaded with the contents of the namelist configuration file. +* ``config``: A ``config_type`` which will be loaded with the contents + of the namelist configuration file. After reading the configuration file, the procedure checks whether all the namelists in the ``required_namelists`` array were present in the file, and reports an error if any are missing. -Once initialisation completes, applications can access -configuration information from the ``namelist_collection_type`` -:ref:`configuration object` or direct from the -:ref:`config_mod` files. +Once initialisation completes, applications can access configuration +information from the :ref:`config object` or direct +from the :ref:`config_mod` files. diff --git a/documentation/source/how_to_use_it/configuration/using_configuration.rst b/documentation/source/how_to_use_it/configuration/using_configuration.rst index a780bdba8..26db0e806 100644 --- a/documentation/source/how_to_use_it/configuration/using_configuration.rst +++ b/documentation/source/how_to_use_it/configuration/using_configuration.rst @@ -4,7 +4,7 @@ under which the code may be used. ----------------------------------------------------------------------------- -.. _using configuration: +.. _generating_configuration: Configuration code generation ============================= @@ -20,23 +20,33 @@ This section describes how to load an application configuration into the application, and how code can use the various types of application configuration. +.. _loading_configuration: + Loading the configuration ========================= -The Configurator generates a procedure, ``read_configuration``, to -read a namelist configuration file. Each namelist configuration is -stored in a ``namelist_type`` object. All the ``namelist_type`` -objects are stored in a ``namelist_collection_type`` object. +The Configurator generates a procedure (``read_configuration``) to read +a configuration file based on an applications metadata file (``.json``). +The configuration which entails one or more Fortran namelists, which +are each read and stored in a namelist specific type +(`_nml_type`). These namelist objects are in turn stored +in a configuration object (`config_type`). + +This allows for multiple configurations to be loaded into a given +application. .. code-block:: fortran - use configuration_mod, only: read_configuration + use config_loader_mod, only: read_configuration - type(namelist_collection_type) :: configuration + type(config_type) :: config_A, config_B + ... - + call config_A%initialise( 'ConfigurationName_A' ) + call config_B%initialise( 'ConfigurationName_B' ) - call read_configuration( namelist_file, configuration ) + call read_configuration( namelist_file_A, config=config_A ) + call read_configuration( namelist_file_B, config=config_B ) The LFRic infrastructure provides a :ref:`driver configuration component` that orchestrates both reading of the @@ -44,42 +54,33 @@ namelist configuration file and cross-checking the contents to ensure all required namelists are present. The driver configuration component can be used instead of directly calling the above procedure. -.. _configuration object: +.. _using_config_object: -Using the Configuration Object +Using the Config Object ============================== -The term "configuration object" refers to an object of type -``namelist_collection_type``. It holds a number of ``namelist_type`` +The term "config object" refers to an object of type +``config_type``. It holds a number of extended ``namelist_type`` objects each of which holds the configuration choices for one of the -namelists. To access a namelist object, call the ``get_namelist`` -function on the namelist name: +namelists. To access a configuration value, simply reference +the configuration hirarchy in the ``config_type``, `e.g.` .. code-block:: fortran - use namelist_mod, only: namelist_type - use namelist_collection_mod, only : namelist_collection_type - - type(namelist_collection_type) :: configuration - - type(namelist_type), pointer :: base_mesh_nml - - base_mesh_nml => configuration%get_namelist('base_mesh') - -Then use the ``get_value`` function of the ``namelist_type`` object to -get the configuration value of a variable: + use config_mod, only: config_type -.. code-block:: fortran + type(config_type) :: config + character(str_def) :: name - character(str_def) :: mesh_name + name = config%base_mesh%mesh_name() - call base_mesh_nml%get_value('mesh_name', mesh_name) +.. _config_enumerations: Enumerations ------------ An enumeration is a variable that can take one of a small number of -fixed values. In the namelist the permitted values are strings, but +fixed values. In the namelist, the permitted values are strings, but within the code, the option and each of the permitted values are converted into integers. @@ -89,9 +90,9 @@ to check against. Enumerations are stored as ``i_def`` integers. The enumeration options are parameters that can be obtained directly from Configurator-generated ``_config_mod`` modules. -To illustrate, Rose metadata can configure the value of the -``geometry`` variable in the namelist so that it can be either the -string "spherical" or the string "planar". In the following code, is +To illustrate, Rose metadata specifies that the value of the +namelist variable ``geometry`` can be either the string "spherical" or +the string "planar". In the following code, the namelist entry is checked against two allowed choices of geometry: ``spherical`` and ``planar``, referenced by the two integer parameters in the ``base_mesh_config_mod`` module. The names of the parameters are @@ -105,8 +106,7 @@ duplication of parameter names with other enumeration variables: integer(i_def) :: geometry_choice real(r_def) :: domain_bottom - base_mesh_nml => configuration%get_namelist('base_mesh') - call base_mesh_nml%get_value('geometry', geometry_choice) + geometry_choice = config%base_mesh%geometry() select case (geometry_choice) case (geometry_planar) @@ -119,30 +119,41 @@ duplication of parameter names with other enumeration variables: .. admonition:: Hidden values - Use of enumerations can be better than using numerical options or - string variables. + Use of enumerations can be better than using numerical options or + string variables. + + A parameter name is more meaningful and memorable than a numerical + option, making code more readable. There is also a clearer link + between the name and the metadata, as the metadata can be easily + searched to find information about the option. - A parameter name is more meaningful and memorable than a numerical - option, making code more readable. There is also a clearer link - between the name and the metadata, as the metadata can be easily - searched to find information about the option. + Code that compares integer options and parameters is safer than code + that compares string options and parameters. If there are spelling + errors in the names in the code, the former will fail at compile + time whereas problems with the latter only arise at run-time. - Code that compares integer options and parameters is safer than code - that compares string options and parameters. If there are spelling - errors in the names in the code, the former will fail at compile - time whereas problems with the latter only arise at run-time. +.. _config_duplicate_namelists: -Duplicating namelists +Duplicate namelists --------------------- -Where namelists are duplicated, the possible values of the instance -variable can be used to distinguish between them. For example, for a -namelist ``partitioning`` with an instance key of ``mesh_choice``, -the relevant parts of the Rose metadata may look as follows:: +When a defined namelist is allowed to have multiple instances in a namelist +input file, the namelist is said to allow `duplicates` (with a given +configuration). This is indicated by the Rose metadata as ``duplicate=true``. +These namelist instances have the same variable names, though those varibles +may contain different values. + +Instances of a ``duplicate`` namelist may be differentiated using one of the +namelists members as a key. The :ref:`extended Rose metadata `, ``!instance_key_member`` +indicates to the configurator tool which namelist variable to use as the +instance key. For example, consider a ``partitioning`` namelist, with the +variable, ``mesh_choice`` used as the instance key member, the relevant parts +of the Rose metadata may look as follows:: [namelist:partitioning] duplicate=true - instance_key_member=mesh_choice + !instance_key_member=mesh_choice [namelist:partitioning=mesh_choice] !enumeration=true @@ -163,74 +174,50 @@ namelist each with a different ``mesh_choice``:: panel_decomposition = 'auto', / -The different namelist options can be extracted with the following -code (noting that the possible ``mesh_choice`` strings must be known -in the code): +To extract a *specific instance*, the possible ``mesh_choice`` string must be known: .. code-block:: fortran - ! Get namelist objects for the source and destination partitioning - source_partitioning_nml => & - configuration%get_namelist('partitioning', & - 'source') - destination_partitioning_nml => & - configuration%get_namelist('partitioning', & - 'destination') + type(partitioning_nml_iterator_type) :: iter + type(partitioning_nml_type), pointer :: partitioning_nml - ! Extract information from the two different namelist objects - call source_partitioning_nml%get_value('partitioner', & - source_partitioner) - call destination_partitioning_nml%get_value('partitioner', & - destination_partitioner) + call iter%initialise(config%partitioning) + do while (iter%has_next()) -.. _config_mod files: + partitioning_nml => iter%next() + mesh_choice = partitioning_nml%get_profile_name() -Using config_mod files -====================== + select case (trim(mesh_choice)) -In the examples above, the ``config_mod`` files were used only to -obtain the parameters that represent the options of an enumeration -variable. - -It is normally possible to obtain any variables direct from the -``config_mod`` files rather than going through the configuration -object functions. However, this method cannot work where namelists are -duplicated. Namelists can be duplicated by metadata definition as -described above, in which case values are distinguished by a key -variable. - -But applications can also be required to read two separate namelist -configurations where the same namelist appears in both. In these -cases, the application can load each configuration into two separate -configuration objects. This means that different parts of the -application can be passed different configuration objects, and the -data in the configuration object will be specific for that part of the -application. While the parameter values that define enumerator options -will be the same for both parts of the application, the values for the -first namelist in the ``config_mod`` file will be overwritten by the -second namelist to be read in. - -In the following example, the same requirement as the example above is -met by directly using the value of the ``geometry`` option from the -``config_mod`` file: + case('source') + srce_partitioner = partitioning_nml%partitioner() -.. code-block:: fortran + case('destination') + dest_partitioner = partitioning_nml%partitioner() - use base_mesh_config_mod, only: geometry_spherical, & - geometry_planar, & - geometry + end select - real(r_def) :: domain_bottom + end do - select case (geometry) - case (geometry_planar) - domain_bottom = 0.0_r_def - case (geometry_spherical) - domain_bottom = earth_radius - case default - call log_event("Invalid geometry", LOG_LEVEL_ERROR) - end select +.. _config_mod_files: + +Using configuration module files +================================ + +In the examples above, the ``config_mod`` modules were used **only** to +obtain the parameters that represent the options of an enumeration +variable. The preferred practice is to only use global scope +``config_mod`` modules to access fixed runtime parameters. + +.. admonition:: Configuration access via ``use`` statements. + + While existing code will allow access to any variables direct from + the ``config_mod`` files, this legacy practice is strongly + **discouraged**. Access via ``use`` statements cannot work where + namelists may have multiple instances or when an application wishes + to load multiple configuration files. It is recommended that access + to configuration namelists be limited to usage of the ``modeldb%config`` + item described above. -The ``default`` case would cause an error if ``geometry`` has not been -set or if it has been set to another valid value that is not supported -by this part of the code. + Direct access from ``*_config_mod`` modules will be restricted to + enumeration parameter values only by April 2026. diff --git a/documentation/source/how_to_use_it/deprecated/deprecated_configuration.rst b/documentation/source/how_to_use_it/deprecated/deprecated_configuration.rst new file mode 100644 index 000000000..d97c148a2 --- /dev/null +++ b/documentation/source/how_to_use_it/deprecated/deprecated_configuration.rst @@ -0,0 +1,59 @@ +.. _DeprecatedConfiguration: + +Modeldb Configuration Item +============================================== + +The ``configuration`` item (``namelist_collection_type``) within the ``modeldb`` +object stores the input namelists used to configure an instance of modeldb. +Once the configuration has been populated, the configuration values are +immutable, unlike other components of ``modeldb``. This item is **deprecated** +and use of the ``config`` item in ``modedb`` is the preferred configuration +access method. The component ``modeldb%configuration`` is marked for removal +after April 2026. + +.. Should provide a link to the namelist collection type (when it's written) #PR206 + +Initialising the configuration +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +The ``modeldb%configuration`` item is populated using a module generated +by the ``configurator`` tool. A namelist input file is simply read in and +any valid namelists are added the ``modeldb%configuration`` item. + +The ``configuration`` item is first initialised before reading a namelist input +file. + +.. code-block:: fortran + + use configuration_mod, only: read_configuration + + call modeldb%configuration%initialise() + call read_configuration( filename, configuration=modeldb%configuration ) + +.. _access_configuration_data: + +Accessing configuration data +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +To access configuration data from the ``configuration`` item, a pointer to +the required namelist is first requested before the namelist variable +member can be retrieved. This allows for different namelists to have +member variables with the same name. + +.. code-block:: fortran + + type(namelist_type), pointer :: config_nml + + config_nml => modeldb%configuration%get_namelist('') + call config_nml%get_value( '', nml_var ) + +All namelists in the collection must have a unique ``, unless +the namelist metadata specfies ``duplicate=.true.``. For namelists which may +appear multiple times in a namelist file, the ``profile_name`` must also be +specified. + +.. code-block:: fortran + + type(namelist_type), pointer :: config_nml + + config_nml => modeldb%configuration%get_namelist( '', & + profile_name='' ) + call config_nml%get_value( '', nml_var ) diff --git a/documentation/source/how_to_use_it/deprecated/index.rst b/documentation/source/how_to_use_it/deprecated/index.rst new file mode 100644 index 000000000..fc4df4eba --- /dev/null +++ b/documentation/source/how_to_use_it/deprecated/index.rst @@ -0,0 +1,16 @@ +.. ----------------------------------------------------------------------------- + (c) Crown copyright Met Office. All rights reserved. + The file LICENCE, distributed with this code, contains details of the terms + under which the code may be used. + ----------------------------------------------------------------------------- + +.. _deprecated_index: + +Deprecated usage +================ + +.. toctree:: + :maxdepth: 1 + + deprecated_configuration + diff --git a/documentation/source/how_to_use_it/index.rst b/documentation/source/how_to_use_it/index.rst index 5d83a6480..a9a3d685b 100644 --- a/documentation/source/how_to_use_it/index.rst +++ b/documentation/source/how_to_use_it/index.rst @@ -23,3 +23,4 @@ How to use it build_and_test/index parallelism/index API/index + deprecated/index diff --git a/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst b/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst index 76b61b179..b1109d045 100644 --- a/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst +++ b/documentation/source/how_to_use_it/lfric_datamodel/modeldb.rst @@ -59,8 +59,8 @@ To add a collection to ``modeldb%fields`` use: .. code-block:: fortran - call modeldb%fields%add_empty_field_collection("my_collection", & - table_len = 100) + call modeldb%fields%add_empty_field_collection("my_collection", & + table_len = 100) where ``"my_collection"`` is the name of the field collection you want adding and the ``table_len`` is the length of the hash table that is @@ -76,11 +76,11 @@ To put a field into one of the collections .. code-block:: fortran - type( field_collection_type ), pointer :: my_collection - type( field_type ), :: my_field + type( field_collection_type ), pointer :: my_collection + type( field_type ), :: my_field - my_collection => modeldb%fields%get_field_collection("my_collection") - call my_collection%add_field(my_field) + my_collection => modeldb%fields%get_field_collection("my_collection") + call my_collection%add_field(my_field) This will put a copy of ``my_field`` into the collection. If you want to use the version held in the collection, you will need to retrieve a @@ -93,11 +93,11 @@ Assuming the field, ``my_field``, has the name "my_field", use: .. code-block:: fortran - type( field_collection_type ), pointer :: my_collection - type( field_type ), pointer :: my_field + type( field_collection_type ), pointer :: my_collection + type( field_type ), pointer :: my_field - my_collection => modeldb%fields%get_field_collection("my_collection") - call my_collection%get_field("my_field", my_field) + my_collection => modeldb%fields%get_field_collection("my_collection") + call my_collection%get_field("my_field", my_field) This returns a pointer to the actual field held in the collection. Any changes to the field you have extracted will instantly change the @@ -137,11 +137,11 @@ To put a value in .. code-block:: fortran - real(real64) :: my_value + real(real64) :: my_value - my_value = 7.0_real64 - call modeldb%values%initialise() - call modeldb%values%add_key_value('my_value', my_value) + my_value = 7.0_real64 + call modeldb%values%initialise() + call modeldb%values%add_key_value('my_value', my_value) Again, this will put a copy of the value into the collection @@ -150,9 +150,9 @@ To get a value out .. code-block:: fortran - real(real64), pointer :: my_value + real(real64), pointer :: my_value - call modeldb%values%get_value("my_value", my_value) + call modeldb%values%get_value("my_value", my_value) This returns a pointer to the value held in the collection. Any subsequent maths performed on what is returned (the pointer) will @@ -162,57 +162,56 @@ location in memory. Configuration ------------- -The configuration item within the modeldb object stores the input namelists -(from a namelist input file) used to configure an instance of modeldb. Once -the configuration has been populated from file, the configuration values are -immutable, unlike other components of modeldb. +The ``config`` item (`config_type`) within the ``modeldb`` object stores +the input namelists used to configure an instance of modeldb. Once the +``config`` item has been populated the configuration values are immutable, +unlike other components of modeldb. .. Should provide a link to the namelist collection type (when it's written) Initialising the configuration ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -The configration item is a `namelist collection type` and is populated using a -module generated by the `configurator` tool. A namelist input file is simply -read in and any valid namelists are added the modeldb%configuration item. +The ``config`` item is populated using a module generated by the +:ref:`Configurator` tool. A namelist input file is simply read +in and any valid namelists are added to the ``config`` item. -As with the ``values`` item, the ``configuration`` item must be initialised +As with the ``values`` item, the ``config`` item must be initialised prior to its first use. .. code-block:: fortran - use configuration_mod, only: read_configuration + use config_loader_mod, only: read_configuration - call modeldb%configuration%initialise() - call read_configuration( filename, modeldb%configuration ) + call modeldb%config%initialise() + call read_configuration( filename, config=modeldb%config ) .. _access_config_data: Accessing configuration data ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -To access data from the configuration item, a pointer to the required namelist -is first requested before the namelist variable member can be retrieved. This -allows for different namelists to have member variables with the same name. +To access configuration data from the ``config`` item, simply +reference the namelist member via its location in the configuration +hierachy. .. code-block:: fortran - type(namelist_type), pointer :: config_nml + MemberValue = modeldb%config%%() - config_nml => modeldb%configuration%get_namelist('') - call config_nml%get_value( '', nml_var ) - -All namelists in the collection must have a unique ``, unless -the namelist metadata specfies `duplicate=.true.`. For namelists which may -appear multiple times in a namelist file, the `profile_name` must also be -specified. +The access pattern for namelists which allow multiple instances +(with metadata ``duplicate=true``) is via an iterator which cycles +through instances of the namelist type. .. code-block:: fortran + :force: - type(namelist_type), pointer :: config_nml - - config_nml => modeldb%configuration%get_namelist( '', & - profile_name='' ) - call config_nml%get_value( '', nml_var ) + type( _nml_iterator_type ) :: iter + type( _nml_type ), pointer :: config_nml + call iter%initialise( modeldb%config% ) + do while ( iter%has_next() ) + config_nml => iter%next() + MemberValue = config_nml%() + end do I/O contexts ------------ @@ -231,10 +230,10 @@ To put an I/O context into the collection ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran - type( lfric_xios_context_type ) :: my_io_context + type( lfric_xios_context_type ) :: my_io_context - call modeldb%io_context%initialise() - call modeldb%io_contexts%add_context(my_io_context) + call modeldb%io_context%initialise() + call modeldb%io_contexts%add_context(my_io_context) This will put a copy of ``io_context`` into the collection. If you want to use the version held in the collection, you will need to @@ -247,8 +246,8 @@ Assuming the context, ``my_io_context``, has the name "my_io_context", use: .. code-block:: fortran - type( lfric_xios_context_type ) :: my_io_context + type( lfric_xios_context_type ) :: my_io_context - call modeldb%io_contexts%get_io_context("my_io_context", my_io_context) + call modeldb%io_contexts%get_io_context("my_io_context", my_io_context) This returns a pointer to the actual I/O context held in the collection. diff --git a/infrastructure/build/configuration.mk b/infrastructure/build/configuration.mk index 1b020218c..f6f8b9388 100644 --- a/infrastructure/build/configuration.mk +++ b/infrastructure/build/configuration.mk @@ -19,13 +19,13 @@ $(CONFIG_DIR)/rose-meta.json $(CONFIG_DIR)/config_namelists.txt: $(META_FILE_DIR $(call MESSAGE,Generating namelist configuration file.) $(Q)mkdir -p $(dir $@) ifdef APPS_ROOT_DIR - $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ - -directory $(CONFIG_DIR) \ - -include_dirs $(APPS_ROOT_DIR)/rose-meta \ + $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ + -directory $(CONFIG_DIR) \ + -include_dirs $(APPS_ROOT_DIR)/rose-meta \ -include_dirs $(CORE_ROOT_DIR)/rose-meta else - $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ - -directory $(CONFIG_DIR) \ + $(Q)rose_picker $(META_FILE_DIR)/rose-meta.conf \ + -directory $(CONFIG_DIR) \ -include_dirs $(CORE_ROOT_DIR)/rose-meta endif # It's not clear why this is needed but as of 5/2/20 the diagnostic @@ -35,9 +35,11 @@ endif .INTERMEDIATE: $(CONFIG_DIR)/build_config_loaders $(CONFIG_DIR)/build_config_loaders: $(CONFIG_DIR)/rose-meta.json $(call MESSAGE,Generating namelist loading modules.) - $(Q)$(LFRIC_BUILD)/tools/GenerateNamelist $(VERBOSE_ARG) \ - $(CONFIG_DIR)/rose-meta.json \ + $(Q)$(LFRIC_BUILD)/tools/GenerateNamelistLoader \ + $(VERBOSE_ARG) \ + $(CONFIG_DIR)/rose-meta.json \ -directory $(CONFIG_DIR) + $(Q)touch $(WORKING_DIR)/duplicate_namelists.txt $(Q)touch $(CONFIG_DIR)/build_config_loaders # This recipe requires config_namelists.txt, although adding it to the dependencies @@ -48,14 +50,26 @@ $(CONFIG_DIR)/build_config_loaders: $(CONFIG_DIR)/rose-meta.json $(WORKING_DIR)/configuration_mod.f90: $(CONFIG_DIR)/build_config_loaders $(call MESSAGE,Generating configuration loader module,$(notdir $@)) $(Q)mkdir -p $(dir $@) - $(Q)$(LFRIC_BUILD)/tools/GenerateLoader $(VERBOSE_ARG) $@ $(shell cat $(CONFIG_DIR)/config_namelists.txt) - + $(Q)$(LFRIC_BUILD)/tools/GenerateConfigLoader \ + $(VERBOSE_ARG) \ + $(shell cat $(CONFIG_DIR)/config_namelists.txt) \ + -o $(WORKING_DIR) + $(Q)$(LFRIC_BUILD)/tools/GenerateExtendedNamelistType \ + $(VERBOSE_ARG) \ + $(CONFIG_DIR)/rose-meta.json \ + -directory $(CONFIG_DIR) + $(Q)$(shell sed 's\^\-duplicate \' <$(CONFIG_DIR)/duplicate_namelists.txt >$(CONFIG_DIR)/duplicates.txt) + $(Q)$(LFRIC_BUILD)/tools/GenerateConfigType \ + $(VERBOSE_ARG) \ + $(shell cat $(CONFIG_DIR)/config_namelists.txt) \ + $(shell cat $(CONFIG_DIR)/duplicates.txt) \ + -o $(WORKING_DIR) .PRECIOUS: $(WORKING_DIR)/feign_config_mod.f90 $(WORKING_DIR)/feign_config_mod.f90: $(CONFIG_DIR)/rose-meta.json $(call MESSAGE,Generating namelist feigning module.) $(Q)mkdir -p $(dir $@) - $(Q)$(LFRIC_BUILD)/tools/GenerateFeigns \ + $(Q)$(LFRIC_BUILD)/tools/GenerateFeigns \ $(CONFIG_DIR)/rose-meta.json \ -output $@ diff --git a/infrastructure/build/tools/GenerateLoader b/infrastructure/build/tools/GenerateConfigLoader similarity index 80% rename from infrastructure/build/tools/GenerateLoader rename to infrastructure/build/tools/GenerateConfigLoader index 2a047d9be..cfce217fd 100755 --- a/infrastructure/build/tools/GenerateLoader +++ b/infrastructure/build/tools/GenerateConfigLoader @@ -10,6 +10,8 @@ Takes a list of namelists and generates source for a namelist loader. """ import argparse import logging +import os + from pathlib import Path from configurator import __version__ @@ -28,9 +30,9 @@ def main(): version=f'%(prog)s {__version__}') parser.add_argument('-verbose', action='store_true', help='Provide a running commentry') - parser.add_argument('outputFilename', metavar='output-filename', - type=Path, - help='Source file to produce') + parser.add_argument( "-o", "--output-dir", type=Path, + default=os.getcwd(), + help="Path to the output directory (default: current directory)" ) parser.add_argument('namelistNames', metavar='namelist', nargs='*', help='Namelists to load.') @@ -41,13 +43,14 @@ def main(): logging.getLogger('configurator').addHandler(handler) logging.getLogger('configurator').setLevel(logging.WARNING) - module_name = args.outputFilename.stem - generator = loader.ConfigurationLoader(module_name) + moduleName = "config_loader_mod" + generator = loader.ConfigurationLoader(moduleName) + for name in args.namelistNames: generator.add_namelist(name) - generator.write_module(args.outputFilename) - + outputFile = Path(str(args.output_dir.joinpath(moduleName)) + ".f90") + generator.write_module(outputFile) if __name__ == '__main__': main() diff --git a/infrastructure/build/tools/GenerateConfigType b/infrastructure/build/tools/GenerateConfigType new file mode 100755 index 000000000..531792cee --- /dev/null +++ b/infrastructure/build/tools/GenerateConfigType @@ -0,0 +1,71 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +# pylint: disable=invalid-name +""" +Takes a list of namelists and generates source defining a ConfigType based +on the namelists. In addition, source code is generated for namelist iterators +for any namelists identified as allowing multiple instances (duplicates). +""" +import argparse +import logging +import os + +from pathlib import Path + +from configurator import __version__ +import configurator.config_type as ConfigType + + +def main(): + """ + Entry point. Handles command-line arguments. + """ + parser = argparse.ArgumentParser(add_help=False, + description=__doc__) + parser.add_argument('-help', '-h', '--help', action='help', + help='Show this help message and exit') + parser.add_argument('-version', action='version', + version=f'%(prog)s {__version__}') + parser.add_argument('-verbose', action='store_true', + help='Provide a running commentry') + parser.add_argument( "-o", "--output-dir", type=Path, + default=os.getcwd(), + help="Path to the output directory (default: current directory)" ) + parser.add_argument('-duplicate', action='append', metavar='-duplicate', nargs=1, + help='Enables multiple instances for the specified namellist.') + parser.add_argument('namelistNames', metavar='namelist', + nargs='*', + help='Namelists memebers of app configuration.') + + args = parser.parse_args() + + if args.verbose: + handler = logging.StreamHandler() + logging.getLogger('configurator').addHandler(handler) + logging.getLogger('configurator').setLevel(logging.WARNING) + + moduleName = "config_mod" + generator = ConfigType.AppConfiguration(moduleName) + + duplicate_namelists = [] + if (args.duplicate): + for name in args.duplicate: + duplicate_namelists.extend(name) + + for name in args.namelistNames: + duplicate=False + if name in duplicate_namelists: + duplicate=True + + generator.add_namelist(name, duplicate) + + outputFile = Path(str(args.output_dir.joinpath(moduleName)) + ".f90") + generator.write_module(outputFile) + + +if __name__ == '__main__': + main() diff --git a/infrastructure/build/tools/GenerateExtendedNamelistType b/infrastructure/build/tools/GenerateExtendedNamelistType new file mode 100755 index 000000000..eeaabe52b --- /dev/null +++ b/infrastructure/build/tools/GenerateExtendedNamelistType @@ -0,0 +1,61 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +# pylint: disable=invalid-name +""" +Reads in a namelist description file and produces Fortran source defining +an extended namelist type specific to the namelist description provided. +""" +import argparse +import logging +from pathlib import Path + +from configurator import __version__ +import configurator.extended_namelist_type as extended_nml + + +def main(): + """ + Entry point. Handles command-line arguments. + """ + parser = argparse.ArgumentParser(add_help=False, + description=__doc__) + parser.add_argument('-help', '-h', '--help', action='help', + help='Show this help message and exit') + parser.add_argument('-version', action='version', + version=f'%(prog)s {__version__}') + parser.add_argument('-verbose', action='store_true', + help='Provide a running commentry') + parser.add_argument('-directory', metavar='path', + type=Path, default=Path.cwd(), + help='Generated source files are put here.') + parser.add_argument('meta_filename', metavar='description-file', nargs=1, + type=Path, + help='The metadata file to load') + + args = parser.parse_args() + + if args.verbose: + handler = logging.StreamHandler() + logging.getLogger('configurator').addHandler(handler) + logging.getLogger('configurator').setLevel(logging.WARNING) + + description_list = [] + + meta_filename = args.meta_filename[0] + + meta_parser = extended_nml.NamelistConfigDescription() + + # Generate namelists from the namelist configuration file. + description_list = meta_parser.process_config(meta_filename) + + for description in description_list: + leafname = description.get_module_name() + '.f90' + module_file = args.directory / leafname + description.write_module(module_file) + +if __name__ == '__main__': + main() diff --git a/infrastructure/build/tools/GenerateNamelist b/infrastructure/build/tools/GenerateNamelistLoader similarity index 86% rename from infrastructure/build/tools/GenerateNamelist rename to infrastructure/build/tools/GenerateNamelistLoader index bc53c4cd3..41948393a 100755 --- a/infrastructure/build/tools/GenerateNamelist +++ b/infrastructure/build/tools/GenerateNamelistLoader @@ -45,6 +45,7 @@ def main(): logging.getLogger('configurator').setLevel(logging.WARNING) description_list = [] + duplicate_list = [] meta_filename = args.meta_filename[0] @@ -58,6 +59,14 @@ def main(): module_file = args.directory / leafname description.write_module(module_file) + if description._multiple_instances_allowed: + duplicate_list.append(description._listname) + + + # Write out which namelist allow duplicates + with open(f'{args.directory}/duplicate_namelists.txt', 'wt', encoding='utf-8') as output: + for listname in duplicate_list: + output.write(f'{listname}\n') if __name__ == '__main__': main() diff --git a/infrastructure/build/tools/configurator/config_type.py b/infrastructure/build/tools/configurator/config_type.py new file mode 100644 index 000000000..06ccbab2f --- /dev/null +++ b/infrastructure/build/tools/configurator/config_type.py @@ -0,0 +1,67 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Generates Fortran source for application specifc configuration object. +""" + +from pathlib import Path +from typing import List + +import jinja2 + + +############################################################################## +class AppConfiguration: + """ + Fortran source object type to store configuration namelists. + """ + + def __init__(self, module_name: str): + self._engine = jinja2.Environment( + loader=jinja2.PackageLoader("configurator", "templates") + ) + self._module_name = module_name + self._namelists: List[str] = [] + self._duplicates: List[bool] = [] + + def add_namelist(self, name: str, duplicate: bool) -> None: + """ + Registers a namelist name for the object to store. + + :param name: Name to register. + :param duplicate: Is this namelist allowed multiple instances. + """ + self._namelists.append(name) + self._duplicates.append(duplicate) + + def write_module(self, module_file: Path) -> None: + """ + Stamps out the Fortran source. + + :param module_file: Filename to use. + """ + + if not self._namelists: + raise ValueError("No registered namelists to store.") + + inserts = { + "moduleName": self._module_name, + "namelists": self._namelists, + "duplicates": self._duplicates, + } + + template = self._engine.get_template("config_type.f90.jinja") + module_file.write_text(template.render(inserts)) + + iter_template = "namelist_iterator_type.f90.jinja" + for i, duplicate in enumerate(self._duplicates): + if duplicate: + iter_file = self._namelists[i] + '_nml_iterator_mod.f90' + name = self._namelists[i] + iter_filepath = module_file.parent.joinpath(iter_file) + template = self._engine.get_template(iter_template) + iter_filepath.write_text(template.render({"listname": name})) diff --git a/infrastructure/build/tools/configurator/configurationloader.py b/infrastructure/build/tools/configurator/configurationloader.py index d9145ea0f..57a4ff75a 100644 --- a/infrastructure/build/tools/configurator/configurationloader.py +++ b/infrastructure/build/tools/configurator/configurationloader.py @@ -41,10 +41,14 @@ def write_module(self, module_file: Path) -> None: :param module_file: Filename to use. """ + + if not self._namelists: + raise ValueError("No registered namelists to load.") + inserts = { "moduleName": self._module_name, "namelists": self._namelists, } - template = self._engine.get_template("loader.f90.jinja") + template = self._engine.get_template("config_loader.f90.jinja") module_file.write_text(template.render(inserts)) diff --git a/infrastructure/build/tools/configurator/extended_namelist_type.py b/infrastructure/build/tools/configurator/extended_namelist_type.py new file mode 100644 index 000000000..aabb8d141 --- /dev/null +++ b/infrastructure/build/tools/configurator/extended_namelist_type.py @@ -0,0 +1,779 @@ +#!/usr/bin/env python3 +############################################################################## +# (C) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Turns namelist descriptions into extended namelist specific objects. +""" + +import collections +import json +import re +from abc import ABC, abstractmethod +from pathlib import Path +from typing import Dict, List, Optional, Sequence, Tuple +from zlib import crc32 + +import jinja2 + +from configurator import jinjamacros + + +############################################################################## +class NamelistDescriptionException(Exception): + """ + Thrown for problems in the namelist. + """ + + pass # pylint: disable=unnecessary-pass + + +############################################################################## +class FortranType: + """ + Represents a Fortran type. + + Implements the singleton pattern such that there is only one object per + type. + """ + + _singletonMap: Dict[str, Dict[str, Dict[str, "FortranType"]]] = {} + + def __init__(self, intrinsic_type: str, kind: str, write_format: str): + """ + :param intrinsic_type: One of "integer", "real", etc. + :param kind: Name of data type kind. + :param write_format: Formatting string for this type. + """ + self.intrinsic_type = intrinsic_type + self.kind = kind + self.write_format = write_format + + def declaration(self) -> str: + """ + Gets the type designator used by declarations in source files. + """ + return f"{self.intrinsic_type}({self.kind})" + + def label(self) -> str: + """ + Gets a label for this type. + """ + return f"{self.intrinsic_type}_{self.kind}" + + def __lt__(self, other): + return self.declaration() < other.declaration() + + def __eq__(self, other): + return self.declaration() == other.declaration() + + def __key(self): + return (self.intrinsic_type, self.kind, self.write_format) + + def __hash__(self): + return hash(self.__key()) + + @classmethod + def instance(cls, intrinsic_type, kind, write_format) -> "FortranType": + """ + Gets the singleton object for a given type. + """ + if intrinsic_type not in cls._singletonMap: + cls._singletonMap[intrinsic_type] = {} + + if kind not in cls._singletonMap[intrinsic_type]: + cls._singletonMap[intrinsic_type][kind] = {} + + if write_format not in cls._singletonMap[intrinsic_type][kind]: + cls._singletonMap[intrinsic_type][kind][write_format] = cls( + intrinsic_type, kind, write_format + ) + + return cls._singletonMap[intrinsic_type][kind][write_format] + + +############################################################################## +class _Property(ABC): + """ + Root of all namelist fields. + + .. todo:: This interface is used externally so shouldn't be "private." + """ + + def __init__(self, name: str, fortran_type: FortranType): + """ + :param name: Identifying name. + :param fortran_type: field's Fortran type. + """ + self.name = name + self.fortran_type = fortran_type + + def required_kinds(self) -> List[str]: + """ + Gets Fortran kind of this field. + """ + return [self.fortran_type.kind] + + @abstractmethod + def get_configure_type(self) -> str: + """ + Gets the configuration meta-data type of this field. + """ + raise NotImplementedError() + + @property + @abstractmethod + def missing_data_indicator(self) -> str: + """ + Gets the value used to indicate an unset field. + """ + raise NotImplementedError() + + +############################################################################## +class _String(_Property): + """ + Namelist string field. + """ + + _fortranStringMap = {"default": "str_def", "filename": "str_max_filename"} + + def __init__(self, name: str, length: Optional[str] = None): + """ + :param name: Identifying name. + :param length: String length is a name which resolves to a length. + """ + if not length: + length = "default" + + super().__init__( + name, + FortranType.instance( + "character", self._fortranStringMap[length], "A" + ), + ) + + def get_configure_type(self) -> str: + return "string" + + @property + def missing_data_indicator(self) -> str: + return "cmdi" + + +############################################################################## +class _Enumeration(_Property): + """ + Namelist enumeration field. + """ + + def __init__(self, name: str, keyDictionary: Dict[str, int]): + """ + :param name: Identifying name. + :param keyDictionary: Mapping of enumerator to representation. + """ + super().__init__(name, FortranType.instance("integer", "i_def", "I0")) + + self.mapping = keyDictionary + self.inverse_mapping = { + value: key for key, value in self.mapping.items() + } + self.first_key = self.inverse_mapping[min(self.inverse_mapping.keys())] + + def required_kinds(self): + return [self.fortran_type.kind, "str_def"] + + def get_configure_type(self): + return "enumeration" + + @property + def missing_data_indicator(self): + return "emdi" + + +############################################################################## +class _Scalar(_Property): + """ + Namelist scalar value field. + """ + + _fortranKindMap = { + "character": {"default": "str_def", "filename": "str_max_filename"}, + "logical": {"default": "l_def", "native": "l_native"}, + "integer": { + "default": "i_def", + "short": "i_short", + "medium": "i_medium", + "long": "i_long", + }, + "real": { + "default": "r_def", + "native": "r_native", + "single": "r_single", + "double": "r_double", + "second": "r_second", + }, + } + + _fortranFormatMap = { + "character": "A", + "logical": "L2", + "integer": "I0", + "real": "E14.7", + } + + _fortranMissingDataIndicator = { + "character": "cmdi", + "logical": ".false.", + "integer": "imdi", + "real": "rmdi", + } + + def __init__( + self, + name: str, + configure_type: str, + configure_kind: Optional[str] = None, + ): + """ + :param name: Identifying name. + :param configure_type: Configuration type identifier. + :param configure_kind: Configuration kind identifier. + """ + if not configure_kind: + configure_kind = "default" + + if configure_type == "string": + configure_type = "character" + + super().__init__( + name, + FortranType.instance( + configure_type, + self._fortranKindMap[configure_type][configure_kind], + self._fortranFormatMap[configure_type], + ), + ) + self._mdi = self._fortranMissingDataIndicator[configure_type] + + def get_configure_type(self): + return "scalar" + + @property + def missing_data_indicator(self): + return self._mdi + + +############################################################################## +class _Computed(_Scalar): + """ + Namelist computed value field. + """ + + def __init__( + self, + name: str, + configure_type: str, + computation: str, + configure_kind: Optional[str], + dereferenced_list_vars: Optional[Sequence[str]] = None, + ): + # pylint: disable=too-many-arguments + """ + :param name: Identifying name. + :param configure_type: Configuration type identifier. + :param configure_kind: Configuration kind identifier. + :param computation: Fortran expression. + :param derefernced_list_vars: Fields needed from other namelists. + """ + super().__init__(name, configure_type, configure_kind) + self.computation = computation + self.dereferenced_list_vars = dereferenced_list_vars + + def get_configure_type(self): + return "computed" + + +############################################################################## +class _Array(_Property): + """ + Namelist array field. + """ + + def __init__(self, name: str, contentProperty: _Property, bounds: str): + """ + :param name: Identifying name. + :param contentProperty: Description of array elements. + :param bounds: Description of array size. + """ + super().__init__(name, contentProperty.fortran_type) + self.content = contentProperty + + if "," in bounds: + message = "Only 1D arrays allowed in configuration: {}" + raise NamelistDescriptionException(message.format(bounds)) + + if ":" in bounds and bounds.strip() != ":": + lower, upper = bounds.split(":") + + if lower.strip() not in ["1", ""]: + message = ( + "Only lower bound of 1 is allowed in configuration: {}" + ) + raise NamelistDescriptionException(message.format(bounds)) + + self.bounds = upper + else: + self.bounds = bounds + + def get_configure_type(self): + return "array" + + @property + def missing_data_indicator(self): + return self.content.missing_data_indicator + + def is_immediate_size(self) -> bool: + """ + :return: True if array size is a fixed number. + """ + if self.bounds.isdigit(): + return True + + return False + + def is_deferred_size(self): + """ + :return: True if array size is dependent on another field. + """ + if not self.bounds[0].isdigit() and self.bounds[0] != ":": + return True + + return False + + def is_arbitrary_size(self): + """ + :return: True if array size is unspecified. + """ + if self.bounds[0] == ":": + return True + + return False + + +############################################################################## +class NamelistDescription: + """ + Describes a namelist and its contained fields. + """ + + def __init__( + self, + listname: str, + multiple_instances_allowed: bool = False, + instance_key_member: Optional[str] = None, + ): + """ + :param listname: Identifying name. + """ + self._listname = listname + self._multiple_instances_allowed = multiple_instances_allowed + self._instance_key_member = instance_key_member + + self._engine = jinja2.Environment( + loader=jinja2.PackageLoader("configurator", "templates"), + extensions=["jinja2.ext.do"], + ) + self._engine.filters["decorate"] = jinjamacros.decorate_macro + + self._parameters: Dict[str, _Property] = collections.OrderedDict() + self._module_usage = collections.defaultdict(set) + self._module_usage["constants_mod"] = set( + ["cmdi", "emdi", "unset_key", "imdi", "rmdi", "str_def"] + ) + + def get_namelist_name(self) -> str: + """ + :return: Namelist identifier. + """ + return self._listname + + def get_module_name(self) -> str: + """ + :return: Namelist loader Fortran module name. + """ + return self._listname + "_nml_mod" + + def add_enumeration(self, name: str, enumerators: Sequence[str]) -> None: + """ + Adds an enumerated field to the namelist. + + .. warning:: + This routine will becomes stuck in an infinite loop if asked + to handle an enumeration with 2^31 enumerators. + + :param name: Identifying name. + :param enumerators: + """ + if not isinstance(enumerators, list): + message = "Expected list of enumerators" + raise NamelistDescriptionException(message) + + key_dict: Dict[str, int] = collections.OrderedDict() + for key in enumerators: + # Hash collisions are always possible and uniqueness is essential + # for our enumerators. This is a simple way of ensuring that + # uniqueness. Obviously it will get in an infinite loop if there + # are more than 2^32 things to deal with but that seems unlikely. + # + # Furthermore everything is limited to 2^31 as Fortran integers are + # always signed. + # + value = crc32(bytes(name + key, encoding="ascii")) & 0x7FFFFFFF + while value in key_dict.values(): + value = (value + 1) & 0x7FFFFFFF + key_dict[key] = value + + self._parameters[name] = _Enumeration(name, key_dict) + + def add_usage(self, name: str, module: str) -> None: + """ + Makes this namelist loading module depend on another Fortran module + for values used in computed fields. + + :param name: Variable name. + :param module: Module name. + """ + self._module_usage[module].add(name) + + def add_string( + self, + name: str, + configure_string_length: Optional[str] = None, + bounds: Optional[str] = None, + ) -> None: + """ + Adds a scalar or array string field to the namelist. + + :param name: Field name. + :param configure_string_length: Length of string is a label which + resolves to a length. + :param bounds: Either a length, slice or naked colon. + """ + new_parameter = _String(name, configure_string_length) + + if bounds: + dereffed_bounds, _ = self._dereference_expression(bounds) + self._parameters[name] = _Array( + name, new_parameter, dereffed_bounds + ) + else: + self._parameters[name] = new_parameter + + def add_value( + self, + name: str, + configure_type: str, + configure_kind: Optional[str] = None, + bounds: Optional[str] = None, + ) -> None: + """ + Adds a scalar or array field of type logical, integer or real to the + namelist. + + :param name: Field name. + :param configure_type: type identifier. + :param configure_kind: kind identifier. + :param bounds: Either a length, slice or naked colon. + """ + new_parameter = _Scalar(name, configure_type, configure_kind) + if bounds: + dereffed_bounds, _ = self._dereference_expression(bounds) + self._parameters[name] = _Array( + name, new_parameter, dereffed_bounds + ) + else: + self._parameters[name] = new_parameter + + def add_computed( + self, + name: str, + configure_type: str, + calculation: str, + configure_kind: Optional[str] = None, + ) -> None: + """ + Adds a computed field to the namelist. + + :param name: Field name. + :param configure_type: type identifier. + :param configure_kind: kind identifier. + :param colculation: Fortran expression. + """ + calculation, dereferenced_list_vars = self._dereference_expression( + calculation + ) + self._parameters[name] = _Computed( + name, + configure_type, + calculation, + configure_kind, + dereferenced_list_vars=dereferenced_list_vars, + ) + + def get_parameters(self) -> List[_Property]: + """ + Gets all the properties associated with this namelist. + """ + return list(self._parameters.values()) + + def write_module(self, file_object: Path) -> None: + """ + Generates Fortran module source and writes it to a file. + + :param file_object: Filename to write to. + """ + if not self._parameters: + message = ( + "Cannot write a module to load an empty namelist (" + + self._listname + + ")" + ) + raise NamelistDescriptionException(message) + + all_kinds = set(["i_def"]) + lone_kind_index = {} + lone_kind_tally: Dict[FortranType, int] = collections.defaultdict(int) + namelist = [] + + for name, parameter in self._parameters.items(): + all_kinds.update(parameter.required_kinds()) + + if not isinstance(parameter, _Computed) and not isinstance( + parameter, _Array + ): + lone_kind_tally[parameter.fortran_type] += 1 + lone_kind_index[name] = lone_kind_tally[parameter.fortran_type] + + if not isinstance(parameter, _Computed): + namelist.append(parameter.name) + + inserts = { + "all_kinds": all_kinds, + "arrays": [ + parameter.name + for parameter in self._parameters.values() + if isinstance(parameter, _Array) + ], + "allocatables": [ + parameter.name + for parameter in self._parameters.values() + if ( + isinstance(parameter, _Array) + and not parameter.is_immediate_size() + ) + ], + "enumerations": [ + parameter.name + for parameter in self._parameters.values() + if isinstance(parameter, _Enumeration) + ], + "listname": self._listname, + "multiple_instances_allowed": self._multiple_instances_allowed, + "instance_key_member": self._instance_key_member, + "lonekindindex": lone_kind_index, + "lonekindtally": lone_kind_tally, + "namelist": namelist, + "parameters": self._parameters, + "use_from": self._module_usage, + } + + nml_template = "extended_namelist_type.f90.jinja" + template = self._engine.get_template(nml_template) + file_object.write_text(template.render(inserts)) + + def _dereference_expression( + self, expression: str + ) -> Tuple[str, List[str]]: + """ + Resolve field references in an expression. + + :param expression: Fortran expression containing field references. + :result: Expression with references resolved and a list of namelist + fields involved. + """ + str_dict = { + "namelist": { + "regexString": r"namelist:(\w*)=(\w*)", + "removalString": r"namelist:\w*=", + "moduleSuffix": "_config_mod", + }, + "source": { + "regexString": r"source:(\w*)=(\w*)", + "removalString": r"source:\w*=", + "moduleSuffix": "", + }, + } + result = expression + + dereferenced_list_vars: List[str] = [] + + for key, value in str_dict.items(): + use_variables = re.findall(value["regexString"], result) + if use_variables is not None: + n_vars = len(use_variables) + + for i_var in range(0, n_vars): + list_name = use_variables[i_var][0] + var_name = use_variables[i_var][1] + + if use_variables[i_var][0] != self._listname: + module_name = f"{list_name}{value['moduleSuffix']}" + self.add_usage(var_name, module=module_name) + + if key == "namelist": + dereferenced_list_vars.append(var_name) + + result = re.sub(value["removalString"], "", result) + + if len(dereferenced_list_vars) == 0: + dereferenced_list_vars = [] + + return result, dereferenced_list_vars + + def add_member(self, member_name: str, meta_dict: Dict[str, str]) -> None: + # pylint: disable=too-many-branches + """ + Processes one field entry from the metadata and adds the appropriate + property to this namelist. + + :param member_name: Identifying name. + :param meta_dict: Field description. + """ + meta_keys = list(meta_dict.keys()) + string_length: Optional[str] = None + xtype: str = "" + xkind: Optional[str] = None + xbounds: Optional[str] = None + + if "string_length" in meta_keys: + string_length = meta_dict["string_length"] + + if "kind" in meta_keys: + xkind = meta_dict["kind"] + + if "type" in meta_keys: + xtype = meta_dict["type"] + if isinstance(xtype, str): + xtype = xtype.replace("character", "string") + + elif ( + "enumeration" not in meta_keys + or meta_dict["enumeration"] == "false" + ): + message = ( + "namelist:" + + self._listname + + "=" + + member_name + + ": Non-enumeration metadata requires " + + "a type definition" + ) + raise NamelistDescriptionException(message) + + # Determining array bounds if any. + if "length" in meta_keys: + xlength = meta_dict["length"] + + if xlength == ":": + if "bounds" in meta_keys: + xbounds = meta_dict["bounds"] + else: + xbounds = ":" + + elif isinstance(int(xlength), int): + xbounds = xlength + + # Generating Enumerators from metadata + # These are not dependant on xtype being specified + if "enumeration" in meta_keys and meta_dict["enumeration"] == "true": + key_values = meta_dict["values"] + if all(isinstance(item, str) for item in key_values): + key_values = key_values.replace("\n", "") + key_values = key_values.replace(" ", "") + key_values = key_values.replace("'", "") + keys = key_values.split(",") + + enumeration_keys = [ + re.sub(r"namelist:", "", member) for member in keys + ] + + self.add_enumeration(member_name, enumerators=enumeration_keys) + + # Check to see if member is a derived variable + elif "expression" in meta_keys: + expression_string = meta_dict["expression"] + self.add_computed( + member_name, + xtype, + configure_kind=xkind, + calculation=expression_string, + ) + + elif xtype == "string": + self.add_string( + member_name, + configure_string_length=string_length, + bounds=xbounds, + ) + else: + self.add_value( + member_name, xtype, configure_kind=xkind, bounds=xbounds + ) + + +############################################################################### +class NamelistConfigDescription: # pylint: disable=too-few-public-methods + """ + Manages the JSON representation of the configuration metadata. + """ + + @staticmethod + def process_config(nml_config_file: Path) -> List[NamelistDescription]: + """ + Loads the file and dissects it. + :param nml_config_file: Input JSON file. + """ + with open(nml_config_file, encoding="utf8") as config_file: + namelist_config = json.load(config_file) + + result = [] + + for listname in namelist_config.keys(): + multiple_instances_allowed = False + instance_key_member = None + if ( + "multiple_instances_allowed" + in namelist_config[listname].keys() + ): + multiple_instances_allowed = namelist_config[listname][ + "multiple_instances_allowed" + ] + instance_key_member = namelist_config[listname][ + "instance_key_member" + ] + + description = NamelistDescription( + listname, multiple_instances_allowed, instance_key_member + ) + members_dict = namelist_config[listname]["members"] + + for member in sorted(members_dict.keys()): + meta_dict = members_dict[member] + description.add_member(member, meta_dict) + + result.append(description) + + return result diff --git a/infrastructure/build/tools/configurator/namelistdescription.py b/infrastructure/build/tools/configurator/namelistdescription.py index d1e99b832..30cc22f1d 100644 --- a/infrastructure/build/tools/configurator/namelistdescription.py +++ b/infrastructure/build/tools/configurator/namelistdescription.py @@ -590,7 +590,7 @@ def write_module(self, file_object: Path) -> None: "use_from": self._module_usage, } - template = self._engine.get_template("namelist.f90.jinja") + template = self._engine.get_template("namelist_loader.f90.jinja") file_object.write_text(template.render(inserts)) def _dereference_expression( diff --git a/infrastructure/build/tools/configurator/templates/loader.f90.jinja b/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja similarity index 73% rename from infrastructure/build/tools/configurator/templates/loader.f90.jinja rename to infrastructure/build/tools/configurator/templates/config_loader.f90.jinja index 224ce01bb..8edad5bf7 100644 --- a/infrastructure/build/tools/configurator/templates/loader.f90.jinja +++ b/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja @@ -15,10 +15,13 @@ module {{moduleName}} use namelist_collection_mod, only: namelist_collection_type use namelist_mod, only: namelist_type - -{%- if namelists %} + use config_mod, only: config_type +{{-'\n'}} +{%- for listname in namelists %} + use {{listname}}_nml_mod, only: {{listname}}_nml_type +{%- endfor %} {{-'\n'}} -{%- for listname in namelists %} +{%- for listname in namelists %} use {{listname}}_config_mod, only : read_{{listname}}_namelist, & {%- set indent = ' use '+listname+'_config_mod, only : ' %} {%- set indent = indent | length() %} @@ -27,9 +30,9 @@ module {{moduleName}} {{' '*indent}}{{listname}}_is_loaded, & {{' '*indent}}{{listname}}_reset_load_status, & {{' '*indent}}{{listname}}_final, & -{{' '*indent}}get_{{listname}}_nml -{%- endfor %} -{%- endif %} +{{' '*indent}}get_{{listname}}_nml, & +{{' '*indent}}get_new_{{listname}}_nml +{%- endfor %} implicit none @@ -42,33 +45,60 @@ contains ! ! [in] filename File holding the namelists. ! - ! TODO: Assumes namelist tags come at the start of lines. ! TODO: Support "namelist file" namelists which recursively call this ! procedure to load other namelist files. ! - subroutine read_configuration( filename, nml_bank ) + subroutine read_configuration( filename, configuration, config ) use io_utility_mod, only : open_file, close_file implicit none character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + + type(namelist_collection_type), optional, intent(inout) :: configuration + type(config_type), optional, intent(inout) :: config integer(i_def) :: local_rank character(str_def), allocatable :: namelists(:) - integer(i_def) :: unit = -1 + integer(i_def) :: unit + + if (.not. present(configuration) .and. .not. present(config)) then + write(log_scratch_space,'(A)') & + 'At least one optional argument must be provided for ' //& + 'read_configuration.' + call log_event(log_scratch_space, log_level_error) + end if local_rank = global_mpi%get_comm_rank() + unit = -1 if (local_rank == 0) unit = open_file( filename ) call get_namelist_names( unit, local_rank, namelists ) - call read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) + if (present(configuration) .and. present(config)) then + ! TODO Transition, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration, & + config=config ) + + else if (present(configuration) .and. .not. present(config)) then + ! TODO Deprecated, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration ) + + else if (.not. present(configuration) .and. present(config)) then + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + config=config ) + + end if if (local_rank == 0) call close_file( unit ) @@ -106,8 +136,7 @@ contains continue_read = read_line( unit, buffer ) if ( .not. continue_read ) exit text_line_loop - ! TODO: Assumes namelist tags are at the start of lines. #1753 - ! + buffer = adjustl(buffer) if (buffer(1:1) == '&') then namecount = namecount + 1 allocate(names_temp(namecount)) @@ -164,6 +193,7 @@ contains case ('{{listname}}') configuration_found = {{listname}}_is_loaded() {%- endfor %} + case default write( log_scratch_space, '(A)' ) & 'Tried to ensure unrecognised namelist "'// & @@ -181,7 +211,7 @@ contains subroutine read_configuration_namelists( unit, local_rank, & namelists, filename, & - nml_bank ) + nml_bank, config ) implicit none integer(i_def), intent(in) :: unit @@ -189,21 +219,23 @@ contains character(str_def), intent(in) :: namelists(:) character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + type(namelist_collection_type), optional, intent(inout) :: nml_bank + type(config_type), optional, intent(inout) :: config type(namelist_type) :: nml_obj +{%- for listname in namelists %} + type({{listname}}_nml_type) :: {{listname}}_nml_obj +{%- endfor %} + integer(i_def) :: i, j logical :: scan -{%- if namelists %} -{{-'\n'}} ! Reset load status from any previous file reads -{%- for listname in namelists %} +{%- for listname in namelists %} call {{listname}}_reset_load_status() -{%- endfor %} -{%- endif %} +{%- endfor %} ! Read the namelists do j=1, 2 @@ -218,14 +250,23 @@ contains do i=1, size(namelists) select case (trim(namelists(i))) -{%- for listname in namelists %} +{% for listname in namelists %} case ('{{listname}}') if ({{listname}}_is_loadable()) then call read_{{listname}}_namelist( unit, local_rank, scan ) if (.not. scan) then call postprocess_{{listname}}_namelist() - nml_obj = get_{{listname}}_nml() - call nml_bank%add_namelist(nml_obj) + + if (present(nml_bank)) then + nml_obj = get_{{listname}}_nml() + call nml_bank%add_namelist(nml_obj) + end if + + if (present(config)) then + {{listname}}_nml_obj = get_new_{{listname}}_nml() + call config%add_namelist({{listname}}_nml_obj) + end if + end if else write( log_scratch_space, '(A)' ) & @@ -234,6 +275,7 @@ contains call log_event( log_scratch_space, LOG_LEVEL_ERROR ) end if {%- endfor %} + case default write( log_scratch_space, '(A)' ) & 'Unrecognised namelist "'//trim(namelists(i))// & @@ -254,13 +296,10 @@ contains subroutine final_configuration() implicit none - -{%- if namelists %} {{-'\n'}} -{%- for listname in namelists %} +{%- for listname in namelists %} call {{listname}}_final() -{%- endfor %} -{%- endif %} +{%- endfor %} return end subroutine final_configuration diff --git a/infrastructure/build/tools/configurator/templates/config_type.f90.jinja b/infrastructure/build/tools/configurator/templates/config_type.f90.jinja new file mode 100644 index 000000000..d79fc8a48 --- /dev/null +++ b/infrastructure/build/tools/configurator/templates/config_type.f90.jinja @@ -0,0 +1,446 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Defines \ object. +!> @details A container object that holds namelist +!> objects of various types). +!> +!> Access pattern will differ for namelist types that are permitted +!> to have multiple instances within the configuration. +!> +module {{moduleName}} + + use constants_mod, only: i_def, l_def, str_def, cmdi + use log_mod, only: log_event, log_scratch_space, & + log_level_error, log_level_warning + use linked_list_mod, only: linked_list_type, linked_list_item_type + + use namelist_mod, only: namelist_type + use namelist_collection_mod, only: namelist_collection_type + +{{-'\n'}} +{%- for i in range(namelists|length) %} + use {{namelists[i]}}_nml_mod, only: {{namelists[i]}}_nml_type +{%- endfor %} + + implicit none + + private + + !----------------------------------------------------------------------------- + ! Type that stores namelists of an application configuration + !----------------------------------------------------------------------------- + type, public :: config_type + + private + + !> The name of the namelist collection if provided. + character(:), allocatable :: config_name + + !> Whether object has been initialised or not + logical :: isinitialised = .false. + + !> The name of the namelist collection if provided. + character(str_def), allocatable :: nml_fullnames(:) + +{{-'\n'}} + ! Single instance namelists +{%- for i in range(namelists|length) %} +{%- if not duplicates[i] %} + type({{namelists[i]}}_nml_type), public, allocatable :: {{namelists[i]}} +{%- endif %} +{%- endfor %} + + ! Namelists which may have multiple instances. + ! These are accesed via the associated + ! _list methods. +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + type(linked_list_type), public, allocatable :: {{namelists[i]}} +{%- endif %} +{%- endfor %} + + contains + + procedure, public :: initialise + procedure, public :: name + procedure, public :: add_namelist + procedure, public :: contents + procedure, public :: n_namelists + procedure, public :: namelist_exists + +{{-'\n'}} +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + procedure, public :: {{namelists[i]}}_list +{%- endif %} +{%- endfor %} + + procedure, public :: clear + + final :: config_destructor + + procedure, private :: update_contents + + end type config_type + +contains + + +!> @brief Initialises application configuration. +!> @param [in] name Optional: The name given to the configuration. +!===================================================================== +subroutine initialise(self, name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), optional, intent(in) :: name + + if (self%isinitialised) then + write(log_scratch_space, '(A)') & + 'Application configuration: [' // & + trim(self%config_name) // & + '] has already been initiaised.' + call log_event(log_scratch_space, log_level_error) + end if + + if (present(name)) then + self%config_name = trim(name) + else + self%config_name = cmdi + end if + + self%isinitialised = .true. + +end subroutine initialise + + +!> @brief Installs a new namelist object into the configuration. +!> @param [in] namelist_obj The extended namelist type object. Only +!> extended namelist types defined by the +!> application metadata file will be accepted. +!=================================================================== +subroutine add_namelist(self, namelist_obj) + + implicit none + + class(config_type), intent(inout) :: self + + class(namelist_type), intent(in) :: namelist_obj + + character(:), allocatable :: name + character(:), allocatable :: profile_name + character(:), allocatable :: full_name + + ! Check namelist name is valid, if not then exit with error + full_name = namelist_obj%get_full_name() + profile_name = namelist_obj%get_profile_name() + name = namelist_obj%get_listname() + + select type(namelist_obj) +{{-'\n'}} +{%- for i in range(namelists|length) %} +{%- if not duplicates[i] %} + type is( {{namelists[i]}}_nml_type ) + ! Multiple instances: NOT ALLOWED + if (self%namelist_exists(trim(name))) then + write(log_scratch_space, '(A)') & + trim(name) // ' namelist already allocated.' + call log_event(log_scratch_space, log_level_error) + else + allocate(self%{{namelists[i]}}, source=namelist_obj) + call self%update_contents(trim(name)) + end if +{% endif %} +{%- endfor %} + +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + type is ( {{namelists[i]}}_nml_type ) + ! Multiple instances: ALLOWED + if (trim(profile_name) == cmdi) then + write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + ' namelist: missing profile name.' + call log_event(log_scratch_space, log_level_warning) + else if (self%namelist_exists(trim(full_name))) then + write(log_scratch_space, '(A)') trim(name) // & + ' namelist (' // trim(profile_name) // '), already allocated.' + call log_event(log_scratch_space, log_level_error) + else + if (.not. allocated(self%{{namelists[i]}})) then + allocate(self%{{namelists[i]}}) + end if + call self%{{namelists[i]}}%insert_item( namelist_obj ) + call self%update_contents(namelist_obj%get_full_name()) + end if +{% endif %} +{%- endfor %} + class default + write(log_scratch_space, '(A)') & + ' Undefined namelist type(' // trim(name) // & + '), for this configuration.' + call log_event(log_scratch_space, log_level_error) + + end select + +end subroutine add_namelist + + +!> @brief Check if a namelist is present the collection. +!> @param [in] name The name of the namelist to be checked. +!> @param [in] profile_name Optional: In the case of namelists which +!> are permitted to have multiple instances, +!> the profile name distiguishes the instances +!> of namelists. +!> @return exists Flag stating if namelist is present or not +!===================================================================== +function namelist_exists(self, name, profile_name) result(exists) + + implicit none + + class(config_type), intent(in) :: self + + character(*), intent(in) :: name + character(*), optional, intent(in) :: profile_name + + logical(l_def) :: exists + + integer(i_def) :: i + character(str_def) :: full_name + + exists = .false. + + if (allocated(self%nml_fullnames)) then + + if (present(profile_name)) then + full_name = trim(name)//':'//trim(profile_name) + else + full_name = trim(name) + end if + + do i=1, size(self%nml_fullnames) + if (trim(self%nml_fullnames(i)) == trim(full_name)) then + exists = .true. + exit + end if + end do + end if + +end function namelist_exists + +{{-'\n'}} +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + +!> @brief Returns a pointer to an instance of <{{namelists[i]}}_nml_type>. +!> @param [in] profile_name Profile name used to identify the +!> instance of <{{namelists[i]}}_nml_type>. +!> @return {{namelists[i]}}_nml_obj Pointer to the requested namelist object. +!===================================================================== +function {{namelists[i]}}_list(self, profile_name) result({{namelists[i]}}_nml_obj) + + implicit none + + class(config_type), intent(in) :: self + character(*), intent(in) :: profile_name + + type({{namelists[i]}}_nml_type), pointer :: {{namelists[i]}}_nml_obj + + ! Pointer to linked list - used for looping through the list + type(linked_list_item_type), pointer :: loop + character(str_def) :: payload_name + + nullify({{namelists[i]}}_nml_obj) + nullify(loop) + + loop => self%{{namelists[i]}}%get_head() + do + ! If the list is empty or the end of the list was + ! reached without finding the namelist, fail with + ! an error. + if (.not. associated(loop)) then + write(log_scratch_space, '(A)') & + 'Instance ' // trim(profile_name) // ' of ' // & + '{{namelists[i]}}_nml_type ' // & + 'not found in configuration.' + call log_event(log_scratch_space, log_level_error) + end if + + ! Otherwise 'cast' to a {{namelists[i]}}_namelist_type + select type(payload => loop%payload) + type is ({{namelists[i]}}_nml_type) + payload_name = payload%get_profile_name() + if (trim(profile_name) == trim(payload_name)) then + {{namelists[i]}}_nml_obj => payload + exit + end if + end select + + loop => loop%next + end do + +end function {{namelists[i]}}_list + +{%- endif %} +{%- endfor %} + +!> @brief Queries config_type for the total number of namelists stored. +!> @return answer The number of namelists stored +!===================================================================== +function n_namelists(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + + integer(i_def) :: answer + + answer = 0 + if (allocated(self%nml_fullnames)) then + answer = size(self%nml_fullnames) + end if + +end function n_namelists + +!> @brief Queries the name of config_type. +!> @return name The name identifying this namelist collection +!> on initialisation. +!===================================================================== +function name(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + character(:), allocatable :: answer + + answer = self%config_name + +end function name + +!> @brief Extracts namelist names in config_type. +!> @param listname Optional: if specified, returns entries +!> begining with this string. +!> @return namelist_names Array of unique names of namelists in the +!> collection. +!===================================================================== +function contents(self, listname) result(namelist_names) + + implicit none + + class(config_type), intent(in) :: self + + character(*), optional, intent(in) :: listname + + character(str_def), allocatable :: namelist_names(:) + + character(str_def), allocatable :: tmp(:) + character(str_def) :: tmp_str + integer(i_def) :: n_found, i, start_index + + if (allocated(namelist_names)) deallocate(namelist_names) + + n_found = 0 + if (present(listname)) then + + allocate(tmp(size(self%nml_fullnames))) + + do i=1, size(self%nml_fullnames) + if (index(trim(self%nml_fullnames(i)), trim(listname)) > 0) then + tmp_str = trim(self%nml_fullnames(i)) + start_index = index(tmp_str, ':') + n_found = n_found + 1_i_def + tmp(n_found) = trim(tmp_str(start_index+1:)) + end if + end do + + allocate(namelist_names(n_found)) + namelist_names = tmp(1:n_found) + deallocate(tmp) + + else + + allocate(namelist_names, source=self%nml_fullnames) + + end if + +end function contents + + +!> @brief Clears all items from the namelist collection. +!===================================================================== +subroutine clear(self) + + implicit none + + class(config_type), intent(inout) :: self + +{{-'\n'}} + ! Namlists which may have multiple instances per configuration +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + call self%{{namelists[i]}}%clear() +{%- endif %} +{%- endfor %} +{% for i in range(namelists|length) %} + if (allocated(self%{{namelists[i]}})) deallocate(self%{{namelists[i]}}) +{%- endfor %} + + if (allocated(self%nml_fullnames)) deallocate(self%nml_fullnames) + + self%config_name = cmdi + self%isinitialised = .false. + +end subroutine clear + + +!> @brief Destructor for the namelist collection +!===================================================================== +subroutine config_destructor(self) + + implicit none + + type(config_type), intent(inout) :: self + + call self%clear() + +end subroutine config_destructor + + +!> @brief Adds namelist identifier to the to list on namelists stored. +!> @param [in] nml_full_name Namelists identifier to be added. +!===================================================================== +subroutine update_contents(self, nml_full_name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), intent(in) :: nml_full_name + + character(str_def), allocatable :: tmp_str(:) + integer(i_def) :: n_entries + + if (allocated(self%nml_fullnames)) then + + n_entries = size(self%nml_fullnames) + allocate(tmp_str, source=self%nml_fullnames) + deallocate(self%nml_fullnames) + allocate(self%nml_fullnames(n_entries+1)) + self%nml_fullnames(1:n_entries) = tmp_str(:) + self%nml_fullnames(n_entries+1) = nml_full_name + + else + + allocate(self%nml_fullnames(1)) + self%nml_fullnames(1) = trim(nml_full_name) + + end if + +end subroutine update_contents + +end module {{moduleName}} diff --git a/infrastructure/build/tools/configurator/templates/extended_namelist_type.f90.jinja b/infrastructure/build/tools/configurator/templates/extended_namelist_type.f90.jinja new file mode 100644 index 000000000..52c3cd22a --- /dev/null +++ b/infrastructure/build/tools/configurator/templates/extended_namelist_type.f90.jinja @@ -0,0 +1,63 @@ +{#- This is the skeleton of the namelist loading module. -#} +{#- The Jinja templating library is used to insert the actual code. -#} +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +!> Manages the {{listname}} namelist. +!> +module {{listname}}_nml_mod + + use constants_mod, only: {{all_kinds | sort | join( ', &\n' + ' '*27 )}} + + use namelist_mod, only: namelist_type + + implicit none + + private + public :: {{listname}}_nml_type + + type, extends(namelist_type) :: {{listname}}_nml_type + private + contains + +{%- for name, parameter in parameters | dictsort %} +{%- if loop.first %}{{'\n'}}{%- endif %} + procedure :: {{parameter.name}} +{%- endfor %} + + end type {{listname}}_nml_type + +contains +{%- for name, parameter in parameters | dictsort %} +{%- if loop.first %}{{'\n'}}{%- endif %} +{%- if name in arrays %} +{# Template function to return an array namelist member #} + function {{parameter.name}}(self) result(answer) + + implicit none + + class({{listname}}_nml_type), intent(in) :: self + {{parameter.fortran_type.intrinsic_type}}({{parameter.fortran_type.kind}}), allocatable :: answer(:) + + call self%get_value('{{name}}', answer) + + end function {{parameter.name}} + +{%- else %} +{# Template function to return an scalar namelist member #} + function {{parameter.name}}(self) result(answer) + + implicit none + + class({{listname}}_nml_type), intent(in) :: self + {{parameter.fortran_type.intrinsic_type}}({{parameter.fortran_type.kind}}) :: answer + + call self%get_value('{{name}}', answer) + + end function {{parameter.name}} + +{%- endif %} +{% endfor %} +end module {{listname}}_nml_mod diff --git a/infrastructure/build/tools/configurator/templates/namelist_iterator_type.f90.jinja b/infrastructure/build/tools/configurator/templates/namelist_iterator_type.f90.jinja new file mode 100644 index 000000000..7d1d9a512 --- /dev/null +++ b/infrastructure/build/tools/configurator/templates/namelist_iterator_type.f90.jinja @@ -0,0 +1,117 @@ +{#- This is the skeleton of the namelist iterator module. -#} +{#- Provides and iterator for extended namelist types that may have -#} +{#- multiple instances. -#} +{#- The Jinja templating library is used to insert the actual code. -#} +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Provides functionality for iterating over all members of a defined +!> namelist ({{listname}}) collection. +!> +!> @details Provides functionality for iteratively returning every member +!> of the defined namelist ({{listname}}) collection. The order of +!> the namelists returned is not defined and can change if the +!> implementation of the namelist collection is changes. +! +module {{listname}}_nml_iterator_mod + + use constants_mod, only: l_def + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + + use {{listname}}_nml_mod, only: {{listname}}_nml_type + + implicit none + + private + public :: {{listname}}_nml_iterator_type + + !----------------------------------------------------------------------------- + ! Type that iterates through a linked list of only {{listname}}_nml_type + !----------------------------------------------------------------------------- + type :: {{listname}}_nml_iterator_type + + private + + !> A pointer to the namelist list being iterated over + type(linked_list_type), pointer :: {{listname}}_list + + !> A pointer to the linked list item within the + !> linked list that will contain the next namelist + !> to be returned + type(linked_list_item_type), pointer :: current + + contains + + procedure, public :: initialise + procedure, public :: next + procedure, public :: has_next + + end type {{listname}}_nml_iterator_type + +contains + +!> @brief Initialise a {{listname}} namelist collection iterator +!> @param [in] nml_list Linked list containing only +!> {{listname}}_nml_types to iterate over. +subroutine initialise(self, nml_list) + + implicit none + + class({{listname}}_nml_iterator_type), intent(inout) :: self + type(linked_list_type), intent(in), target :: nml_list + + ! Store a pointer to the collection being iterated over + self%{{listname}}_list => nml_list + + ! Start the iterator at the beginning of the nml_list. + nullify(self%current) + self%current => self%{{listname}}_list%get_head() + +end subroutine initialise + +!> @brief Returns the next {{listname}} namelist from the collection +!> @return A pointer to the next {{listname}} namelist in the collection +function next(self) result (nml_obj) + + implicit none + + class({{listname}}_nml_iterator_type), intent(inout), target :: self + type({{listname}}_nml_type), pointer :: nml_obj + + nml_obj => null() + + ! Empty lists are valid + ! + if (.not. associated(self%current)) return + + ! Extract a pointer to the current namelist + select type(list_nml => self%current%payload) + type is ({{listname}}_nml_type) + nml_obj => list_nml + end select + + ! Move the current item pointer onto the next item + self%current => self%current%next + +end function next + +!> @brief Checks if there are any further namelists in the collection +!> being iterated over. +!> @return next .true. if there is another namelist in the collection. +function has_next(self) result(next) + + implicit none + + class({{listname}}_nml_iterator_type), intent(in) :: self + logical(l_def) :: next + + next = .true. + if (.not.associated(self%current)) next = .false. + +end function has_next + +end module {{listname}}_nml_iterator_mod diff --git a/infrastructure/build/tools/configurator/templates/namelist.f90.jinja b/infrastructure/build/tools/configurator/templates/namelist_loader.f90.jinja similarity index 93% rename from infrastructure/build/tools/configurator/templates/namelist.f90.jinja rename to infrastructure/build/tools/configurator/templates/namelist_loader.f90.jinja index 3fda6acd1..abce2d3db 100644 --- a/infrastructure/build/tools/configurator/templates/namelist.f90.jinja +++ b/infrastructure/build/tools/configurator/templates/namelist_loader.f90.jinja @@ -34,7 +34,7 @@ module {{listname}}_config_mod {{' '*12}}{{listname}}_is_loadable, {{listname}}_is_loaded, & {{' '*12}}{{listname}}_reset_load_status, & {{' '*12}}{{listname}}_multiples_allowed, {{listname}}_final, & -{{' '*12}}get_{{listname}}_nml +{{' '*12}}get_{{listname}}_nml, get_new_{{listname}}_nml {%- for name in enumerations | sort %} {%- if loop.first %}{{'\n'}}{%- endif %} @@ -365,8 +365,8 @@ contains {%- for name, parameter in parameters | dictsort %} {%- if loop.first %}{{'\n'}}{% endif %} - call members({{loop.index}})%initialise( & - '{{parameter.name}}', {{parameter.name}} ) + call members({{loop.index}})%initialise( & + '{{parameter.name}}', {{parameter.name}} ) {{- '\n'}} {%- endfor %} if (trim(profile_name) /= trim(cmdi) ) then @@ -380,6 +380,35 @@ contains end function get_{{listname}}_nml + !> @brief Returns a <<{{listname}}_nml_type>> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <<{{listname}}_nml_type>> with current namelist contents. + function get_new_{{listname}}_nml() result(namelist_obj) + + use {{listname}}_nml_mod, only: {{listname}}_nml_type + + implicit none + + type({{listname}}_nml_type) :: namelist_obj + type(namelist_item_type) :: members({{parameters|length}}) + +{%- for name, parameter in parameters | dictsort %} +{%- if loop.first %}{{'\n'}}{% endif %} + call members({{loop.index}})%initialise( & + '{{parameter.name}}', {{parameter.name}} ) +{{- '\n'}} +{%- endfor %} + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_{{listname}}_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/app_config/bar_nml_iterator_mod.f90 b/infrastructure/build/tools/configurator/tests/app_config/bar_nml_iterator_mod.f90 new file mode 100644 index 000000000..0d9f5b225 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/bar_nml_iterator_mod.f90 @@ -0,0 +1,113 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Provides functionality for iterating over all members of a defined +!> namelist (bar) collection. +!> +!> @details Provides functionality for iteratively returning every member +!> of the defined namelist (bar) collection. The order of +!> the namelists returned is not defined and can change if the +!> implementation of the namelist collection is changes. +! +module bar_nml_iterator_mod + + use constants_mod, only: l_def + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + + use bar_nml_mod, only: bar_nml_type + + implicit none + + private + public :: bar_nml_iterator_type + + !----------------------------------------------------------------------------- + ! Type that iterates through a linked list of only bar_nml_type + !----------------------------------------------------------------------------- + type :: bar_nml_iterator_type + + private + + !> A pointer to the namelist list being iterated over + type(linked_list_type), pointer :: bar_list + + !> A pointer to the linked list item within the + !> linked list that will contain the next namelist + !> to be returned + type(linked_list_item_type), pointer :: current + + contains + + procedure, public :: initialise + procedure, public :: next + procedure, public :: has_next + + end type bar_nml_iterator_type + +contains + +!> @brief Initialise a bar namelist collection iterator +!> @param [in] nml_list Linked list containing only +!> bar_nml_types to iterate over. +subroutine initialise(self, nml_list) + + implicit none + + class(bar_nml_iterator_type), intent(inout) :: self + type(linked_list_type), intent(in), target :: nml_list + + ! Store a pointer to the collection being iterated over + self%bar_list => nml_list + + ! Start the iterator at the beginning of the nml_list. + nullify(self%current) + self%current => self%bar_list%get_head() + +end subroutine initialise + +!> @brief Returns the next bar namelist from the collection +!> @return A pointer to the next bar namelist in the collection +function next(self) result (nml_obj) + + implicit none + + class(bar_nml_iterator_type), intent(inout), target :: self + type(bar_nml_type), pointer :: nml_obj + + nml_obj => null() + + ! Empty lists are valid + ! + if (.not. associated(self%current)) return + + ! Extract a pointer to the current namelist + select type(list_nml => self%current%payload) + type is (bar_nml_type) + nml_obj => list_nml + end select + + ! Move the current item pointer onto the next item + self%current => self%current%next + +end function next + +!> @brief Checks if there are any further namelists in the collection +!> being iterated over. +!> @return next .true. if there is another namelist in the collection. +function has_next(self) result(next) + + implicit none + + class(bar_nml_iterator_type), intent(in) :: self + logical(l_def) :: next + + next = .true. + if (.not.associated(self%current)) next = .false. + +end function has_next + +end module bar_nml_iterator_mod diff --git a/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 b/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 new file mode 100644 index 000000000..c84d6c534 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 @@ -0,0 +1,498 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Defines \ object. +!> @details A container object that holds namelist +!> objects of various types). +!> +!> Access pattern will differ for namelist types that are permitted +!> to have multiple instances within the configuration. +!> +module config_mod + + use constants_mod, only: i_def, l_def, str_def, cmdi + use log_mod, only: log_event, log_scratch_space, & + log_level_error, log_level_warning + use linked_list_mod, only: linked_list_type, linked_list_item_type + + use namelist_mod, only: namelist_type + use namelist_collection_mod, only: namelist_collection_type + + use foo_nml_mod, only: foo_nml_type + use bar_nml_mod, only: bar_nml_type + use moo_nml_mod, only: moo_nml_type + use pot_nml_mod, only: pot_nml_type + + implicit none + + private + + !----------------------------------------------------------------------------- + ! Type that stores namelists of an application configuration + !----------------------------------------------------------------------------- + type, public :: config_type + + private + + !> The name of the namelist collection if provided. + character(:), allocatable :: config_name + + !> Whether object has been initialised or not + logical :: isinitialised = .false. + + !> The name of the namelist collection if provided. + character(str_def), allocatable :: nml_fullnames(:) + + ! Single instance namelists + type(foo_nml_type), public, allocatable :: foo + type(moo_nml_type), public, allocatable :: moo + + ! Namelists which may have multiple instances. + ! These are accesed via the associated + ! _list methods. + type(linked_list_type), public, allocatable :: bar + type(linked_list_type), public, allocatable :: pot + + contains + + procedure, public :: initialise + procedure, public :: name + procedure, public :: add_namelist + procedure, public :: contents + procedure, public :: n_namelists + procedure, public :: namelist_exists + + procedure, public :: bar_list + procedure, public :: pot_list + + procedure, public :: clear + + final :: config_destructor + + procedure, private :: update_contents + + end type config_type + +contains + + +!> @brief Initialises application configuration. +!> @param [in] name Optional: The name given to the configuration. +!===================================================================== +subroutine initialise(self, name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), optional, intent(in) :: name + + if (self%isinitialised) then + write(log_scratch_space, '(A)') & + 'Application configuration: [' // & + trim(self%config_name) // & + '] has already been initiaised.' + call log_event(log_scratch_space, log_level_error) + end if + + if (present(name)) then + self%config_name = trim(name) + else + self%config_name = cmdi + end if + + self%isinitialised = .true. + +end subroutine initialise + + +!> @brief Installs a new namelist object into the configuration. +!> @param [in] namelist_obj The extended namelist type object. Only +!> extended namelist types defined by the +!> application metadata file will be accepted. +!=================================================================== +subroutine add_namelist(self, namelist_obj) + + implicit none + + class(config_type), intent(inout) :: self + + class(namelist_type), intent(in) :: namelist_obj + + character(:), allocatable :: name + character(:), allocatable :: profile_name + character(:), allocatable :: full_name + + ! Check namelist name is valid, if not then exit with error + full_name = namelist_obj%get_full_name() + profile_name = namelist_obj%get_profile_name() + name = namelist_obj%get_listname() + + select type(namelist_obj) + + type is( foo_nml_type ) + ! Multiple instances: NOT ALLOWED + if (self%namelist_exists(trim(name))) then + write(log_scratch_space, '(A)') & + trim(name) // ' namelist already allocated.' + call log_event(log_scratch_space, log_level_error) + else + allocate(self%foo, source=namelist_obj) + call self%update_contents(trim(name)) + end if + + type is( moo_nml_type ) + ! Multiple instances: NOT ALLOWED + if (self%namelist_exists(trim(name))) then + write(log_scratch_space, '(A)') & + trim(name) // ' namelist already allocated.' + call log_event(log_scratch_space, log_level_error) + else + allocate(self%moo, source=namelist_obj) + call self%update_contents(trim(name)) + end if + + type is ( bar_nml_type ) + ! Multiple instances: ALLOWED + if (trim(profile_name) == cmdi) then + write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + ' namelist: missing profile name.' + call log_event(log_scratch_space, log_level_warning) + else if (self%namelist_exists(trim(full_name))) then + write(log_scratch_space, '(A)') trim(name) // & + ' namelist (' // trim(profile_name) // '), already allocated.' + call log_event(log_scratch_space, log_level_error) + else + if (.not. allocated(self%bar)) then + allocate(self%bar) + end if + call self%bar%insert_item( namelist_obj ) + call self%update_contents(namelist_obj%get_full_name()) + end if + + type is ( pot_nml_type ) + ! Multiple instances: ALLOWED + if (trim(profile_name) == cmdi) then + write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + ' namelist: missing profile name.' + call log_event(log_scratch_space, log_level_warning) + else if (self%namelist_exists(trim(full_name))) then + write(log_scratch_space, '(A)') trim(name) // & + ' namelist (' // trim(profile_name) // '), already allocated.' + call log_event(log_scratch_space, log_level_error) + else + if (.not. allocated(self%pot)) then + allocate(self%pot) + end if + call self%pot%insert_item( namelist_obj ) + call self%update_contents(namelist_obj%get_full_name()) + end if + + class default + write(log_scratch_space, '(A)') & + ' Undefined namelist type(' // trim(name) // & + '), for this configuration.' + call log_event(log_scratch_space, log_level_error) + + end select + +end subroutine add_namelist + + +!> @brief Check if a namelist is present the collection. +!> @param [in] name The name of the namelist to be checked. +!> @param [in] profile_name Optional: In the case of namelists which +!> are permitted to have multiple instances, +!> the profile name distiguishes the instances +!> of namelists. +!> @return exists Flag stating if namelist is present or not +!===================================================================== +function namelist_exists(self, name, profile_name) result(exists) + + implicit none + + class(config_type), intent(in) :: self + + character(*), intent(in) :: name + character(*), optional, intent(in) :: profile_name + + logical(l_def) :: exists + + integer(i_def) :: i + character(str_def) :: full_name + + exists = .false. + + if (allocated(self%nml_fullnames)) then + + if (present(profile_name)) then + full_name = trim(name)//':'//trim(profile_name) + else + full_name = trim(name) + end if + + do i=1, size(self%nml_fullnames) + if (trim(self%nml_fullnames(i)) == trim(full_name)) then + exists = .true. + exit + end if + end do + end if + +end function namelist_exists + + +!> @brief Returns a pointer to an instance of . +!> @param [in] profile_name Profile name used to identify the +!> instance of . +!> @return bar_nml_obj Pointer to the requested namelist object. +!===================================================================== +function bar_list(self, profile_name) result(bar_nml_obj) + + implicit none + + class(config_type), intent(in) :: self + character(*), intent(in) :: profile_name + + type(bar_nml_type), pointer :: bar_nml_obj + + ! Pointer to linked list - used for looping through the list + type(linked_list_item_type), pointer :: loop + character(str_def) :: payload_name + + nullify(bar_nml_obj) + nullify(loop) + + loop => self%bar%get_head() + do + ! If the list is empty or the end of the list was + ! reached without finding the namelist, fail with + ! an error. + if (.not. associated(loop)) then + write(log_scratch_space, '(A)') & + 'Instance ' // trim(profile_name) // ' of ' // & + 'bar_nml_type ' // & + 'not found in configuration.' + call log_event(log_scratch_space, log_level_error) + end if + + ! Otherwise 'cast' to a bar_namelist_type + select type(payload => loop%payload) + type is (bar_nml_type) + payload_name = payload%get_profile_name() + if (trim(profile_name) == trim(payload_name)) then + bar_nml_obj => payload + exit + end if + end select + + loop => loop%next + end do + +end function bar_list + +!> @brief Returns a pointer to an instance of . +!> @param [in] profile_name Profile name used to identify the +!> instance of . +!> @return pot_nml_obj Pointer to the requested namelist object. +!===================================================================== +function pot_list(self, profile_name) result(pot_nml_obj) + + implicit none + + class(config_type), intent(in) :: self + character(*), intent(in) :: profile_name + + type(pot_nml_type), pointer :: pot_nml_obj + + ! Pointer to linked list - used for looping through the list + type(linked_list_item_type), pointer :: loop + character(str_def) :: payload_name + + nullify(pot_nml_obj) + nullify(loop) + + loop => self%pot%get_head() + do + ! If the list is empty or the end of the list was + ! reached without finding the namelist, fail with + ! an error. + if (.not. associated(loop)) then + write(log_scratch_space, '(A)') & + 'Instance ' // trim(profile_name) // ' of ' // & + 'pot_nml_type ' // & + 'not found in configuration.' + call log_event(log_scratch_space, log_level_error) + end if + + ! Otherwise 'cast' to a pot_namelist_type + select type(payload => loop%payload) + type is (pot_nml_type) + payload_name = payload%get_profile_name() + if (trim(profile_name) == trim(payload_name)) then + pot_nml_obj => payload + exit + end if + end select + + loop => loop%next + end do + +end function pot_list + +!> @brief Queries config_type for the total number of namelists stored. +!> @return answer The number of namelists stored +!===================================================================== +function n_namelists(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + + integer(i_def) :: answer + + answer = 0 + if (allocated(self%nml_fullnames)) then + answer = size(self%nml_fullnames) + end if + +end function n_namelists + +!> @brief Queries the name of config_type. +!> @return name The name identifying this namelist collection +!> on initialisation. +!===================================================================== +function name(self) result(answer) + + implicit none + + class(config_type), intent(in) :: self + character(:), allocatable :: answer + + answer = self%config_name + +end function name + +!> @brief Extracts namelist names in config_type. +!> @param listname Optional: if specified, returns entries +!> begining with this string. +!> @return namelist_names Array of unique names of namelists in the +!> collection. +!===================================================================== +function contents(self, listname) result(namelist_names) + + implicit none + + class(config_type), intent(in) :: self + + character(*), optional, intent(in) :: listname + + character(str_def), allocatable :: namelist_names(:) + + character(str_def), allocatable :: tmp(:) + character(str_def) :: tmp_str + integer(i_def) :: n_found, i, start_index + + if (allocated(namelist_names)) deallocate(namelist_names) + + n_found = 0 + if (present(listname)) then + + allocate(tmp(size(self%nml_fullnames))) + + do i=1, size(self%nml_fullnames) + if (index(trim(self%nml_fullnames(i)), trim(listname)) > 0) then + tmp_str = trim(self%nml_fullnames(i)) + start_index = index(tmp_str, ':') + n_found = n_found + 1_i_def + tmp(n_found) = trim(tmp_str(start_index+1:)) + end if + end do + + allocate(namelist_names(n_found)) + namelist_names = tmp(1:n_found) + deallocate(tmp) + + else + + allocate(namelist_names, source=self%nml_fullnames) + + end if + +end function contents + + +!> @brief Clears all items from the namelist collection. +!===================================================================== +subroutine clear(self) + + implicit none + + class(config_type), intent(inout) :: self + + ! Namlists which may have multiple instances per configuration + call self%bar%clear() + call self%pot%clear() + + if (allocated(self%foo)) deallocate(self%foo) + if (allocated(self%bar)) deallocate(self%bar) + if (allocated(self%moo)) deallocate(self%moo) + if (allocated(self%pot)) deallocate(self%pot) + + if (allocated(self%nml_fullnames)) deallocate(self%nml_fullnames) + + self%config_name = cmdi + self%isinitialised = .false. + +end subroutine clear + + +!> @brief Destructor for the namelist collection +!===================================================================== +subroutine config_destructor(self) + + implicit none + + type(config_type), intent(inout) :: self + + call self%clear() + +end subroutine config_destructor + + +!> @brief Adds namelist identifier to the to list on namelists stored. +!> @param [in] nml_full_name Namelists identifier to be added. +!===================================================================== +subroutine update_contents(self, nml_full_name) + + implicit none + + class(config_type), intent(inout) :: self + + character(*), intent(in) :: nml_full_name + + character(str_def), allocatable :: tmp_str(:) + integer(i_def) :: n_entries + + if (allocated(self%nml_fullnames)) then + + n_entries = size(self%nml_fullnames) + allocate(tmp_str, source=self%nml_fullnames) + deallocate(self%nml_fullnames) + allocate(self%nml_fullnames(n_entries+1)) + self%nml_fullnames(1:n_entries) = tmp_str(:) + self%nml_fullnames(n_entries+1) = nml_full_name + + else + + allocate(self%nml_fullnames(1)) + self%nml_fullnames(1) = trim(nml_full_name) + + end if + +end subroutine update_contents + +end module config_mod diff --git a/infrastructure/build/tools/configurator/tests/app_config/pot_nml_iterator_mod.f90 b/infrastructure/build/tools/configurator/tests/app_config/pot_nml_iterator_mod.f90 new file mode 100644 index 000000000..6e7a61dd0 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/pot_nml_iterator_mod.f90 @@ -0,0 +1,113 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Provides functionality for iterating over all members of a defined +!> namelist (pot) collection. +!> +!> @details Provides functionality for iteratively returning every member +!> of the defined namelist (pot) collection. The order of +!> the namelists returned is not defined and can change if the +!> implementation of the namelist collection is changes. +! +module pot_nml_iterator_mod + + use constants_mod, only: l_def + use linked_list_mod, only: linked_list_type, & + linked_list_item_type + + use pot_nml_mod, only: pot_nml_type + + implicit none + + private + public :: pot_nml_iterator_type + + !----------------------------------------------------------------------------- + ! Type that iterates through a linked list of only pot_nml_type + !----------------------------------------------------------------------------- + type :: pot_nml_iterator_type + + private + + !> A pointer to the namelist list being iterated over + type(linked_list_type), pointer :: pot_list + + !> A pointer to the linked list item within the + !> linked list that will contain the next namelist + !> to be returned + type(linked_list_item_type), pointer :: current + + contains + + procedure, public :: initialise + procedure, public :: next + procedure, public :: has_next + + end type pot_nml_iterator_type + +contains + +!> @brief Initialise a pot namelist collection iterator +!> @param [in] nml_list Linked list containing only +!> pot_nml_types to iterate over. +subroutine initialise(self, nml_list) + + implicit none + + class(pot_nml_iterator_type), intent(inout) :: self + type(linked_list_type), intent(in), target :: nml_list + + ! Store a pointer to the collection being iterated over + self%pot_list => nml_list + + ! Start the iterator at the beginning of the nml_list. + nullify(self%current) + self%current => self%pot_list%get_head() + +end subroutine initialise + +!> @brief Returns the next pot namelist from the collection +!> @return A pointer to the next pot namelist in the collection +function next(self) result (nml_obj) + + implicit none + + class(pot_nml_iterator_type), intent(inout), target :: self + type(pot_nml_type), pointer :: nml_obj + + nml_obj => null() + + ! Empty lists are valid + ! + if (.not. associated(self%current)) return + + ! Extract a pointer to the current namelist + select type(list_nml => self%current%payload) + type is (pot_nml_type) + nml_obj => list_nml + end select + + ! Move the current item pointer onto the next item + self%current => self%current%next + +end function next + +!> @brief Checks if there are any further namelists in the collection +!> being iterated over. +!> @return next .true. if there is another namelist in the collection. +function has_next(self) result(next) + + implicit none + + class(pot_nml_iterator_type), intent(in) :: self + logical(l_def) :: next + + next = .true. + if (.not.associated(self%current)) next = .false. + +end function has_next + +end module pot_nml_iterator_mod diff --git a/infrastructure/build/tools/configurator/tests/app_config/test_app_config.py b/infrastructure/build/tools/configurator/tests/app_config/test_app_config.py new file mode 100644 index 000000000..f5094edac --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/app_config/test_app_config.py @@ -0,0 +1,50 @@ +#!/usr/bin/env python3 +############################################################################## +# (c) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Unit tests Application Configuration Object generator. +""" + +from pathlib import Path + +import configurator.config_type as AppConfig + +HERE = Path(__file__).resolve().parent + + +class TestAppConfig: + """ + Tests generation of application configuration object. + """ + + def test_with_content(self, tmp_path: Path): # pylint: disable=no-self-use + """ + Generating application configuration object. + """ + uut = AppConfig.AppConfiguration("config_mod") + uut.add_namelist("foo", duplicate=False) + uut.add_namelist("bar", duplicate=True) + uut.add_namelist("moo", duplicate=False) + uut.add_namelist("pot", duplicate=True) + output_file = tmp_path / "content_mod.f90" + uut.write_module(output_file) + + expected_file = HERE / "content_mod.f90" + assert output_file.read_text( + encoding="ascii" + ) + "\n" == expected_file.read_text(encoding="ascii") + + output_file = tmp_path / "bar_nml_iterator_mod.f90" + expected_file = HERE / "bar_nml_iterator_mod.f90" + assert output_file.read_text( + encoding="ascii" + ) + "\n" == expected_file.read_text(encoding="ascii") + + output_file = tmp_path / "pot_nml_iterator_mod.f90" + expected_file = HERE / "pot_nml_iterator_mod.f90" + assert output_file.read_text( + encoding="ascii" + ) + "\n" == expected_file.read_text(encoding="ascii") diff --git a/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 b/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 index 2d1e31285..2a4164c97 100644 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 @@ -13,6 +13,9 @@ module content_mod use namelist_collection_mod, only: namelist_collection_type use namelist_mod, only: namelist_type + use config_mod, only: config_type + + use foo_nml_mod, only: foo_nml_type use foo_config_mod, only : read_foo_namelist, & postprocess_foo_namelist, & @@ -20,7 +23,8 @@ module content_mod foo_is_loaded, & foo_reset_load_status, & foo_final, & - get_foo_nml + get_foo_nml, & + get_new_foo_nml implicit none @@ -33,33 +37,60 @@ module content_mod ! ! [in] filename File holding the namelists. ! - ! TODO: Assumes namelist tags come at the start of lines. ! TODO: Support "namelist file" namelists which recursively call this ! procedure to load other namelist files. ! - subroutine read_configuration( filename, nml_bank ) + subroutine read_configuration( filename, configuration, config ) use io_utility_mod, only : open_file, close_file implicit none character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + + type(namelist_collection_type), optional, intent(inout) :: configuration + type(config_type), optional, intent(inout) :: config integer(i_def) :: local_rank character(str_def), allocatable :: namelists(:) - integer(i_def) :: unit = -1 + integer(i_def) :: unit + + if (.not. present(configuration) .and. .not. present(config)) then + write(log_scratch_space,'(A)') & + 'At least one optional argument must be provided for ' //& + 'read_configuration.' + call log_event(log_scratch_space, log_level_error) + end if local_rank = global_mpi%get_comm_rank() + unit = -1 if (local_rank == 0) unit = open_file( filename ) call get_namelist_names( unit, local_rank, namelists ) - call read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) + if (present(configuration) .and. present(config)) then + ! TODO Transition, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration, & + config=config ) + + else if (present(configuration) .and. .not. present(config)) then + ! TODO Deprecated, remove when all code ported to config + ! access pattern + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + nml_bank=configuration ) + + else if (.not. present(configuration) .and. present(config)) then + call read_configuration_namelists( unit, local_rank, & + namelists, filename, & + config=config ) + + end if if (local_rank == 0) call close_file( unit ) @@ -97,8 +128,7 @@ subroutine get_namelist_names( unit, local_rank, names ) continue_read = read_line( unit, buffer ) if ( .not. continue_read ) exit text_line_loop - ! TODO: Assumes namelist tags are at the start of lines. #1753 - ! + buffer = adjustl(buffer) if (buffer(1:1) == '&') then namecount = namecount + 1 allocate(names_temp(namecount)) @@ -153,6 +183,7 @@ function ensure_configuration( names, success_mask ) select case(trim( names(i) )) case ('foo') configuration_found = foo_is_loaded() + case default write( log_scratch_space, '(A)' ) & 'Tried to ensure unrecognised namelist "'// & @@ -170,7 +201,7 @@ end function ensure_configuration subroutine read_configuration_namelists( unit, local_rank, & namelists, filename, & - nml_bank ) + nml_bank, config ) implicit none integer(i_def), intent(in) :: unit @@ -178,9 +209,11 @@ subroutine read_configuration_namelists( unit, local_rank, & character(str_def), intent(in) :: namelists(:) character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank + type(namelist_collection_type), optional, intent(inout) :: nml_bank + type(config_type), optional, intent(inout) :: config type(namelist_type) :: nml_obj + type(foo_nml_type) :: foo_nml_obj integer(i_def) :: i, j @@ -202,13 +235,23 @@ subroutine read_configuration_namelists( unit, local_rank, & do i=1, size(namelists) select case (trim(namelists(i))) + case ('foo') if (foo_is_loadable()) then call read_foo_namelist( unit, local_rank, scan ) if (.not. scan) then call postprocess_foo_namelist() - nml_obj = get_foo_nml() - call nml_bank%add_namelist(nml_obj) + + if (present(nml_bank)) then + nml_obj = get_foo_nml() + call nml_bank%add_namelist(nml_obj) + end if + + if (present(config)) then + foo_nml_obj = get_new_foo_nml() + call config%add_namelist(foo_nml_obj) + end if + end if else write( log_scratch_space, '(A)' ) & @@ -216,6 +259,7 @@ subroutine read_configuration_namelists( unit, local_rank, & '" can not be read. Too many instances?' call log_event( log_scratch_space, LOG_LEVEL_ERROR ) end if + case default write( log_scratch_space, '(A)' ) & 'Unrecognised namelist "'//trim(namelists(i))// & diff --git a/infrastructure/build/tools/configurator/tests/configuration_loader/empty_mod.f90 b/infrastructure/build/tools/configurator/tests/configuration_loader/empty_mod.f90 deleted file mode 100644 index 132a84345..000000000 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/empty_mod.f90 +++ /dev/null @@ -1,216 +0,0 @@ -!----------------------------------------------------------------------------- -! (C) Crown copyright 2022 Met Office. All rights reserved. -! The file LICENCE, distributed with this code, contains details of the terms -! under which the code may be used. -!----------------------------------------------------------------------------- -! Handles the loading of namelists. -! -module empty_mod - - use constants_mod, only : i_def, l_def, str_def, str_max_filename - use lfric_mpi_mod, only : global_mpi - use log_mod, only : log_scratch_space, log_event, LOG_LEVEL_ERROR - - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type - - implicit none - - private - public :: read_configuration, ensure_configuration, final_configuration - -contains - - ! Reads configuration namelists from a file. - ! - ! [in] filename File holding the namelists. - ! - ! TODO: Assumes namelist tags come at the start of lines. - ! TODO: Support "namelist file" namelists which recursively call this - ! procedure to load other namelist files. - ! - subroutine read_configuration( filename, nml_bank ) - - use io_utility_mod, only : open_file, close_file - - implicit none - - character(*), intent(in) :: filename - type(namelist_collection_type), intent(inout) :: nml_bank - - integer(i_def) :: local_rank - - character(str_def), allocatable :: namelists(:) - integer(i_def) :: unit = -1 - - local_rank = global_mpi%get_comm_rank() - - if (local_rank == 0) unit = open_file( filename ) - - call get_namelist_names( unit, local_rank, namelists ) - - call read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) - - if (local_rank == 0) call close_file( unit ) - - end subroutine read_configuration - - ! Finds names of all namelists present in file. - ! - ! [in] unit File holding namelists. - ! [out] names of namelist in file (in order). - ! - subroutine get_namelist_names( unit, local_rank, names ) - - use io_utility_mod, only : read_line - - implicit none - - integer(i_def), intent(in) :: unit - integer(i_def), intent(in) :: local_rank - character(str_def), intent(inout), allocatable :: names(:) - - character(str_def), allocatable :: names_temp(:) - ! TODO: Buffer is large enough for a fair sized string and a filename. - ! Ideally it should be dynamically sized for the length of the - ! incoming data but I'm not sure how best to achieve that at the - ! moment. #1752 - character(str_def + str_max_filename) :: buffer - logical(l_def) :: continue_read - ! Number of names - integer(i_def) :: namecount(1) - - namecount = 0 - if (local_rank == 0) then - text_line_loop: do - - continue_read = read_line( unit, buffer ) - if ( .not. continue_read ) exit text_line_loop - - ! TODO: Assumes namelist tags are at the start of lines. #1753 - ! - if (buffer(1:1) == '&') then - namecount = namecount + 1 - allocate(names_temp(namecount)) - if (namecount > 1) then - names_temp(1:namecount-1) = names - end if - names_temp(namecount) = trim(buffer(2:)) - call move_alloc(names_temp, names) - end if - end do text_line_loop - rewind(unit) - end if - - call global_mpi%broadcast( namecount, 0 ) - - if (local_rank /= 0) then - allocate(names(namecount)) - end if - - call global_mpi%broadcast( names, namecount*str_def, 0 ) - - end subroutine get_namelist_names - - ! Checks that the requested namelists have been loaded. - ! - ! [in] names List of namelists. - ! [out] success_mask Marks corresponding namelists as having failed. - ! - ! [return] Overall success. - ! - function ensure_configuration( names, success_mask ) - - implicit none - - character(*), intent(in) :: names(:) - logical(l_def), optional, intent(out) :: success_mask(:) - logical(l_def) :: ensure_configuration - - integer(i_def) :: i - logical :: configuration_found = .True. - - if (present(success_mask) & - .and. (size(success_mask, 1) /= size(names, 1))) then - call log_event( 'Arguments "names" and "success_mask" to function' & - // '"ensure_configuration" are different shapes', & - LOG_LEVEL_ERROR ) - end if - - ensure_configuration = .True. - - name_loop: do i = 1, size(names) - select case(trim( names(i) )) - case default - write( log_scratch_space, '(A)' ) & - 'Tried to ensure unrecognised namelist "'// & - trim(names(i))//'" was loaded.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) - end select - - ensure_configuration = ensure_configuration .and. configuration_found - - if (present(success_mask)) success_mask(i) = configuration_found - - end do name_loop - - end function ensure_configuration - - subroutine read_configuration_namelists( unit, local_rank, & - namelists, filename, & - nml_bank ) - implicit none - - integer(i_def), intent(in) :: unit - integer(i_def), intent(in) :: local_rank - character(str_def), intent(in) :: namelists(:) - character(*), intent(in) :: filename - - type(namelist_collection_type), intent(inout) :: nml_bank - - type(namelist_type) :: nml_obj - - integer(i_def) :: i, j - - logical :: scan - - ! Read the namelists - do j=1, 2 - - select case(j) - case(1) - scan = .true. - case(2) - scan = .false. - end select - - do i=1, size(namelists) - - select case (trim(namelists(i))) - case default - write( log_scratch_space, '(A)' ) & - 'Unrecognised namelist "'//trim(namelists(i))// & - '" found in file '//trim(filename)//'.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) - end select - - end do ! Namelists - - if ( local_rank == 0 ) then - rewind( unit ) - end if - - end do ! Reading passes - - end subroutine read_configuration_namelists - - subroutine final_configuration() - - implicit none - - return - end subroutine final_configuration - -end module empty_mod diff --git a/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py b/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py index 3c51b695b..14b43b40e 100644 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py +++ b/infrastructure/build/tools/configurator/tests/configuration_loader/test_configuration_loader.py @@ -20,19 +20,6 @@ class TestLoader: Tests generation of configuration loader. """ - def test_empty(self, tmp_path: Path): # pylint: disable=no-self-use - """ - Generating configuration loader for no configuration. - """ - output_file = tmp_path / "empty_mod.f90" - uut = loader.ConfigurationLoader("empty_mod") - uut.write_module(output_file) - - expected_file = HERE / "empty_mod.f90" - assert output_file.read_text( - encoding="ascii" - ) + "\n" == expected_file.read_text(encoding="ascii") - def test_with_content(self, tmp_path: Path): # pylint: disable=no-self-use """ Generating configuration loader. diff --git a/infrastructure/build/tools/configurator/tests/extended_nml/one_each_mod.f90 b/infrastructure/build/tools/configurator/tests/extended_nml/one_each_mod.f90 new file mode 100644 index 000000000..f6c7e5807 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/extended_nml/one_each_mod.f90 @@ -0,0 +1,219 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +!> Manages the one_of_each namelist. +!> +module one_of_each_nml_mod + + use constants_mod, only: i_def, & + i_long, & + i_short, & + l_def, & + r_def, & + r_double, & + r_second, & + r_single, & + str_def, & + str_max_filename + + use namelist_mod, only: namelist_type + + implicit none + + private + public :: one_of_each_nml_type + + type, extends(namelist_type) :: one_of_each_nml_type + private + contains + + procedure :: dint + procedure :: dlog + procedure :: dreal + procedure :: dstr + procedure :: enum + procedure :: fstr + procedure :: lint + procedure :: lreal + procedure :: sint + procedure :: sreal + procedure :: treal + procedure :: vint + procedure :: vreal + procedure :: vstr + + end type one_of_each_nml_type + +contains + + + function dint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_def) :: answer + + call self%get_value('dint', answer) + + end function dint + + + function dlog(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + logical(l_def) :: answer + + call self%get_value('dlog', answer) + + end function dlog + + + function dreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_def) :: answer + + call self%get_value('dreal', answer) + + end function dreal + + + function dstr(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + character(str_def) :: answer + + call self%get_value('dstr', answer) + + end function dstr + + + function enum(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_def) :: answer + + call self%get_value('enum', answer) + + end function enum + + + function fstr(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + character(str_max_filename) :: answer + + call self%get_value('fstr', answer) + + end function fstr + + + function lint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_long) :: answer + + call self%get_value('lint', answer) + + end function lint + + + function lreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_double) :: answer + + call self%get_value('lreal', answer) + + end function lreal + + + function sint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_short) :: answer + + call self%get_value('sint', answer) + + end function sint + + + function sreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_single) :: answer + + call self%get_value('sreal', answer) + + end function sreal + + + function treal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_second) :: answer + + call self%get_value('treal', answer) + + end function treal + + + function vint(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + integer(i_def) :: answer + + call self%get_value('vint', answer) + + end function vint + + + function vreal(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + real(r_def) :: answer + + call self%get_value('vreal', answer) + + end function vreal + + + function vstr(self) result(answer) + + implicit none + + class(one_of_each_nml_type), intent(in) :: self + character(str_def) :: answer + + call self%get_value('vstr', answer) + + end function vstr + +end module one_of_each_nml_mod diff --git a/infrastructure/build/tools/configurator/tests/extended_nml/test_extended_nml.py b/infrastructure/build/tools/configurator/tests/extended_nml/test_extended_nml.py new file mode 100644 index 000000000..ae2a26971 --- /dev/null +++ b/infrastructure/build/tools/configurator/tests/extended_nml/test_extended_nml.py @@ -0,0 +1,53 @@ +#!/usr/bin/env python3 +############################################################################## +# (c) Crown copyright 2025 Met Office. All rights reserved. +# The file LICENCE, distributed with this code, contains details of the terms +# under which the code may be used. +############################################################################## +""" +Unit tests for Extended Namelist Specific Object generator. +""" + +from pathlib import Path + +import configurator.extended_namelist_type as ExtendedNml + +HERE = Path(__file__).resolve().parent + + +class TestExtendedNml: + """ + Tests generation of extended namelist specific object. + """ + + def test_write_one_of_each(self, tmp_path: Path): + # pylint: disable=no-self-use + """ + Generating extended namelist object with one of each + component member type. + """ + output_file = tmp_path / "one_of_each_mod.f90" + uut = ExtendedNml.NamelistDescription("one_of_each") + + uut.add_value("vint", "integer") + uut.add_value("dint", "integer", "default") + uut.add_value("sint", "integer", "short") + uut.add_value("lint", "integer", "long") + uut.add_value("dlog", "logical", "default") + uut.add_value("vreal", "real") + uut.add_value("dreal", "real", "default") + uut.add_value("sreal", "real", "single") + uut.add_value("lreal", "real", "double") + uut.add_value("treal", "real", "second") + uut.add_string("vstr") + uut.add_string("dstr", configure_string_length="default") + uut.add_string("fstr", configure_string_length="filename") + uut.add_enumeration("enum", enumerators=["one", "two", "three"]) + + uut.write_module(output_file) + + expected_file = HERE / "one_each_mod.f90" + assert ( + expected_file.read_text(encoding="ascii") + == output_file.read_text(encoding="ascii") + "\n" + ) diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 index 2779e9c7a..ebbbb760b 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/array_mod.f90 @@ -27,7 +27,7 @@ module aerial_config_mod aerial_is_loadable, aerial_is_loaded, & aerial_reset_load_status, & aerial_multiples_allowed, aerial_final, & - get_aerial_nml + get_aerial_nml, get_new_aerial_nml integer(i_def), parameter, public :: max_array_size = 500 @@ -157,20 +157,20 @@ function get_aerial_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(5) - call members(1)%initialise( & - 'absolute', absolute ) + call members(1)%initialise( & + 'absolute', absolute ) - call members(2)%initialise( & - 'inlist', inlist ) + call members(2)%initialise( & + 'inlist', inlist ) - call members(3)%initialise( & - 'lsize', lsize ) + call members(3)%initialise( & + 'lsize', lsize ) - call members(4)%initialise( & - 'outlist', outlist ) + call members(4)%initialise( & + 'outlist', outlist ) - call members(5)%initialise( & - 'unknown', unknown ) + call members(5)%initialise( & + 'unknown', unknown ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -183,6 +183,44 @@ function get_aerial_nml() result(namelist_obj) end function get_aerial_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_aerial_nml() result(namelist_obj) + + use aerial_nml_mod, only: aerial_nml_type + + implicit none + + type(aerial_nml_type) :: namelist_obj + type(namelist_item_type) :: members(5) + + call members(1)%initialise( & + 'absolute', absolute ) + + call members(2)%initialise( & + 'inlist', inlist ) + + call members(3)%initialise( & + 'lsize', lsize ) + + call members(4)%initialise( & + 'outlist', outlist ) + + call members(5)%initialise( & + 'unknown', unknown ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_aerial_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 index 3b28a50a8..26c553d54 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/computed_mod.f90 @@ -25,7 +25,7 @@ module teapot_config_mod teapot_is_loadable, teapot_is_loaded, & teapot_reset_load_status, & teapot_multiples_allowed, teapot_final, & - get_teapot_nml + get_teapot_nml, get_new_teapot_nml real(r_def), public, protected :: bar = rmdi real(r_def), public, protected :: foo = rmdi @@ -121,14 +121,14 @@ function get_teapot_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(3) - call members(1)%initialise( & - 'bar', bar ) + call members(1)%initialise( & + 'bar', bar ) - call members(2)%initialise( & - 'foo', foo ) + call members(2)%initialise( & + 'foo', foo ) - call members(3)%initialise( & - 'fum', fum ) + call members(3)%initialise( & + 'fum', fum ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -141,6 +141,38 @@ function get_teapot_nml() result(namelist_obj) end function get_teapot_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_teapot_nml() result(namelist_obj) + + use teapot_nml_mod, only: teapot_nml_type + + implicit none + + type(teapot_nml_type) :: namelist_obj + type(namelist_item_type) :: members(3) + + call members(1)%initialise( & + 'bar', bar ) + + call members(2)%initialise( & + 'foo', foo ) + + call members(3)%initialise( & + 'fum', fum ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_teapot_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 index e49f029c3..8bb06cefd 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/constants_mod.f90 @@ -25,7 +25,7 @@ module cheese_config_mod cheese_is_loadable, cheese_is_loaded, & cheese_reset_load_status, & cheese_multiples_allowed, cheese_final, & - get_cheese_nml + get_cheese_nml, get_new_cheese_nml real(r_def), public, protected :: fred = rmdi real(r_def), public, protected :: wilma = rmdi @@ -116,11 +116,11 @@ function get_cheese_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(2) - call members(1)%initialise( & - 'fred', fred ) + call members(1)%initialise( & + 'fred', fred ) - call members(2)%initialise( & - 'wilma', wilma ) + call members(2)%initialise( & + 'wilma', wilma ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -133,6 +133,35 @@ function get_cheese_nml() result(namelist_obj) end function get_cheese_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_cheese_nml() result(namelist_obj) + + use cheese_nml_mod, only: cheese_nml_type + + implicit none + + type(cheese_nml_type) :: namelist_obj + type(namelist_item_type) :: members(2) + + call members(1)%initialise( & + 'fred', fred ) + + call members(2)%initialise( & + 'wilma', wilma ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_cheese_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 index 89d60df65..f0e028e71 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/enum_only_mod.f90 @@ -26,7 +26,7 @@ module enum_config_mod enum_is_loadable, enum_is_loaded, & enum_reset_load_status, & enum_multiples_allowed, enum_final, & - get_enum_nml + get_enum_nml, get_new_enum_nml integer(i_def), public, parameter :: value_one = 1695414371 integer(i_def), public, parameter :: value_three = 839906103 @@ -210,8 +210,8 @@ function get_enum_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(1) - call members(1)%initialise( & - 'value', value ) + call members(1)%initialise( & + 'value', value ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -224,6 +224,32 @@ function get_enum_nml() result(namelist_obj) end function get_enum_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_enum_nml() result(namelist_obj) + + use enum_nml_mod, only: enum_nml_type + + implicit none + + type(enum_nml_type) :: namelist_obj + type(namelist_item_type) :: members(1) + + call members(1)%initialise( & + 'value', value ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_enum_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 index b5cb503bb..ed48b9f62 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/first_growing_mod.f90 @@ -24,7 +24,7 @@ module test_config_mod test_is_loadable, test_is_loaded, & test_reset_load_status, & test_multiples_allowed, test_final, & - get_test_nml + get_test_nml, get_new_test_nml integer(i_def), public, protected :: foo = imdi @@ -113,8 +113,8 @@ function get_test_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(1) - call members(1)%initialise( & - 'foo', foo ) + call members(1)%initialise( & + 'foo', foo ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -127,6 +127,32 @@ function get_test_nml() result(namelist_obj) end function get_test_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_test_nml() result(namelist_obj) + + use test_nml_mod, only: test_nml_type + + implicit none + + type(test_nml_type) :: namelist_obj + type(namelist_item_type) :: members(1) + + call members(1)%initialise( & + 'foo', foo ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_test_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 index 41a5ddfae..677a0a38b 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/one_each_mod.f90 @@ -34,7 +34,7 @@ module test_config_mod test_is_loadable, test_is_loaded, & test_reset_load_status, & test_multiples_allowed, test_final, & - get_test_nml + get_test_nml, get_new_test_nml integer(i_def), public, parameter :: enum_one = 189779348 integer(i_def), public, parameter :: enum_three = 1061269036 @@ -301,47 +301,47 @@ function get_test_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(14) - call members(1)%initialise( & - 'dint', dint ) + call members(1)%initialise( & + 'dint', dint ) - call members(2)%initialise( & - 'dlog', dlog ) + call members(2)%initialise( & + 'dlog', dlog ) - call members(3)%initialise( & - 'dreal', dreal ) + call members(3)%initialise( & + 'dreal', dreal ) - call members(4)%initialise( & - 'dstr', dstr ) + call members(4)%initialise( & + 'dstr', dstr ) - call members(5)%initialise( & - 'enum', enum ) + call members(5)%initialise( & + 'enum', enum ) - call members(6)%initialise( & - 'fstr', fstr ) + call members(6)%initialise( & + 'fstr', fstr ) - call members(7)%initialise( & - 'lint', lint ) + call members(7)%initialise( & + 'lint', lint ) - call members(8)%initialise( & - 'lreal', lreal ) + call members(8)%initialise( & + 'lreal', lreal ) - call members(9)%initialise( & - 'sint', sint ) + call members(9)%initialise( & + 'sint', sint ) - call members(10)%initialise( & - 'sreal', sreal ) + call members(10)%initialise( & + 'sreal', sreal ) - call members(11)%initialise( & - 'treal', treal ) + call members(11)%initialise( & + 'treal', treal ) - call members(12)%initialise( & - 'vint', vint ) + call members(12)%initialise( & + 'vint', vint ) - call members(13)%initialise( & - 'vreal', vreal ) + call members(13)%initialise( & + 'vreal', vreal ) - call members(14)%initialise( & - 'vstr', vstr ) + call members(14)%initialise( & + 'vstr', vstr ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -354,6 +354,71 @@ function get_test_nml() result(namelist_obj) end function get_test_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_test_nml() result(namelist_obj) + + use test_nml_mod, only: test_nml_type + + implicit none + + type(test_nml_type) :: namelist_obj + type(namelist_item_type) :: members(14) + + call members(1)%initialise( & + 'dint', dint ) + + call members(2)%initialise( & + 'dlog', dlog ) + + call members(3)%initialise( & + 'dreal', dreal ) + + call members(4)%initialise( & + 'dstr', dstr ) + + call members(5)%initialise( & + 'enum', enum ) + + call members(6)%initialise( & + 'fstr', fstr ) + + call members(7)%initialise( & + 'lint', lint ) + + call members(8)%initialise( & + 'lreal', lreal ) + + call members(9)%initialise( & + 'sint', sint ) + + call members(10)%initialise( & + 'sreal', sreal ) + + call members(11)%initialise( & + 'treal', treal ) + + call members(12)%initialise( & + 'vint', vint ) + + call members(13)%initialise( & + 'vreal', vreal ) + + call members(14)%initialise( & + 'vstr', vstr ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_test_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 index f6a0d110e..970ed713c 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/second_growing_mod.f90 @@ -25,7 +25,7 @@ module test_config_mod test_is_loadable, test_is_loaded, & test_reset_load_status, & test_multiples_allowed, test_final, & - get_test_nml + get_test_nml, get_new_test_nml real(r_def), public, protected :: bar = rmdi integer(i_def), public, protected :: foo = imdi @@ -121,11 +121,11 @@ function get_test_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(2) - call members(1)%initialise( & - 'bar', bar ) + call members(1)%initialise( & + 'bar', bar ) - call members(2)%initialise( & - 'foo', foo ) + call members(2)%initialise( & + 'foo', foo ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -138,6 +138,35 @@ function get_test_nml() result(namelist_obj) end function get_test_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_test_nml() result(namelist_obj) + + use test_nml_mod, only: test_nml_type + + implicit none + + type(test_nml_type) :: namelist_obj + type(namelist_item_type) :: members(2) + + call members(1)%initialise( & + 'bar', bar ) + + call members(2)%initialise( & + 'foo', foo ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_test_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 index c571d8b59..20b940cb5 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/string_mod.f90 @@ -26,7 +26,7 @@ module mirth_config_mod mirth_is_loadable, mirth_is_loaded, & mirth_reset_load_status, & mirth_multiples_allowed, mirth_final, & - get_mirth_nml + get_mirth_nml, get_new_mirth_nml integer(i_def), parameter, public :: max_array_size = 500 @@ -145,17 +145,17 @@ function get_mirth_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(4) - call members(1)%initialise( & - 'chortle', chortle ) + call members(1)%initialise( & + 'chortle', chortle ) - call members(2)%initialise( & - 'chuckle', chuckle ) + call members(2)%initialise( & + 'chuckle', chuckle ) - call members(3)%initialise( & - 'guffaw', guffaw ) + call members(3)%initialise( & + 'guffaw', guffaw ) - call members(4)%initialise( & - 'hysterics', hysterics ) + call members(4)%initialise( & + 'hysterics', hysterics ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -168,6 +168,41 @@ function get_mirth_nml() result(namelist_obj) end function get_mirth_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_mirth_nml() result(namelist_obj) + + use mirth_nml_mod, only: mirth_nml_type + + implicit none + + type(mirth_nml_type) :: namelist_obj + type(namelist_item_type) :: members(4) + + call members(1)%initialise( & + 'chortle', chortle ) + + call members(2)%initialise( & + 'chuckle', chuckle ) + + call members(3)%initialise( & + 'guffaw', guffaw ) + + call members(4)%initialise( & + 'hysterics', hysterics ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_mirth_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 b/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 index f1f8fbb2e..95e56b40a 100644 --- a/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/namelist_description/two_enum_mod.f90 @@ -27,7 +27,7 @@ module twoenum_config_mod twoenum_is_loadable, twoenum_is_loaded, & twoenum_reset_load_status, & twoenum_multiples_allowed, twoenum_final, & - get_twoenum_nml + get_twoenum_nml, get_new_twoenum_nml integer(i_def), public, parameter :: first_one = 1952457118 integer(i_def), public, parameter :: first_three = 1813125082 @@ -306,11 +306,11 @@ function get_twoenum_nml() result(namelist_obj) type(namelist_type) :: namelist_obj type(namelist_item_type) :: members(2) - call members(1)%initialise( & - 'first', first ) + call members(1)%initialise( & + 'first', first ) - call members(2)%initialise( & - 'second', second ) + call members(2)%initialise( & + 'second', second ) if (trim(profile_name) /= trim(cmdi) ) then call namelist_obj%initialise( trim(listname), & @@ -323,6 +323,35 @@ function get_twoenum_nml() result(namelist_obj) end function get_twoenum_nml + !> @brief Returns a <> object populated with the + !> current contents of this configuration module. + !> @return namelist_obj <> with current namelist contents. + function get_new_twoenum_nml() result(namelist_obj) + + use twoenum_nml_mod, only: twoenum_nml_type + + implicit none + + type(twoenum_nml_type) :: namelist_obj + type(namelist_item_type) :: members(2) + + call members(1)%initialise( & + 'first', first ) + + call members(2)%initialise( & + 'second', second ) + + if (trim(profile_name) /= trim(cmdi) ) then + call namelist_obj%initialise( trim(listname), & + members, & + profile_name = profile_name ) + else + call namelist_obj%initialise( trim(listname), & + members ) + end if + + end function get_new_twoenum_nml + !> Performs any processing to be done once all namelists are loaded !> diff --git a/infrastructure/build/tools/dependerator/analyser.py b/infrastructure/build/tools/dependerator/analyser.py index 60e4906d1..73a0ead17 100755 --- a/infrastructure/build/tools/dependerator/analyser.py +++ b/infrastructure/build/tools/dependerator/analyser.py @@ -464,6 +464,7 @@ def lines_of_code( for module_name in module_names: if module_name is not None: logger.info(" Depends on external " + module_name) + assert isinstance(program_unit, str) add_dependency(program_unit, module_name) continue diff --git a/infrastructure/source/configuration/configuration_mod.f90 b/infrastructure/source/configuration/configuration_mod.f90 new file mode 100644 index 000000000..c59109995 --- /dev/null +++ b/infrastructure/source/configuration/configuration_mod.f90 @@ -0,0 +1,24 @@ +!----------------------------------------------------------------------------- +! (C) Crown copyright 2025 Met Office. All rights reserved. +! The file LICENCE, distributed with this code, contains details of the terms +! under which the code may be used. +!----------------------------------------------------------------------------- +! +!> @brief Temporary module to redirect code that calls generated configuration +!> module. +!> @details This isolates the change to new namelist access pattern to core repository. +!> It allows inplementation in lfric apps repo to be done piecemeal +!> +!---------------------------------------------------------------------------- +module configuration_mod + + use config_loader_mod, only: read_configuration, & + ensure_configuration, & + final_configuration + + implicit none + + private + public :: read_configuration, ensure_configuration, final_configuration + +end module configuration_mod diff --git a/infrastructure/source/configuration/namelist_item_mod.f90 b/infrastructure/source/configuration/namelist_item_mod.f90 index f1c607e98..dad1610f7 100644 --- a/infrastructure/source/configuration/namelist_item_mod.f90 +++ b/infrastructure/source/configuration/namelist_item_mod.f90 @@ -723,16 +723,7 @@ subroutine value_str_arr( self, value ) class(namelist_item_type), intent(in) :: self - !> @todo This was applied with #3547. This would have been - !> similar to the scalar string: i.e. - !> - !> character(*), allocatable, intent(out) :: value(:) - !> - !> However, the revision of the Intel compiler on the XC40 - !> produced unexpected behaviour so the length has been - !> limited to str_def. This should be revisited when the - !> XC40 compilers are later than 17.0.0.098/5. - character(str_def), allocatable, intent(out) :: value(:) + character(*), allocatable, intent(out) :: value(:) integer :: arr_len integer :: i diff --git a/infrastructure/source/configuration/namelist_mod.F90 b/infrastructure/source/configuration/namelist_mod.F90 index f84ee19f4..81bc13e05 100644 --- a/infrastructure/source/configuration/namelist_mod.F90 +++ b/infrastructure/source/configuration/namelist_mod.F90 @@ -436,17 +436,7 @@ subroutine get_str_arr_value( self, name, value ) class(namelist_type), intent(in) :: self character(*), intent(in) :: name - !> @todo This was applied with #3547. This would have been - !> similar to the scalar string: i.e. - !> - !> character(*), allocatable, intent(out) :: value(:) - !> - !> However, the revision of the Intel compiler on the XC40 - !> produced unexpected behaviour so the length has been - !> limited to str_def. This should be revisited when the - !> XC40 compilers are later than 17.0.0.098/5. - character(str_def), intent(out), & - allocatable :: value(:) + character(*), intent(out), allocatable :: value(:) integer(i_def) :: i diff --git a/infrastructure/source/io/ncdf_quad_mod.F90 b/infrastructure/source/io/ncdf_quad_mod.F90 index c83aec22b..b887bcd7e 100644 --- a/infrastructure/source/io/ncdf_quad_mod.F90 +++ b/infrastructure/source/io/ncdf_quad_mod.F90 @@ -2873,9 +2873,9 @@ subroutine write_mesh( self, & node_coordinates_ncdf(:,:) = real( node_coordinates(:,:), kind=r_ncdf ) face_coordinates_ncdf(:,:) = real( face_coordinates(:,:), kind=r_ncdf ) - self%geometry = geometry - self%topology = topology - self%coord_sys = coord_sys + self%geometry = trim(geometry) + self%topology = trim(topology) + self%coord_sys = trim(coord_sys) self%npanels = npanels ! Determine if the contents of object is a global/regional model. @@ -2899,7 +2899,7 @@ subroutine write_mesh( self, & self%mesh_extents = GLOBAL_MESH_FLAG end if - self%mesh_name = mesh_name + self%mesh_name = trim(mesh_name) self%north_pole(:) = north_pole(:) self%null_island(:) = null_island(:) self%equatorial_latitude = equatorial_latitude diff --git a/mesh_tools/source/cubedsphere_mesh_generator.f90 b/mesh_tools/source/cubedsphere_mesh_generator.f90 index a27a6da26..6447f856b 100644 --- a/mesh_tools/source/cubedsphere_mesh_generator.f90 +++ b/mesh_tools/source/cubedsphere_mesh_generator.f90 @@ -17,7 +17,8 @@ program cubedsphere_mesh_generator use cli_mod, only: parse_command_line use constants_mod, only: i_def, l_def, r_def, str_def, & cmdi, imdi, emdi, str_max_filename - use configuration_mod, only: read_configuration, final_configuration + use config_loader_mod, only: read_configuration, final_configuration + use config_mod, only: config_type use coord_transform_mod, only: rebase_longitude_range use gencube_ps_mod, only: gencube_ps_type, & set_partition_parameters @@ -30,7 +31,6 @@ program cubedsphere_mesh_generator use halo_comms_mod, only: initialise_halo_comms, & finalise_halo_comms use io_utility_mod, only: open_file, close_file - use namelist_collection_mod, only: namelist_collection_type use lfric_mpi_mod, only: global_mpi, create_comm, & destroy_comm, lfric_comm_type use local_mesh_collection_mod, only: local_mesh_collection_type @@ -41,7 +41,6 @@ program cubedsphere_mesh_generator log_level_error, log_level_warning use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use ncdf_quad_mod, only: ncdf_quad_type use omp_lib, only: omp_get_thread_num @@ -135,8 +134,8 @@ program cubedsphere_mesh_generator ! Counters. integer(i_def) :: i, j, k, l, n_voids + type(config_type), save :: config type(namelist_collection_type), save :: configuration - type(namelist_type), pointer :: nml_obj ! Configuration variables to obtain from configuration. character(str_max_filename) :: mesh_file_prefix @@ -170,7 +169,6 @@ program cubedsphere_mesh_generator character(9), parameter :: timer_file = 'timer.txt' nullify(partitioner_ptr) - nullify(nml_obj) !=================================================================== ! Read in the control namelists from file. @@ -197,43 +195,39 @@ program cubedsphere_mesh_generator call initialise_logging( communicator%get_comm_mpi_val(), 'CubeGen' ) call configuration%initialise( 'CubeGen', table_len=10 ) - call read_configuration( filename, configuration ) + call config%initialise( 'CubeGen' ) + + call read_configuration( filename, & + configuration=configuration, & + config=config ) deallocate( filename ) - if (configuration%namelist_exists('mesh')) then - nml_obj => configuration%get_namelist('mesh') - call nml_obj%get_value( 'mesh_file_prefix', mesh_file_prefix ) - call nml_obj%get_value( 'n_meshes', n_meshes ) - call nml_obj%get_value( 'mesh_names', mesh_names ) - call nml_obj%get_value( 'mesh_maps', mesh_maps ) - call nml_obj%get_value( 'partition_mesh', partition_mesh ) - call nml_obj%get_value( 'rotate_mesh', rotate_mesh ) - call nml_obj%get_value( 'coord_sys', coord_sys ) - call nml_obj%get_value( 'topology', topology ) - call nml_obj%get_value( 'geometry', geometry ) - end if + mesh_file_prefix = config%mesh%mesh_file_prefix() + n_meshes = config%mesh%n_meshes() + mesh_names = config%mesh%mesh_names() + mesh_maps = config%mesh%mesh_maps() + partition_mesh = config%mesh%partition_mesh() + rotate_mesh = config%mesh%rotate_mesh() + coord_sys = config%mesh%coord_sys() + topology = config%mesh%topology() + geometry = config%mesh%geometry() - if (configuration%namelist_exists('partitions')) then - nml_obj => configuration%get_namelist('partitions') - call nml_obj%get_value( 'max_stencil_depth', max_stencil_depth ) - call nml_obj%get_value( 'n_partitions', n_partitions ) - call nml_obj%get_value( 'partition_range', partition_range ) - call nml_obj%get_value( 'generate_inner_halos', generate_inner_halos ) - end if + edge_cells = config%cubedsphere_mesh%edge_cells() + smooth_passes = config%cubedsphere_mesh%smooth_passes() + equatorial_latitude = config%cubedsphere_mesh%equatorial_latitude() - if (configuration%namelist_exists('rotation')) then - nml_obj => configuration%get_namelist('rotation') - call nml_obj%get_value( 'rotation_target', rotation_target ) - call nml_obj%get_value( 'target_north_pole', target_north_pole ) - call nml_obj%get_value( 'target_null_island', target_null_island ) + if (partition_mesh) then + max_stencil_depth = config%partitions%max_stencil_depth() + n_partitions = config%partitions%n_partitions() + partition_range = config%partitions%partition_range() + generate_inner_halos = config%partitions%generate_inner_halos() end if - if (configuration%namelist_exists('cubedsphere_mesh')) then - nml_obj => configuration%get_namelist('cubedsphere_mesh') - call nml_obj%get_value( 'edge_cells', edge_cells ) - call nml_obj%get_value( 'smooth_passes', smooth_passes ) - call nml_obj%get_value( 'equatorial_latitude', equatorial_latitude ) + if (rotate_mesh) then + rotation_target = config%rotation%rotation_target() + target_north_pole = config%rotation%target_north_pole() + target_null_island = config%rotation%target_null_island() end if call init_timer(timer_file) diff --git a/mesh_tools/source/planar_mesh_generator.f90 b/mesh_tools/source/planar_mesh_generator.f90 index f25491306..6ac208821 100644 --- a/mesh_tools/source/planar_mesh_generator.f90 +++ b/mesh_tools/source/planar_mesh_generator.f90 @@ -18,7 +18,8 @@ program planar_mesh_generator use cli_mod, only: parse_command_line use constants_mod, only: i_def, l_def, r_def, str_def, & cmdi, imdi, emdi, str_max_filename - use configuration_mod, only: read_configuration, final_configuration + use config_loader_mod, only: read_configuration, final_configuration + use config_mod, only: config_type use coord_transform_mod, only: rebase_longitude_range use gen_lbc_mod, only: gen_lbc_type use gen_planar_mod, only: gen_planar_type, & @@ -41,8 +42,6 @@ program planar_mesh_generator LOG_LEVEL_ERROR use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type - use ncdf_quad_mod, only: ncdf_quad_type use omp_lib, only: omp_get_thread_num use partition_mod, only: partition_type, partitioner_interface @@ -138,8 +137,8 @@ program planar_mesh_generator integer(i_def) :: i, j, k, l, n_voids ! Configuration variables - type(namelist_collection_type) :: configuration - type(namelist_type), pointer :: nml_obj + type(config_type), save :: config + type(namelist_collection_type), save :: configuration character(str_max_filename) :: mesh_file_prefix @@ -185,7 +184,6 @@ program planar_mesh_generator character(9), parameter :: timer_file = 'timer.txt' nullify(partitioner_ptr) - nullify(nml_obj) !=================================================================== ! Read in the control namelists from file. @@ -214,55 +212,52 @@ program planar_mesh_generator call initialise_logging( communicator%get_comm_mpi_val(), "PlanarGen" ) call configuration%initialise( 'PlanarGen', table_len=10 ) - call read_configuration( filename, configuration ) + call config%initialise( 'PlanarGen' ) + + call read_configuration( filename, & + configuration=configuration, & + config=config ) deallocate( filename ) - if (configuration%namelist_exists('mesh')) then - nml_obj => configuration%get_namelist('mesh') - call nml_obj%get_value( 'mesh_file_prefix', mesh_file_prefix ) - call nml_obj%get_value( 'n_meshes', n_meshes ) - call nml_obj%get_value( 'mesh_names', mesh_names ) - call nml_obj%get_value( 'mesh_maps', mesh_maps ) - call nml_obj%get_value( 'partition_mesh', partition_mesh ) - call nml_obj%get_value( 'rotate_mesh', rotate_mesh ) - call nml_obj%get_value( 'coord_sys', coord_sys ) - call nml_obj%get_value( 'topology', topology ) - call nml_obj%get_value( 'geometry', geometry ) - end if - if (configuration%namelist_exists('partitions')) then - nml_obj => configuration%get_namelist('partitions') - call nml_obj%get_value( 'max_stencil_depth', max_stencil_depth ) - call nml_obj%get_value( 'n_partitions', n_partitions ) - call nml_obj%get_value( 'partition_range', partition_range ) - call nml_obj%get_value( 'partition_range', partition_range ) - call nml_obj%get_value( 'generate_inner_halos', generate_inner_halos ) - end if + mesh_file_prefix = config%mesh%mesh_file_prefix() + + n_meshes = config%mesh%n_meshes() + mesh_names = config%mesh%mesh_names() + mesh_maps = config%mesh%mesh_maps() + partition_mesh = config%mesh%partition_mesh() + rotate_mesh = config%mesh%rotate_mesh() + coord_sys = config%mesh%coord_sys() + topology = config%mesh%topology() + geometry = config%mesh%geometry() + + edge_cells_x = config%planar_mesh%edge_cells_x() + edge_cells_y = config%planar_mesh%edge_cells_y() + periodic_x = config%planar_mesh%periodic_x() + periodic_y = config%planar_mesh%periodic_y() + domain_size = config%planar_mesh%domain_size() + domain_centre = config%planar_mesh%domain_centre() + create_lbc_mesh = config%planar_mesh%create_lbc_mesh() + lbc_rim_depth = config%planar_mesh%lbc_rim_depth() + lbc_parent_mesh = config%planar_mesh%lbc_parent_mesh() + + apply_stretch_transform = config%planar_mesh%apply_stretch_transform() - if (configuration%namelist_exists('rotation')) then - nml_obj => configuration%get_namelist('rotation') - call nml_obj%get_value( 'rotation_target', rotation_target ) - call nml_obj%get_value( 'target_north_pole', target_north_pole ) - call nml_obj%get_value( 'target_null_island', target_null_island ) + if (partition_mesh) then + max_stencil_depth = config%partitions%max_stencil_depth() + n_partitions = config%partitions%n_partitions() + partition_range = config%partitions%partition_range() + generate_inner_halos = config%partitions%generate_inner_halos() end if - if (configuration%namelist_exists('planar_mesh')) then - nml_obj => configuration%get_namelist('planar_mesh') - call nml_obj%get_value( 'edge_cells_x', edge_cells_x ) - call nml_obj%get_value( 'edge_cells_y', edge_cells_y ) - call nml_obj%get_value( 'periodic_x', periodic_x ) - call nml_obj%get_value( 'periodic_y', periodic_y ) - call nml_obj%get_value( 'domain_size', domain_size ) - call nml_obj%get_value( 'domain_centre', domain_centre ) - call nml_obj%get_value( 'create_lbc_mesh', create_lbc_mesh ) - call nml_obj%get_value( 'lbc_rim_depth', lbc_rim_depth ) - call nml_obj%get_value( 'lbc_parent_mesh', lbc_parent_mesh ) - call nml_obj%get_value( 'apply_stretch_transform', apply_stretch_transform ) + if (rotate_mesh) then + rotation_target = config%rotation%rotation_target() + target_north_pole = config%rotation%target_north_pole() + target_null_island = config%rotation%target_null_island() end if - if (configuration%namelist_exists('stretch_transform')) then - nml_obj => configuration%get_namelist('stretch_transform') - call nml_obj%get_value( 'transform_mesh', transform_mesh ) + if (apply_stretch_transform) then + transform_mesh = config%stretch_transform%transform_mesh() end if call init_timer(timer_file)