diff --git a/applications/coupled/source/coupled.f90 b/applications/coupled/source/coupled.f90 index b1e4f280a..a74455853 100644 --- a/applications/coupled/source/coupled.f90 +++ b/applications/coupled/source/coupled.f90 @@ -41,27 +41,23 @@ program coupled call parse_command_line( filename, component_name=cpl_component_name ) 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) // & - '-bit real numbers.' - call log_event( log_scratch_space, log_level_trace ) + call modeldb%values%add_key_value('cpl_name', cpl_component_name) modeldb%mpi => global_mpi - call modeldb%values%add_key_value('cpl_name', cpl_component_name) call init_comm( "coupled", modeldb ) - - call init_config( filename, & - coupled_required_namelists, & - configuration=modeldb%configuration, & + call init_config( filename, coupled_required_namelists, & config=modeldb%config ) call init_logger( modeldb%mpi%get_comm(), & program_name//"_"//cpl_component_name ) + + write(log_scratch_space,'(A)') & + 'Application built with '// trim(precision_real) // & + '-bit real numbers.' + call log_event( log_scratch_space, log_level_trace ) + call init_collections() call init_time( modeldb ) deallocate( filename ) diff --git a/applications/coupled/source/driver/coupled_driver_mod.f90 b/applications/coupled/source/driver/coupled_driver_mod.f90 index 2f525142c..550e405f1 100644 --- a/applications/coupled/source/driver/coupled_driver_mod.f90 +++ b/applications/coupled/source/driver/coupled_driver_mod.f90 @@ -120,7 +120,7 @@ subroutine initialise( program_name, modeldb, calendar ) ! Create the required meshes stencil_depth = 1 apply_partition_check = .false. - call init_mesh( modeldb%configuration, & + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & base_mesh_names, extrusion, & 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 52d3d640b..71fd3cb46 100644 --- a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 @@ -17,7 +17,6 @@ module io_demo_constants_mod ! Infrastructure 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 @@ -49,16 +48,14 @@ 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(modeldb, mesh, chi, panel_id) + subroutine create_io_demo_constants(mesh, chi, panel_id) implicit none ! Arguments - 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 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 0be601260..9cafc6cc1 100644 --- a/applications/io_demo/source/driver/init_io_demo_mod.F90 +++ b/applications/io_demo/source/driver/init_io_demo_mod.F90 @@ -106,7 +106,7 @@ subroutine init_io_demo(modeldb, mesh, chi, panel_id) ! 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(modeldb, mesh, chi, panel_id) + call create_io_demo_constants(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 73fd63c24..2b59171da 100644 --- a/applications/io_demo/source/driver/io_demo_driver_mod.f90 +++ b/applications/io_demo/source/driver/io_demo_driver_mod.f90 @@ -155,7 +155,7 @@ subroutine initialise(program_name, modeldb) ! --------------------------------------------------------- stencil_depth = 1 check_partitions = .false. - call init_mesh( modeldb%configuration, & + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & base_mesh_names, extrusion, & diff --git a/applications/io_demo/source/io_demo.f90 b/applications/io_demo/source/io_demo.f90 index 7f5d7d5db..601702c87 100644 --- a/applications/io_demo/source/io_demo.f90 +++ b/applications/io_demo/source/io_demo.f90 @@ -10,7 +10,8 @@ program io_demo use cli_mod, only : parse_command_line use driver_collections_mod, only : init_collections, final_collections - use constants_mod, only : precision_real + use constants_mod, only : precision_real,l_def, & + str_max_filename use driver_comm_mod, only : init_comm, final_comm use driver_config_mod, only : init_config, final_config use driver_log_mod, only : init_logger, final_logger @@ -25,46 +26,45 @@ program io_demo use io_demo_mod, only: io_demo_required_namelists use io_demo_driver_mod, only: initialise, step, finalise use timing_mod, only: init_timing, final_timing - use io_config_mod, only: timer_output_path - use namelist_mod, only: namelist_type implicit none ! The technical and scientific state - type(modeldb_type) :: modeldb - character(*), parameter :: program_name = "io_demo" - character(:), allocatable :: filename - type(namelist_type), pointer :: io_nml - logical :: lsubroutine_timers - integer, parameter :: default_seed = 123456789 + type(modeldb_type) :: modeldb + character(*), parameter :: program_name = "io_demo" + character(:), allocatable :: filename + integer, parameter :: default_seed = 123456789 + type(random_number_generator_type), pointer :: rng + character(str_max_filename) :: timer_output_path + logical(l_def) :: subroutine_timers + call parse_command_line( filename ) - call modeldb%values%initialise() - call modeldb%configuration%initialise( program_name, table_len=10 ) call modeldb%config%initialise(program_name) + call modeldb%values%initialise() + + modeldb%mpi => global_mpi + + call init_comm(program_name, modeldb) + call init_config(filename, io_demo_required_namelists, & + config=modeldb%config) + + call init_logger( modeldb%mpi%get_comm(), program_name ) write(log_scratch_space,& '("Application built with ", A, "-bit real numbers")') & trim(precision_real) 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, & - configuration=modeldb%configuration, & - config=modeldb%config) + subroutine_timers = modeldb%config%io%subroutine_timers() + timer_output_path = modeldb%config%io%timer_output_path() + call init_timing( modeldb%mpi%get_comm(), subroutine_timers, & + program_name, timer_output_path ) - deallocate( filename ) - - call init_logger( modeldb%mpi%get_comm(), program_name ) - io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value('subroutine_timers', lsubroutine_timers) - call init_timing( modeldb%mpi%get_comm(), lsubroutine_timers, program_name, timer_output_path ) - nullify( io_nml ) call init_collections() call init_time(modeldb) + deallocate( filename ) allocate(rng, source=random_number_generator_type(default_seed)) call modeldb%values%add_key_value("rng", rng) 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 45880fcbd..7372357eb 100644 --- a/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 +++ b/applications/lbc_demo/source/driver/lbc_demo_driver_mod.f90 @@ -186,7 +186,7 @@ subroutine initialise( program_name, modeldb) stencil_depth = 1 check_partitions = .false. - call init_mesh( modeldb%configuration, & + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & base_mesh_names, extrusion, & diff --git a/applications/lbc_demo/source/lbc_demo.f90 b/applications/lbc_demo/source/lbc_demo.f90 index 50612d273..1500ada59 100644 --- a/applications/lbc_demo/source/lbc_demo.f90 +++ b/applications/lbc_demo/source/lbc_demo.f90 @@ -37,22 +37,16 @@ program lbc_demo integer :: geometry, topology call parse_command_line( filename ) + call modeldb%config%initialise( program_name ) - write(log_scratch_space, '(A)') & - 'Application built with ' // trim(precision_real) // '-bit real numbers' - call log_event( log_scratch_space, log_level_trace ) - - ! 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, & - configuration=modeldb%configuration, & + call init_config(filename, required_namelists, & config=modeldb%config) + call init_logger( modeldb%mpi%get_comm(), program_name ) + ! Before anything else, test that the mesh provided was a regional domain. ! This application is not intended for cubed-sphere meshes. geometry = modeldb%config%base_mesh%geometry() @@ -64,10 +58,12 @@ program lbc_demo call log_event( 'Cubed-Sphere mesh is not supported.', log_level_error) end if - call init_logger( modeldb%mpi%get_comm(), program_name ) + write(log_scratch_space, '(A)') & + 'Application built with ' // trim(precision_real) // '-bit real numbers' + call log_event( log_scratch_space, log_level_trace ) + call init_collections() call init_time(modeldb) - deallocate( filename ) ! Create the depository field collection and place it in modeldb 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 eba4754c6..77613851e 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 @@ -17,7 +17,6 @@ module simple_diffusion_constants_mod ! Infrastructure 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 @@ -49,19 +48,16 @@ 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( modeldb, & - mesh, & + subroutine create_simple_diffusion_constants( mesh, & chi, & panel_id ) implicit none ! Arguments - 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 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 1dc960087..44a047234 100644 --- a/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 +++ b/applications/simple_diffusion/source/driver/init_simple_diffusion_mod.F90 @@ -21,8 +21,7 @@ module init_simple_diffusion_mod 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 log_mod, only : log_event, log_level_trace use mesh_mod, only : mesh_type use lfric_xios_write_mod, only : write_field_generic use simple_diffusion_constants_mod, only : create_simple_diffusion_constants @@ -64,7 +63,8 @@ subroutine init_simple_diffusion(mesh, chi, panel_id, modeldb) fs => function_space_collection%get_fs(mesh, order_h, order_v, Wtheta) - call log_event( 'simple_diffusion: Initialising miniapp ...', LOG_LEVEL_TRACE ) + call log_event( 'simple_diffusion: Initialising miniapp ...', & + log_level_trace ) ! Create prognostic fields ! Creates a field in the Wtheta function space @@ -87,9 +87,9 @@ 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(modeldb, mesh, chi, panel_id) + call create_simple_diffusion_constants(mesh, chi, panel_id) - call log_event( 'simple_diffusion: Miniapp initialised', LOG_LEVEL_TRACE ) + call log_event( 'simple_diffusion: Miniapp initialised', log_level_trace ) end subroutine init_simple_diffusion 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 6907b7da9..e62497053 100644 --- a/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 +++ b/applications/simple_diffusion/source/driver/simple_diffusion_driver_mod.f90 @@ -149,7 +149,7 @@ subroutine initialise( program_name, modeldb) ! --------------------------------------------------------- stencil_depth = 1 check_partitions = .false. - call init_mesh( modeldb%configuration, & + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & base_mesh_names, extrusion, & diff --git a/applications/simple_diffusion/source/simple_diffusion.f90 b/applications/simple_diffusion/source/simple_diffusion.f90 index e2b09fce6..b990fe6cf 100644 --- a/applications/simple_diffusion/source/simple_diffusion.f90 +++ b/applications/simple_diffusion/source/simple_diffusion.f90 @@ -36,25 +36,25 @@ 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")') & - trim(precision_real) - 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, & - configuration=modeldb%configuration, & + call init_comm(program_name, modeldb) + call init_config( filename, & + simple_diffusion_required_namelists, & config=modeldb%config ) - deallocate( filename ) - call init_logger( modeldb%mpi%get_comm(), program_name ) + + write(log_scratch_space,& + '("Application built with ", A, "-bit real numbers")') & + trim(precision_real) + call log_event( log_scratch_space, log_level_trace ) + call init_collections() call init_time( modeldb ) + deallocate( filename ) allocate(rng, source=random_number_generator_type(default_seed)) call modeldb%values%add_key_value("rng", rng) diff --git a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 index 0cc5cada1..4717f9b7c 100644 --- a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 @@ -113,6 +113,7 @@ contains integer(tik) :: id if ( LPROF ) call start_timing( id, 'skeleton_constants_alg' ) + call log_event( "Skeleton: creating runtime constants", LOG_LEVEL_INFO ) order_h = modeldb%config%finite_element%element_order_h() diff --git a/applications/skeleton/source/driver/skeleton_driver_mod.f90 b/applications/skeleton/source/driver/skeleton_driver_mod.f90 index 0ea9629ac..c0a005fd5 100644 --- a/applications/skeleton/source/driver/skeleton_driver_mod.f90 +++ b/applications/skeleton/source/driver/skeleton_driver_mod.f90 @@ -141,7 +141,7 @@ subroutine initialise(program_name, modeldb) !----------------------------------------------------------------------- stencil_depth = 1 apply_partition_check = .false. - call init_mesh( modeldb%configuration, & + call init_mesh( modeldb%config, & modeldb%mpi%get_comm_rank(), & modeldb%mpi%get_comm_size(), & base_mesh_names, extrusion, & diff --git a/applications/skeleton/source/skeleton.f90 b/applications/skeleton/source/skeleton.f90 index 687fe9fc9..cd35a0ee8 100644 --- a/applications/skeleton/source/skeleton.f90 +++ b/applications/skeleton/source/skeleton.f90 @@ -37,22 +37,21 @@ program skeleton character(:), allocatable :: filename 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) // & - '-bit real numbers.' - call log_event( log_scratch_space, log_level_trace ) - modeldb%mpi => global_mpi call init_comm( "skeleton", modeldb ) call init_config( filename, skeleton_required_namelists, & - configuration=modeldb%configuration, & config=modeldb%config ) call init_logger( modeldb%mpi%get_comm(), program_name ) + + write(log_scratch_space,'(A)') & + 'Application built with '// trim(precision_real) // & + '-bit real numbers.' + call log_event( log_scratch_space, log_level_trace ) + call init_collections() call init_time( modeldb ) deallocate( filename ) diff --git a/components/driver/source/driver_coordinates_mod.F90 b/components/driver/source/driver_coordinates_mod.F90 index 686b196f2..21d73c9fc 100644 --- a/components/driver/source/driver_coordinates_mod.F90 +++ b/components/driver/source/driver_coordinates_mod.F90 @@ -167,7 +167,18 @@ subroutine assign_coordinate_field(chi, panel_id, mesh) 'stretching factor is not 1 and mesh is not cubed-sphere', & log_level_error & ) - end if + end if + + +! if ( geometry == geometry_spherical .and. & +! topology == topology_fully_periodic) then +! stretch_factor = get_stretch_factor() +! else +! stretch_factor = 1.0_r_def +! end if + +! inverse_rot_matrix = get_inverse_mesh_rotation_matrix() +! to_rotate = get_to_rotate() panel_id_proxy%data = 1.0_r_def diff --git a/components/driver/source/driver_fem_mod.f90 b/components/driver/source/driver_fem_mod.f90 index 715786011..7ba02690e 100644 --- a/components/driver/source/driver_fem_mod.f90 +++ b/components/driver/source/driver_fem_mod.f90 @@ -37,6 +37,8 @@ module driver_fem_mod use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection_type + use base_mesh_config_mod, only: geometry, topology + implicit none private @@ -78,7 +80,8 @@ subroutine init_fem( mesh_collection, chi_inventory, panel_id_inventory ) ! ======================================================================== ! ! Initialise coordinate transformations - call init_chi_transforms(mesh_collection) + call init_chi_transforms( geometry, topology, & + mesh_collection=mesh_collection ) ! To loop through mesh collection, get all mesh names ! Then get mesh from collection using these names diff --git a/components/driver/source/driver_io_mod.F90 b/components/driver/source/driver_io_mod.F90 index 294cac940..2beadda81 100644 --- a/components/driver/source/driver_io_mod.F90 +++ b/components/driver/source/driver_io_mod.F90 @@ -10,7 +10,7 @@ !> module driver_io_mod - use constants_mod, only: str_def, i_def + use constants_mod, only: str_def, i_def, l_def use driver_modeldb_mod, only: modeldb_type use driver_model_data_mod, only: model_data_type use empty_io_context_mod, only: empty_io_context_type @@ -32,7 +32,6 @@ module driver_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 implicit none @@ -87,12 +86,9 @@ subroutine init_io( context_name, & procedure(callback_clock_arg), pointer :: before_close_ptr - type(namelist_type), pointer :: io_nml + logical(l_def) :: use_xios_io - logical :: use_xios_io - - io_nml => modeldb%configuration%get_namelist('io') - call io_nml%get_value( 'use_xios_io', use_xios_io ) + use_xios_io = modeldb%config%io%use_xios_io() ! Allocate IO context type based on model configuration if ( use_xios_io ) then @@ -201,10 +197,6 @@ subroutine init_xios_io_context( context_name, & integer(i_def) :: num_meshes, i, j - type(namelist_type), pointer :: io_nml - - io_nml => modeldb%configuration%get_namelist('io') - mesh => null() chi => null() panel_id => null() diff --git a/components/driver/source/driver_mesh_mod.f90 b/components/driver/source/driver_mesh_mod.f90 index 37452a28a..015cc492f 100644 --- a/components/driver/source/driver_mesh_mod.f90 +++ b/components/driver/source/driver_mesh_mod.f90 @@ -29,6 +29,7 @@ module driver_mesh_mod str_max_filename use check_global_mesh_mod, only: check_global_mesh use check_local_mesh_mod, only: check_local_mesh + use config_mod, only: config_type use create_mesh_mod, only: create_extrusion, create_mesh use extrusion_mod, only: extrusion_type use global_mesh_mod, only: global_mesh_type @@ -39,8 +40,6 @@ module driver_mesh_mod log_scratch_space, & log_level_debug, & log_level_error - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type use panel_decomposition_mod, only: panel_decomposition_type use partition_mod, only: partitioner_interface @@ -70,7 +69,7 @@ module driver_mesh_mod !=============================================================================== !> @brief Generates mesh(es) from mesh input file(s) on a given extrusion. !> -!> @param[in] configuration Application configuration object. +!> @param[in] config Application configuration object. !> This configuration object should contain the !> following defined namelist objects: !> * base_mesh @@ -87,7 +86,7 @@ module driver_mesh_mod !> @param[in] alt_names (Optional), Alternative names for meshes in the !> application mesh collection object. !=============================================================================== -subroutine init_mesh( configuration, & +subroutine init_mesh( config, & local_rank, total_ranks, & mesh_names, extrusion, & stencil_depth, & @@ -97,8 +96,7 @@ subroutine init_mesh( configuration, & implicit none ! Arguments - type(namelist_collection_type) :: configuration - + type(config_type), intent(in) :: config integer(i_def), intent(in) :: local_rank integer(i_def), intent(in) :: total_ranks character(str_def), intent(in) :: mesh_names(:) @@ -113,16 +111,12 @@ subroutine init_mesh( configuration, & character(len=9), parameter :: routine_name = 'init_mesh' ! Namelist variables - type(namelist_type), pointer :: base_mesh_nml - type(namelist_type), pointer :: finite_element_nml - type(namelist_type), pointer :: partitioning_nml - character(str_max_filename) :: file_prefix integer(i_def) :: cellshape - logical :: prepartitioned - logical :: generate_inner_halos + logical(l_def) :: prepartitioned + logical(l_def) :: generate_inner_halos integer :: geometry integer :: topology @@ -141,24 +135,19 @@ subroutine init_mesh( configuration, & character(str_def) :: fmt_str, number_str !============================================================================ - ! 0.0 Extract configuration variables + ! Extract configuration variables !============================================================================ - base_mesh_nml => configuration%get_namelist('base_mesh') - call base_mesh_nml%get_value( 'prepartitioned', prepartitioned ) - call base_mesh_nml%get_value( 'file_prefix', file_prefix ) - - finite_element_nml => configuration%get_namelist('finite_element') - call finite_element_nml%get_value( 'cellshape', cellshape ) + prepartitioned = config%base_mesh%prepartitioned() + file_prefix = config%base_mesh%file_prefix() + cellshape = config%finite_element%cellshape() if ( .not. prepartitioned ) then - partitioning_nml => configuration%get_namelist('partitioning') - call partitioning_nml%get_value( 'generate_inner_halos', generate_inner_halos ) + generate_inner_halos = config%partitioning%generate_inner_halos() end if - !============================================================================ - ! 0.1 Some basic checks + ! Some basic checks !============================================================================ ! Set up stencil depth if (stencil_depth < 0_i_def) then @@ -175,7 +164,7 @@ subroutine init_mesh( configuration, & !============================================================================ - ! 1.0 Determine which names to apply to resultant meshes. + ! Determine which names to apply to resultant meshes. !============================================================================ if (present(alt_names)) then if (size(alt_names) == size(mesh_names)) then @@ -192,15 +181,15 @@ subroutine init_mesh( configuration, & !=========================================================================== - ! 2.0 Create local mesh objects: - ! Two code pathes presented, either: - ! 1. The input files have been pre-partitioned. - ! Meshes and are simply read from file and local mesh objects - ! are populated. - ! 2. The input files have not been partitioned. - ! Global meshes are loaded from file and partitioning is applied - ! at runtime. NOTE: This option is provided as legacy, and support - ! is on a best endeavours basis. + ! Create local mesh objects: + ! Two code pathes presented, either: + ! 1. The input files have been pre-partitioned. + ! Meshes and are simply read from file and local mesh objects + ! are populated. + ! 2. The input files have not been partitioned. + ! Global meshes are loaded from file and partitioning is applied + ! at runtime. NOTE: This option is provided as legacy, and support + ! is on a best endeavours basis. !=========================================================================== generate_inner_halos = .false. @@ -208,8 +197,8 @@ subroutine init_mesh( configuration, & if (prepartitioned) then !========================================================================== - ! 2.1 Read in local meshes / partition information / mesh maps - ! direct from file. + ! Read in local meshes / partition information / mesh maps + ! direct from file. !========================================================================== ! ! For this local rank, a mesh input file with a common base name @@ -229,22 +218,22 @@ subroutine init_mesh( configuration, & call log_event( "Loading local mesh(es)", log_level_debug ) - ! 2.1a Read in all local mesh data for this rank and - ! initialise local mesh objects from them. + ! Read in all local mesh data for this rank and + ! initialise local mesh objects from them. !=========================================================== ! Each partitioned mesh file will contain meshes of the ! same name as all other partitions. call load_local_mesh( input_mesh_file, mesh_names ) - ! 2.1b Apply configuration related checks to ensure that these - ! meshes are suitable for the supplied application - ! configuration. + ! Apply configuration related checks to ensure that these + ! meshes are suitable for the supplied application + ! configuration. !=========================================================== - call check_local_mesh( configuration, & + call check_local_mesh( config, & stencil_depth, & mesh_names ) - ! 2.1c Load and assign mesh maps. + ! Load and assign mesh maps. !=========================================================== ! Mesh map identifiers are determined by the source/target ! mesh IDs they relate to. As a result inter-grid mesh maps @@ -257,15 +246,12 @@ subroutine init_mesh( configuration, & else !========================================================================== - ! 2.2 Perform runtime partitioning of global meshes. + ! Perform runtime partitioning of global meshes. !========================================================================== - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) - - partitioning_nml => configuration%get_namelist('partitioning') + geometry = config%base_mesh%geometry() + topology = config%base_mesh%topology() - call partitioning_nml%get_value( 'generate_inner_halos', & - generate_inner_halos ) + generate_inner_halos = config%partitioning%generate_inner_halos() if ( geometry == geometry_spherical .and. & topology == topology_fully_periodic ) then @@ -281,8 +267,8 @@ subroutine init_mesh( configuration, & ! 2.2a Set constants that will control partitioning. !=========================================================== - call get_partition_parameters( configuration, mesh_selection, & - total_ranks, decomposition, & + call get_partition_parameters( config%partitioning, mesh_selection, & + total_ranks, decomposition, & partitioner_ptr ) ! 2.2b Read in all global meshes from input file @@ -293,7 +279,7 @@ subroutine init_mesh( configuration, & ! meshes are suitable for the supplied application ! configuration. !=========================================================== - call check_global_mesh( configuration, mesh_names ) + call check_global_mesh( config, mesh_names ) ! 2.2e Partition the global meshes !=========================================================== diff --git a/components/driver/source/driver_time_mod.f90 b/components/driver/source/driver_time_mod.f90 index 71dfb926f..f553795c2 100644 --- a/components/driver/source/driver_time_mod.f90 +++ b/components/driver/source/driver_time_mod.f90 @@ -12,7 +12,6 @@ module driver_time_mod use driver_modeldb_mod, only: modeldb_type use log_mod, only: log_event, LOG_LEVEL_ERROR use model_clock_mod, only: model_clock_type - use namelist_mod, only: namelist_type use step_calendar_mod, only: step_calendar_type implicit none @@ -40,9 +39,6 @@ subroutine init_time( modeldb ) integer(i_timestep) :: first integer(i_timestep) :: last - type(namelist_type), pointer :: time_nml - type(namelist_type), pointer :: timestepping_nml - character(str_def) :: timestep_start character(str_def) :: timestep_end character(str_def) :: calendar_origin @@ -54,18 +50,13 @@ subroutine init_time( modeldb ) ! ------------------------------- ! Extract namelist variables ! ------------------------------- - time_nml => modeldb%configuration%get_namelist('time') - timestepping_nml => modeldb%configuration%get_namelist('timestepping') - - call time_nml%get_value( 'timestep_start', timestep_start ) - call time_nml%get_value( 'timestep_end', timestep_end ) - call time_nml%get_value( 'calendar_origin', calendar_origin ) - call time_nml%get_value( 'calendar_start', calendar_start ) - - call timestepping_nml%get_value( 'dt', timestep_length ) - call timestepping_nml%get_value( 'spinup_period', spinup_period ) + timestep_start = modeldb%config%time%timestep_start() + timestep_end = modeldb%config%time%timestep_end() + calendar_origin = modeldb%config%time%calendar_origin() + calendar_start = modeldb%config%time%calendar_start() - nullify( time_nml, timestepping_nml ) + timestep_length = modeldb%config%timestepping%dt() + spinup_period = modeldb%config%timestepping%spinup_period() ! Instantiate the calendar !--------------------------------- diff --git a/components/driver/source/mesh/check_global_mesh_mod.f90 b/components/driver/source/mesh/check_global_mesh_mod.f90 index 55efb274e..e7665fefa 100644 --- a/components/driver/source/mesh/check_global_mesh_mod.f90 +++ b/components/driver/source/mesh/check_global_mesh_mod.f90 @@ -5,14 +5,12 @@ !----------------------------------------------------------------------------- module check_global_mesh_mod - use constants_mod, only: i_def, str_def, & - str_max_filename - use global_mesh_mod, only: global_mesh_type - use log_mod, only: log_event, & - log_scratch_space, & - LOG_LEVEL_ERROR - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type + use constants_mod, only: i_def, str_def, str_max_filename + use config_mod, only: config_type + use global_mesh_mod, only: global_mesh_type + use log_mod, only: log_event, & + log_scratch_space, & + LOG_LEVEL_ERROR use global_mesh_collection_mod, only: global_mesh_collection @@ -34,15 +32,15 @@ module check_global_mesh_mod !> @brief Basic validation that global meshes are suitable !! for the specified configuration. -!> @param[in] configuration Configuration object. -!> @param[in] mesh_names Global meshes held in application -!! global mesh collection object. -subroutine check_global_mesh( configuration, mesh_names ) +!> @param[in] config Configuration object. +!> @param[in] mesh_names Global meshes held in application +!! global mesh collection object. +subroutine check_global_mesh( config, mesh_names ) implicit none - type(namelist_collection_type), intent(in) :: configuration - character(str_def), intent(in) :: mesh_names(:) + type(config_type), intent(in) :: config + character(str_def), intent(in) :: mesh_names(:) integer(i_def) :: topology integer(i_def) :: geometry @@ -50,17 +48,12 @@ subroutine check_global_mesh( configuration, mesh_names ) logical :: valid_geometry logical :: valid_topology - type(global_mesh_type), pointer :: global_mesh => null() - type(namelist_type), pointer :: base_mesh_nml => null() + type(global_mesh_type), pointer :: global_mesh integer(i_def) :: i - base_mesh_nml => configuration%get_namelist('base_mesh') - - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) - - base_mesh_nml => null() + geometry = config%base_mesh%geometry() + topology = config%base_mesh%topology() do i=1, size(mesh_names) diff --git a/components/driver/source/mesh/check_local_mesh_mod.f90 b/components/driver/source/mesh/check_local_mesh_mod.f90 index fc9bd8ed3..14759d787 100644 --- a/components/driver/source/mesh/check_local_mesh_mod.f90 +++ b/components/driver/source/mesh/check_local_mesh_mod.f90 @@ -7,13 +7,13 @@ module check_local_mesh_mod use constants_mod, only: i_def, str_def, & str_max_filename + use config_mod, only: config_type use local_mesh_collection_mod, only: local_mesh_collection use local_mesh_mod, only: local_mesh_type use log_mod, only: log_event, & log_scratch_space, & log_level_error - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type + use sci_query_mod, only: is_lbc, check_lbc use base_mesh_config_mod, only: key_from_geometry, & @@ -31,20 +31,20 @@ module check_local_mesh_mod !> @brief Basic validation that local meshes are suitable !! for the specified configuration. -!> @param[in] configuration Configuration object. +!> @param[in] config Configuration object. !> @param[in] stencil_depth Stencil depth that local meshes !> need to support. !> @param[in] mesh_names Local meshes held in application !! local mesh collection object. -subroutine check_local_mesh( configuration, & +subroutine check_local_mesh( config, & stencil_depth, & mesh_names ) implicit none - type(namelist_collection_type), intent(in) :: configuration - integer(i_def), intent(in) :: stencil_depth - character(str_def), intent(in) :: mesh_names(:) + type(config_type), intent(in) :: config + integer(i_def), intent(in) :: stencil_depth + character(str_def), intent(in) :: mesh_names(:) integer(i_def) :: topology integer(i_def) :: geometry @@ -52,18 +52,13 @@ subroutine check_local_mesh( configuration, & logical :: valid_geometry logical :: valid_topology - type(local_mesh_type), pointer :: local_mesh => null() - type(namelist_type), pointer :: base_mesh_nml => null() - integer(i_def) :: i integer(i_def) :: max_stencil_depth - base_mesh_nml => configuration%get_namelist('base_mesh') - - call base_mesh_nml%get_value( 'geometry', geometry ) - call base_mesh_nml%get_value( 'topology', topology ) + type(local_mesh_type), pointer :: local_mesh - base_mesh_nml => null() + geometry = config%base_mesh%geometry() + topology = config%base_mesh%topology() do i=1, size(mesh_names) diff --git a/components/driver/source/mesh/runtime_partition_lfric_mod.f90 b/components/driver/source/mesh/runtime_partition_lfric_mod.f90 index 155662def..3916697b7 100644 --- a/components/driver/source/mesh/runtime_partition_lfric_mod.f90 +++ b/components/driver/source/mesh/runtime_partition_lfric_mod.f90 @@ -9,8 +9,8 @@ module runtime_partition_lfric_mod use constants_mod, only: i_def, l_def - use namelist_collection_mod, only: namelist_collection_type - use namelist_mod, only: namelist_type + use config_mod, only: config_type + use partitioning_nml_mod, only: partitioning_nml_type use partition_mod, only: partitioner_interface use runtime_partition_mod, only: get_partition_strategy use panel_decomposition_mod, only: panel_decomposition_type, & @@ -34,53 +34,19 @@ module runtime_partition_lfric_mod private public :: get_partition_parameters - interface get_partition_parameters - procedure get_partition_parameters_cfg - procedure get_partition_parameters_nml - end interface get_partition_parameters contains -subroutine get_partition_parameters_cfg( configuration, & - mesh_selection, & - total_ranks, & - decomposition, & - partitioner_ptr ) - - implicit none - - type(namelist_collection_type), intent(in) :: configuration - - integer, intent(in) :: mesh_selection - integer(i_def), intent(in) :: total_ranks - - class(panel_decomposition_type), intent(inout), allocatable :: decomposition - - type(namelist_type), pointer :: partitioning - - procedure(partitioner_interface), intent(out), pointer :: partitioner_ptr - - partitioning => configuration%get_namelist('partitioning') - - call get_partition_parameters_nml( partitioning, & +subroutine get_partition_parameters( partitioning_nml, & mesh_selection, & total_ranks, & decomposition, & partitioner_ptr ) - -end subroutine get_partition_parameters_cfg - -subroutine get_partition_parameters_nml( partitioning, & - mesh_selection, & - total_ranks, & - decomposition, & - partitioner_ptr ) - implicit none - type(namelist_type), intent(in), pointer :: partitioning + type(partitioning_nml_type), intent(in) :: partitioning_nml integer, intent(in) :: mesh_selection integer(i_def), intent(in) :: total_ranks @@ -91,9 +57,11 @@ subroutine get_partition_parameters_nml( partitioning, & integer(i_def) :: panel_xproc, panel_yproc - integer :: panel_decomposition + integer(i_def) :: panel_decomposition - call partitioning%get_value( 'panel_decomposition', panel_decomposition ) + panel_decomposition = partitioning_nml%panel_decomposition() + panel_xproc = partitioning_nml%panel_xproc() + panel_yproc = partitioning_nml%panel_yproc() select case (panel_decomposition) @@ -107,15 +75,12 @@ subroutine get_partition_parameters_nml( partitioning, & decomposition = column_decomposition_type() case ( panel_decomposition_custom ) - call partitioning%get_value( 'panel_xproc', panel_xproc ) - call partitioning%get_value( 'panel_yproc', panel_yproc ) decomposition = custom_decomposition_type( panel_xproc, panel_yproc ) case ( panel_decomposition_auto_nonuniform ) decomposition = auto_nonuniform_decomposition_type() case ( panel_decomposition_guided_nonuniform ) - call partitioning%get_value( 'panel_xproc', panel_xproc ) decomposition = guided_nonuniform_decomposition_type( panel_xproc ) case default @@ -127,7 +92,7 @@ subroutine get_partition_parameters_nml( partitioning, & call get_partition_strategy(mesh_selection, total_ranks, partitioner_ptr) -end subroutine get_partition_parameters_nml +end subroutine get_partition_parameters end module runtime_partition_lfric_mod diff --git a/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 index 65f29eacf..3d00ff143 100644 --- a/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_broken_div_operator_kernel_mod.F90 @@ -16,9 +16,12 @@ module sci_compute_broken_div_operator_kernel_mod use constants_mod, only: r_def, i_def use sci_coordinate_jacobian_mod, only: coordinate_jacobian use fs_continuity_mod, only: W2broken, W3 - use finite_element_config_mod, only: rehabilitate use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system, rehabilitate + use planet_config_mod, only: scaled_radius + implicit none private @@ -141,7 +144,8 @@ subroutine compute_broken_div_operator_code(cell, nlayers, ncell_3d, & end do ! Compute Jacobian - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) ! Run over dof extent of W2Broken diff --git a/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 index 15da848d3..ddcb67d05 100644 --- a/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_curl_operator_kernel_mod.F90 @@ -17,6 +17,10 @@ module sci_compute_curl_operator_kernel_mod use fs_continuity_mod, only: W1, W2 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -129,7 +133,8 @@ subroutine compute_curl_operator_code(cell, nlayers, ncell_3d, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) do df1 = 1, ndf_w1 do df2 = 1, ndf_w2 diff --git a/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 index d6af12148..dcbf2607b 100644 --- a/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_derham_matrices_kernel_mod.F90 @@ -28,6 +28,10 @@ module sci_compute_derham_matrices_kernel_mod use fs_continuity_mod, only: W0, W1, W2, W2broken, W3, Wtheta use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -241,7 +245,9 @@ subroutine compute_derham_matrices_code(cell, nlayers, & do qp2 = 1, nqp_v do qp1 = 1, nqp_h ! Precompute some frequently used terms - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,qp1,qp2), & diff_basis_chi(:,:,qp1,qp2), & jac, dj) diff --git a/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 index b0e8c4630..05b84b344 100644 --- a/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_div_operator_kernel_mod.F90 @@ -15,9 +15,12 @@ module sci_compute_div_operator_kernel_mod use constants_mod, only: r_def, i_def use sci_coordinate_jacobian_mod, only: coordinate_jacobian use fs_continuity_mod, only: W2, W3 - use finite_element_config_mod, only: rehabilitate use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system, rehabilitate + use planet_config_mod, only: scaled_radius + implicit none private @@ -138,7 +141,8 @@ subroutine compute_div_operator_code(cell, nlayers, ncell_3d, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) do df2 = 1, ndf_w2 diff --git a/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 b/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 index f221e2996..9c06d929f 100644 --- a/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_grad_operator_kernel_mod.F90 @@ -19,6 +19,10 @@ module sci_compute_grad_operator_kernel_mod use fs_continuity_mod, only: W0, W1 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -134,7 +138,8 @@ subroutine compute_grad_operator_code(cell, nlayers, ncell_3d, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) call coordinate_jacobian_inverse(nqp_h, nqp_v, jac, dj, jac_inv) do qp2 = 1, nqp_v diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 index f9dc0ff44..b0beabbbb 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w1_mod.F90 @@ -23,6 +23,10 @@ module sci_compute_mass_matrix_kernel_w1_mod use fs_continuity_mod, only: W1 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -134,7 +138,8 @@ subroutine compute_mass_matrix_w1_code(cell, nlayers, ncell_3d, & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) call coordinate_jacobian_inverse(nqp_h, nqp_v, jac, dj, jac_inv) do df2 = 1, ndf_w1 diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 index 351086a38..6c91b47f6 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w2_mod.F90 @@ -22,6 +22,10 @@ module sci_compute_mass_matrix_kernel_w2_mod use fs_continuity_mod, only: Wchi use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -138,7 +142,8 @@ subroutine compute_mass_matrix_w2_code(cell, nlayers, ncell_3d, & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jac, dj) do df2 = 1, ndf_w2 diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 index dfbf5b0e5..ac030d6be 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w3_mod.F90 @@ -18,10 +18,13 @@ module sci_compute_mass_matrix_kernel_w3_mod CELL_COLUMN, GH_QUADRATURE_XYoZ use sci_coordinate_jacobian_mod, only: coordinate_jacobian use constants_mod, only: i_def, r_single, r_double - use finite_element_config_mod, only: rehabilitate use fs_continuity_mod, only: W3 use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system, rehabilitate + use planet_config_mod, only: scaled_radius + implicit none private @@ -138,7 +141,9 @@ subroutine compute_mass_matrix_w3_code_r_single( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, & diff_basis_chi, jac, dj) @@ -229,7 +234,9 @@ subroutine compute_mass_matrix_w3_code_mixed_precision( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, & diff_basis_chi, jac, dj) @@ -320,7 +327,9 @@ subroutine compute_mass_matrix_w3_code_r_double( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, & diff_basis_chi, jac, dj) diff --git a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 index f63540f33..a5b0054b1 100644 --- a/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 +++ b/components/science/source/kernel/fem/sci_compute_mass_matrix_kernel_w_scalar_mod.F90 @@ -24,6 +24,10 @@ module sci_compute_mass_matrix_kernel_w_scalar_mod use fs_continuity_mod, only: W0, Wtheta, Wchi use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -161,7 +165,9 @@ subroutine compute_mass_matrix_w_scalar_code_r32( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, ipanel, & basis_chi, diff_basis_chi, & jac, dj) @@ -257,7 +263,9 @@ subroutine compute_mass_matrix_w_scalar_code_r32r64( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, ipanel, & basis_chi, diff_basis_chi, & jac, dj) @@ -356,7 +364,9 @@ subroutine compute_mass_matrix_w_scalar_code_r64( & chi3_e(df) = chi3(map_chi(df) + k - 1) end do - call coordinate_jacobian(ndf_chi, nqp_h, nqp_v, & + call coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, nqp_h, nqp_v, & chi1_e, chi2_e, chi3_e, ipanel, & basis_chi, diff_basis_chi, & jac, dj) diff --git a/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 b/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 index c2a874845..ca6d73d1e 100644 --- a/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_gp_rhs_kernel_mod.F90 @@ -96,6 +96,10 @@ subroutine gp_rhs_code(nlayers, & use sci_coordinate_jacobian_mod, only: coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -135,7 +139,11 @@ subroutine gp_rhs_code(nlayers, & chi_2_cell(df) = chi_2( map_chi(df) + k ) chi_3_cell(df) = chi_3( map_chi(df) + k ) end do - call coordinate_jacobian(ndf_chi, & + call coordinate_jacobian(coord_system, & + geometry, & + topology, & + scaled_radius, & + ndf_chi, & nqp_h, & nqp_v, & chi_1_cell, & diff --git a/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 b/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 index 114b58b6f..0db2fbe49 100644 --- a/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_gp_vector_rhs_kernel_mod.F90 @@ -14,8 +14,6 @@ module sci_gp_vector_rhs_kernel_mod ANY_DISCONTINUOUS_SPACE_3, & GH_BASIS, GH_DIFF_BASIS, & CELL_COLUMN, GH_QUADRATURE_XYoZ - use base_mesh_config_mod, only : geometry, & - geometry_spherical use sci_chi_transform_mod, only : chi2xyz use constants_mod, only : r_def, i_def use sci_coordinate_jacobian_mod, only : coordinate_jacobian, & @@ -24,6 +22,11 @@ module sci_gp_vector_rhs_kernel_mod use fs_continuity_mod, only : W0, W2 use kernel_mod, only : kernel_type + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -171,7 +174,11 @@ subroutine gp_vector_rhs_code(nlayers, & chi_2_cell(df) = chi_2( map_chi(df) + k ) chi_3_cell(df) = chi_3( map_chi(df) + k ) end do - call coordinate_jacobian(ndf_chi, & + call coordinate_jacobian(coord_system, & + geometry, & + topology, & + scaled_radius, & + ndf_chi, & nqp_h, & nqp_v, & chi_1_cell, & diff --git a/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 b/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 index e40bb543f..04329bd5b 100644 --- a/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 +++ b/components/science/source/kernel/fem/sci_mg_derham_mat_kernel_mod.F90 @@ -27,6 +27,10 @@ module sci_mg_derham_mat_kernel_mod use fs_continuity_mod, only: W2, W3, wtheta use kernel_mod, only: kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -178,7 +182,9 @@ subroutine mg_derham_mat_code(cell, nlayers, & do qp2 = 1, nqp_v do qp1 = 1, nqp_h ! Precompute some frequently used terms - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,qp1,qp2), & diff_basis_chi(:,:,qp1,qp2), & jac, dj) diff --git a/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 index d69363c65..e351c679d 100644 --- a/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_da_at_w2_kernel_mod.F90 @@ -80,6 +80,10 @@ subroutine calc_dA_at_w2_code( nlayers, & use sci_coordinate_jacobian_mod, only: coordinate_jacobian, coordinate_jacobian_inverse + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -120,8 +124,9 @@ subroutine calc_dA_at_w2_code( nlayers, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, ndf_w2, chi1_e, chi2_e, chi3_e, & - ipanel, basis_chi, diff_basis_chi, jacobian, dj) + call coordinate_jacobian( coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf_w2, chi1_e, chi2_e, chi3_e, & + ipanel, basis_chi, diff_basis_chi, jacobian, dj) call coordinate_jacobian_inverse(ndf_w2, jacobian, dj, jac_inv) diff --git a/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 index d1447a72f..de29f199a 100644 --- a/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_detj_at_w2_kernel_mod.F90 @@ -82,6 +82,10 @@ subroutine calc_detj_at_w2_code( nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -119,7 +123,9 @@ subroutine calc_detj_at_w2_code( nlayers, & end do do df = 1,ndf_w2 - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) diff --git a/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 index ba6a1cfca..a9aef1b6d 100644 --- a/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_detj_at_w3_kernel_mod.F90 @@ -20,6 +20,10 @@ module sci_calc_detj_at_w3_kernel_mod use fs_continuity_mod, only : W3 use kernel_mod, only : kernel_type + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none private @@ -128,7 +132,9 @@ subroutine calc_detj_at_w3_code_r_single( nlayers, & end do do df = 1,ndf_w3 - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) @@ -190,7 +196,9 @@ subroutine calc_detj_at_w3_code_r_double( nlayers, & end do do df = 1,ndf_w3 - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) diff --git a/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 index 80093d8a9..f9bd1ee16 100644 --- a/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_calc_directional_detj_at_w2_kernel_mod.F90 @@ -96,6 +96,10 @@ subroutine calc_directional_detj_at_w2_code( nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -142,7 +146,9 @@ subroutine calc_directional_detj_at_w2_code( nlayers, & chi3_e(cdf) = chi3(map_chi(cdf) + k) end do - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), & jacobian, detj) diff --git a/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 b/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 index 4192c8791..39ccfe0fb 100644 --- a/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 +++ b/components/science/source/kernel/geometry/sci_chi_transform_mod.F90 @@ -13,11 +13,6 @@ !------------------------------------------------------------------------------ module sci_chi_transform_mod -use base_mesh_config_mod, only : geometry, & - geometry_spherical, & - geometry_planar, & - topology, & - topology_fully_periodic use constants_mod, only : r_def, i_def, l_def, & str_def, EPS, PI, rmdi use coord_transform_mod, only : alphabetar2xyz, & @@ -28,15 +23,21 @@ module sci_chi_transform_mod mesh_rotation_matrix, & schmidt_transform_xyz, & inverse_schmidt_transform_xyz -use finite_element_config_mod, only : coord_system, & - coord_system_xyz, & - coord_system_native use log_mod, only : log_event, & log_scratch_space, & LOG_LEVEL_ERROR, & LOG_LEVEL_DEBUG, & LOG_LEVEL_WARNING use matrix_invert_mod, only : matrix_invert_3x3 + +use base_mesh_config_mod, only : geometry, & + geometry_spherical, & + geometry_planar, & + topology, & + topology_fully_periodic +use finite_element_config_mod, only : coord_system, & + coord_system_xyz, & + coord_system_native use planet_config_mod, only : scaled_radius implicit none @@ -89,7 +90,9 @@ module sci_chi_transform_mod !! argument, and ideally should only be used for !! unit-testing. !------------------------------------------------------------------------------ -subroutine init_chi_transforms(mesh_collection, north_pole_arg, equator_lat_arg) +subroutine init_chi_transforms( geometry, topology, & + mesh_collection, & + north_pole_arg, equator_lat_arg ) use local_mesh_mod, only : local_mesh_type use mesh_collection_mod, only : mesh_collection_type @@ -97,6 +100,9 @@ subroutine init_chi_transforms(mesh_collection, north_pole_arg, equator_lat_arg) implicit none + integer(i_def), intent(in) :: geometry + integer(i_def), intent(in) :: topology + type(mesh_collection_type), optional, intent(in) :: mesh_collection real(kind=r_def), optional, intent(in) :: north_pole_arg(2) real(kind=r_def), optional, intent(in) :: equator_lat_arg diff --git a/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 b/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 index df0a05e4d..e92884d14 100644 --- a/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 +++ b/components/science/source/kernel/geometry/sci_coordinate_jacobian_mod.F90 @@ -10,14 +10,7 @@ !> per panel for certain meshes such as cubed sphere. module sci_coordinate_jacobian_mod - use base_mesh_config_mod, only: geometry, & - geometry_planar, & - topology, & - topology_fully_periodic - use constants_mod, only: l_def, i_def, r_double, r_single - use finite_element_config_mod, only: coord_system, & - coord_system_xyz, & - coord_system_native + use constants_mod, only: l_def, i_def, r_def, r_double, r_single use coord_transform_mod, only: PANEL_ROT_MATRIX, & alphabetar2xyz, & xyz2llr, & @@ -25,12 +18,18 @@ module sci_coordinate_jacobian_mod llr2xyz, & schmidt_transform_lat - use planet_config_mod, only: scaled_radius use sci_chi_transform_mod, only: get_mesh_rotation_matrix, & get_to_stretch, & get_to_rotate, & get_stretch_factor + ! Configuration modules + use base_mesh_config_mod, only: geometry_planar, & + topology_fully_periodic + use finite_element_config_mod, only: coord_system_xyz, & + coord_system_native +! use planet_config_mod, only: scaled_radius + implicit none private @@ -39,6 +38,7 @@ module sci_coordinate_jacobian_mod public :: coordinate_jacobian_inverse public :: pointwise_coordinate_jacobian public :: pointwise_coordinate_jacobian_inverse + ! Public for unit-testing public :: jacobian_stretched @@ -120,19 +120,27 @@ module sci_coordinate_jacobian_mod !> J^{i,j} = \frac{\partial \chi_i} / {\partial \hat{\chi_j}} !> \f} !> - !! @param[in] ndf Size of the chi arrays - !! @param[in] ngp_h Number of quadrature points in horizontal direction - !! @param[in] ngp_v Number of quadrature points in vertical direction - !! @param[in] chi_1 1st component of the coordinate field - !! @param[in] chi_2 2nd component of the coordinate field - !! @param[in] chi_3 3rd component of the coordinate field - !! @param[in] panel_id An integer identifying the mesh panel - !! @param[in] basis Wchi basis functions - !! @param[in] diff_basis Grad of Wchi basis functions - !! @param[out] jac Jacobian on quadrature points - !! @param[out] dj Determinant of the Jacobian on quadrature points + !! @param[in] coord_system Finite-element coordiante system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !! @param[in] ndf Size of the chi arrays + !! @param[in] ngp_h Number of quadrature points in horizontal direction + !! @param[in] ngp_v Number of quadrature points in vertical direction + !! @param[in] chi_1 1st component of the coordinate field + !! @param[in] chi_2 2nd component of the coordinate field + !! @param[in] chi_3 3rd component of the coordinate field + !! @param[in] panel_id An integer identifying the mesh panel + !! @param[in] basis Wchi basis functions + !! @param[in] diff_basis Grad of Wchi basis functions + !! @param[out] jac Jacobian on quadrature points + !! @param[out] dj Determinant of the Jacobian on quadrature points !! - subroutine coordinate_jacobian_quadrature_r_single( & + subroutine coordinate_jacobian_quadrature_r_single( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, ngp_h, ngp_v, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -143,6 +151,11 @@ subroutine coordinate_jacobian_quadrature_r_single( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, ngp_h, ngp_v integer(kind=i_def), intent(in) :: panel_id @@ -228,9 +241,9 @@ subroutine coordinate_jacobian_quadrature_r_single( & ! Apply stretching --------------------------------------------------- if (to_stretch) then ! Convert chi to spherical polar (un-stretched) coordinates - call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & + call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & native_x, native_y, native_z) - call xyz2ll(native_x, native_y, native_z, & + call xyz2ll(native_x, native_y, native_z, & native_lon, native_lat) stretch_factor = real(get_stretch_factor(), r_single) jac_S = jacobian_stretched(native_lon, native_lat, radius_vec(k), stretch_factor) @@ -286,7 +299,11 @@ subroutine coordinate_jacobian_quadrature_r_single( & end subroutine coordinate_jacobian_quadrature_r_single - subroutine coordinate_jacobian_quadrature_r_double( & + subroutine coordinate_jacobian_quadrature_r_double( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, ngp_h, ngp_v, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -297,6 +314,11 @@ subroutine coordinate_jacobian_quadrature_r_double( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, ngp_h, ngp_v integer(kind=i_def), intent(in) :: panel_id @@ -382,9 +404,9 @@ subroutine coordinate_jacobian_quadrature_r_double( & ! Apply stretching --------------------------------------------------- if (to_stretch) then ! Convert chi to spherical polar (un-stretched) coordinates - call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & + call alphabetar2xyz(alpha_vec(k), beta_vec(k), radius_vec(k), panel_id, & native_x, native_y, native_z) - call xyz2ll(native_x, native_y, native_z, & + call xyz2ll(native_x, native_y, native_z, & native_lon, native_lat) stretch_factor = real(get_stretch_factor(), r_double) jac_S = jacobian_stretched(native_lon, native_lat, radius_vec(k), stretch_factor) @@ -450,17 +472,25 @@ end subroutine coordinate_jacobian_quadrature_r_double !> reference space \f[ \hat{\chi} \f] to physical space \f[ \chi \f] !> \f[ J^{i,j} = \frac{\partial \chi_i} / {\partial \hat{\chi_j}} \f] !> and the determinant det(J) - !! @param[in] ndf Size of the chi arrays - !! @param[in] neval_points Number of points basis functions are evaluated on - !! @param[in] chi_1 1st component of the coordinate field - !! @param[in] chi_2 2nd component of the coordinate field - !! @param[in] chi_3 3rd component of the coordinate field - !! @param[in] panel_id An integer identifying the mesh panel - !! @param[in] basis Wchi basis functions - !! @param[in] diff_basis Grad of Wchi basis functions - !! @param[out] jac Jacobian on quadrature points - !! @param[out] dj Determinant of the Jacobian on quadrature points - subroutine coordinate_jacobian_evaluator_r_single( & + !! @param[in] coord_system Finite-element coordiante system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !! @param[in] ndf Size of the chi arrays + !! @param[in] neval_points Number of points basis functions are evaluated on + !! @param[in] chi_1 1st component of the coordinate field + !! @param[in] chi_2 2nd component of the coordinate field + !! @param[in] chi_3 3rd component of the coordinate field + !! @param[in] panel_id An integer identifying the mesh panel + !! @param[in] basis Wchi basis functions + !! @param[in] diff_basis Grad of Wchi basis functions + !! @param[out] jac Jacobian on quadrature points + !! @param[out] dj Determinant of the Jacobian on quadrature points + subroutine coordinate_jacobian_evaluator_r_single( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, neval_points, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -471,6 +501,11 @@ subroutine coordinate_jacobian_evaluator_r_single( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, neval_points integer(kind=i_def), intent(in) :: panel_id @@ -590,7 +625,11 @@ subroutine coordinate_jacobian_evaluator_r_single( & end subroutine coordinate_jacobian_evaluator_r_single - subroutine coordinate_jacobian_evaluator_r_double( & + subroutine coordinate_jacobian_evaluator_r_double( & + coord_system, & + geometry, & + topology, & + scaled_radius, & ndf, neval_points, & chi_1, chi_2, chi_3, & panel_id, basis, & @@ -601,6 +640,11 @@ subroutine coordinate_jacobian_evaluator_r_double( & !----------------------------------------------------------------------------- implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf, neval_points integer(kind=i_def), intent(in) :: panel_id @@ -869,21 +913,32 @@ end subroutine coordinate_jacobian_inverse_evaluator_r_double !> reference space \f[ \hat{\chi} \f] to physical space \f[ \chi \f] !> \f[ J^{i,j} = \frac{\partial \chi_i} / {\partial \hat{\chi_j}} \f] !> and the determinant det(J) for a single point - !! @param[in] ndf Size of the chi arrays - !! @param[in] chi_1 Coordinate field - !! @param[in] chi_2 Coordinate field - !! @param[in] chi_3 Coordinate field - !! @param[in] panel_id panel_id - !! @param[in] basis Wchi basis functions - !! @param[in] diff_basis Grad of Wchi basis functions - !! @param[out] jac Jacobian on quadrature points - !! @param[out] dj Determinant of the Jacobian on quadrature points - subroutine pointwise_coordinate_jacobian_r_single( & - ndf, chi_1, chi_2, chi_3, & - panel_id, basis, diff_basis, & - jac, dj ) + !! @param[in] coord_system Finite-element coordiante system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !! @param[in] ndf Size of the chi arrays + !! @param[in] chi_1 Coordinate field + !! @param[in] chi_2 Coordinate field + !! @param[in] chi_3 Coordinate field + !! @param[in] panel_id panel_id + !! @param[in] basis Wchi basis functions + !! @param[in] diff_basis Grad of Wchi basis functions + !! @param[out] jac Jacobian on quadrature points + !! @param[out] dj Determinant of the Jacobian on quadrature points + subroutine pointwise_coordinate_jacobian_r_single( & + coord_system, geometry, & + topology, scaled_radius, & + ndf, chi_1, chi_2, chi_3, & + panel_id, basis, diff_basis, & + jac, dj ) implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf integer(kind=i_def), intent(in) :: panel_id @@ -990,12 +1045,19 @@ subroutine pointwise_coordinate_jacobian_r_single( & end subroutine pointwise_coordinate_jacobian_r_single - subroutine pointwise_coordinate_jacobian_r_double( & - ndf, chi_1, chi_2, chi_3, & - panel_id, basis, diff_basis, & - jac, dj ) + subroutine pointwise_coordinate_jacobian_r_double( & + coord_system, geometry, & + topology, scaled_radius, & + ndf, chi_1, chi_2, chi_3, & + panel_id, basis, diff_basis, & + jac, dj ) implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf integer(kind=i_def), intent(in) :: panel_id diff --git a/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 b/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 index 53a375d7b..9898833a7 100644 --- a/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 +++ b/components/science/source/kernel/geometry/sci_native_jacobian_mod.F90 @@ -13,27 +13,23 @@ !! This gives a data access optimisation. module sci_native_jacobian_mod - use base_mesh_config_mod, only: geometry, & - geometry_planar, & - topology, & - topology_fully_periodic use constants_mod, only: l_def, i_def, r_def, r_single - use finite_element_config_mod, only: coord_system, & - coord_system_xyz, & - coord_system_native use coord_transform_mod, only: PANEL_ROT_MATRIX, & alphabetar2xyz, & xyz2llr, & xyz2ll, & llr2xyz, & schmidt_transform_lat - - use planet_config_mod, only: scaled_radius use sci_chi_transform_mod, only: get_mesh_rotation_matrix, & get_to_stretch, & get_to_rotate, & get_stretch_factor + use finite_element_config_mod, only: coord_system_xyz, & + coord_system_native + use base_mesh_config_mod, only: geometry_planar, & + topology_fully_periodic + implicit none private @@ -53,22 +49,32 @@ module sci_native_jacobian_mod !> @brief Compute the Jacobian matrices at a 1D array of points (e.g. DoFs) !! for a whole column, using the native coordinates of the mesh - !> @param[in] ndf_chi Num DoFs per cell for coordinate fields - !> @param[in] nlayers Number of layers in the mesh - !> @param[in] chi_1 First native coord field, for a single cell - !> @param[in] chi_2 Second native coord field, for a single cell - !> @param[in] chi_3 Third native coord field, for the whole column - !> @param[in] panel_id Mesh panel ID value for the column - !> @param[in] basis Wchi basis, evaluated at a 1D array of points - !> @param[in] diff_basis Derivatives of Wchi basis functions, evaluated at + !! @param[in] coord_system Finite-element coordiante system enumeration. + !! @param[in] geometry Mesh geometry enumeration. + !! @param[in] topology Mesh topology enumeration. + !! @param[in] scaled_radius Scaled planetary radius. + !> @param[in] ndf_chi Num DoFs per cell for coordinate fields + !> @param[in] nlayers Number of layers in the mesh + !> @param[in] chi_1 First native coord field, for a single cell + !> @param[in] chi_2 Second native coord field, for a single cell + !> @param[in] chi_3 Third native coord field, for the whole column + !> @param[in] panel_id Mesh panel ID value for the column + !> @param[in] basis Wchi basis, evaluated at a 1D array of points + !> @param[in] diff_basis Derivatives of Wchi basis functions, evaluated at !! a 1D array of points !> @param[in,out] jac Array of Jacobian matrices to be calculated for !! a whole column !> @param[in,out] dj Jacobian determinants for the whole column - subroutine native_jacobian(ndf_chi, nlayers, chi_1, chi_2, chi_3, panel_id, & + subroutine native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, nlayers, chi_1, chi_2, chi_3, panel_id, & basis, diff_basis, jac, dj) implicit none + integer(kind=i_def), intent(in) :: coord_system + integer(kind=i_def), intent(in) :: geometry + integer(kind=i_def), intent(in) :: topology + real(kind=r_def), intent(in) :: scaled_radius + integer(kind=i_def), intent(in) :: ndf_chi integer(kind=i_def), intent(in) :: nlayers integer(kind=i_def), intent(in) :: panel_id diff --git a/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 b/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 index a4acdd020..04c411675 100644 --- a/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 +++ b/components/science/source/kernel/geometry/sci_scale_by_detj_kernel_mod.F90 @@ -86,6 +86,10 @@ subroutine scale_by_detj_code(nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -124,7 +128,9 @@ subroutine scale_by_detj_code(nlayers, & do df = 1,ndf_ws ! Compute detj at dof points - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,df), & diff_basis_wx(:,:,df), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 index 722a5f256..a78f203d4 100644 --- a/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_compute_map_u_operators_kernel_mod.F90 @@ -113,12 +113,15 @@ subroutine compute_map_u_operators_code(cell, nlayers, ncell_3d_1, & nqp_h, nqp_v, wqp_h, wqp_v & ) - use base_mesh_config_mod, only : geometry, & - geometry_spherical, & - geometry_planar - use sci_chi_transform_mod, only : chi2llr + use sci_chi_transform_mod, only : chi2llr use sci_coordinate_jacobian_mod, only : coordinate_jacobian - use coord_transform_mod, only : sphere2cart_vector + use coord_transform_mod, only : sphere2cart_vector + + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical, & + geometry_planar + use planet_config_mod, only: scaled_radius implicit none @@ -173,7 +176,11 @@ subroutine compute_map_u_operators_code(cell, nlayers, ncell_3d_1, & chi_sph_3_cell(df) = chi_sph_3( map_chi_sph(df) + k ) end do - call coordinate_jacobian(ndf_chi_sph, & + call coordinate_jacobian(coord_system, & + geometry, & + topology, & + scaled_radius, & + ndf_chi_sph, & nqp_h, & nqp_v, & chi_sph_1_cell, & diff --git a/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 index c6426b267..4bfbb79e1 100644 --- a/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_compute_sample_u_ops_kernel_mod.F90 @@ -26,14 +26,18 @@ module sci_compute_sample_u_ops_kernel_mod use constants_mod, only : r_def, i_def use fs_continuity_mod, only : W2broken, W3, Wtheta, Wchi use kernel_mod, only : kernel_type - use base_mesh_config_mod, only : geometry, geometry_spherical, & - geometry_planar use sci_chi_transform_mod, only : chi2llr use sci_coordinate_jacobian_mod, only : coordinate_jacobian, & coordinate_jacobian_inverse use coord_transform_mod, only : sphere2cart_vector use reference_element_mod, only : W, S, N, E, T, B + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical, & + geometry_planar + use planet_config_mod, only: scaled_radius + implicit none private @@ -176,8 +180,9 @@ subroutine compute_sample_u_ops_code( col, nlayers, & chi3_e(df_chi) = chi3(map_chi(df_chi) + k) end do - call coordinate_jacobian(ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & - ipanel, chi_basis, chi_diff_basis, jacobian, dj) + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & + ipanel, chi_basis, chi_diff_basis, jacobian, dj) call coordinate_jacobian_inverse(ndf_w2b, jacobian, dj, jac_inv) ! X and Y components contribute equally to all W2 DoFs @@ -225,7 +230,8 @@ subroutine compute_sample_u_ops_code( col, nlayers, & chi3_e(df_chi) = chi3(map_chi(df_chi) + k) end do - call coordinate_jacobian(ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf_w2b, chi1_e, chi2_e, chi3_e, & ipanel, chi_basis, chi_diff_basis, jacobian, dj) call coordinate_jacobian_inverse(ndf_w2b, jacobian, dj, jac_inv) diff --git a/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 index 8cbc37847..a075503ae 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_hcurl_field_kernel_mod.F90 @@ -89,7 +89,13 @@ subroutine convert_hcurl_field_code(nlayers, & ndf_pid, undf_pid, map_pid & ) - use sci_coordinate_jacobian_mod, only: coordinate_jacobian, coordinate_jacobian_inverse + use sci_coordinate_jacobian_mod, only: coordinate_jacobian, & + coordinate_jacobian_inverse + + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -124,7 +130,8 @@ subroutine convert_hcurl_field_code(nlayers, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, ndf,chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf,chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jacobian, dj) call coordinate_jacobian_inverse(ndf, jacobian, dj, jacobian_inv) do df = 1,ndf diff --git a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 index bc56cbe84..a9b5d98c1 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_field_kernel_mod.F90 @@ -99,6 +99,11 @@ subroutine convert_hdiv_field_code(nlayers, & ndf_pid, undf_pid, map_pid & ) use sci_coordinate_jacobian_mod, only: coordinate_jacobian + + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -141,7 +146,8 @@ subroutine convert_hdiv_field_code(nlayers, & chi2_e(df) = chi2(map_chi(df) + k) chi3_e(df) = chi3(map_chi(df) + k) end do - call coordinate_jacobian(ndf_chi, ndf1, chi1_e, chi2_e, chi3_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi, ndf1, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi, diff_basis_chi, jacobian, dj) do df = 1,ndf1 diff --git a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 index 24b789b88..b5e4782d6 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_hdiv_native_kernel_mod.F90 @@ -100,6 +100,10 @@ subroutine convert_hdiv_native_code(nlayers, & use sci_native_jacobian_mod, only: native_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -149,10 +153,11 @@ subroutine convert_hdiv_native_code(nlayers, & do df_w2 = 1, ndf_w2 ! Compute Jacobian for whole column at this DoF - call native_jacobian( & - ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & - basis_chi(:,:,df_w2), diff_basis_chi(:,:,df_w2), jacobian, dj & - ) + call native_jacobian( & + coord_system, geometry, topology, scaled_radius, & + ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & + basis_chi(:,:,df_w2), diff_basis_chi(:,:,df_w2), & + jacobian, dj ) ! Create vector of HDiv values at this point vector_in(:,:) = 0.0_r_def diff --git a/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 index 9a6d2960e..fece67189 100644 --- a/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_convert_phys_to_hdiv_kernel_mod.F90 @@ -106,12 +106,16 @@ subroutine convert_phys_to_hdiv_code( nlayers, & undf_pid, & map_pid ) - use base_mesh_config_mod, only : geometry_spherical use sci_chi_transform_mod, only : chi2llr use sci_coordinate_jacobian_mod, only : pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse use coord_transform_mod, only : sphere2cart_vector + use base_mesh_config_mod, only: topology, & + geometry_spherical + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -163,7 +167,8 @@ subroutine convert_phys_to_hdiv_code( nlayers, & end do ! Compute Jacobian at this W2 point - call pointwise_coordinate_jacobian(ndf_chi, & + call pointwise_coordinate_jacobian(coord_system, geometry, topology, & + scaled_radius, ndf_chi, & chi_1_cell, chi_2_cell, chi_3_cell, & ipanel, & basis_chi(:,:,df_w2), & diff --git a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 index 71c0acd92..a5f125b6f 100644 --- a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_field_kernel_mod.F90 @@ -100,6 +100,11 @@ subroutine dg_convert_hdiv_field_code(nlayers, & ndf_pid, undf_pid, map_pid & ) use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -152,7 +157,9 @@ subroutine dg_convert_hdiv_field_code(nlayers, & chi2_e(dfx) = chi2(map_chi(dfx) + k) chi3_e(dfx) = chi3(map_chi(dfx) + k) end do - call pointwise_coordinate_jacobian(ndf_chi, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_chi, chi1_e, chi2_e, chi3_e, & ipanel, basis_chi(:,:,df), & diff_basis_chi(:,:,df), jacobian, dj) vector_in(:) = 0.0_r_def diff --git a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 index 4d89fa4c8..1b93a5772 100644 --- a/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_dg_convert_hdiv_native_kernel_mod.F90 @@ -104,6 +104,10 @@ subroutine dg_convert_hdiv_native_code(nlayers, & use sci_native_jacobian_mod, only: native_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -137,7 +141,9 @@ subroutine dg_convert_hdiv_native_code(nlayers, & integer(kind=i_def) :: w2_idx, w3_idx, chi_idx real(kind=r_def) :: jacobian(nlayers,3,3), dj(nlayers) real(kind=r_def) :: vector_in(nlayers,3), vector_out(nlayers,3) - real(kind=r_def) :: chi_1_e(ndf_chi), chi_2_e(ndf_chi), chi_3_e(nlayers,ndf_chi) + real(kind=r_def) :: chi_1_e(ndf_chi) + real(kind=r_def) :: chi_2_e(ndf_chi) + real(kind=r_def) :: chi_3_e(nlayers,ndf_chi) integer(kind=i_def) :: ipanel @@ -154,17 +160,18 @@ subroutine dg_convert_hdiv_native_code(nlayers, & end do ! Compute Jacobian for whole column - call native_jacobian( & - ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & - basis_chi(:,:,df_w3), diff_basis_chi(:,:,df_w3), jacobian, dj & - ) + call native_jacobian( & + coord_system, geometry, topology, scaled_radius, & + ndf_chi, nlayers, chi_1_e, chi_2_e, chi_3_e, ipanel, & + basis_chi(:,:,df_w3), diff_basis_chi(:,:,df_w3), & + jacobian, dj ) ! Create vector of W2 values vector_in(:,:) = 0.0_r_def do df_w2 = 1, ndf_w2 w2_idx = map_w2(df_w2) do i = 1, 3 - vector_in(:,i) = vector_in(:,i) & + vector_in(:,i) = vector_in(:,i) & + hdiv_field(w2_idx : w2_idx+nlayers-1)*basis_w2(i,df_w2,1) end do end do diff --git a/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 index 426037eff..5fbf011d8 100644 --- a/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_project_w3_to_w2b_operator_kernel_mod.F90 @@ -100,6 +100,10 @@ subroutine project_w3_to_w2b_operator_code( cell, nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -145,7 +149,9 @@ subroutine project_w3_to_w2b_operator_code( cell, nlayers, & projection_operator(ik,:,:) = 0.0_r_def do qp_v = 1,nqp_v do qp_h = 1,nqp_h - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,qp_h,qp_v), & diff_basis_wx(:,:,qp_h,qp_v), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 index c8d849f7e..607c2782b 100644 --- a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w1_operator_kernel_mod.F90 @@ -106,9 +106,12 @@ subroutine project_ws_to_w1_operator_code( cell, nlayers, & pointwise_coordinate_jacobian_inverse use sci_chi_transform_mod, only: chi2llr use coord_transform_mod, only: sphere2cart_vector - use base_mesh_config_mod, only: geometry, & - geometry_spherical, & - geometry_planar + + use base_mesh_config_mod, only: geometry, topology, & + geometry_spherical, & + geometry_planar + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius implicit none @@ -173,7 +176,9 @@ subroutine project_ws_to_w1_operator_code( cell, nlayers, & ipanel, llr(1), llr(2), llr(3)) end if - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,qp_h,qp_v), & diff_basis_wx(:,:,qp_h,qp_v), & jac, detj) diff --git a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 index 0d1f4ff08..a42d10188 100644 --- a/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 +++ b/components/science/source/kernel/inter_function_space/sci_project_ws_to_w2_operator_kernel_mod.F90 @@ -101,6 +101,10 @@ subroutine project_ws_to_w2_operator_code( cell, nlayers, & use sci_coordinate_jacobian_mod, only: pointwise_coordinate_jacobian + use base_mesh_config_mod, only: geometry, topology + use finite_element_config_mod, only: coord_system + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -146,7 +150,9 @@ subroutine project_ws_to_w2_operator_code( cell, nlayers, & projection_operator(ik,:,:) = 0.0_r_def do qp_v = 1,nqp_v do qp_h = 1,nqp_h - call pointwise_coordinate_jacobian(ndf_wx, chi1_e, chi2_e, chi3_e, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf_wx, chi1_e, chi2_e, chi3_e, & ipanel, basis_wx(:,:,qp_h,qp_v), & diff_basis_wx(:,:,qp_h,qp_v), & jac, detj) diff --git a/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 b/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 index 76511ae26..bbdee962a 100644 --- a/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 +++ b/components/science/source/kernel/inter_mesh/sci_proj_mr_to_sh_rho_rhs_op_kernel_mod.F90 @@ -125,6 +125,10 @@ subroutine proj_mr_to_sh_rho_rhs_op_code( & use sci_coordinate_jacobian_mod, only: coordinate_jacobian + use finite_element_config_mod, only: coord_system + use base_mesh_config_mod, only: geometry, topology + use planet_config_mod, only: scaled_radius + implicit none ! Arguments @@ -184,10 +188,12 @@ subroutine proj_mr_to_sh_rho_rhs_op_code( & end do ! Get detj for lower and upper half cells - call coordinate_jacobian(ndf_chi_dl, nqp_h, nqp_v, lower_chi_1_e, lower_chi_2_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi_dl, nqp_h, nqp_v, lower_chi_1_e, lower_chi_2_e, & lower_chi_3_e, ipanel, chi_dl_basis, chi_dl_diff_basis, & lower_jac, lower_dj) - call coordinate_jacobian(ndf_chi_dl, nqp_h, nqp_v, upper_chi_1_e, upper_chi_2_e, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf_chi_dl, nqp_h, nqp_v, upper_chi_1_e, upper_chi_2_e, & upper_chi_3_e, ipanel, chi_dl_basis, chi_dl_diff_basis, & upper_jac, upper_dj) diff --git a/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf b/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf index 9eb563920..c5ab6cc8d 100644 --- a/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf +++ b/components/science/unit-test/algorithm/solver/sci_field_vector_mod_test.pf @@ -56,10 +56,8 @@ contains integer(i_def) :: mesh_id type(function_space_type), pointer :: w2_fs => null() - type(mesh_type), pointer :: mesh_out => null() type(mesh_type), pointer :: mesh_ptr => null() - integer(i_def) :: err integer :: i, undf real(r_def) :: sum1, min1, max1, sum2, min2, max2, scalar real(r_def) :: test, answer 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 35dd156a3..1b55bedf7 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 @@ -7,7 +7,7 @@ !> module compute_broken_div_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, & get_w3_m3x3_dofmap @@ -63,7 +63,7 @@ contains element_order_v=1_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 3941363f6..51792780b 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 @@ -8,7 +8,7 @@ !> module compute_curl_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, only : get_w0_m3x3_dofmap, & get_w3_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -66,7 +66,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 934836e6f..419bd61b8 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 @@ -8,7 +8,7 @@ !> module compute_derham_matrices_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only: i_def, r_def, imdi use funit implicit none @@ -47,7 +47,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 ce747ddc1..c2e03822f 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 @@ -8,7 +8,7 @@ !> module compute_div_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, & get_w3_m3x3_dofmap @@ -64,7 +64,7 @@ contains element_order_v=1_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 0f980c255..40bf54429 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 @@ -8,7 +8,7 @@ !> module compute_grad_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w1_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -58,7 +58,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 b7201eee2..9981b9412 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 @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_w1_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, get_w3_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, & @@ -60,7 +60,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 03e1f2046..135907c6f 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 @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_w2_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w0_m3x3_dofmap, get_w3_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, & @@ -60,7 +60,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 d8e8bf1e7..15edcf644 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 @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_w3_mod_test - use constants_mod, only : i_def, r_def, r_single, r_double + use constants_mod, only : i_def, r_def, r_single, r_double, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -60,7 +60,7 @@ contains element_order_v = 0_i_def, & rehabilitate = .true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 b03037328..81bfe9693 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 @@ -8,7 +8,7 @@ !> module compute_mass_matrix_kernel_wtheta_mod_test - use constants_mod, only : i_def, r_def, r_single, r_double, l_def + use constants_mod, only : i_def, r_def, r_single, r_double, l_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, & only : get_w0_m3x3_q3x3x3_size, & @@ -66,7 +66,7 @@ contains element_order_v = 0_i_def, & rehabilitate = .true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 def8a7352..115d35382 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 @@ -7,7 +7,7 @@ !------------------------------------------------------------------------------- module gp_rhs_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use quadrature_xyoz_mod, only: quadrature_xyoz_type, & quadrature_xyoz_proxy_type @@ -65,7 +65,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) qr = quadrature_xyoz_type(3, quadrature_rule) 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 c68bb9a07..257ae2285 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 @@ -71,7 +71,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(geometry_planar, topology_fully_periodic) qr = quadrature_xyoz_type(3, quadrature_rule) 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 6e9cc05e9..ed4780122 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 @@ -8,7 +8,7 @@ !> module mg_derham_mat_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit implicit none @@ -47,7 +47,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 1d10f4862..22fd81315 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 @@ -8,7 +8,7 @@ !> module calc_dA_at_w2_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & @@ -59,7 +59,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 9820a4135..26d06c299 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 @@ -8,7 +8,7 @@ !> module calc_detj_at_w2_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -60,7 +60,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 6a8135fae..dcf7ab7cd 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 @@ -8,7 +8,7 @@ !> module calc_detj_at_w3_kernel_mod_test - use constants_mod, only : i_def, r_def, r_single, r_double + use constants_mod, only: imdi, i_def, r_def, r_single, r_double use funit use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -59,7 +59,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 ee9614202..dbb62e143 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 @@ -8,7 +8,7 @@ !> module calc_directional_detj_at_w2_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & @@ -58,7 +58,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 3975544d3..234ddb980 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 @@ -283,15 +283,20 @@ contains if ( this%source_coord_system == LLH_rot ) then north_pole(1) = PI/2.0_r_def north_pole(2) = 0.0_r_def - call init_chi_transforms(north_pole_arg=north_pole) + call init_chi_transforms(geometry_spherical,& + topology, & + north_pole_arg=north_pole) else if ( this%source_coord_system == ABH_stretch_rot ) then north_pole(1) = -PI/2.0_r_def north_pole(2) = 0.0_r_def equatorial_latitude = PI/6.0_r_def - call init_chi_transforms(north_pole_arg=north_pole, equator_lat_arg=equatorial_latitude) + call init_chi_transforms(geometry_spherical, & + topology, & + north_pole_arg=north_pole, & + equator_lat_arg=equatorial_latitude) else ! Non-rotated or stretched case - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology) end if end subroutine setUp 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 ba4d5217a..ee65c0293 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 @@ -6,7 +6,7 @@ module compute_latlon_kernel_mod_test - use constants_mod, only : i_def, r_def, pi + use constants_mod, only : i_def, r_def, pi, imdi use get_unit_test_m3x3_dofmap_mod, & only : get_w3_m3x3_dofmap, get_wchi_m3x3_dofmap use get_unit_test_m3x3_q3x3x3_sizes_mod, & @@ -57,7 +57,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 ed7d1d02b..9057707f4 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 @@ -10,6 +10,12 @@ module coordinate_jacobian_alphabetaz_mod_test use funit use constants_mod, only : r_def, i_def + use base_mesh_config_mod, only : geometry_spherical, & + topology_fully_periodic +! use extrusion_config_mod, only : method_uniform, & +! stretching_method_linear + use finite_element_config_mod, only : coord_system_native + implicit none public :: set_up, tear_down, test_all @@ -22,46 +28,24 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_fully_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config + + !use feign_config_mod, only : feign_base_mesh_config, & + ! feign_extrusion_config, & + ! feign_finite_element_config, & + ! feign_planet_config use sci_chi_transform_mod, only : init_chi_transforms implicit none - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_fully_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() + !call feign_extrusion_config( method=method_uniform, & + ! planet_radius=radius, & + ! domain_height=10.0_r_def, & + ! number_of_layers=5_i_def, & + ! stretching_method=stretching_method_linear, & + ! stretching_height=15.0_r_def, & + ! eta_values=(/0.5_r_def/) ) + + call init_chi_transforms(geometry_spherical, topology_fully_periodic) end subroutine set_up @@ -90,6 +74,10 @@ contains pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse +! use base_mesh_config_mod, only : geometry_spherical, & +! topology_fully_periodic +! use finite_element_config_mod, only : coord_system_native + implicit none real(kind=r_def), parameter :: tol = 1.0e-14_r_def ! r_def 64bit @@ -109,6 +97,11 @@ contains real(kind=r_def), parameter :: b = 0.1_r_def real(kind=r_def), parameter :: h = 2.0_r_def + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_fully_periodic + real(r_def), parameter :: scaled_radius = 1000.0_r_def + ! We choose a box centred on alpha = 0, beta = 0 alpha(:) = (/ -a, a, a, -a, -a, a, a, -a /) beta(:) = (/ -b, -b, b, b, -b, -b, b, b /) @@ -147,7 +140,8 @@ contains basis(:,:,:,:) = 0.125_r_def - call coordinate_jacobian(ndf, ngp, ngp, alpha, beta, height, ipanel, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, ngp, ngp, alpha, beta, height, ipanel, & basis, diff_basis, jac, dj) call coordinate_jacobian_inverse(ngp,ngp, jac, dj, jac_inv) @@ -183,7 +177,9 @@ contains end do ! Test the pointwise computations - call pointwise_coordinate_jacobian(ndf, alpha, beta, height, ipanel, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf, alpha, beta, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), & jac(:,:,1,1), dj(1,1) ) jac_inv(:,:,1,1) = pointwise_coordinate_jacobian_inverse(jac(:,:,1,1), & 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 dd96612bc..3d717c8b0 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 @@ -22,47 +22,8 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_non_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config - use sci_chi_transform_mod, only : init_chi_transforms - implicit none - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_non_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() - end subroutine set_up !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -84,12 +45,17 @@ contains subroutine test_all() use, intrinsic :: iso_fortran_env, only: real64 + use sci_chi_transform_mod, only : init_chi_transforms use sci_coordinate_jacobian_mod, & only : coordinate_jacobian, & coordinate_jacobian_inverse, & pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse + use base_mesh_config_mod, only: geometry_spherical, & + topology_non_periodic + use finite_element_config_mod, only: coord_system_native + implicit none real(kind=r_def), parameter :: tol = 1.0e-12_r_def ! r_def 64bit @@ -104,6 +70,11 @@ contains real(kind=r_def) :: basis(1,8,1,1), jac(3,3,1,1), dj(1,1), h real(kind=r_def) :: jac_inv(3,3,1,1), identity(3,3,1,1), err, answer(3,3) + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_non_periodic + real(r_def), parameter :: scaled_radius = 270.0_r_def + ! Box of length dlon, width dlat and height dh real(kind=r_def), parameter :: dlon = 0.2_r_def real(kind=r_def), parameter :: dlat = 0.1_r_def @@ -163,7 +134,10 @@ contains basis(:,:,:,:) = 0.125_r_def - call coordinate_jacobian(ndf, ngp, ngp, longitude, latitude, height, & + call init_chi_transforms(geometry, topology) + + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, ngp, ngp, longitude, latitude, height, & ipanel, basis, diff_basis, jac, dj) call coordinate_jacobian_inverse(ngp, ngp, jac, dj, jac_inv) @@ -197,7 +171,9 @@ contains end do ! Test the pointwise computations - call pointwise_coordinate_jacobian(ndf, longitude, latitude, height, ipanel, & + call pointwise_coordinate_jacobian(coord_system, geometry, & + topology, scaled_radius, & + ndf, longitude, latitude, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), & jac(:,:,1,1), dj(1,1) ) jac_inv(:,:,1,1) = pointwise_coordinate_jacobian_inverse(jac(:,:,1,1), dj(1,1)) 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 0e509c6f0..525348b9e 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 @@ -8,7 +8,7 @@ module coordinate_jacobian_xyz_mod_test use funit - use constants_mod, only : r_def, i_def + use constants_mod, only : r_def, i_def, imdi implicit none @@ -28,24 +28,13 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine setUp( this ) - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_xyz - use feign_config_mod, only : feign_finite_element_config use sci_chi_transform_mod, only : init_chi_transforms implicit none class(jacobian_xyz_test_type), intent(inout) :: this - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_xyz, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp @@ -74,12 +63,21 @@ contains pointwise_coordinate_jacobian, & pointwise_coordinate_jacobian_inverse + use finite_element_config_mod, only: coord_system_xyz + use base_mesh_config_mod, only: geometry_planar, & + topology_non_periodic + implicit none class(jacobian_xyz_test_type), intent(inout) :: this real(kind=r_def) :: tol, zero, one, two, eight + integer(i_def), parameter :: coord_system = coord_system_xyz + integer(i_def), parameter :: geometry = geometry_planar + integer(i_def), parameter :: topology = topology_non_periodic + real(r_def), parameter :: scaled_radius = 1.0_r_def + integer :: ndf = 8 integer :: ngp = 1 integer :: ipanel = 1 @@ -109,7 +107,8 @@ contains basis(:,:,:,:) = 0.125_r_def - call coordinate_jacobian(ndf, ngp, ngp, x, y, z, ipanel, basis, & + call coordinate_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, ngp, ngp, x, y, z, ipanel, basis, & diff_basis, jac, dj) call coordinate_jacobian_inverse(ngp,ngp, jac, dj, jac_inv) @@ -137,7 +136,9 @@ contains @assertEqual( zero, err, tol) ! Test the pointwise computations - call pointwise_coordinate_jacobian(ndf, x, y, z, ipanel, basis(:,:,1,1), & + call pointwise_coordinate_jacobian(coord_system, geometry, topology, & + scaled_radius, & + ndf, x, y, z, ipanel, basis(:,:,1,1), & diff_basis(:,:,1,1), jac(:,:,1,1), & dj(1,1)) 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 664dec52c..53aed1296 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 @@ -8,7 +8,10 @@ module native_jacobian_alphabetaz_mod_test use funit - use constants_mod, only : r_def, i_def + use constants_mod, only: r_def, i_def + use base_mesh_config_mod, only: geometry_spherical, & + topology_fully_periodic + use finite_element_config_mod, only: coord_system_native implicit none @@ -22,46 +25,11 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_fully_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config use sci_chi_transform_mod, only : init_chi_transforms implicit none - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_fully_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_fully_periodic) end subroutine set_up @@ -105,6 +73,11 @@ contains real(kind=r_def), parameter :: b = 0.1_r_def real(kind=r_def), parameter :: h = 2.0_r_def + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_fully_periodic + real(r_def), parameter :: scaled_radius = 1000.0_r_def + ! We choose a box centred on alpha = 0, beta = 0 alpha(:) = (/ -a, a, a, -a, -a, a, a, -a /) beta(:) = (/ -b, -b, b, b, -b, -b, b, b /) @@ -142,7 +115,8 @@ contains basis(:,:,:,:) = 0.125_r_def ! Test the pointwise computations - call native_jacobian(ndf, nlayers, alpha, beta, height, ipanel, & + call native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, nlayers, alpha, beta, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), jac, dj) if ( r_def == real64 ) then 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 8a32cf7c4..e63daeeab 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 @@ -10,6 +10,10 @@ module native_jacobian_lonlatz_mod_test use funit use constants_mod, only : r_def, i_def, PI + use base_mesh_config_mod, only: geometry_spherical, & + topology_non_periodic + use finite_element_config_mod, only: coord_system_native + implicit none public :: set_up, tear_down, test_all @@ -22,46 +26,11 @@ contains @before subroutine set_up() - use base_mesh_config_mod, only : geometry_spherical, & - topology_non_periodic - use extrusion_config_mod, only : method_uniform, & - stretching_method_linear - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_native - use feign_config_mod, only : feign_base_mesh_config, & - feign_extrusion_config, & - feign_finite_element_config, & - feign_planet_config - use sci_chi_transform_mod, only : init_chi_transforms + use sci_chi_transform_mod, only: init_chi_transforms implicit none - call feign_base_mesh_config( file_prefix='foo', & - prime_mesh_name='unit_test', & - geometry=geometry_spherical, & - prepartitioned=.false., & - topology=topology_non_periodic, & - fplane=.false., f_lat_deg=0.0_r_def ) - - call feign_extrusion_config( method=method_uniform, & - planet_radius=radius, & - domain_height=10.0_r_def, & - number_of_layers=5_i_def, & - stretching_method=stretching_method_linear, & - stretching_height=15.0_r_def, & - eta_values=(/0.5_r_def/) ) - - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_native, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call feign_planet_config( scaling_factor=1.0_r_def ) - - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_non_periodic) end subroutine set_up @@ -97,7 +66,13 @@ contains integer(kind=i_def) :: ipanel = 1 integer(kind=i_def) :: df, i, j - real(kind=r_def) :: longitude(8), latitude(8), height(1,8), diff_basis(3,8,1,1) + integer(i_def), parameter :: coord_system = coord_system_native + integer(i_def), parameter :: geometry = geometry_spherical + integer(i_def), parameter :: topology = topology_non_periodic + real(r_def), parameter :: scaled_radius = 270.0_r_def + + real(kind=r_def) :: longitude(8), latitude(8) + real(kind=r_def) :: height(1,8), diff_basis(3,8,1,1) real(kind=r_def) :: basis(1,8,1,1), jac(1,3,3), dj(1), h real(kind=r_def) :: answer(1,3,3), answer_dj(1) @@ -159,7 +134,8 @@ contains basis(:,:,:,:) = 0.125_r_def ! Test the pointwise computations - call native_jacobian(ndf, nlayers, longitude, latitude, height, ipanel, & + call native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, nlayers, longitude, latitude, height, ipanel, & basis(:,:,1,1), diff_basis(:,:,1,1), jac, dj) if ( r_def == real64 ) then 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 cd7f4c1c0..20a73605c 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 @@ -8,7 +8,7 @@ module native_jacobian_xyz_mod_test use funit - use constants_mod, only : r_def, i_def + use constants_mod, only : r_def, i_def, imdi implicit none @@ -28,24 +28,13 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine setUp( this ) - use finite_element_config_mod, only : cellshape_quadrilateral, & - coord_system_xyz - use feign_config_mod, only : feign_finite_element_config - use sci_chi_transform_mod, only : init_chi_transforms + use sci_chi_transform_mod, only : init_chi_transforms implicit none class(jacobian_xyz_test_type), intent(inout) :: this - call feign_finite_element_config( & - cellshape=cellshape_quadrilateral, & - coord_order=0_i_def, & - coord_system=coord_system_xyz, & - element_order_h=0_i_def, & - element_order_v=0_i_def, & - rehabilitate=.true. ) - - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp @@ -68,7 +57,8 @@ contains @Test subroutine test_all( this ) - use sci_native_jacobian_mod, only : native_jacobian + use sci_native_jacobian_mod, only: native_jacobian + use finite_element_config_mod, only: coord_system_xyz implicit none @@ -82,6 +72,11 @@ contains integer :: ipanel = 1 integer :: df + integer(i_def), parameter :: coord_system = coord_system_xyz + integer(i_def), parameter :: geometry = imdi + integer(i_def), parameter :: topology = imdi + real(r_def), parameter :: scaled_radius = imdi + real(kind=r_def) :: x(8), y(8), z(1,8), diff_basis(3,8,1,1), basis(1,8,1,1) real(kind=r_def) :: jac(1,3,3), dj(1) @@ -104,7 +99,8 @@ contains basis(:,:,:,:) = 0.125_r_def ! Test the pointwise computations - call native_jacobian(ndf, nlayers, x, y, z, ipanel, basis(:,:,1,1), & + call native_jacobian(coord_system, geometry, topology, scaled_radius, & + ndf, nlayers, x, y, z, ipanel, basis(:,:,1,1), & diff_basis(:,:,1,1), jac, dj) eight = 8.0_r_def 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 05e927fbe..01bccfc8e 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 @@ -6,7 +6,7 @@ module nodal_xyz_coordinates_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & @@ -61,7 +61,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 514504428..7e7a21976 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 @@ -7,7 +7,7 @@ !> Test the scale by detJ kernel module scale_by_detj_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit use get_unit_test_wthetanodal_basis_mod, only : get_w0_wthetanodal_basis, & get_w0_wthetanodal_diff_basis @@ -49,7 +49,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 89b220967..2a5c4dd49 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 @@ -61,7 +61,7 @@ contains call feign_planet_config( scaling_factor=1.0_r_def ) - call init_chi_transforms() + call init_chi_transforms(geometry_spherical,topology_non_periodic) end subroutine set_up 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 9af3b0820..f5fda906e 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 @@ -63,7 +63,7 @@ contains call feign_planet_config( scaling_factor=scaling ) - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_non_periodic) end subroutine set_up 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 4fe973987..3d7743e9a 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 @@ -6,7 +6,7 @@ module convert_hcurl_field_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w1_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -55,7 +55,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 c384e912f..bf164890c 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 @@ -6,7 +6,7 @@ module convert_hdiv_field_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -55,7 +55,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 bba3f3095..f5874f147 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 @@ -6,7 +6,7 @@ module convert_hdiv_native_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -55,7 +55,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 8ebf1baef..247e482e9 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 @@ -56,7 +56,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(geometry_planar, topology_fully_periodic) end subroutine setUp 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 1eafa87bb..7f4f63696 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 @@ -4,7 +4,8 @@ ! should have received as part of this distribution. !----------------------------------------------------------------------------- module dg_convert_hdiv_field_kernel_mod_test - use constants_mod, only : i_def, r_def + + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size, & @@ -58,7 +59,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 760e355d8..16f6233b8 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 @@ -4,7 +4,7 @@ ! under which the code may be used. !----------------------------------------------------------------------------- module dg_convert_hdiv_native_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w2_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size @@ -56,7 +56,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 f4762e276..6f8c4fe88 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 @@ -7,7 +7,7 @@ !> Test the kernel for computing the operator to projec from W3 to W2b module project_w3_to_w2b_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit implicit none @@ -46,7 +46,7 @@ contains rehabilitate=.true., & coord_system=coord_system_xyz ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 445a8fb9e..3c8c17e91 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 @@ -68,7 +68,7 @@ contains rehabilitate=.true., & coord_system=coord_system_xyz ) - call init_chi_transforms() + call init_chi_transforms(geometry_planar,topology_fully_periodic) end subroutine setUp 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 c60604a6b..c48388d5d 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 @@ -7,7 +7,7 @@ !> Test the projection from a scalar space to W2 module project_ws_to_w2_operator_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use funit implicit none @@ -46,7 +46,7 @@ contains rehabilitate=.true., & coord_system=coord_system_xyz ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp 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 f7d076412..c24a3b329 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 @@ -61,7 +61,7 @@ contains call feign_planet_config( scaling_factor=1.0_r_def ) - call init_chi_transforms() + call init_chi_transforms(geometry_spherical, topology_fully_periodic) end subroutine set_up 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 42a142a2f..43a2927eb 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 @@ -6,7 +6,7 @@ !> Test the consist_w3_to_sh_w3_op kernel !> module consist_w3_to_sh_w3_op_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w3_m3x3_q3x3x3_size use get_unit_test_m3x3_dofmap_mod, only : get_w3_m3x3_dofmap use funit @@ -48,7 +48,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 81ac3438a..ee657d5e8 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 @@ -7,7 +7,7 @@ !> module proj_mr_to_sh_rho_rhs_op_kernel_mod_test - use constants_mod, only : i_def, r_def + use constants_mod, only : i_def, r_def, imdi use get_unit_test_m3x3_q3x3x3_sizes_mod, only : get_w0_m3x3_q3x3x3_size, & get_w3_m3x3_q3x3x3_size, & get_wtheta_m3x3_q3x3x3_size @@ -59,7 +59,7 @@ contains element_order_v=0_i_def, & rehabilitate=.true. ) - call init_chi_transforms() + call init_chi_transforms(imdi, imdi) end subroutine setUp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja b/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja index 8edad5bf7..ea542679b 100644 --- a/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja +++ b/infrastructure/build/tools/configurator/templates/config_loader.f90.jinja @@ -11,7 +11,6 @@ module {{moduleName}} 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 @@ -65,10 +64,11 @@ contains 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) + write(6,'(A)') & + 'At least one optional argument must ' //& + 'be provided for read_configuration.' + flush(6) + stop end if local_rank = global_mpi%get_comm_rank() @@ -175,17 +175,19 @@ contains logical(l_def), optional, intent(out) :: success_mask(:) logical(l_def) :: ensure_configuration - integer(i_def) :: i - logical :: configuration_found = .True. + 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 ) + write(6, '(A)') & + 'Arguments "names" and "success_mask" to function' //& + '"ensure_configuration" are different shapes.' + flush(6) + stop end if - ensure_configuration = .True. + ensure_configuration = .true. name_loop: do i = 1, size(names) select case(trim( names(i) )) @@ -195,10 +197,11 @@ contains {%- endfor %} case default - write( log_scratch_space, '(A)' ) & - 'Tried to ensure unrecognised namelist "'// & + write(6, '(A)') & + 'Tried to ensure unrecognised namelist "' //& trim(names(i))//'" was loaded.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) + flush(6) + stop end select ensure_configuration = ensure_configuration .and. configuration_found @@ -269,18 +272,20 @@ contains end if else - write( log_scratch_space, '(A)' ) & - 'Namelist "'//trim(namelists(i))// & + write(6, '(A)') & + 'Namelist "'//trim(namelists(i)) //& '" can not be read. Too many instances?' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) + flush(6) + stop end if {%- endfor %} case default - write( log_scratch_space, '(A)' ) & - 'Unrecognised namelist "'//trim(namelists(i))// & + write(6, '(A)') & + 'Unrecognised namelist "'//trim(namelists(i)) //& '" found in file '//trim(filename)//'.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) + flush(6) + stop end select end do ! Namelists diff --git a/infrastructure/build/tools/configurator/templates/config_type.f90.jinja b/infrastructure/build/tools/configurator/templates/config_type.f90.jinja index d79fc8a48..aa91770be 100644 --- a/infrastructure/build/tools/configurator/templates/config_type.f90.jinja +++ b/infrastructure/build/tools/configurator/templates/config_type.f90.jinja @@ -14,8 +14,6 @@ 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 @@ -102,11 +100,12 @@ subroutine initialise(self, name) 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) + write(6, '(A)') & + 'Application configuration: [' //& + trim(self%config_name) //& + '] has already been initialised.' + flush(6) + stop end if if (present(name)) then @@ -115,6 +114,13 @@ subroutine initialise(self, name) self%config_name = cmdi end if + ! Allocate linked lists +{%- for i in range(namelists|length) %} +{%- if duplicates[i] %} + allocate(self%{{namelists[i]}}) +{%- endif %} +{%- endfor %} + self%isinitialised = .true. end subroutine initialise @@ -149,9 +155,10 @@ subroutine add_namelist(self, namelist_obj) type is( {{namelists[i]}}_nml_type ) ! Multiple instances: NOT ALLOWED if (self%namelist_exists(trim(name))) then - write(log_scratch_space, '(A)') & + write(6, '(A)') & trim(name) // ' namelist already allocated.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop else allocate(self%{{namelists[i]}}, source=namelist_obj) call self%update_contents(trim(name)) @@ -164,27 +171,26 @@ subroutine add_namelist(self, namelist_obj) type is ( {{namelists[i]}}_nml_type ) ! Multiple instances: ALLOWED if (trim(profile_name) == cmdi) then - write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + write(6, '(A)') 'Ignoring ' // trim(name) // & ' namelist: missing profile name.' - call log_event(log_scratch_space, log_level_warning) + flush(6) else if (self%namelist_exists(trim(full_name))) then - write(log_scratch_space, '(A)') trim(name) // & + write(6, '(A)') trim(name) // & ' namelist (' // trim(profile_name) // '), already allocated.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop 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) + write(6, '(A)') & + ' Undefined namelist type(' // trim(name) //& + '), for this configuration.' + flush(6) + stop end select @@ -264,11 +270,12 @@ function {{namelists[i]}}_list(self, profile_name) result({{namelists[i]}}_nml_o ! reached without finding the namelist, fail with ! an error. if (.not. associated(loop)) then - write(log_scratch_space, '(A)') & + write(6, '(A)') & 'Instance ' // trim(profile_name) // ' of ' // & '{{namelists[i]}}_nml_type ' // & 'not found in configuration.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop end if ! Otherwise 'cast' to a {{namelists[i]}}_namelist_type 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 index 81329a75b..0d9f5b225 100644 --- 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 @@ -10,7 +10,7 @@ !> @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 changed. +!> implementation of the namelist collection is changes. ! 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 index c84d6c534..58666a61f 100644 --- a/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/app_config/content_mod.f90 @@ -14,8 +14,6 @@ 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 @@ -91,11 +89,12 @@ subroutine initialise(self, name) 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) + write(6, '(A)') & + 'Application configuration: [' //& + trim(self%config_name) //& + '] has already been initialised.' + flush(6) + stop end if if (present(name)) then @@ -104,6 +103,10 @@ subroutine initialise(self, name) self%config_name = cmdi end if + ! Allocate linked lists + allocate(self%bar) + allocate(self%pot) + self%isinitialised = .true. end subroutine initialise @@ -136,9 +139,10 @@ subroutine add_namelist(self, namelist_obj) type is( foo_nml_type ) ! Multiple instances: NOT ALLOWED if (self%namelist_exists(trim(name))) then - write(log_scratch_space, '(A)') & + write(6, '(A)') & trim(name) // ' namelist already allocated.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop else allocate(self%foo, source=namelist_obj) call self%update_contents(trim(name)) @@ -147,9 +151,10 @@ subroutine add_namelist(self, namelist_obj) type is( moo_nml_type ) ! Multiple instances: NOT ALLOWED if (self%namelist_exists(trim(name))) then - write(log_scratch_space, '(A)') & + write(6, '(A)') & trim(name) // ' namelist already allocated.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop else allocate(self%moo, source=namelist_obj) call self%update_contents(trim(name)) @@ -158,17 +163,15 @@ subroutine add_namelist(self, namelist_obj) type is ( bar_nml_type ) ! Multiple instances: ALLOWED if (trim(profile_name) == cmdi) then - write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + write(6, '(A)') 'Ignoring ' // trim(name) // & ' namelist: missing profile name.' - call log_event(log_scratch_space, log_level_warning) + flush(6) else if (self%namelist_exists(trim(full_name))) then - write(log_scratch_space, '(A)') trim(name) // & + write(6, '(A)') trim(name) // & ' namelist (' // trim(profile_name) // '), already allocated.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop 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 @@ -176,26 +179,25 @@ subroutine add_namelist(self, namelist_obj) type is ( pot_nml_type ) ! Multiple instances: ALLOWED if (trim(profile_name) == cmdi) then - write(log_scratch_space, '(A)') 'Ignoring ' // trim(name) // & + write(6, '(A)') 'Ignoring ' // trim(name) // & ' namelist: missing profile name.' - call log_event(log_scratch_space, log_level_warning) + flush(6) else if (self%namelist_exists(trim(full_name))) then - write(log_scratch_space, '(A)') trim(name) // & + write(6, '(A)') trim(name) // & ' namelist (' // trim(profile_name) // '), already allocated.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop 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) + write(6, '(A)') & + ' Undefined namelist type(' // trim(name) //& + '), for this configuration.' + flush(6) + stop end select @@ -272,11 +274,12 @@ function bar_list(self, profile_name) result(bar_nml_obj) ! reached without finding the namelist, fail with ! an error. if (.not. associated(loop)) then - write(log_scratch_space, '(A)') & + write(6, '(A)') & 'Instance ' // trim(profile_name) // ' of ' // & 'bar_nml_type ' // & 'not found in configuration.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop end if ! Otherwise 'cast' to a bar_namelist_type @@ -321,11 +324,12 @@ function pot_list(self, profile_name) result(pot_nml_obj) ! reached without finding the namelist, fail with ! an error. if (.not. associated(loop)) then - write(log_scratch_space, '(A)') & + write(6, '(A)') & 'Instance ' // trim(profile_name) // ' of ' // & 'pot_nml_type ' // & 'not found in configuration.' - call log_event(log_scratch_space, log_level_error) + flush(6) + stop end if ! Otherwise 'cast' to a pot_namelist_type 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 2a4164c97..9f6588cad 100644 --- a/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 +++ b/infrastructure/build/tools/configurator/tests/configuration_loader/content_mod.f90 @@ -9,7 +9,6 @@ module content_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 @@ -57,10 +56,11 @@ subroutine read_configuration( filename, configuration, config ) 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) + write(6,'(A)') & + 'At least one optional argument must ' //& + 'be provided for read_configuration.' + flush(6) + stop end if local_rank = global_mpi%get_comm_rank() @@ -167,17 +167,19 @@ function ensure_configuration( names, success_mask ) logical(l_def), optional, intent(out) :: success_mask(:) logical(l_def) :: ensure_configuration - integer(i_def) :: i - logical :: configuration_found = .True. + 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 ) + write(6, '(A)') & + 'Arguments "names" and "success_mask" to function' //& + '"ensure_configuration" are different shapes.' + flush(6) + stop end if - ensure_configuration = .True. + ensure_configuration = .true. name_loop: do i = 1, size(names) select case(trim( names(i) )) @@ -185,10 +187,11 @@ function ensure_configuration( names, success_mask ) configuration_found = foo_is_loaded() case default - write( log_scratch_space, '(A)' ) & - 'Tried to ensure unrecognised namelist "'// & + write(6, '(A)') & + 'Tried to ensure unrecognised namelist "' //& trim(names(i))//'" was loaded.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) + flush(6) + stop end select ensure_configuration = ensure_configuration .and. configuration_found @@ -254,17 +257,19 @@ subroutine read_configuration_namelists( unit, local_rank, & end if else - write( log_scratch_space, '(A)' ) & - 'Namelist "'//trim(namelists(i))// & + write(6, '(A)') & + 'Namelist "'//trim(namelists(i)) //& '" can not be read. Too many instances?' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) + flush(6) + stop end if case default - write( log_scratch_space, '(A)' ) & - 'Unrecognised namelist "'//trim(namelists(i))// & + write(6, '(A)') & + 'Unrecognised namelist "'//trim(namelists(i)) //& '" found in file '//trim(filename)//'.' - call log_event( log_scratch_space, LOG_LEVEL_ERROR ) + flush(6) + stop end select end do ! Namelists diff --git a/mesh_tools/source/cubedsphere_mesh_generator.f90 b/mesh_tools/source/cubedsphere_mesh_generator.f90 index 6447f856b..9e13f2174 100644 --- a/mesh_tools/source/cubedsphere_mesh_generator.f90 +++ b/mesh_tools/source/cubedsphere_mesh_generator.f90 @@ -40,8 +40,6 @@ program cubedsphere_mesh_generator log_scratch_space, log_level_info, & log_level_error, log_level_warning - use namelist_collection_mod, only: namelist_collection_type - use ncdf_quad_mod, only: ncdf_quad_type use omp_lib, only: omp_get_thread_num use partition_mod, only: partition_type, & @@ -135,7 +133,6 @@ program cubedsphere_mesh_generator integer(i_def) :: i, j, k, l, n_voids type(config_type), save :: config - type(namelist_collection_type), save :: configuration ! Configuration variables to obtain from configuration. character(str_max_filename) :: mesh_file_prefix @@ -192,15 +189,12 @@ program cubedsphere_mesh_generator total_ranks = global_mpi%get_comm_size() local_rank = global_mpi%get_comm_rank() - call initialise_logging( communicator%get_comm_mpi_val(), 'CubeGen' ) - call configuration%initialise( 'CubeGen', table_len=10 ) - call config%initialise( 'CubeGen' ) - call read_configuration( filename, & - configuration=configuration, & - config=config ) + call config%initialise( 'CubeGen' ) + call read_configuration( filename, config=config ) + call initialise_logging( communicator%get_comm_mpi_val(), 'CubeGen' ) deallocate( filename ) mesh_file_prefix = config%mesh%mesh_file_prefix() diff --git a/mesh_tools/source/planar_mesh_generator.f90 b/mesh_tools/source/planar_mesh_generator.f90 index 6ac208821..80bd9f604 100644 --- a/mesh_tools/source/planar_mesh_generator.f90 +++ b/mesh_tools/source/planar_mesh_generator.f90 @@ -41,7 +41,6 @@ program planar_mesh_generator log_scratch_space, LOG_LEVEL_INFO, & LOG_LEVEL_ERROR - use namelist_collection_mod, only: namelist_collection_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,7 +137,6 @@ program planar_mesh_generator ! Configuration variables type(config_type), save :: config - type(namelist_collection_type), save :: configuration character(str_max_filename) :: mesh_file_prefix @@ -211,12 +209,9 @@ program planar_mesh_generator local_rank = global_mpi%get_comm_rank() call initialise_logging( communicator%get_comm_mpi_val(), "PlanarGen" ) - call configuration%initialise( 'PlanarGen', table_len=10 ) call config%initialise( 'PlanarGen' ) - call read_configuration( filename, & - configuration=configuration, & - config=config ) + call read_configuration( filename, config=config ) deallocate( filename )